The Pretty Printer Backend

You can start by defining a class with two slots—one to hold an instance of indenting-printer and one to hold the tab width—the number of spaces you want to increase the indentation for each level of nesting of HTML elements.

(defclass html-pretty-printer ()
  ((printer   :accessor printer   :initarg :printer)
   (tab-width :accessor tab-width :initarg :tab-width :initform 2)))

Now you can implement methods specialized on html-pretty-printer on the eight generic functions that make up the backend interface.

The FOO processors use the raw-string function to emit strings that don’t need character escaping, either because you actually want to emit normally reserved characters or because all reserved characters have already been escaped. Usually raw-string is invoked with strings that don’t contain newlines, so the default behavior is to use emit/no-newlines unless the caller specifies a non-**NIL** newlines-p argument.

(defmethod raw-string ((pp html-pretty-printer) string &optional newlines-p)
  (if newlines-p
    (emit (printer pp) string)
    (emit/no-newlines (printer pp) string)))

The functions newline, freshline, indent, unindent, and toggle-indenting implement fairly straightforward manipulations of the underlying indenting-printer. The only wrinkle is that the HTML pretty printer generates pretty output only when the dynamic variable *pretty* is true. When it’s **NIL**, you should generate compact HTML with no unnecessary whitespace. So, these methods, with the exception of newline, all check *pretty* before doing anything:5

(defmethod newline ((pp html-pretty-printer))
  (emit-newline (printer pp)))
(defmethod freshline ((pp html-pretty-printer))
  (when *pretty* (emit-freshline (printer pp))))
(defmethod indent ((pp html-pretty-printer))
  (when *pretty* 
    (incf (indentation (printer pp)) (tab-width pp))))
(defmethod unindent ((pp html-pretty-printer))
  (when *pretty* 
    (decf (indentation (printer pp)) (tab-width pp))))
(defmethod toggle-indenting ((pp html-pretty-printer))
  (when *pretty* 
    (with-slots (indenting-p) (printer pp)
      (setf indenting-p (not indenting-p)))))

Finally, the functions embed-value and embed-code are used only by the FOO compiler—embed-value is used to generate code that’ll emit the value of a Common Lisp expression, while embed-code is used to embed a bit of code to be run and its result discarded. In the interpreter, you can’t meaningfully evaluate embedded Lisp code, so the methods on these functions always signal an error.

(defmethod embed-value ((pp html-pretty-printer) value)
  (error "Can't embed values when  interpreting. Value: ~s" value))
(defmethod embed-code ((pp html-pretty-printer) code)
  (error "Can't embed code when interpreting. Code: ~s" code))

Using Conditions to Have Your Cake and Eat It Too

An alternate approach would be to use **EVAL** to evaluate Lisp expressions in the interpreter. The problem with this approach is that **EVAL** has no access to the lexical environment. Thus, there’s no way to make something like this work:

(let ((x 10)) (emit-html '(:p x)))

when x is a lexical variable. The symbol x that’s passed to emit-html at runtime has no particular connection to the lexical variable named with the same symbol. The Lisp compiler arranges for references to x in the code to refer to the variable, but after the code is compiled, there’s no longer necessarily any association between the name x and that variable. This is the main reason that when you think **EVAL** is the solution to your problem, you’re probably wrong.

However, if x was a dynamic variable, declared with **DEFVAR** or **DEFPARAMETER** (and likely named *x* instead of x), **EVAL** could get at its value. Thus, it might be useful to allow the FOO interpreter to use **EVAL** in some situations. But it’s a bad idea to always use **EVAL**. You can get the best of both worlds by combining the idea of using **EVAL** with the condition system.

First define some error classes that you can signal when embed-value and embed-code are called in the interpreter.

(define-condition embedded-lisp-in-interpreter (error)
  ((form :initarg :form :reader form)))

(define-condition value-in-interpreter (embedded-lisp-in-interpreter) ()
  (:report
   (lambda (c s) 
     (format s "Can't embed values when interpreting. Value: ~s" (form c)))))

(define-condition code-in-interpreter (embedded-lisp-in-interpreter) ()
  (:report
   (lambda (c s) 
     (format s "Can't embed code when interpreting. Code: ~s" (form c)))))

Now you can implement embed-value and embed-code to signal those errors and provide a restart that’ll evaluate the form with **EVAL**.

(defmethod embed-value ((pp html-pretty-printer) value)
  (restart-case (error 'value-in-interpreter :form value)
    (evaluate ()
      :report (lambda (s) (format s "EVAL ~s in null lexical environment." value))
      (raw-string pp (escape (princ-to-string (eval value)) *escapes*) t))))

(defmethod embed-code ((pp html-pretty-printer) code)
  (restart-case (error 'code-in-interpreter :form code)
    (evaluate ()
      :report (lambda (s) (format s "EVAL ~s in null lexical environment." code))
      (eval code))))

Now you can do something like this:

HTML> (defvar *x* 10)
*X*
HTML> (emit-html '(:p *x*))

and you’ll get dropped into the debugger with this message:

Can't embed values when interpreting. Value: *X*
   [Condition of type VALUE-IN-INTERPRETER]

Restarts:
  0: [EVALUATE] EVAL *X* in null lexical environment.
  1: [ABORT] Abort handling SLIME request.
  2: [ABORT] Abort entirely from this process.

If you invoke the evaluate restart, embed-value will **EVAL** *x*, get the value 10, and generate this HTML:

<p>10</p>

Then, as a convenience, you can provide restart functions—functions that invoke the evaluate restart—in certain situations. The evaluate restart function unconditionally invokes the restart, while eval-dynamic-variables and eval-code invoke it only if the form in the condition is a dynamic variable or potential code.

(defun evaluate (&optional condition)
  (declare (ignore condition))
  (invoke-restart 'evaluate))

(defun eval-dynamic-variables (&optional condition)
  (when (and (symbolp (form condition)) (boundp (form condition)))
    (evaluate)))

(defun eval-code (&optional condition)
  (when (consp (form condition))
    (evaluate)))

Now you can use **HANDLER-BIND** to set up a handler to automatically invoke the evaluate restart for you.

HTML> (handler-bind ((value-in-interpreter #'evaluate)) (emit-html '(:p *x*)))
<p>10</p>
T

Finally, you can define a macro to provide a nicer syntax for binding handlers for the two kinds of errors.

(defmacro with-dynamic-evaluation ((&key values code) &body body)
  `(handler-bind (
       ,@(if values `((value-in-interpreter #'evaluate)))
       ,@(if code `((code-in-interpreter #'evaluate))))
     ,@body))

With this macro defined, you can write this:

HTML> (with-dynamic-evaluation (:values t) (emit-html '(:p *x*)))
<p>10</p>
T