From 00599f0751b3d3b204863e1abf0f285d814f8ca4 Mon Sep 17 00:00:00 2001
From: Marcus Kammer <marcus.kammer@mailbox.org>
Date: Sat, 22 Jun 2024 20:24:00 +0200
Subject: [PATCH] Re-write with-form macro

---
 src/app.lisp                    |  2 ++
 src/handlers/questionnaire.lisp |  2 +-
 src/package.lisp                |  1 +
 src/views/main.lisp             | 53 ---------------------------------
 src/views/package.lisp          |  6 ++--
 src/views/sus.lisp              | 17 ++++++-----
 6 files changed, 18 insertions(+), 63 deletions(-)

diff --git a/src/app.lisp b/src/app.lisp
index d4d09b8..e6ef6dc 100644
--- a/src/app.lisp
+++ b/src/app.lisp
@@ -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))))
 
diff --git a/src/handlers/questionnaire.lisp b/src/handlers/questionnaire.lisp
index 5a65e02..198f01c 100644
--- a/src/handlers/questionnaire.lisp
+++ b/src/handlers/questionnaire.lisp
@@ -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)
diff --git a/src/package.lisp b/src/package.lisp
index 45995c1..180c736 100644
--- a/src/package.lisp
+++ b/src/package.lisp
@@ -3,6 +3,7 @@
   (:import-from #:hunchentoot
                 #:easy-acceptor)
   (:export
+   #:*html-lang*
    #:survey
    #:survey-id
    #:survey-data-dir-p
diff --git a/src/views/main.lisp b/src/views/main.lisp
index c960997..de42d4a 100644
--- a/src/views/main.lisp
+++ b/src/views/main.lisp
@@ -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))))))
diff --git a/src/views/package.lisp b/src/views/package.lisp
index 519b35b..e664990 100644
--- a/src/views/package.lisp
+++ b/src/views/package.lisp
@@ -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)
diff --git a/src/views/sus.lisp b/src/views/sus.lisp
index 5ac1b32..e29ab35 100644
--- a/src/views/sus.lisp
+++ b/src/views/sus.lisp
@@ -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"))))