(defparameter *block-elements*
'(:body :colgroup :dl :fieldset :form :head :html :map :noscript :object
:ol :optgroup :pre :script :select :style :table :tbody :tfoot :thead
:tr :ul))
(defparameter *paragraph-elements*
'(:area :base :blockquote :br :button :caption :col :dd :div :dt :h1
:h2 :h3 :h4 :h5 :h6 :hr :input :li :link :meta :option :p :param
:td :textarea :th :title))
(defparameter *inline-elements*
'(:a :abbr :acronym :address :b :bdo :big :cite :code :del :dfn :em
:i :img :ins :kbd :label :legend :q :samp :small :span :strong :sub
:sup :tt :var))
The functions block-element-p and paragraph-element-p test whether a given tag is a member of the corresponding list.[316]
(defun block-element-p (tag) (find tag *block-elements*))
(defun paragraph-element-p (tag) (find tag *paragraph-elements*))
Two other categorizations with their own predicates are the elements that are always empty, such as br and hr, and the three elements, pre, style, and script, in which whitespace is supposed to be preserved. The former are handled specially when generating regular HTML (in other words, not XHTML) since they're not supposed to have a closing tag. And when emitting the three tags in which whitespace is preserved, you can temporarily turn off indentation so the pretty printer doesn't add any spaces that aren't part of the element's actual contents.
(defparameter *empty-elements*
'(:area :base :br :col :hr :img :input :link :meta :param))
(defparameter *preserve-whitespace-elements* '(:pre :script :style))
(defun empty-element-p (tag) (find tag *empty-elements*))
(defun preserve-whitespace-p (tag) (find tag *preserve-whitespace-elements*))
The last piece of information you need when generating HTML is whether you're generating XHTML since that affects how you emit empty elements.
(defparameter *xhtml* nil)
With all that information, you're ready to process a cons FOO form. You use parse-cons-form to parse the list into three parts, the tag symbol, a possibly empty plist of attribute key/value pairs, and a possibly empty list of body forms. You then emit the opening tag, the body, and the closing tag with the helper functions emit-open-tag, emit-element-body, and emit-close-tag.
(defun process-cons-sexp-html (processor form)
(when (string= *escapes* *attribute-escapes*)
(error "Can't use cons forms in attributes: ~a" form))
(multiple-value-bind (tag attributes body) (parse-cons-form form)
(emit-open-tag processor tag body attributes)
(emit-element-body processor tag body)
(emit-close-tag processor tag body)))
In emit-open-tag you have to call freshline when appropriate and then emit the attributes with emit-attributes. You need to pass the element's body to emit-open-tag so when it's emitting XHTML, it knows whether to finish the tag with /> or >.
(defun emit-open-tag (processor tag body-p attributes)
(when (or (paragraph-element-p tag) (block-element-p tag))
(freshline processor))
(raw-string processor (format nil "<~(~a~)" tag))
(emit-attributes processor attributes)
(raw-string processor (if (and *xhtml* (not body-p)) "/>" ">")))
In emit-attributes the attribute names aren't evaluated since they must be keyword symbols, but you should invoke the top-level process function to evaluate the attribute values, binding *escapes* to *attribute-escapes*. As a convenience for specifying boolean attributes, whose value should be the name of the attribute, if the value is T—not just any true value but actually T—then you replace the value with the name of the attribute.[317]
(defun emit-attributes (processor attributes)
(loop for (k v) on attributes by #'cddr do
(raw-string processor (format nil " ~(~a~)='" k))
(let ((*escapes* *attribute-escapes*))
(process processor (if (eql v t) (string-downcase k) v)))
(raw-string processor "'")))
Emitting the element's body is similar to emitting the attribute values: you can loop through the body calling process to evaluate each form. The rest of the code is dedicated to emitting fresh lines and adjusting the indentation as appropriate for the type of element.
(defun emit-element-body (processor tag body)
(when (block-element-p tag)
(freshline processor)
(indent processor))
(when (preserve-whitespace-p tag) (toggle-indenting processor))
(dolist (item body) (process processor item))
(when (preserve-whitespace-p tag) (toggle-indenting processor))
(when (block-element-p tag)
(unindent processor)
(freshline processor)))
Finally, emit-close-tag, as you'd probably expect, emits the closing tag (unless no closing tag is necessary, such as when the body is empty and you're either emitting XHTML or the element is one of the special empty elements). Regardless of whether you actually emit a close tag, you need to emit a final fresh line for block and paragraph elements.
(defun emit-close-tag (processor tag body-p)
(unless (and (or *xhtml* (empty-element-p tag)) (not body-p))
(raw-string processor (format nil "</~(~a~)>" tag)))
(when (or (paragraph-element-p tag) (block-element-p tag))
(freshline processor)))
The function process is the basic FOO interpreter. To make it a bit easier to use, you can define a function, emit-html, that invokes process, passing it an html-pretty-printer and a form to evaluate. You can define and use a helper function, get-pretty-printer, to get the pretty printer, which returns the current value of *html-pretty-printer* if it's bound; otherwise, it makes a new instance of html-pretty-printer with *html-output* as its output stream.
(defun emit-html (sexp) (process (get-pretty-printer) sexp))
(defun get-pretty-printer ()
(or *html-pretty-printer*
(make-instance
'html-pretty-printer
316
You don't need a predicate for *inline-elements* since you only ever test for block and paragraph elements. I include the parameter here for completeness.
317
While XHTML requires boolean attributes to be notated with their name as the value to indicate a true value, in HTML it's also legal to simply include the name of the attribute with no value, for example, <option selected> rather than <option selected='selected'>. All HTML 4.0-compatible browsers should understand both forms, but some buggy browsers understand only the no-value form for certain attributes. If you need to generate HTML for such browsers, you'll need to hack emit-attributes to emit those attributes a bit differently.