diff --git a/test/test-web.lisp b/test/test-web.lisp index db7fde6..89164f5 100644 --- a/test/test-web.lisp +++ b/test/test-web.lisp @@ -36,10 +36,10 @@ (t:show-result)))) (deftest test-dom () - (== (dom:render + (== (dom:rndr (dom:link '(:href "https://example.com" :title "Demo" :class (:demo-link :plain)) - (dom:text "Link to example.com"))) + "Link to example.com")) "Link to example.com")) (deftest test-server-config (server) diff --git a/web/dom.lisp b/web/dom.lisp index 39ca696..00d14c3 100644 --- a/web/dom.lisp +++ b/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 (:use :common-lisp) (:local-nicknames (:util :scopes/util) (:alx :alexandria)) - (:export #:render #:text + (:export #:render #:text #:rndr #:dl #:link)) (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)) +(defun rndr (&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 put-string (s) - `(write-string ,s *output*)) - -(defmacro put-char (c) - `(write-char ,c *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*)) + +(defun put-char (c) + (write-char c *output*)) + (defun put-attrs (plist) (loop for (key val . r) on plist by #'cddr do (put-char #\Space) @@ -56,25 +107,22 @@ (put-string tag) (put-char #\>)) -(defun text (s) - (put-string (string s))) - (defun newline () (put-char #\Newline)) ;;;; tag-specific renderers -(defun dl (attrs plist) +(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 dd (attrs v) +(defun xdd (attrs v) (if (atom v) (setf v (list v))) (dolist (el v) (element "dd" attrs (text el)))) - -(defmacro link (attrs &body body) - `(element "a" ,attrs ,@body)) diff --git a/web/response.lisp b/web/response.lisp index 1dafdde..a50b360 100644 --- a/web/response.lisp +++ b/web/response.lisp @@ -28,7 +28,7 @@ ((ctype :initform "text/html"))) (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