Commit | Line | Data |
---|---|---|
d31d0bc7 | 1 | ;;; Macros for generating HTML from ParenScript code. |
8e198a08 | 2 | |
97eb9b75 | 3 | (in-package :parenscript) |
8e198a08 MB |
4 | |
5 | (defun optimize-string-list (list) | |
6 | (let (res | |
7 | cur) | |
8 | (dolist (node list) | |
9 | (when (numberp node) | |
10 | (setf node (format nil "~A" node))) | |
11 | (cond ((null cur) (setf cur node)) | |
12 | ((and (stringp cur) | |
13 | (stringp node)) | |
14 | (setf cur (concatenate 'string cur node))) | |
15 | (t (push cur res) | |
16 | (setf cur node)))) | |
17 | (push cur res) | |
18 | (nreverse res))) | |
19 | ||
20 | (defun process-html-forms (forms) | |
21 | (let (res) | |
22 | (labels ((handle-form (form) | |
7abef5d4 HH |
23 | (cond ((keywordp form) |
24 | (push (format nil "<~A/>" | |
25 | (string-downcase (symbol-name form))) res)) | |
551080b7 | 26 | |
7abef5d4 HH |
27 | ((atom form) |
28 | (push form res)) | |
8e198a08 | 29 | |
7abef5d4 HH |
30 | ((and (consp form) |
31 | (keywordp (first form))) | |
32 | (let ((node-name (string-downcase (symbol-name (first form))))) | |
33 | (push (format nil "<~A>" node-name) res) | |
34 | (map nil #'handle-form (cdr form)) | |
35 | (push (format nil "</~A>" node-name) res))) | |
551080b7 | 36 | |
7abef5d4 HH |
37 | ((and (consp form) |
38 | (consp (first form)) | |
39 | (keywordp (caar form))) | |
40 | (let ((node-name (string-downcase (symbol-name (caar form))))) | |
41 | (push (format nil "<~A" node-name) res) | |
8e198a08 | 42 | |
7abef5d4 HH |
43 | (loop with attrs = (cdar form) |
44 | while attrs | |
45 | for attr-name = (pop attrs) | |
46 | for attr-test = (when (not (keywordp attr-name)) | |
47 | (let ((test attr-name)) | |
48 | (setf attr-name (pop attrs)) | |
49 | test)) | |
50 | for attr-val = (pop attrs) | |
51 | do | |
52 | (if attr-test | |
53 | (push `(if ,attr-test | |
54 | (+ ,(format nil " ~A=\"" (string-downcase (symbol-name attr-name))) | |
55 | ,attr-val | |
56 | "\"") | |
57 | "") | |
58 | res) | |
59 | (progn | |
60 | (push (format nil " ~A=\"" (string-downcase (symbol-name attr-name))) | |
61 | res) | |
62 | (push attr-val res) | |
63 | (push "\"" res)))) | |
64 | (push ">" res) | |
65 | (map nil #'handle-form (cdr form)) | |
66 | (push (format nil "</~A>" node-name) res))) | |
67 | ||
68 | ((consp form) | |
69 | (push form res))))) | |
8e198a08 MB |
70 | (map nil #'handle-form forms)) |
71 | (cons '+ (optimize-string-list (nreverse res))))) | |
72 | ||
d31d0bc7 | 73 | (define-ps-special-form ps-html (expecting &rest forms) |
4a987e2b | 74 | (compile-parenscript-form (process-html-forms forms))) |
28967ee4 | 75 | |
4a987e2b | 76 | (defun process-css-forms (proplist) |
28967ee4 HH |
77 | (optimize-string-list (butlast |
78 | (loop for propval on proplist by #'cddr appending | |
4a987e2b | 79 | (list (string-downcase (symbol-name (first propval))) |
28967ee4 HH |
80 | ":" |
81 | (second propval) | |
82 | ";"))))) | |
83 | ||
84 | ||
4a987e2b VS |
85 | (define-ps-special-form css-inline (expecting &rest forms) |
86 | (compile-parenscript-form (cons '+ (process-css-forms forms)))) |