web/dom: now with creating an intermediate structure (basically working)
This commit is contained in:
parent
ae7545d5ce
commit
a00f7c652d
3 changed files with 68 additions and 20 deletions
|
@ -36,10 +36,10 @@
|
||||||
(t:show-result))))
|
(t:show-result))))
|
||||||
|
|
||||||
(deftest test-dom ()
|
(deftest test-dom ()
|
||||||
(== (dom:render
|
(== (dom:rndr
|
||||||
(dom:link '(:href "https://example.com"
|
(dom:link '(:href "https://example.com"
|
||||||
:title "Demo" :class (:demo-link :plain))
|
:title "Demo" :class (:demo-link :plain))
|
||||||
(dom:text "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>"))
|
||||||
|
|
||||||
(deftest test-server-config (server)
|
(deftest test-server-config (server)
|
||||||
|
|
82
web/dom.lisp
82
web/dom.lisp
|
@ -1,35 +1,86 @@
|
||||||
;;;; cl-scopes/web/dom - "Data Output Model" = simple and dedicated HTML generator
|
;;;; cl-scopes/web/dom - "Data Output Method" = simple and dedicated HTML generator
|
||||||
|
|
||||||
(defpackage :scopes/web/dom
|
(defpackage :scopes/web/dom
|
||||||
(:use :common-lisp)
|
(:use :common-lisp)
|
||||||
(:local-nicknames (:util :scopes/util)
|
(:local-nicknames (:util :scopes/util)
|
||||||
(:alx :alexandria))
|
(:alx :alexandria))
|
||||||
(:export #:render #:text
|
(:export #:render #:text #:rndr
|
||||||
#:dl #:link))
|
#:dl #:link))
|
||||||
|
|
||||||
(in-package :scopes/web/dom)
|
(in-package :scopes/web/dom)
|
||||||
|
|
||||||
;;;; basic / common stuff
|
;;;; using classes...
|
||||||
|
|
||||||
|
(defgeneric put (s)
|
||||||
|
(:method ((s string))
|
||||||
|
(put-string s)))
|
||||||
|
|
||||||
|
(defclass element ()
|
||||||
|
((tag :reader tag :initarg :tag)
|
||||||
|
(attrs :reader attrs :initarg :attrs)
|
||||||
|
(content :reader content :initarg :content)))
|
||||||
|
|
||||||
|
(defmethod print-object ((el element) stream)
|
||||||
|
(format stream "<~a ~s>~s" (tag el) (attrs el) (content el)))
|
||||||
|
|
||||||
|
(defmethod put ((el element))
|
||||||
|
(start (tag el) (attrs el))
|
||||||
|
(dolist (c (content 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 content)
|
||||||
|
(elem "a" attrs content))
|
||||||
|
|
||||||
|
(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 dds (attrs body)
|
||||||
|
(if (atom body)
|
||||||
|
(list (dd nil body))
|
||||||
|
(mapcar #'(lambda (x) (dd nil x)) body )))
|
||||||
|
|
||||||
|
(defun dd (attrs &rest body)
|
||||||
|
(elem "dd" attrs body))
|
||||||
|
|
||||||
|
;;;; rendering
|
||||||
|
|
||||||
(defvar *output* (make-string-output-stream))
|
(defvar *output* (make-string-output-stream))
|
||||||
|
|
||||||
|
(defun rndr (&rest elems)
|
||||||
|
(let ((*output* (make-string-output-stream)))
|
||||||
|
(dolist (el elems)
|
||||||
|
(put el))
|
||||||
|
(get-output-stream-string *output*)))
|
||||||
|
|
||||||
(defmacro render (&body body)
|
(defmacro render (&body body)
|
||||||
`(let ((*output* (make-string-output-stream)))
|
`(let ((*output* (make-string-output-stream)))
|
||||||
,@body
|
,@body
|
||||||
(get-output-stream-string *output*)))
|
(get-output-stream-string *output*)))
|
||||||
|
|
||||||
(defmacro put-string (s)
|
|
||||||
`(write-string ,s *output*))
|
|
||||||
|
|
||||||
(defmacro put-char (c)
|
|
||||||
`(write-char ,c *output*))
|
|
||||||
|
|
||||||
(defmacro element (tag attrs &body body)
|
(defmacro element (tag attrs &body body)
|
||||||
`(progn
|
`(progn
|
||||||
(start ,tag ,attrs)
|
(start ,tag ,attrs)
|
||||||
,@body
|
,@body
|
||||||
(end ,tag)))
|
(end ,tag)))
|
||||||
|
|
||||||
|
(defmacro text (s)
|
||||||
|
`(put-string (string ,s)))
|
||||||
|
|
||||||
|
(defun put-string (s)
|
||||||
|
(write-string s *output*))
|
||||||
|
|
||||||
|
(defun put-char (c)
|
||||||
|
(write-char c *output*))
|
||||||
|
|
||||||
(defun put-attrs (plist)
|
(defun put-attrs (plist)
|
||||||
(loop for (key val . r) on plist by #'cddr do
|
(loop for (key val . r) on plist by #'cddr do
|
||||||
(put-char #\Space)
|
(put-char #\Space)
|
||||||
|
@ -56,25 +107,22 @@
|
||||||
(put-string tag)
|
(put-string tag)
|
||||||
(put-char #\>))
|
(put-char #\>))
|
||||||
|
|
||||||
(defun text (s)
|
|
||||||
(put-string (string s)))
|
|
||||||
|
|
||||||
(defun newline ()
|
(defun newline ()
|
||||||
(put-char #\Newline))
|
(put-char #\Newline))
|
||||||
|
|
||||||
;;;; tag-specific renderers
|
;;;; tag-specific renderers
|
||||||
|
|
||||||
(defun dl (attrs plist)
|
(defmacro xlink (attrs &rest body)
|
||||||
|
`(element "a" ,attrs ,@body))
|
||||||
|
|
||||||
|
(defun xdl (attrs plist)
|
||||||
(element "dl" attrs
|
(element "dl" attrs
|
||||||
(loop for (key val . r) on plist by #'cddr do
|
(loop for (key val . r) on plist by #'cddr do
|
||||||
(element "dt" nil (put-string (string-downcase key)))
|
(element "dt" nil (put-string (string-downcase key)))
|
||||||
(dd nil val))))
|
(dd nil val))))
|
||||||
|
|
||||||
(defun dd (attrs v)
|
(defun xdd (attrs v)
|
||||||
(if (atom v)
|
(if (atom v)
|
||||||
(setf v (list v)))
|
(setf v (list v)))
|
||||||
(dolist (el v)
|
(dolist (el v)
|
||||||
(element "dd" attrs (text el))))
|
(element "dd" attrs (text el))))
|
||||||
|
|
||||||
(defmacro link (attrs &body body)
|
|
||||||
`(element "a" ,attrs ,@body))
|
|
||||||
|
|
|
@ -28,7 +28,7 @@
|
||||||
((ctype :initform "text/html")))
|
((ctype :initform "text/html")))
|
||||||
|
|
||||||
(defmethod render-content ((resp html-response) msg)
|
(defmethod render-content ((resp html-response) msg)
|
||||||
(dom:render (dom:dl nil (message:data msg))))
|
(dom:rndr (dom:dl nil (message:data msg))))
|
||||||
|
|
||||||
;;;; common definitions
|
;;;; common definitions
|
||||||
|
|
||||||
|
|
Loading…
Add table
Reference in a new issue