Re-write with-form macro
This commit is contained in:
parent
11ea452104
commit
00599f0751
6 changed files with 18 additions and 63 deletions
|
@ -1,5 +1,7 @@
|
||||||
(in-package :ml-survey)
|
(in-package :ml-survey)
|
||||||
|
|
||||||
|
(defparameter *html-lang* "en")
|
||||||
|
|
||||||
(defun set-default-directory (directory)
|
(defun set-default-directory (directory)
|
||||||
(setf *default-pathname-defaults* (truename (merge-pathnames directory))))
|
(setf *default-pathname-defaults* (truename (merge-pathnames directory))))
|
||||||
|
|
||||||
|
|
|
@ -13,7 +13,7 @@
|
||||||
|
|
||||||
(defun process-questionnaire-get (lang)
|
(defun process-questionnaire-get (lang)
|
||||||
(check-type lang string)
|
(check-type lang string)
|
||||||
(setf spinneret:*html-lang* lang)
|
(setf ml-survey:*html-lang* lang)
|
||||||
(ml-survey/views:sus-form))
|
(ml-survey/views:sus-form))
|
||||||
|
|
||||||
(defun process-questionnaire-post (request survey)
|
(defun process-questionnaire-post (request survey)
|
||||||
|
|
|
@ -3,6 +3,7 @@
|
||||||
(:import-from #:hunchentoot
|
(:import-from #:hunchentoot
|
||||||
#:easy-acceptor)
|
#:easy-acceptor)
|
||||||
(:export
|
(:export
|
||||||
|
#:*html-lang*
|
||||||
#:survey
|
#:survey
|
||||||
#:survey-id
|
#:survey-id
|
||||||
#:survey-data-dir-p
|
#:survey-data-dir-p
|
||||||
|
|
|
@ -1,56 +1,3 @@
|
||||||
(in-package :ml-survey/views)
|
(in-package :ml-survey/views)
|
||||||
|
|
||||||
(defparameter *use-cdn* nil)
|
(defparameter *use-cdn* nil)
|
||||||
|
|
||||||
(defmacro with-form ((&key
|
|
||||||
meta
|
|
||||||
(title "Web page")
|
|
||||||
add-css-urls
|
|
||||||
add-js-urls)
|
|
||||||
&body body)
|
|
||||||
"This macro simplifies the process of creating an HTML web page.
|
|
||||||
|
|
||||||
META: The meta-information for the web page.
|
|
||||||
|
|
||||||
TITLE: Specifies the title of the web page. Defaults to 'Web page'.
|
|
||||||
|
|
||||||
MAIN-CON: If t add css class `container` to <main>.
|
|
||||||
|
|
||||||
ADD-CSS-URLS: An optional parameter for additional CSS file URLs.
|
|
||||||
|
|
||||||
ADD-JS-URLS: An optional parameter for additional JavaScript file URLs.
|
|
||||||
|
|
||||||
BODY: Denotes the markup for the body of the web page.
|
|
||||||
|
|
||||||
Example usage:
|
|
||||||
(with-form (:meta (:author \"John Doe\") :title \"My Page\") \"foo\")"
|
|
||||||
`(spinneret:with-html-string
|
|
||||||
(:doctype)
|
|
||||||
(:html :data-bs-theme ,dev.metalisp.sbt:*color-theme*
|
|
||||||
(:head (:meta :charset "utf-8")
|
|
||||||
(:meta :name "viewport"
|
|
||||||
:content "width=device-width, initial-scale=1")
|
|
||||||
,@(loop for (key value) on meta by #'cddr
|
|
||||||
collect `(:meta :name
|
|
||||||
,(string-downcase (symbol-name key))
|
|
||||||
:content ,(getf meta key)))
|
|
||||||
|
|
||||||
(:title ,title)
|
|
||||||
|
|
||||||
(:link :type "text/css" :rel "stylesheet" :href ,(dev.metalisp.sbt:bs-url-css))
|
|
||||||
,@(loop for url in add-css-urls
|
|
||||||
collect `(:link :type "text/css"
|
|
||||||
:rel "stylesheet" :href ,url)))
|
|
||||||
|
|
||||||
(:body
|
|
||||||
|
|
||||||
(:div :class "container text-center py-3"
|
|
||||||
(:a :href "#main-content"
|
|
||||||
:class "skip-link"
|
|
||||||
(find-l10n "skip-link" spinneret:*html-lang* *l10n*)))
|
|
||||||
|
|
||||||
,@body
|
|
||||||
|
|
||||||
(:script :src ,(dev.metalisp.sbt:bs-url-js))
|
|
||||||
,@(loop for url in add-js-urls
|
|
||||||
collect `(:script :src ,url))))))
|
|
||||||
|
|
|
@ -1,5 +1,7 @@
|
||||||
(defpackage ml-survey/views
|
(defpackage ml-survey/views
|
||||||
(:use #:cl)
|
(:use #:cl)
|
||||||
|
(:import-from #:hunchentoot
|
||||||
|
#:request-uri*)
|
||||||
(:import-from #:spinneret
|
(:import-from #:spinneret
|
||||||
#:*html*)
|
#:*html*)
|
||||||
(:import-from #:dev.metalisp.sbt
|
(:import-from #:dev.metalisp.sbt
|
||||||
|
@ -7,8 +9,8 @@
|
||||||
#:*l10n*
|
#:*l10n*
|
||||||
#:*use-cdn*
|
#:*use-cdn*
|
||||||
#:with-page
|
#:with-page
|
||||||
#:body-header
|
#:body-header
|
||||||
#:body-main)
|
#:body-main)
|
||||||
(:import-from #:dev.metalisp.sbt/btn
|
(:import-from #:dev.metalisp.sbt/btn
|
||||||
#:btn
|
#:btn
|
||||||
#:btn-primary)
|
#:btn-primary)
|
||||||
|
|
|
@ -12,16 +12,19 @@
|
||||||
(load form-path))
|
(load form-path))
|
||||||
nil)
|
nil)
|
||||||
|
|
||||||
(defun sus-form ()
|
(defmacro with-form (&body body)
|
||||||
(with-form (:title "SUS Form")
|
`(spinneret:with-html
|
||||||
(:main :id "main-content"
|
(:main :id "main-content"
|
||||||
:class "container my-5"
|
:class "container my-5"
|
||||||
(:h1 "Usability Feedback Form")
|
|
||||||
(:p "Please fill out the following forms and press the submit button.")
|
(:p "Please fill out the following forms and press the submit button.")
|
||||||
(:form :action (hunchentoot:request-uri*)
|
(:form :action (request-uri*)
|
||||||
:method "post"
|
:method "post"
|
||||||
:class (spacing :property "m" :side "y" :size 5)
|
:class (spacing :property "m" :side "y" :size 5)
|
||||||
;; load the multi-form from disk
|
,@body
|
||||||
(load-form spinneret:*html-lang* "sus.lisp")
|
|
||||||
(btn-primary (:type "submit")
|
(btn-primary (:type "submit")
|
||||||
(find-l10n "submit" spinneret:*html-lang* *l10n*))))))
|
(find-l10n "submit" ml-survey:*html-lang* *l10n*))))))
|
||||||
|
|
||||||
|
(defun sus-form ()
|
||||||
|
(with-page (:title "SUS Form")
|
||||||
|
(body-header "System Usability Form")
|
||||||
|
(with-form (load-form ml-survey:*html-lang* "sus.lisp"))))
|
||||||
|
|
Loading…
Add table
Reference in a new issue