| 1 | ;; Description: |
| 2 | ;; Javascript html generator |
| 3 | |
| 4 | (in-package :parenscript) |
| 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 | |
| 44 | (loop with attrs = (cdar form) |
| 45 | while attrs |
| 46 | for attr-name = (pop attrs) |
| 47 | for attr-test = (when (not (keywordp attr-name)) |
| 48 | (let ((test attr-name)) |
| 49 | (setf attr-name (pop attrs)) |
| 50 | test)) |
| 51 | for attr-val = (pop attrs) |
| 52 | do |
| 53 | (if attr-test |
| 54 | (push `(if ,attr-test |
| 55 | (+ ,(format nil " ~A=\"" (string-downcase (symbol-name attr-name))) |
| 56 | ,attr-val |
| 57 | "\"") |
| 58 | "") |
| 59 | res) |
| 60 | (progn |
| 61 | (push (format nil " ~A=\"" (string-downcase (symbol-name attr-name))) |
| 62 | res) |
| 63 | (push attr-val res) |
| 64 | (push "\"" res)))) |
| 65 | (push ">" res) |
| 66 | (map nil #'handle-form (cdr form)) |
| 67 | (push (format nil "</~A>" node-name) res))) |
| 68 | |
| 69 | ((consp form) |
| 70 | (push form res))))) |
| 71 | (map nil #'handle-form forms)) |
| 72 | (cons '+ (optimize-string-list (nreverse res))))) |
| 73 | |
| 74 | (define-ps-special-form html (expecting &rest forms) |
| 75 | (compile-parenscript-form (process-html-forms forms))) |
| 76 | |
| 77 | (defun process-css-forms (proplist) |
| 78 | (optimize-string-list (butlast |
| 79 | (loop for propval on proplist by #'cddr appending |
| 80 | (list (string-downcase (symbol-name (first propval))) |
| 81 | ":" |
| 82 | (second propval) |
| 83 | ";"))))) |
| 84 | |
| 85 | |
| 86 | (define-ps-special-form css-inline (expecting &rest forms) |
| 87 | (compile-parenscript-form (cons '+ (process-css-forms forms)))) |