ps-html.lisp 2.72 KB
Newer Older
Red Daly's avatar
Red Daly committed
1
(in-package :parenscript)
2

3
(defun process-html-forms (forms) ; this needs a rewrite
4
  (let ((res ()))
5
    (labels ((handle-form (form)
6
7
8
               (cond ((keywordp form)
                      (push (format nil "<~A/>"
                                    (string-downcase (symbol-name form))) res))
9

10
11
                     ((atom form)
                      (push form res))
12

13
14
15
16
17
18
                     ((and (consp form)
                           (keywordp (first form)))
                      (let ((node-name (string-downcase (symbol-name (first form)))))
                        (push (format nil "<~A>" node-name) res)
                        (map nil #'handle-form (cdr form))
                        (push (format nil "</~A>" node-name) res)))
19

20
21
22
23
24
                     ((and (consp form)
                           (consp (first form))
                           (keywordp (caar form)))
                      (let ((node-name (string-downcase (symbol-name (caar form)))))
                        (push (format nil "<~A" node-name) res)
25

26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
                        (loop with attrs = (cdar form)
                              while attrs
                              for attr-name = (pop attrs)
                              for attr-test = (when (not (keywordp attr-name))
                                                (let ((test attr-name))
                                                  (setf attr-name (pop attrs))
                                                  test))
                              for attr-val = (pop attrs)
                              do
                              (if attr-test
                                  (push `(if ,attr-test
                                          (+ ,(format nil " ~A=\"" (string-downcase (symbol-name attr-name)))
                                           ,attr-val
                                           "\"")
                                          "")
                                        res)
                                  (progn 
                                    (push (format nil " ~A=\"" (string-downcase (symbol-name attr-name)))
                                          res)
                                    (push attr-val res)
                                    (push "\"" res))))
                        (push ">" res)
                        (map nil #'handle-form (cdr form))
                        (push (format nil "</~A>" node-name) res)))

                     ((consp form)
                      (push form res)))))
53
54
      (map nil #'handle-form forms)
      (concat-constant-strings (reverse res)))))
55

56
57
(defpsmacro ps-html (&rest html-forms)
  (cons '+ (process-html-forms html-forms)))
Henrik Hjelte's avatar
Henrik Hjelte committed
58

59
60
(defmacro ps-html (&rest html-forms)
  `(format nil "~@{~A~}" ,@(process-html-forms html-forms)))