Peter Siebel - Practical Common Lisp

(loop with str = (get-output-stream-string buf)

for start = 0 then (1+ pos)

for pos = (position #\Newline str :start start)

when (< start (length str))

do (push-op `(:raw-string ,(subseq str start pos) nil) ops)

when pos do (push-op '(:newline) ops)

while pos))

The last step is to translate the ops into the corresponding Common Lisp code. This phase also pays attention to the value of *pretty*. When *pretty*is true, it generates code that invokes the backend generic functions on *html-pretty-printer*, which will be bound to an instance of html-pretty-printer. When *pretty*is NIL , it generates code that writes directly to *html-output*, the stream to which the pretty printer would send its output.

The actual function, generate-code, is trivial.

(defun generate-code (ops)

(loop for op across ops collect (apply #'op->code op)))

All the work is done by methods on the generic function op->codespecializing the opargument with an EQL specializer on the name of the op.

(defgeneric op->code (op &rest operands))

(defmethod op->code ((op (eql :raw-string)) &rest operands)

(destructuring-bind (string check-for-newlines) operands

(if *pretty*

`(raw-string *html-pretty-printer* ,string ,check-for-newlines)

`(write-sequence ,string *html-output*))))

(defmethod op->code ((op (eql :newline)) &rest operands)

(if *pretty*

`(newline *html-pretty-printer*)

`(write-char #\Newline *html-output*)))

(defmethod op->code ((op (eql :freshline)) &rest operands)

(if *pretty*

`(freshline *html-pretty-printer*)

(error "Bad op when not pretty-printing: ~a" op)))

(defmethod op->code ((op (eql :indent)) &rest operands)

(if *pretty*

`(indent *html-pretty-printer*)

(error "Bad op when not pretty-printing: ~a" op)))

(defmethod op->code ((op (eql :unindent)) &rest operands)

(if *pretty*

`(unindent *html-pretty-printer*)

(error "Bad op when not pretty-printing: ~a" op)))

(defmethod op->code ((op (eql :toggle-indenting)) &rest operands)

(if *pretty*

`(toggle-indenting *html-pretty-printer*)

(error "Bad op when not pretty-printing: ~a" op)))

The two most interesting op->codemethods are the ones that generate code for the :embed-valueand :embed-codeops. In the :embed-valuemethod, you can generate slightly different code depending on the value of the escapesoperand since if escapesis NIL , you don't need to generate a call to escape. And when both *pretty*and escapesare NIL , you can generate code that uses PRINC to emit the value directly to the stream.

(defmethod op->code ((op (eql :embed-value)) &rest operands)

(destructuring-bind (value escapes) operands

(if *pretty*

(if escapes

`(raw-string *html-pretty-printer* (escape (princ-to-string ,value) ,escapes) t)

`(raw-string *html-pretty-printer* (princ-to-string ,value) t))

(if escapes

`(write-sequence (escape (princ-to-string ,value) ,escapes) *html-output*)

`(princ ,value *html-output*)))))

Thus, something like this:

HTML> (let ((x 10)) (html (:p x)))

10

NIL

works because htmltranslates (:p x)into something like this:

(progn

(write-sequence "

" *html-output*)

(write-sequence (escape (princ-to-string x) "<>&") *html-output*)

(write-sequence "

When that code replaces the call to htmlin the context of the LET , you get the following:

(let ((x 10))

(progn

(write-sequence "

" *html-output*)

(write-sequence (escape (princ-to-string x) "<>&") *html-output*)

(write-sequence "

and the reference to xin the generated code turns into a reference to the lexical variable from the LET surrounding the htmlform.

The :embed-codemethod, on the other hand, is interesting because it's so trivial. Because processpassed the form to embed-code, which stashed it in the :embed-codeop, all you have to do is pull it out and return it.

(defmethod op->code ((op (eql :embed-code)) &rest operands)

(first operands))

This allows code like this to work:

HTML> (html (:ul (dolist (x '(foo bar baz)) (html (:li x)))))

• FOO
• BAR
• BAZ

NIL

The outer call to htmlexpands into code that does something like this:

(progn

(write-sequence "

" *html-output*)

(dolist (x '(foo bar baz)) (html (:li x)))

(write-sequence "

Then if you expand the call to htmlin the body of the DOLIST , you'll get something like this: