Skip to content

Commit

Permalink
declaration are supported per cl-who docs. This patch detect them and…
Browse files Browse the repository at this point in the history
… put them in proper place
  • Loading branch information
alaa-alawi committed Apr 27, 2012
1 parent b3472db commit 3a031d7
Show file tree
Hide file tree
Showing 2 changed files with 16 additions and 2 deletions.
10 changes: 10 additions & 0 deletions util.lisp
Expand Up @@ -228,3 +228,13 @@ determine whether CHAR must be escaped."
character set."
(escape-string string :test #'non-7bit-ascii-escape-char-p))

(defun extract-declarations (body)
"Given a FORM, the declarations - if any - will be exctracted
from the head of the FORM, and will return two values the declarations,
and the remaining of FORM"
(do ((sexp (first body) (first forms))
(forms (rest body) (rest forms))
(declarations nil))
((not (eq (first sexp) 'cl:declare))
(values declarations (append (if (null sexp) sexp (list sexp)) forms)))
(push sexp declarations)))
8 changes: 6 additions & 2 deletions who.lisp
Expand Up @@ -273,7 +273,9 @@ into Lisp code to write the corresponding HTML as strings to VAR -
which should either hold a stream or which'll be bound to STREAM if
supplied."
(declare (ignore prologue))
(multiple-value-bind (declarations forms) (extract-declarations body)
`(let ((,var ,(or stream var)))
,@declarations
(macrolet ((htm (&body body)
`(with-html-output (,',var nil :prologue nil :indent ,,indent)
,@body))
Expand All @@ -287,7 +289,7 @@ supplied."
(with-unique-names (result)
`(let ((,result ,thing))
(when ,result (princ ,result ,',var))))))
,@(apply 'tree-to-commands body var rest))))
,@(apply 'tree-to-commands forms var rest)))))

(defmacro with-html-output-to-string ((var &optional string-form
&key (element-type #-:lispworks ''character
Expand All @@ -297,11 +299,13 @@ supplied."
&body body)
"Transform the enclosed BODY consisting of HTML as s-expressions
into Lisp code which creates the corresponding HTML as a string."
(multiple-value-bind (declarations forms) (extract-declarations body)
`(with-output-to-string (,var ,string-form
#-(or :ecl :cmu :sbcl) :element-type
#-(or :ecl :cmu :sbcl) ,element-type)
,@declarations
(with-html-output (,var nil :prologue ,prologue :indent ,indent)
,@body)))
,@forms))))

;; stuff for Nikodemus Siivola's HYPERDOC
;; see <http://common-lisp.net/project/hyperdoc/>
Expand Down

0 comments on commit 3a031d7

Please sign in to comment.