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