src/lib/ps-html.lisp

   1 (in-package :parenscript)
   2
   3 (defun process-html-forms (forms) ; this needs a rewrite
   4   (let ((res ()))
   5     (labels ((handle-form (form)
   6                (cond ((keywordp form)
   7                       (push (format nil "<~A/>"
   8                                     (string-downcase (symbol-name form))) res))
   9
  10                      ((atom form)
  11                       (push form res))
  12
  13                      ((and (consp form)
  14                            (keywordp (first form)))
  15                       (let ((node-name (string-downcase (symbol-name (first form)))))
  16                         (push (format nil "<~A>" node-name) res)
  17                         (map nil #'handle-form (cdr form))
  18                         (push (format nil "</~A>" node-name) res)))
  19
  20                      ((and (consp form)
  21                            (consp (first form))
  22                            (keywordp (caar form)))
  23                       (let ((node-name (string-downcase (symbol-name (caar form)))))
  24                         (push (format nil "<~A" node-name) res)
  25
  26                         (loop with attrs = (cdar form)
  27                               while attrs
  28                               for attr-name = (pop attrs)
  29                               for attr-test = (when (not (keywordp attr-name))
  30                                                 (let ((test attr-name))
  31                                                   (setf attr-name (pop attrs))
  32                                                   test))
  33                               for attr-val = (pop attrs)
  34                               do
  35                               (if attr-test
  36                                   (push `(if ,attr-test
  37                                           (+ ,(format nil " ~A=\"" (string-downcase (symbol-name attr-name)))
  38                                            ,attr-val
  39                                            "\"")
  40                                           "")
  41                                         res)
  42                                   (progn
  43                                     (push (format nil " ~A=\"" (string-downcase (symbol-name attr-name)))
  44                                           res)
  45                                     (push attr-val res)
  46                                     (push "\"" res))))
  47                         (push ">" res)
  48                         (map nil #'handle-form (cdr form))
  49                         (push (format nil "</~A>" node-name) res)))
  50
  51                      ((consp form)
  52                       (push form res)))))
  53       (map nil #'handle-form forms)
  54       (concat-constant-strings (reverse res)))))
  55
  56 (defpsmacro ps-html (&rest html-forms)
  57   (cons '+ (process-html-forms html-forms)))
  58
  59 (defmacro ps-html (&rest html-forms)
  60   `(format nil "~@{~A~}" ,@(process-html-forms html-forms)))