marcuskammer/dev.metalisp.survey
1
0
Fork 0
Code Issues 9 Pull requests Projects Releases Packages Wiki Activity Actions

Re-write with-form macro

Browse source
This commit is contained in:
Marcus Kammer 2024-06-22 20:24:00 +02:00
parent 11ea452104
commit 00599f0751
Signed by: marcuskammer
GPG key ID: C374817BE285268F
6 changed files with 18 additions and 63 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
src/app.lisp
View file

@ -1,5 +1,7 @@
(in-package :ml-survey)
(defparameter *html-lang* "en")
(defun set-default-directory (directory)
(setf *default-pathname-defaults* (truename (merge-pathnames directory))))

2
src/handlers/questionnaire.lisp
View file

@ -13,7 +13,7 @@
(defun process-questionnaire-get (lang)
(check-type lang string)
(setf spinneret:*html-lang* lang)
(setf ml-survey:*html-lang* lang)
(ml-survey/views:sus-form))
(defun process-questionnaire-post (request survey)

1
src/package.lisp
View file

@ -3,6 +3,7 @@
(:import-from #:hunchentoot
#:easy-acceptor)
(:export
#:*html-lang*
#:survey
#:survey-id
#:survey-data-dir-p

53
src/views/main.lisp
View file

@ -1,56 +1,3 @@
(in-package :ml-survey/views)
(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))))))

6
src/views/package.lisp
View file

@ -1,5 +1,7 @@
(defpackage ml-survey/views
(:use #:cl)
(:import-from #:hunchentoot
#:request-uri*)
(:import-from #:spinneret
#:*html*)
(:import-from #:dev.metalisp.sbt
@ -7,8 +9,8 @@
#:*l10n*
#:*use-cdn*
#:with-page
#:body-header
#:body-main)
#:body-header
#:body-main)
(:import-from #:dev.metalisp.sbt/btn
#:btn
#:btn-primary)

17
src/views/sus.lisp
View file

@ -12,16 +12,19 @@
(load form-path))
nil)
(defun sus-form ()
(with-form (:title "SUS Form")
(defmacro with-form (&body body)
`(spinneret:with-html
(:main :id "main-content"
:class "container my-5"
(:h1 "Usability Feedback Form")
(:p "Please fill out the following forms and press the submit button.")
(:form :action (hunchentoot:request-uri*)
(:form :action (request-uri*)
:method "post"
:class (spacing :property "m" :side "y" :size 5)
;; load the multi-form from disk
(load-form spinneret:*html-lang* "sus.lisp")
,@body
(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"))))