web/dom: rewrite with element class OK
This commit is contained in:
parent
a00f7c652d
commit
e33a86d031
3 changed files with 24 additions and 47 deletions
|
@ -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"))
|
||||
|
|
67
web/dom.lisp
67
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))))
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
Loading…
Add table
Reference in a new issue