| 1 | ;; Description: |
| 2 | ;; Javascript html generator |
| 3 | |
| 4 | (in-package :js) |
| 5 | |
| 6 | (defun optimize-string-list (list) |
| 7 | (let (res |
| 8 | cur) |
| 9 | (dolist (node list) |
| 10 | (when (numberp node) |
| 11 | (setf node (format nil "~A" node))) |
| 12 | (cond ((null cur) (setf cur node)) |
| 13 | ((and (stringp cur) |
| 14 | (stringp node)) |
| 15 | (setf cur (concatenate 'string cur node))) |
| 16 | (t (push cur res) |
| 17 | (setf cur node)))) |
| 18 | (push cur res) |
| 19 | (nreverse res))) |
| 20 | |
| 21 | (defun process-html-forms (forms) |
| 22 | (let (res) |
| 23 | (labels ((handle-form (form) |
| 24 | (cond ((keywordp form) |
| 25 | (push (format nil "<~A/>" |
| 26 | (string-downcase (symbol-name form))) res)) |
| 27 | |
| 28 | ((atom form) |
| 29 | (push form res)) |
| 30 | |
| 31 | ((and (consp form) |
| 32 | (keywordp (first form))) |
| 33 | (let ((node-name (string-downcase (symbol-name (first form))))) |
| 34 | (push (format nil "<~A>" node-name) res) |
| 35 | (map nil #'handle-form (cdr form)) |
| 36 | (push (format nil "</~A>" node-name) res))) |
| 37 | |
| 38 | ((and (consp form) |
| 39 | (consp (first form)) |
| 40 | (keywordp (caar form))) |
| 41 | (let ((node-name (string-downcase (symbol-name (caar form))))) |
| 42 | (push (format nil "<~A" node-name) res) |
| 43 | (loop for (attr-name attr-val) on (cdar form) by #'cddr |
| 44 | do (unless (keywordp attr-name) |
| 45 | (error "~A is not a node attribute" attr-name)) |
| 46 | (push (format nil " ~A=\"" (string-downcase (symbol-name attr-name))) |
| 47 | res) |
| 48 | (push attr-val res) |
| 49 | (push "\"" res)) |
| 50 | (push ">" res) |
| 51 | (map nil #'handle-form (cdr form)) |
| 52 | (push (format nil "</~A>" node-name) res))) |
| 53 | |
| 54 | ((consp form) |
| 55 | (push form res))))) |
| 56 | (map nil #'handle-form forms)) |
| 57 | (cons '+ (optimize-string-list (nreverse res))))) |
| 58 | |
| 59 | (define-js-compiler-macro html (&rest forms) |
| 60 | (js-compile (process-html-forms forms))) |