Commit | Line | Data |
---|---|---|
8e198a08 MB |
1 | ;; Description: |
2 | ;; Javascript html generator | |
3 | ||
97eb9b75 | 4 | (in-package :parenscript) |
8e198a08 MB |
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) | |
7abef5d4 HH |
24 | (cond ((keywordp form) |
25 | (push (format nil "<~A/>" | |
26 | (string-downcase (symbol-name form))) res)) | |
551080b7 | 27 | |
7abef5d4 HH |
28 | ((atom form) |
29 | (push form res)) | |
8e198a08 | 30 | |
7abef5d4 HH |
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))) | |
551080b7 | 37 | |
7abef5d4 HH |
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) | |
8e198a08 | 43 | |
7abef5d4 HH |
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))))) | |
8e198a08 MB |
71 | (map nil #'handle-form forms)) |
72 | (cons '+ (optimize-string-list (nreverse res))))) | |
73 | ||
9da682ca RD |
74 | (define-script-special-form html (&rest forms) |
75 | (compile-script-form (process-html-forms forms))) | |
28967ee4 HH |
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 | ||
9da682ca RD |
86 | (define-script-special-form css-inline (&rest forms) |
87 | (compile-script-form (cons '+ (process-css-forms forms)))) |