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 ()
|
(deftest test-dom ()
|
||||||
(== (dom:render
|
(== (dom:render
|
||||||
(dom:link '(:href "https://example.com"
|
(dom:element :a '(:href "https://example.com"
|
||||||
:title "Demo" :class (:demo-link :plain))
|
:title "Demo" :class (:demo-link :plain))
|
||||||
"Link to example.com"))
|
"Link to example.com"))
|
||||||
"<a href=\"https://example.com\" title=\"Demo\" class=\"demo-link plain\">Link to example.com</a>"))
|
"<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 " "))
|
(defun flatten-str (s &key (with " "))
|
||||||
(str:join with (str:lines s)))
|
(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)
|
(if (atom k)
|
||||||
(format nil "~(~a~)" k)
|
(format nil pattern k)
|
||||||
(str:join sep (mapcar #'(lambda (s) (format nil "~(~a~)" s)) k))))
|
(str:join sep (mapcar #'(lambda (s) (format nil pattern s)) k)))))
|
||||||
|
|
||||||
(defun to-keyword (s)
|
(defun to-keyword (s)
|
||||||
(intern (string-upcase s) :keyword))
|
(intern (string-upcase s) :keyword))
|
||||||
|
|
48
web/dom.lisp
48
web/dom.lisp
|
@ -4,8 +4,8 @@
|
||||||
(:use :common-lisp)
|
(:use :common-lisp)
|
||||||
(:local-nicknames (:util :scopes/util)
|
(:local-nicknames (:util :scopes/util)
|
||||||
(:alx :alexandria))
|
(:alx :alexandria))
|
||||||
(:export #:render
|
(:export #:elem #:element #:render
|
||||||
#:dlist #:dd #:dl #:dt #:link))
|
#:dlist))
|
||||||
|
|
||||||
(in-package :scopes/web/dom)
|
(in-package :scopes/web/dom)
|
||||||
|
|
||||||
|
@ -18,45 +18,35 @@
|
||||||
(defclass element ()
|
(defclass element ()
|
||||||
((tag :reader tag :initarg :tag)
|
((tag :reader tag :initarg :tag)
|
||||||
(attrs :reader attrs :initarg :attrs)
|
(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)
|
(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))
|
(defmethod put ((el element))
|
||||||
(start (tag el) (attrs el))
|
(start (tag el) (attrs el))
|
||||||
(dolist (c (content el))
|
(dolist (c (body el))
|
||||||
(put c))
|
(put c))
|
||||||
(end (tag el)))
|
(end (tag el)))
|
||||||
|
|
||||||
(defun elem (tag attrs content)
|
;;;; elements with specific functionality
|
||||||
(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
|
|
||||||
|
|
||||||
(defun dlist (attrs plist)
|
(defun dlist (attrs plist)
|
||||||
(apply #'dl attrs
|
(elem :dl attrs
|
||||||
(loop for (key val . r) on plist by #'cddr append
|
(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)
|
(defun dds (attrs cont)
|
||||||
(if (atom cont)
|
(if (atom cont)
|
||||||
(list (dd attrs cont))
|
(list (element :dd attrs cont))
|
||||||
(mapcar #'(lambda (x) (dd nil x)) cont)))
|
(mapcar #'(lambda (x) (element :dd nil x)) cont)))
|
||||||
|
|
||||||
;;;; rendering
|
;;;; rendering
|
||||||
|
|
||||||
|
@ -86,8 +76,8 @@
|
||||||
|
|
||||||
(defun attr-str (key val)
|
(defun attr-str (key val)
|
||||||
(case key
|
(case key
|
||||||
((:id :class) (util:to-string val))
|
((:id :class) (util:to-string val :lower-case t))
|
||||||
(t (string val))))
|
(t (util:to-string val))))
|
||||||
|
|
||||||
(defun start (tag &optional attrs)
|
(defun start (tag &optional attrs)
|
||||||
(put-char #\<)
|
(put-char #\<)
|
||||||
|
|
Loading…
Add table
Reference in a new issue