src/lib/js-html.lisp

   1 ;;; Macros for generating HTML from ParenScript code.
   2
   3 (in-package :parenscript)
   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)
  23                (cond ((keywordp form)
  24                       (push (format nil "<~A/>"
  25                                     (string-downcase (symbol-name form))) res))
  26
  27                      ((atom form)
  28                       (push form res))
  29
  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)))
  36
  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)
  42
  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)))))
  70       (map nil #'handle-form forms))
  71     (cons '+ (optimize-string-list (nreverse res)))))
  72
  73 (define-ps-special-form ps-html (expecting &rest forms)
  74   (compile-parenscript-form (process-html-forms forms)))
  75
  76 (defun process-css-forms (proplist)
  77   (optimize-string-list (butlast
  78                          (loop for propval on proplist by #'cddr appending
  79                               (list (string-downcase (symbol-name (first propval)))
  80                                     ":"
  81                                     (second propval)
  82                                     ";")))))
  83
  84
  85 (define-ps-special-form css-inline (expecting &rest forms)
  86   (compile-parenscript-form (cons '+ (process-css-forms forms))))