From e33a86d031157e02b929004e650fa48badae6595 Mon Sep 17 00:00:00 2001
From: Helmut Merz <helmutm@cy55.de>
Date: Mon, 15 Jul 2024 17:18:07 +0200
Subject: [PATCH] web/dom: rewrite with element class OK

---
 test/test-web.lisp |  2 +-
 web/dom.lisp       | 67 +++++++++++++++-------------------------------
 web/response.lisp  |  2 +-
 3 files changed, 24 insertions(+), 47 deletions(-)

diff --git a/test/test-web.lisp b/test/test-web.lisp
index 89164f5..5d13a88 100644
--- a/test/test-web.lisp
+++ b/test/test-web.lisp
@@ -36,7 +36,7 @@
       (t:show-result))))
 
 (deftest test-dom ()
-  (== (dom:rndr 
+  (== (dom:render 
         (dom:link '(:href "https://example.com"
                     :title "Demo" :class (:demo-link :plain))
                   "Link to example.com"))
diff --git a/web/dom.lisp b/web/dom.lisp
index 00d14c3..67b0612 100644
--- a/web/dom.lisp
+++ b/web/dom.lisp
@@ -4,12 +4,12 @@
   (:use :common-lisp)
   (:local-nicknames (:util :scopes/util)
                     (:alx :alexandria))
-  (:export #:render #:text #:rndr
-           #:dl #:link))
+  (:export #:render
+           #:dlist #:dd #:dl #:dt #:link))
 
 (in-package :scopes/web/dom)
 
-;;;; using classes...
+;;;; basic definitions
 
 (defgeneric put (s)
   (:method ((s string))
@@ -34,47 +34,40 @@
 
 ;;;; specific tags / elements
 
-(defun link (attrs &rest content)
-  (elem "a" attrs content))
+(defun link (attrs &rest body)
+  (elem "a" attrs body))
 
-(defun dl (attrs plist)
-  (elem "dl" attrs
-    (loop for (key val . r) on plist by #'cddr 
-          append 
-            (cons (elem "dt" nil (list (string-downcase key))) (dds nil val)))))
+(defun dl (attrs &rest body)
+  (elem "dl" attrs body))
 
-(defun dds (attrs body)
-  (if (atom body)
-    (list (dd nil body))
-    (mapcar #'(lambda (x) (dd nil x)) body )))
+(defun dt (attrs &rest body)
+  (elem "dt" attrs body))
 
 (defun dd (attrs &rest body)
   (elem "dd" attrs body))
 
+;;;; slightly higher-level elements with specific functionality
+
+(defun dlist (attrs plist)
+  (apply #'dl attrs
+    (loop for (key val . r) on plist by #'cddr append 
+          (cons (dt nil (string-downcase key)) (dds nil val)))))
+
+(defun dds (attrs cont)
+  (if (atom cont)
+    (list (dd attrs cont))
+    (mapcar #'(lambda (x) (dd nil x)) cont)))
+
 ;;;; rendering
 
 (defvar *output* (make-string-output-stream))
 
-(defun rndr (&rest elems)
+(defun render (&rest elems)
   (let ((*output* (make-string-output-stream)))
     (dolist (el elems)
       (put el))
     (get-output-stream-string *output*)))
 
-(defmacro render (&body body)
-  `(let ((*output* (make-string-output-stream)))
-     ,@body
-     (get-output-stream-string *output*)))
-
-(defmacro element (tag attrs &body body)
-  `(progn
-     (start ,tag ,attrs)
-     ,@body
-     (end ,tag)))
-
-(defmacro text (s)
-  `(put-string (string ,s)))
-
 (defun put-string (s)
   (write-string s *output*))
 
@@ -110,19 +103,3 @@
 (defun newline ()
   (put-char #\Newline))
 
-;;;; tag-specific renderers
-
-(defmacro xlink (attrs &rest body)
-  `(element "a" ,attrs ,@body))
-
-(defun xdl (attrs plist)
-  (element "dl" attrs
-    (loop for (key val . r) on plist by #'cddr do
-      (element "dt" nil (put-string (string-downcase key)))
-      (dd nil val))))
-
-(defun xdd (attrs v)
-  (if (atom v)
-    (setf v (list v)))
-  (dolist (el v)
-    (element "dd" attrs (text el))))
diff --git a/web/response.lisp b/web/response.lisp
index a50b360..ab85b33 100644
--- a/web/response.lisp
+++ b/web/response.lisp
@@ -28,7 +28,7 @@
   ((ctype :initform "text/html")))
 
 (defmethod render-content ((resp html-response) msg)
-  (dom:rndr (dom:dl nil (message:data msg))))
+  (dom:render (dom:dlist nil (message:data msg))))
 
 ;;;; common definitions