;; $Id: //info.ravenbrook.com/user/ndl/lisp/bcs/simple-xhtml.lisp#3 $

(in-package "CL-USER")

;;                        SIMPLE-XHTML.LISP
;;                     Nick Levine, 2006-04-09
;;
;; The purpose of this document is to demonstrate the power of lisp
;; macros and closures by using them to implement a partial interface
;; to the generation of xhtml.
;;
;; The macro with-xhtml uses a closure to walk the forms (and
;; recursively the subforms) of its body, transforming those forms
;; whose operator are valid xhtml tags into code to spit out the
;; appropriate xhtml.
;;
;; This document is provided "as is", without any express or implied
;; warranty.  In no event will the author be held liable for any
;; damages arising from the use of this document.  You may make and
;; distribute verbatim copies of this document provided that you do
;; not charge a fee for this document or for its distribution.


(defmacro with-xhtml ((stream) &body body)
  (let ((walked-body (walk-form `(html ,@body)
                                (lambda (subform)
                                  (form-write-tags subform stream)))))
    `(with-output-to-string (,stream)
       ,walked-body)))

(defparameter *all-tags*
  '(a abbr acronym address applet area b base basefont bdo big
      blockquote body br button caption center cite code col colgroup
      dd del dfn dir div dl dt em fieldset font form h1 h2 h3 h4 h5 h6
      head hr html i iframe img input ins isindex kbd label legend li
      link map menu meta noframes noscript object ol optgroup option p
      param pre q s samp script select small span strike strong style
      sub sup table tbody td textarea tfoot th thead title tr tt u ul
      var))

(defun form-write-tags (form stream)
  (or (when (listp form)
        (let ((first (first form)))
          (when (find first *all-tags*)
            (let ((tag (string-downcase first)))
              `(progn
                 (format ,stream ,(format nil "<~a>" tag))
                 ,@(collect-subforms (rest form) stream)
                 (format ,stream ,(format nil "</~a>~%" tag)))))))
      form))

(defun collect-subforms (subforms stream)
  (when subforms
    (cons (let ((content (first subforms)))
            (if (listp content)
                content
              `(format ,stream "~a" ,content)))
          (collect-subforms (rest subforms) stream))))

;;;;;;;;;;;; Implementation dependency ;;;;;;;;;;;;

;; Question: in the other example, it didn't matter whether the
;; implementation dependencies came before or after the sample
;; application. In this case, it does matter. Why?

(defun walk-form (form walker)
  (walker:walk-form form ()
                    (lambda (form &rest ignore)
                      (declare (ignore ignore))
                      (funcall walker form))))


;;;;;;;;;;;;;;;;; Example of use ;;;;;;;;;;;;;;;;;;

(defun test-xhtml (title)
  (with-xhtml (stream)
    (let ((capitalized-title (string-capitalize title)))
      (head (title capitalized-title))
      (body (h1 capitalized-title)
            (ul (li (p (format stream "It was the best of ~a, it was the worst of ~a."
                               title title))))))))