web/dom: clean-up, improvements, ...
This commit is contained in:
parent
e33a86d031
commit
a43de69210
3 changed files with 27 additions and 36 deletions
|
@ -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>"))
|
||||
|
|
|
@ -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))
|
||||
|
|
48
web/dom.lisp
48
web/dom.lisp
|
@ -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 #\<)
|
||||
|
|
Loading…
Add table
Reference in a new issue