tests from the reference
[clinton/parenscript.git] / js-html.lisp
CommitLineData
8e198a08
MB
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)))