Abstract
There are plenty of Lisp Markup Languages out there - every Lisp programmer seems to write at least one during his career - and CL-WHO (where WHO means "with-html-output" for want of a better acronym) is probably just as good or bad as the next one. They are all more or less similar in that they provide convenient means to convert S-expressions intermingled with code into (X)HTML, XML, or whatever but differ with respect to syntax, implementation, and API. So, if you haven't made a choice yet, check out the alternatives as well before you begin to use CL-WHO just because it was the first one you came across. (Was that repelling enough?) If you're looking for a slightly different approach you might also want to look at HTML-TEMPLATE.I wrote this one in 2002 although at least Tim Bradshaw's htout and AllegroServe's HTML generation facilities by John Foderaro of Franz Inc. were readily available. Actually, I don't remember why I had to write my own library - maybe just because it was fun and didn't take very long. The syntax was obviously inspired by htout although it is slightly different.
CL-WHO tries to create efficient code in that it makes constant strings as long as possible. In other words, the code generated by the CL-WHO macros will usually be a sequence of
WRITE-STRINGforms for constant parts of the output interspersed with arbitrary code inserted by the user of the macro. CL-WHO will make sure that there aren't two adjacentWRITE-STRINGforms with constant strings. CL-WHO's output is either XHTML (default), 'plain' (SGML) HTML or HTML5 (using HTML syntax) — depending on what you've setHTML-MODEto.CL-WHO is intended to be portable and should work with all conforming Common Lisp implementations. Let us know if you encounter any problems.
It comes with a BSD-style license so you can basically do with it whatever you want.
CL-WHO is for example used by clutu and Heike Stephan.
Download shortcut: http://weitz.de/files/cl-who.tar.gz.
with-html-output
with-html-output-to-string
*attribute-quote-char*
*downcase-tokens-p*
*html-empty-tag-aware-p*
*html-empty-tags*
*html-no-indent-tags*
*prologue*
esc
fmt
htm
str
html-mode
escape-string
escape-char
*escape-char-p*
escape-string-minimal
escape-string-minimal-plus-quotes
escape-string-iso-8859-1
escape-string-all
escape-char-minimal
escape-char-minimal-plus-quotes
escape-char-iso-8859-1
escape-char-all
conc
convert-tag-to-string-list
convert-attributes
*HTTP-STREAM* is the stream your web
application is supposed to write to. Here are some contrived code snippets
together with the Lisp code generated by CL-WHO and the resulting HTML output.
(with-html-output (*http-stream*) (loop for (link . title) in '(("http://zappa.com/" . "Frank Zappa") ("http://marcusmiller.com/" . "Marcus Miller") ("http://www.milesdavis.com/" . "Miles Davis")) do (htm (:a :href link (:b (str title))) :br))) |
Frank Zappa Marcus Miller Miles Davis |
|||||||||||||||||||||||||
;; code generated by CL-WHO (simplified)
(let ((*http-stream* *http-stream*))
(progn
nil
(loop for (link . title) in '(("http://zappa.com/" . "Frank Zappa")
("http://marcusmiller.com/" . "Marcus Miller")
("http://www.milesdavis.com/" . "Miles Davis"))
do (progn
(write-string "<a href='" *http-stream*)
(princ link *http-stream*)
(write-string "'><b>" *http-stream*)
(princ title *http-stream*)
(write-string "</b></a><br />" *http-stream*)))))
|
||||||||||||||||||||||||||
(with-html-output (*http-stream*) (:table :border 0 :cellpadding 4 (loop for i below 25 by 5 do (htm (:tr :align "right" (loop for j from i below (+ i 5) do (htm (:td :bgcolor (if (oddp j) "pink" "green") (fmt "~@R" (1+ j)))))))))) |
|
|||||||||||||||||||||||||
;; code generated by CL-WHO (simplified)
(let ((*http-stream* *http-stream*))
(progn
nil
(write-string "<table border='0' cellpadding='4'>" *http-stream*)
(loop for i below 25 by 5
do (progn
(write-string "<tr align='right'>" *http-stream*)
(loop for j from i below (+ i 5)
do (progn
(write-string "<td bgcolor='" *http-stream*)
(princ (if (oddp j) "pink" "green") *http-stream*)
(write-string "'>" *http-stream*)
(format *http-stream* "~@r" (1+ j))
(write-string "</td>" *http-stream*)))
(write-string "</tr>" *http-stream*)))
(write-string "</table>" *http-stream*)))
|
||||||||||||||||||||||||||
(with-html-output (*http-stream*) (:h4 "Look at the character entities generated by this example") (loop for i from 0 for string in '("Fête" "Sørensen" "naïve" "Hühner" "Straße") do (htm (:p :style (conc "background-color:" (case (mod i 3) ((0) "red") ((1) "orange") ((2) "blue"))) (htm (esc string)))))) |
Look at the character entities generated by this exampleFête Sørensen naïve Hühner Straße |
|||||||||||||||||||||||||
;; code generated by CL-WHO (simplified)
(let ((*http-stream* *http-stream*))
(progn
nil
(write-string
"<h4>Look at the character entities generated by this example</h4>"
*http-stream*)
(loop for i from 0 for string in '("Fête" "Sørensen" "naïve" "Hühner" "Straße")
do (progn
(write-string "<p style='" *http-stream*)
(princ (conc "background-color:"
(case (mod i 3)
((0) "red")
((1) "orange")
((2) "blue")))
*http-stream*)
(write-string "'>" *http-stream*)
(progn (write-string (escape-string string) *http-stream*))
(write-string "</p>" *http-stream*)))))
|
The preferred method to fetch, compile and load CL-WHO is via Quicklisp. Install Quicklisp, then run
(ql:quickload :cl-who)
The current development version of CL-WHO can be found at https://github.com/edicl/cl-who. This is the one to send patches against. Use at your own risk.
Luís Oliveira maintains an unofficial darcs repository of CL-WHO at http://common-lisp.net/~loliveira/ediware/.
You can run a test suite which tests some (but not all) aspects of the library with
(asdf:oos 'asdf:test-op :cl-who)
WITH-HTML-OUTPUT, which
transforms the body of code it encloses into something else obeying the
following rules (which we'll call transformation rules) for the body's forms:
"foo" => (write-string "foo" s) |
(:br) => (write-string "<br />" s) |
HTML-MODE set to :SGML an empty element is written this way:
(:br) => (write-string "<br>" s) |
NIL.) The form denoting the attribute's value will be treated as follows. (Note that the behaviour with respect to attributes is incompatible with versions earlier than 0.3.0!)
(:td :bgcolor "red") => (write-string "<td bgcolor='red' />" s) |
T and HTML-MODE is :XML (default) the attribute's value will be the attribute's name (following XHTML convention to denote attributes which don't have a value in HTML).
(:td :nowrap t) => (write-string "<td nowrap='nowrap' />" s) |
HTML-MODE set to :SGML or :HTML5:
(:td :nowrap t) => (write-string "<td nowrap>" s) |
*EMPTY-ATTRIBUTE-SYNTAX*NIL the attribute will be left out completely.
(:td :nowrap nil) => (write-string "<td />" s) |
"~A" at macro expansion time.
(:table :border 3) => (write-string "<table border='3' />" s) |
PRINC unless the value is T or NIL which will be treated as above. (It is the application developer's job to provide the correct printer control variables.)
;; simplified example, see function CHECKBOX below
;; note that this form is not necessarily CONSTANTP in all Lisps
(:table :border (+ 1 2)) => (write-string "<table border='" s)
(princ (+ 1 2) s)
(write-string "' />" s) |
(:table :border 0 :cellpadding 5 :cellspacing 5)
=> (write-string "<table border='0' cellpadding='5' cellspacing='5' />" s) |
(:p "Paragraph") => (write-string "<p>Paragraph</p>" s)
(:p :class "foo" "Paragraph") => (write-string "<p class='foo'>Paragraph</p>" s)
(:p :class "foo" "One" " " "long" " " "sentence") => (write-string "<p class='foo'>One long sentence</p>" s)
(:p :class "foo" "Visit " (:a :href "http://www.cliki.net/" "CLiki"))
=> (write-string "<p class='foo'>Visit <a href='http://www.cliki.net/'>CLiki</a></p>" s) |
((:p) "Paragraph") => (write-string "<p>Paragraph</p>" s)
((:p :class "foo") "Paragraph") => (write-string "<p class='foo'>Paragraph</p>" s)
((:p :class "foo" :name "humpty-dumpty") "One" " " "long" " " "sentence")
=> (write-string "<p class='foo' name='humpty-dumpty'>One long sentence</p>" s)
((:p :class "foo") "Visit " ((:a :href "http://www.cliki.net/") "CLiki"))
=> (write-string "<p class='foo'>Visit <a href='http://www.cliki.net/'>CLiki</a></p>" s) |
* (defun checkbox (stream name checked &optional value)
(with-html-output (stream)
(:input :type "checkbox" :name name :checked checked :value value)))
CHECKBOX
* (with-output-to-string (s) (checkbox s "foo" t))
"<input type='checkbox' name='foo' checked='checked' />"
* (with-output-to-string (s) (checkbox s "foo" nil))
"<input type='checkbox' name='foo' />"
* (with-output-to-string (s) (checkbox s "foo" nil "bar"))
"<input type='checkbox' name='foo' value='bar' />"
* (with-output-to-string (s) (checkbox s "foo" t "bar"))
"<input type='checkbox' name='foo' checked='checked' value='bar' />"
:hr => (write-string "<hr />" s) |
(str form) will be substituted with
(let ((result form)) (when result (princ result s))).
(loop for i below 10 do (str i)) =>
(loop for i below 10 do
(let ((#:result i))
(when #:result (princ #:result *standard-output*)))) |
(fmt form*) will be substituted with (format s form*).
(loop for i below 10 do (fmt "~R" i)) => (loop for i below 10 do (format s "~R" i)) |
(esc form) will be substituted with
(let ((result form)) (when result (write-string (escape-string result s)))).
(htm form*) then each of the forms will be subject to the transformation rules we're just describing, i.e. this is the body is wrapped with another invocation of WITH-HTML-OUTPUT.
(loop for i below 100 do (htm (:b "foo") :br))
=> (loop for i below 100 do (progn (write-string "<b>foo</b><br />" s))) |
:foobar instead of :hr.
[Macro]
with-html-output (var &optional stream &key prologue indent) declaration* form* => result*
This is the main macro of CL-WHO. It will transform its body by the transformation rules described in Syntax and Semantics such that the output generated is sent to the stream denoted byvarandstream.varmust be a symbol. IfstreamisNILit is assumed thatvaris already bound to a stream, ifstreamis notNILvarwill be bound to the formstreamwhich will be evaluated at run time.prologueshould be a string (orNILfor the empty string which is the default) which is guaranteed to be the first thing sent to the stream from within the body of this macro. IfprologueisTthe prologue string is the value of*PROLOGUE*.CL-WHO will usually try not to insert any unnecessary whitespace in order to save bandwidth. However, if
indentis true line breaks will be inserted and nested tags will be indented properly. The value ofindent- if it is an integer - will be taken as the initial indentation. If it is not an integer it is assumed to mean0. Value of*HTML-NO-INDENT-TAGS*controls which tag-contents are excempt from indentation: by default contents ofPREandTEXTAREAtags are not indented to avoid spurious layout changes. (Note: in certain situations additional whitespace may change the layout of tables.)The
resultsare the values returned by theforms.Note that the keyword arguments
prologueandindent, and the associated variables are used at macro expansion time.* (with-html-output (*standard-output* nil :prologue t) (:html (:body "Not much there")) (values)) <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd"><html><body>Not much there</body></html> * (with-html-output (*standard-output*) (:html (:body :bgcolor "white" "Not much there")) (values)) <html><body bgcolor='white'>Not much there</body></html> * (with-html-output (*standard-output* nil :prologue t :indent t) (:html (:body :bgcolor "white" "Not much there")) (values)) <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd"> <html> <body bgcolor='white'> Not much there </body> </html>
This is just a thin wrapper aroundWITH-HTML-OUTPUT. Indeed, the wrapper is so thin that the best explanation probably is to show its definition:(defmacro with-html-output-to-string ((var &optional string-form &key (element-type ''character) prologue indent) &body body) "Transform the enclosed BODY consisting of HTML as s-expressions into Lisp code which creates the corresponding HTML as a string." `(with-output-to-string (,var ,string-form :element-type ,element-type) (with-html-output (,var nil :prologue ,prologue :indent ,indent) ,@body)))Note that theresultsof this macro are determined by the behaviour ofWITH-OUTPUT-TO-STRING.
[Special variable]
*attribute-quote-char*
This character is used as the quote character when building attributes. Defaults to the single quote#\'. Only other reasonable character is the double quote#\".
[Special variable]
*downcase-tokens-p*
If the value of this variable isNIL, keyword symbols representing a tag or attribute name will not be automatically converted to lowercase. This is useful when one needs to output case sensitive XML. The default isT.
[Special variable]
*html-empty-tag-aware-p*
Set this toNILto if you want to use CL-WHO as a strict XML generator. Otherwise, CL-WHO will only write empty tags listed in*HTML-EMPTY-TAGS*as<tag/>(XHTML mode) or<tag>(SGML mode or HTML mode). For all other tags, it will always generate<tag></tag>. The initial value of this variable isT.
[Special variable]
*html-empty-tags*
The list of HTML tags that should be output as empty tags. See*HTML-EMPTY-TAG-AWARE-P*. The initial value is the list(:area :atop :audioscope :base :basefont :br :choose :col :command :embed :frame :hr :img :input :isindex :keygen :left :limittext :link :meta :nextid :of :over :param :range :right :source :spacer :spot :tab :track :wbr)
[Special variable]
*html-no-indent-tags*
The list of HTML tags that should disable indentation inside them even when indentation is requested. The initial value is a list containing only:preand:texarea.
[Special variable]
*prologue*
This is the prologue string which will be printed if theprologuekeyword argument toWITH-HTML-OUTPUTisT. Gets changed when you setHTML-MODE. Its initial value is"<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\" \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">"
[Special variable]
*empty-attribute-syntax*
This controls the attribute minimization. (also called 'boolean attributes', or 'empty attribute syntax' according to the w3 html standard). Set value toTto enable attribute minimization.In XHTML attribute minimization is forbidden, and all attributes must have a value. Thus in XHTML boolean attributes must be defined as
<input disabled='disabled' />In HTML5 and SGML HTML boolean attributes can be defined as<input disabled>Gets changed when you setHTML-MODE. Its initial value isNIL
[Symbol]
esc
[Symbol]
fmt
[Symbol]
htm
[Symbol]
str
These are just symbols with no bindings associated with them. The only reason they are exported is their special meaning during the transformations described in Syntax and Semantics.
[Accessor]
html-mode => mode
(setf (html-mode) mode)
The functionHTML-MODEreturns the current mode for generating HTML. The default is:XMLfor XHTML. You can change this by setting it with(SETF (HTML-MODE) :SGML)to pre-XML HTML mode or(SETF (HTML-MODE) :HTML5)to HTML5 mode (using HTML syntax).Setting it to SGML HTML sets the
*prologue*to the doctype string for HTML 4.01 transitional:<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd">Code generation in HTML5 and SGML HTML is slightly different from XHTML - there's no need to end empty elements with/>and empty attributes are allowed.Setting it to HTML5 sets the
*prologue*to the following doctype string:<!DOCTYPE html>
[Function]
escape-string string &key test => escaped-string
This function will accept a stringstringand will replace every character for whichtestreturns true with its character entity. The numeric character entities use decimal instead of hexadecimal values whenHTML-MODEis set to:SGMLbecause of compatibility reasons with old clients.testmust be a function of one argument which accepts a character and returns a generalized boolean. The default is the value of*ESCAPE-CHAR-P*. Note theESCshortcut described in Syntax and Semantics.* (escape-string "<Hühner> 'naïve'") "<Hühner> 'naïve'" * (with-html-output-to-string (s) (:b (esc "<Hühner> 'naïve'"))) "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\" \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\"<b><Hühner> 'naïve'</b>"
[Function]
escape-char character &key test => escaped-string
This function works identical toESCAPE-STRING, except that it operates on characters instead of strings.
[Special variable]
*escape-char-p*
This is the default for thetestkeyword argument toESCAPE-STRINGandESCAPE-CHAR. Its initial value is#'(lambda (char) (or (find char "<>&'\"") (> (char-code char) 127)))
[Function]
escape-string-minimal string => escaped-string
[Function]
escape-string-minimal-plus-quotes string => escaped-string
[Function]
escape-string-iso-8859-1 string => escaped-string
[Function]
escape-string-all string => escaped-string
[Function]
escape-char-minimal character => escaped-string
[Function]
escape-char-minimal-plus-quotes character => escaped-string
[Function]
escape-char-iso-8859-1 character => escaped-string
[Function]
escape-char-all character => escaped-string
These are convenience function based onESCAPE-STRINGandESCAPE-CHAR. The string functions are defined in a way similar to this one:(defun escape-string-minimal (string) "Escape only #\<, #\>, and #\& in STRING." (escape-string string :test #'(lambda (char) (find char "<>&")))) (defun escape-string-minimal-plus-quotes (string) "Like ESCAPE-STRING-MINIMAL but also escapes quotes." (escape-string string :test #'(lambda (char) (find char "<>&'\"")))) (defun escape-string-iso-8859-1 (string) "Escapes all characters in STRING which aren't defined in ISO-8859-1." (escape-string string :test #'(lambda (char) (or (find char "<>&'\"") (> (char-code char) 255))))) (defun escape-string-all (string) "Escapes all characters in STRING which aren't in the 7-bit ASCII character set." (escape-string string :test #'(lambda (char) (or (find char "<>&'\"") (> (char-code char) 127)))))The character functions are defined in an analogous manner.
[Function]
conc &rest string-list => string
Utility function to concatenate all arguments (which should be strings) into one string. Meant to be used mainly with attribute values.* (conc "This" " " "is" " " "a" " " "sentence") "This is a sentence" * (with-html-output-to-string (s) (:div :style (conc "padding:" (format nil "~A" (+ 3 2))) "Foobar")) "<div style='padding:5'>Foobar</div>"
[Generic Function]
convert-tag-to-string-list tag attr-list body body-fn => strings-or-forms
This function exposes some of CL-WHO's internals so users can customize its behaviour. It is called whenever a tag is processed and must return a corresponding list of strings or Lisp forms. The idea is that you can specialize this generic function in order to process certain tags yourself.
tagis a keyword symbol naming the outer tag,attr-listis an alist of its attributes (the car is the attribute's name as a keyword, the cdr is its value),bodyis the tag's body, andbody-fnis a function which should be applied to the body to further process it. Of course, if you define your own methods you can ignorebody-fnif you want.Here are some simple examples:
* (defmethod convert-tag-to-string-list ((tag (eql :red)) attr-list body body-fn) (declare (ignore attr-list)) (nconc (cons "<font color='red'>" (funcall body-fn body)) (list "</font>"))) ; Compiling LAMBDA (PCL::.PV-CELL. PCL::.NEXT-METHOD-CALL. TAG ATTR-LIST BODY BODY-FN): ; Compiling Top-Level Form: #<STANDARD-METHOD CONVERT-TAG-TO-STRING-LIST ((EQL :RED) T T T) {582B268D}> * (with-html-output (*standard-output*) (:red (:b "Bold and red")) (values)) <font color='red'><b>Bold and red</b></font> * (show-html-expansion (s) (:red :style "spiffy" (if (foo) (htm "Attributes are ignored")))) (LET ((S S)) (PROGN NIL (WRITE-STRING "<font color='red'>" S) (IF (FOO) (PROGN (WRITE-STRING "Attributes are ignored" S))) (WRITE-STRING "</font>" S))) * (defmethod convert-tag-to-string-list ((tag (eql :table)) attr-list body body-fn) (cond ((cdr (assoc :simple attr-list)) (nconc (cons "<table" (convert-attributes (remove :simple attr-list :key #'car))) (list ">") (loop for row in body collect "<tr>" nconc (loop for col in row collect "<td>" when (constantp col) collect (format nil "~A" col) else collect col collect "</td>") collect "</tr>") (list "</table>"))) (t ;; you could as well invoke CALL-NEXT-METHOD here, of course (nconc (cons "<table " (convert-attributes attr-list)) (list ">") (funcall body-fn body) (list "</table>"))))) ; Compiling LAMBDA (PCL::.PV-CELL. PCL::.NEXT-METHOD-CALL. TAG ATTR-LIST BODY BODY-FN): ; Compiling Top-Level Form: #<STANDARD-METHOD CONVERT-TAG-TO-STRING-LIST ((EQL :TABLE) T T T) {58AFB7CD}> * (with-html-output (*standard-output*) (:table :border 0 (:tr (:td "1") (:td "2")) (:tr (:td "3") (:td "4")))) <table border='0'><tr><td>1</td><td>2</td></tr><tr><td>3</td><td>4</td></tr></table> "</td></tr></table>" * (show-html-expansion (s) (:table :simple t :border 0 (1 2) (3 (fmt "Result = ~A" (compute-result))))) (LET ((S S)) (PROGN NIL (WRITE-STRING "<table border='0'><tr><td>1</td><td>2</td></tr><tr><td>3</td><td>" S) (FORMAT S "Result = ~A" (COMPUTE-RESULT)) (WRITE-STRING "</td></tr></table>" S)))
[Function]
convert-attributes attr-list => strings-or-forms
This is a helper function which can be called fromCONVERT-TAG-TO-STRING-LISTto process the list of attributes.
$Header: /usr/local/cvsrep/cl-who/doc/index.html,v 1.68 2009/03/09 21:54:11 edi Exp $
BACK TO MY HOMEPAGE
cl-who-20171130-git/packages.lisp 0000664 0000000 0000000 00000004731 13040103647 0016376 0 ustar 00root root 0000000 0000000 ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-USER; Base: 10 -*-
;;; $Header: /usr/local/cvsrep/cl-who/packages.lisp,v 1.21 2009/01/26 11:10:49 edi Exp $
;;; Copyright (c) 2003-2009, Dr. Edmund Weitz. All rights reserved.
;;; Redistribution and use in source and binary forms, with or without
;;; modification, are permitted provided that the following conditions
;;; are met:
;;; * Redistributions of source code must retain the above copyright
;;; notice, this list of conditions and the following disclaimer.
;;; * Redistributions in binary form must reproduce the above
;;; copyright notice, this list of conditions and the following
;;; disclaimer in the documentation and/or other materials
;;; provided with the distribution.
;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED
;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
(in-package :cl-user)
(defpackage :cl-who
(:use :cl)
(:nicknames :who)
#+:sbcl (:shadow :defconstant)
#+:sb-package-locks (:lock t)
(:export :*attribute-quote-char*
:*empty-attribute-syntax*
:*escape-char-p*
:*prologue*
:*downcase-tokens-p*
:*html-no-indent-tags*
:*html-empty-tags*
:*html-empty-tag-aware-p*
:conc
:convert-attributes
:convert-tag-to-string-list
:esc
:escape-char
:escape-char-all
:escape-char-iso-8859-1
:escape-char-minimal
:escape-char-minimal-plus-quotes
:escape-string
:escape-string-all
:escape-string-iso-8859-1
:escape-string-minimal
:escape-string-minimal-plus-quotes
:fmt
:htm
:html-mode
:str
:with-html-output
:with-html-output-to-string))
(pushnew :cl-who *features*)
cl-who-20171130-git/specials.lisp 0000664 0000000 0000000 00000010473 13040103647 0016423 0 ustar 00root root 0000000 0000000 ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package:CL-WHO; Base: 10 -*-
;;; $Header: /usr/local/cvsrep/cl-who/specials.lisp,v 1.6 2009/01/26 11:10:49 edi Exp $
;;; Copyright (c) 2003-2009, Dr. Edmund Weitz. All rights reserved.
;;; Redistribution and use in source and binary forms, with or without
;;; modification, are permitted provided that the following conditions
;;; are met:
;;; * Redistributions of source code must retain the above copyright
;;; notice, this list of conditions and the following disclaimer.
;;; * Redistributions in binary form must reproduce the above
;;; copyright notice, this list of conditions and the following
;;; disclaimer in the documentation and/or other materials
;;; provided with the distribution.
;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED
;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
(in-package :cl-who)
#+:sbcl
(defmacro defconstant (name value &optional doc)
"Make sure VALUE is evaluated only once \(to appease SBCL)."
`(cl:defconstant ,name (if (boundp ',name) (symbol-value ',name) ,value)
,@(when doc (list doc))))
(defvar *prologue*
""
"This is the first line that'll be printed if the :PROLOGUE keyword
argument is T")
(defvar *escape-char-p*
(lambda (char)
(or (find char "<>&'\"")
(> (char-code char) 127)))
"Used by ESCAPE-STRING to test whether a character should be escaped.")
(defvar *indent* nil
"Whether to insert line breaks and indent. Also controls amount of
indentation dynamically.")
(defvar *html-mode* :xml
":SGML for \(SGML-)HTML, :XML \(default) for XHTML, :HTML5 for HTML5.")
(defvar *empty-attribute-syntax* nil
"Set this to t to enable attribute minimization (also called
'boolean attributes', or 'empty attribute syntax' according to the w3
html standard). In XHTML attribute minimization is forbidden, and all
attributes must have a value. Thus in XHTML boolean attributes must be
defined as . In HTML5 boolean attributes
can be defined as ")
(defvar *downcase-tokens-p* t
"If NIL, a keyword symbol representing a tag or attribute name will
not be automatically converted to lowercase. This is useful when one
needs to output case sensitive XML.")
(defvar *attribute-quote-char* #\'
"Quote character for attributes.")
(defvar *empty-tag-end* " />"
"End of an empty tag. Default is XML style.")
(defvar *html-no-indent-tags*
'(:pre :textarea)
"The list of HTML tags that should disable indentation inside them. The initial
value is a list containing only :PRE and :TEXTAREA.")
(defvar *html-empty-tags*
'(:area
:atop
:audioscope
:base
:basefont
:br
:choose
:col
:command
:embed
:frame
:hr
:img
:input
:isindex
:keygen
:left
:limittext
:link
:meta
:nextid
:of
:over
:param
:range
:right
:source
:spacer
:spot
:tab
:track
:wbr)
"The list of HTML tags that should be output as empty tags.
See *HTML-EMPTY-TAG-AWARE-P*.")
(defvar *html-empty-tag-aware-p* t
"Set this to NIL to if you want to use CL-WHO as a strict XML
generator. Otherwise, CL-WHO will only write empty tags listed
in *HTML-EMPTY-TAGS* as Fête Sørensen naïve Hühner Straße Bar
Bar
Marcus Miller
Miles Davis
")
;;; 2
(string= (with-output-to-string (out)
(with-html-output (out nil)
(loop for (link . title) in '(("http://zappa.com/" . "Frank Zappa")
("http://marcusmiller.com/" . "Marcus Miller")
("http://www.milesdavis.com/" . "Miles Davis"))
do (htm (:a :href link
(:b (str title)))
:br))))
"Frank Zappa
Marcus Miller
Miles Davis
")
;;; 3
(string= (with-output-to-string (foo)
(with-html-output (out foo)
(loop for (link . title) in '(("http://zappa.com/" . "Frank Zappa")
("http://marcusmiller.com/" . "Marcus Miller")
("http://www.milesdavis.com/" . "Miles Davis"))
do (htm (:a :href link
(:b (str title)))
:br))))
"Frank Zappa
Marcus Miller
Miles Davis
")
;;; 4
(string= (with-html-output-to-string (out)
(loop for (link . title) in '(("http://zappa.com/" . "Frank Zappa")
("http://marcusmiller.com/" . "Marcus Miller")
("http://www.milesdavis.com/" . "Miles Davis"))
do (htm (:a :href link
(:b (str title)))
:br)))
"Frank Zappa
Marcus Miller
Miles Davis
")
;;; 5
(string= (with-html-output-to-string (out nil)
(loop for (link . title) in '(("http://zappa.com/" . "Frank Zappa")
("http://marcusmiller.com/" . "Marcus Miller")
("http://www.milesdavis.com/" . "Miles Davis"))
do (htm (:a :href link
(:b (str title)))
:br)))
"Frank Zappa
Marcus Miller
Miles Davis
")
;;; 6
(string= (with-html-output-to-string (out nil :prologue nil)
(loop for (link . title) in '(("http://zappa.com/" . "Frank Zappa")
("http://marcusmiller.com/" . "Marcus Miller")
("http://www.milesdavis.com/" . "Miles Davis"))
do (htm (:a :href link
(:b (str title)))
:br)))
"Frank Zappa
Marcus Miller
Miles Davis
")
;;; 7
(eq (array-element-type
(with-html-output-to-string (out nil :element-type 'base-char)
(:br)))
'base-char)
;;; 8
(string= (let ((*attribute-quote-char* #\"))
(with-html-output-to-string (out)
(loop for (link . title) in '(("http://zappa.com/" . "Frank Zappa")
("http://marcusmiller.com/" . "Marcus Miller")
("http://www.milesdavis.com/" . "Miles Davis"))
do (htm (:a :href link
(:b (str title)))
:br))))
"Frank Zappa
Marcus Miller
Miles Davis
")
;;; 9
(string= (with-html-output-to-string (out nil :prologue t)
(loop for (link . title) in '(("http://zappa.com/" . "Frank Zappa")
("http://marcusmiller.com/" . "Marcus Miller")
("http://www.milesdavis.com/" . "Miles Davis"))
do (htm (:a :href link
(:b (str title)))
:br)))
"
Frank Zappa
Marcus Miller
Miles Davis
")
;;; 10
(string= (with-html-output-to-string
(out nil :prologue "")
(:apply (:factorial) (:cn "3")))
"
Marcus Miller
Miles Davis
")
;;; 13
(string= (with-html-output-to-string (out nil :indent 0)
(loop for (link . title) in '(("http://zappa.com/" . "Frank Zappa")
("http://marcusmiller.com/" . "Marcus Miller")
("http://www.milesdavis.com/" . "Miles Davis"))
do (htm (:a :href link
(:b (str title)))
:br)))
"
Frank Zappa
Marcus Miller
Miles Davis
")
;;; 14
(string= (with-html-output-to-string (out nil :indent 3)
(loop for (link . title) in '(("http://zappa.com/" . "Frank Zappa")
("http://marcusmiller.com/" . "Marcus Miller")
("http://www.milesdavis.com/" . "Miles Davis"))
do (htm (:a :href link
(:b (str title)))
:br)))
"
Frank Zappa
Marcus Miller
Miles Davis
")
;;; 15
(string= (with-html-output-to-string (out)
(:table :border 0 :cellpadding 4
(loop for i below 25 by 5
do (htm
(:tr :align "right"
(loop for j from i below (+ i 5)
do (htm
(:td :bgcolor (if (oddp j)
"pink"
"green")
(fmt "~@R" (1+ j))))))))))
"
")
;;; 16
(string= (with-html-output-to-string (out)
(:h4 "Look at the character entities generated by this example")
(loop for i from 0
for string in '("Fête" "Sørensen" "naïve" "Hühner" "Straße")
do (htm
(:p :style (conc "background-color:" (case (mod i 3)
((0) "red")
((1) "orange")
((2) "blue")))
(htm (esc string))))))
"I II III IV V VI VII VIII IX X XI XII XIII XIV XV XVI XVII XVIII XIX XX XXI XXII XXIII XXIV XXV Look at the character entities generated by this example
")
;;; 24
(string= (with-html-output-to-string (out)
(:div (:pre "Foo")))
"Foo
Foo