print-html

* Overview

This program is an Html generator for Common Lisp.

Why another one?

I want programmatically generate and process Html.
In particular I want to

- Store Html in variables

- Use Html as a function argument

- Use Html as a function return value

To achieve this, we transform symbolic expressions into lists of tag
structures.  The method print-html then prints its input as properly
escaped Html.


* Package

We only use common-lisp.

#+begin_src lisp
(defpackage print-html
  (:use :common-lisp)
  (:export :render :print-html :print-html-to-string :html :unsafe))

(in-package :print-html)
#+end_src

* Self closing tags

#+begin_src lisp
(defvar *self-closing-tags*
  (list :area :base :br :col :command :embed :frame :hr :img :input :keygen
	:link :menuitem :meta :param :source :track :wbr)
  "List of self closing tags.")
#+end_src

* Render

The /RENDER/ method is called by /PRINT-HTML/ to map an
object into something that /PRINT-HTML/ is specialized for.
By default, /RENDER/ calls /princ-to-string/.

#+begin_src lisp
(defgeneric render (object)
  (:method (object)
    (princ-to-string object)))
#+end_src

* Print Html

The interpreter. Calls /render/ for objects it is not specialized
for.

#+begin_src lisp
(defgeneric print-html (object stream)
  (:method (object stream)
    (print-html (render object) stream))
  (:method ((char character) stream)
    (case char
      (#\< (write-string "&lt;" stream))
      (#\> (write-string "&gt;" stream))
      (#\& (write-string "&amp;" stream))
      (#\" (write-string "&quot;" stream))
      (t (write-char char stream))))
  (:method ((string string) stream)
    (map nil (lambda (char) (print-html char stream)) string))
  (:method ((list list) stream)
    (dolist (object list)
      (print-html object stream))))
#+end_src

Print /OBJECT/ to string.  Note: This function is also used to
escape attributes.

#+begin_src lisp
(defun print-html-to-string (object)
  (with-output-to-string (stream)
    (print-html object stream)))
#+end_src

* Tag

#+begin_src lisp
(defstruct tag name attrs children)

(defmethod print-html ((self tag) stream)
  (print-html (tag-children self) stream))

(defmethod print-html :before ((self tag) stream)
  (format stream "~&<~(~a~)~{ ~(~a~)=~s~}>" (tag-name self)
	  (loop for (k v) on (tag-attrs self) by #'cddr when v
	     collect (print-html-to-string k) and
	     collect (print-html-to-string (if (eq v t) k v)))))

(defmethod print-html :after ((self tag) stream)
  (unless (member (tag-name self) *self-closing-tags*)
    (format stream "</~(~a~)>~&" (tag-name self))))
#+end_src

* Html DSL 

Macroexpand example:

The code

#+begin_example
 (print-html-to-string
   (html
     ((:span :style "color:blue") "text")))
#+end_example

expands to

#+begin_example
(PRINT-HTML-TO-STRING (LIST (MAKE-TAG :NAME
                                      :SPAN
                                      :ATTRS
                                      (LIST :STYLE "color:blue")
                                      :CHILDREN
                                      (HTML "text"))))
#+end_example

and evaluates to

#+begin_example
"<span style=\"color:blue\">text</span>"
#+end_example

The html generation macro: 

#+begin_src lisp
(defmacro html (&body body)
  (labels ((listify (x) (if (listp x) x (list x)))
           (codegen (x)
             (cond ((atom x) x)
                   ((not (keywordp (car (listify (car x))))) x)
                   (t (destructuring-bind (head &rest body) x
                        (destructuring-bind (name &rest attrs) (listify head)
                          `(make-tag :name ,name :attrs (list ,@attrs)
                                     :children (html ,@body))))))))
    `(list ,@(mapcar #'codegen body))))
#+end_src

* Extending the Print-Html package

** Doctype

Print doctype.

#+begin_src lisp
(defmethod print-html ((self (eql :doctype-html)) stream)
  (format stream "<!doctype html>~&"))
#+end_src

** Unsafe

Print string without escaping

#+begin_src lisp
(defstruct (unsafe (:constructor unsafe (string))) string)

(defmethod print-html ((unsafe unsafe) stream)
  (write-string (unsafe-string unsafe) stream))
#+end_src


print-html

Upstream URL

Author

License

print-html

Version:

License:

Authors:

Dependencies:

Dependencies (0)

Dependents (0)