web/dom: clean-up, improvements, ...

This commit is contained in:
Helmut Merz 2024-07-15 19:35:56 +02:00
parent e33a86d031
commit a43de69210
3 changed files with 27 additions and 36 deletions

View file

@ -37,7 +37,7 @@
(deftest test-dom ()
(== (dom:render
(dom:link '(:href "https://example.com"
(dom:element :a '(:href "https://example.com"
:title "Demo" :class (:demo-link :plain))
"Link to example.com"))
"<a href=\"https://example.com\" title=\"Demo\" class=\"demo-link plain\">Link to example.com</a>"))

View file

@ -13,10 +13,11 @@
(defun flatten-str (s &key (with " "))
(str:join with (str:lines s)))
(defun to-string (k &key (sep " "))
(defun to-string (k &key (sep " ") lower-case)
(let ((pattern (if lower-case "~(~a~)" "~a")))
(if (atom k)
(format nil "~(~a~)" k)
(str:join sep (mapcar #'(lambda (s) (format nil "~(~a~)" s)) k))))
(format nil pattern k)
(str:join sep (mapcar #'(lambda (s) (format nil pattern s)) k)))))
(defun to-keyword (s)
(intern (string-upcase s) :keyword))

View file

@ -4,8 +4,8 @@
(:use :common-lisp)
(:local-nicknames (:util :scopes/util)
(:alx :alexandria))
(:export #:render
#:dlist #:dd #:dl #:dt #:link))
(:export #:elem #:element #:render
#:dlist))
(in-package :scopes/web/dom)
@ -18,45 +18,35 @@
(defclass element ()
((tag :reader tag :initarg :tag)
(attrs :reader attrs :initarg :attrs)
(content :reader content :initarg :content)))
(body :reader body :initarg :body)))
(defun elem (tag attrs body)
(make-instance 'element :tag (string-downcase tag)
:attrs attrs :body body))
(defun element (tag attrs &rest body)
(elem tag attrs body))
(defmethod print-object ((el element) stream)
(format stream "<~a ~s>~s" (tag el) (attrs el) (content el)))
(format stream "<~a ~s>~s" (tag el) (attrs el) (body el)))
(defmethod put ((el element))
(start (tag el) (attrs el))
(dolist (c (content el))
(dolist (c (body el))
(put c))
(end (tag el)))
(defun elem (tag attrs content)
(make-instance 'element :tag tag :attrs attrs :content content))
;;;; specific tags / elements
(defun link (attrs &rest body)
(elem "a" attrs body))
(defun dl (attrs &rest body)
(elem "dl" attrs 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
;;;; elements with specific functionality
(defun dlist (attrs plist)
(apply #'dl attrs
(elem :dl attrs
(loop for (key val . r) on plist by #'cddr append
(cons (dt nil (string-downcase key)) (dds nil val)))))
(cons (element :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)))
(list (element :dd attrs cont))
(mapcar #'(lambda (x) (element :dd nil x)) cont)))
;;;; rendering
@ -86,8 +76,8 @@
(defun attr-str (key val)
(case key
((:id :class) (util:to-string val))
(t (string val))))
((:id :class) (util:to-string val :lower-case t))
(t (util:to-string val))))
(defun start (tag &optional attrs)
(put-char #\<)