[bknr-cvs] r2232 - in branches/trunk-reorg/thirdparty: . cl-who-0.11.0 cl-who-0.11.0/doc
bknr at bknr.net
bknr at bknr.net
Mon Oct 8 04:39:28 UTC 2007
Author: hhubner
Date: 2007-10-08 00:39:27 -0400 (Mon, 08 Oct 2007)
New Revision: 2232
Added:
branches/trunk-reorg/thirdparty/cl-who-0.11.0/
branches/trunk-reorg/thirdparty/cl-who-0.11.0/CHANGELOG
branches/trunk-reorg/thirdparty/cl-who-0.11.0/cl-who.asd
branches/trunk-reorg/thirdparty/cl-who-0.11.0/doc/
branches/trunk-reorg/thirdparty/cl-who-0.11.0/doc/index.html
branches/trunk-reorg/thirdparty/cl-who-0.11.0/packages.lisp
branches/trunk-reorg/thirdparty/cl-who-0.11.0/specials.lisp
branches/trunk-reorg/thirdparty/cl-who-0.11.0/who.lisp
Removed:
branches/trunk-reorg/thirdparty/cl-who-0.10.0/
Log:
update cl-who
Added: branches/trunk-reorg/thirdparty/cl-who-0.11.0/CHANGELOG
===================================================================
--- branches/trunk-reorg/thirdparty/cl-who-0.11.0/CHANGELOG 2007-10-07 23:19:21 UTC (rev 2231)
+++ branches/trunk-reorg/thirdparty/cl-who-0.11.0/CHANGELOG 2007-10-08 04:39:27 UTC (rev 2232)
@@ -0,0 +1,91 @@
+Version 0.11.0
+2007-08-24
+Replaces *DOWNCASE-TAGS-P* with *DOWNCASE-TOKENS-P* (thanks to Osei Poku)
+
+Version 0.10.0
+2007-07-25
+Added ESCAPE-CHAR-... functions (based on a patch by Volkan Yazici)
+
+Version 0.9.1
+2007-05-28
+Fixed bug in CONVERT-TAG-TO-STRING-LIST (thanks to Simon Cusack)
+
+Version 0.9.0
+2007-05-08
+Changed behaviour of STR and ESC when "argument" is NIL (patch by Mac Chan)
+
+Version 0.8.1
+2007-04-27
+Removed antiquated installation instructions and files (thanks to a hint by Mac Chan)
+
+Version 0.8.0
+2007-04-27
+Added *HTML-EMPTY-TAG-AWARE-P* (patch by Mac Chan)
+A bit of refactoring
+
+Version 0.7.1
+2007-04-05
+Made *HTML-MODE* a compile-time flag (patch by Mac Chan)
+
+Version 0.7.0
+2007-03-23
+Added *DOWNCASE-TAGS-P* (patch by Mac Chan)
+
+Version 0.6.3
+2006-12-22
+Fixed example for CONVERT-TAG-TO-STRING-LIST (thanks to Daniel Gackle)
+
+Version 0.6.2
+2006-10-10
+Reintroduced ESCAPE-STRING-ISO-8859-1 for backwards compatibility
+
+Version 0.6.1
+2006-07-27
+EVAL CONSTANTP forms in attribute position (caught by Erik Enge)
+Added WHO nickname to CL-WHO package
+
+Version 0.6.0
+2005-08-02
+Introduced *ATTRIBUTE-QUOTE-CHAR* and HTML-MODE and adapted code accordingly (patch by Stefan Scholl)
+
+Version 0.5.0
+2005-03-01
+Enable customization via CONVERT-TAG-TO-STRING-LIST
+
+Version 0.4.4
+2005-01-22
+Explicitely provide elementy type for +SPACES+ to prevent problems with LW (thanks to Bob Hutchinson)
+
+Version 0.4.3
+2004-09-13
+ESCAPE-STRING-ISO-8859 wasn't exported
+
+Version 0.4.2
+2004-09-08
+Fixed bug in docs (caught by Peter Seibel)
+Added hyperdoc support
+
+Version 0.4.1
+2004-04-15
+Added :CL-WHO to *FEATURES* (for TBNL)
+
+Version 0.4.0
+2003-12-03
+Allow for optional LHTML syntax (patch by Kevin Rosenberg)
+
+Version 0.3.0
+2003-08-02
+Changed behaviour of attributes (incompatible with 0.2.0 syntax!) due to a question by Jörg-Cyril Höhle
+Changed ' back to ' because of IE
+
+Version 0.2.0
+2003-07-27
+Changed default for :PROLOGUE (I was convinced by Rob Warnock and Eduardo Muñoz)
+
+Version 0.1.1
+2003-07-20
+Typo in WITH-OUTPUT-TO-STRING
+
+Version 0.1.0
+2003-07-17
+Initial release
Added: branches/trunk-reorg/thirdparty/cl-who-0.11.0/cl-who.asd
===================================================================
--- branches/trunk-reorg/thirdparty/cl-who-0.11.0/cl-who.asd 2007-10-07 23:19:21 UTC (rev 2231)
+++ branches/trunk-reorg/thirdparty/cl-who-0.11.0/cl-who.asd 2007-10-08 04:39:27 UTC (rev 2232)
@@ -0,0 +1,35 @@
+;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-USER; Base: 10 -*-
+;;; $Header: /usr/local/cvsrep/cl-who/cl-who.asd,v 1.18 2007/08/24 08:01:37 edi Exp $
+
+;;; Copyright (c) 2003-2007, 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.
+
+(asdf:defsystem :cl-who
+ :version "0.11.0"
+ :serial t
+ :components ((:file "packages")
+ (:file "specials")
+ (:file "who")))
Added: branches/trunk-reorg/thirdparty/cl-who-0.11.0/doc/index.html
===================================================================
--- branches/trunk-reorg/thirdparty/cl-who-0.11.0/doc/index.html 2007-10-07 23:19:21 UTC (rev 2231)
+++ branches/trunk-reorg/thirdparty/cl-who-0.11.0/doc/index.html 2007-10-08 04:39:27 UTC (rev 2232)
@@ -0,0 +1,807 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">
+<html>
+
+<head>
+ <meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1">
+ <title>CL-WHO - Yet another Lisp markup language</title>
+ <style type="text/css">
+ pre { padding:5px; background-color:#e0e0e0 }
+ h3, h4 { text-decoration: underline; }
+ a { text-decoration: none; padding: 1px 2px 1px 2px; }
+ a:visited { text-decoration: none; padding: 1px 2px 1px 2px; }
+ a:hover { text-decoration: none; padding: 1px 1px 1px 1px; border: 1px solid #000000; }
+ a:focus { text-decoration: none; padding: 1px 2px 1px 2px; border: none; }
+ a.none { text-decoration: none; padding: 0; }
+ a.none:visited { text-decoration: none; padding: 0; }
+ a.none:hover { text-decoration: none; border: none; padding: 0; }
+ a.none:focus { text-decoration: none; border: none; padding: 0; }
+ a.noborder { text-decoration: none; padding: 0; }
+ a.noborder:visited { text-decoration: none; padding: 0; }
+ a.noborder:hover { text-decoration: none; border: none; padding: 0; }
+ a.noborder:focus { text-decoration: none; border: none; padding: 0; }
+ pre.none { padding:5px; background-color:#ffffff }
+ </style>
+</head>
+
+<body bgcolor=white>
+
+<h2>CL-WHO - Yet another Lisp markup language</h2>
+
+<blockquote>
+<br> <br><h3><a name=abstract class=none>Abstract</a></h3>
+
+There are plenty of <a
+href="http://www.cliki.net/Lisp%20Markup%20Languages">Lisp Markup
+Languages</a> out there - every Lisp programmer seems to write at
+least one during his career - and CL-WHO (where <em>WHO</em> 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 <a
+href="http://weitz.de/html-template/">HTML-TEMPLATE</a>.
+<p>
+I wrote this one in 2002 although at least Tim Bradshaw's <a
+href="http://www.cliki.net/htout">htout</a> and <a
+href="http://opensource.franz.com/aserve/aserve-dist/doc/htmlgen.html">AllegroServe's
+HTML generation facilities</a> by John Foderaro of Franz Inc. where
+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.
+<p>
+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 <code>WRITE-STRING</code>
+forms 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 adjacent <code>WRITE-STRING</code> forms with
+constant strings - see
+examples <a href="#show-html-expansion">below</a>. CL-WHO's output is
+either XHTML (default) or 'plain' (SGML) HTML — depending on
+what you've set <a href="#html-mode"><code>HTML-MODE</code></a> to.
+<p>
+CL-WHO is intended to be portable and should work with all
+conforming Common Lisp implementations. <a
+href="#mail">Let us know</a> if you encounter any
+problems.
+<p>
+It comes with a <a
+href="http://www.opensource.org/licenses/bsd-license.php">BSD-style
+license</a> so you can basically do with it whatever you want.
+<p>
+CL-WHO is used by <a href="http://clutu.com/">clutu</a>, <a href="http://ergoweb.de/">ERGO</a>, and <a href="http://heikestephan.de/">Heike Stephan</a>.
+
+<p>
+<font color=red>Download shortcut:</font> <a href="http://weitz.de/files/cl-who.tar.gz">http://weitz.de/files/cl-who.tar.gz</a>.
+</blockquote>
+
+<br> <br><h3><a class=none name="contents">Contents</a></h3>
+<ol>
+ <li><a href="#example">Example usage</a>
+ <li><a href="#install">Download and installation</a>
+ <li><a href="#mail">Support and mailing lists</a>
+ <li><a href="#syntax">Syntax and Semantics</a>
+ <li><a href="#dictionary">The CL-WHO dictionary</a>
+ <ol>
+ <li><a href="#with-html-output"><code>with-html-output</code></a>
+ <li><a href="#with-html-output-to-string"><code>with-html-output-to-string</code></a>
+ <li><a href="#show-html-expansion"><code>show-html-expansion</code></a>
+ <li><a href="#*attribute-quote-char*"><code>*attribute-quote-char*</code></a>
+ <li><a href="#*prologue*"><code>*prologue*</code></a>
+ <li><a href="#*html-empty-tag-aware-p*"><code>*html-empty-tag-aware-p*</code></a>
+ <li><a href="#*html-empty-tags*"><code>*html-empty-tags*</code></a>
+ <li><a href="#*downcase-tokens-p*"><code>*downcase-tokens-p*</code></a>
+ <li><a href="#esc"><code>esc</code></a>
+ <li><a href="#fmt"><code>fmt</code></a>
+ <li><a href="#htm"><code>htm</code></a>
+ <li><a href="#str"><code>str</code></a>
+ <li><a href="#html-mode"><code>html-mode</code></a>
+ <li><a href="#escape-string"><code>escape-string</code></a>
+ <li><a href="#escape-char"><code>escape-char</code></a>
+ <li><a href="#*escape-char-p*"><code>*escape-char-p*</code></a>
+ <li><a href="#escape-string-minimal"><code>escape-string-minimal</code></a>
+ <li><a href="#escape-string-minimal-plus-quotes"><code>escape-string-minimal-plus-quotes</code></a>
+ <li><a href="#escape-string-iso-8859"><code>escape-string-iso-8859</code></a>
+ <li><a href="#escape-string-iso-8859-1"><code>escape-string-iso-8859-1</code></a>
+ <li><a href="#escape-string-all"><code>escape-string-all</code></a>
+ <li><a href="#escape-char-minimal"><code>escape-char-minimal</code></a>
+ <li><a href="#escape-char-minimal-plus-quotes"><code>escape-char-minimal-plus-quotes</code></a>
+ <li><a href="#escape-char-iso-8859-1"><code>escape-char-iso-8859-1</code></a>
+ <li><a href="#escape-char-all"><code>escape-char-all</code></a>
+ <li><a href="#conc"><code>conc</code></a>
+ <li><a href="#convert-tag-to-string-list"><code>convert-tag-to-string-list</code></a>
+ <li><a href="#convert-attributes"><code>convert-attributes</code></a>
+ </ol>
+ <li><a href="#ack">Acknowledgements</a>
+</ol>
+
+<br> <br><h3><a name="example" class=none>Example usage</a></h3>
+
+Let's assume that <code>*HTTP-STREAM*</code> 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.
+
+<table border=0 cellspacing=10 width="100%">
+
+<tr>
+<td bgcolor="#e0e0e0" valign=top><pre>
+(<a class=noborder href="#with-html-output">with-html-output</a> (*http-stream*)
+ (loop for (link . title) in '(("http://zappa.com/" . "Frank Zappa")
+ ("http://marcusmiller.com/" . "Marcus Miller")
+ ("http://www.milesdavis.com/" . "Miles Davis"))
+ do (<a class=noborder href="#htm">htm</a> (:a :href link
+ (:b (str title)))
+ :br)))
+</pre></td>
+
+<td valign=top rowspan=2>
+<a href='http://zappa.com/'><b>Frank Zappa</b></a><br /><a href='http://marcusmiller.com/'><b>Marcus Miller</b></a><br /><a href='http://www.milesdavis.com/'><b>Miles Davis</b></a><br />
+</td>
+</tr>
+
+<tr>
+<td bgcolor="#e0e0e0" valign=top><pre>
+<font color="orange">;; Code generated by CL-WHO</font>
+
+(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*)))))
+</pre></td>
+</tr>
+
+<tr>
+<td bgcolor="#e0e0e0" valign=top><pre>
+(<a class=noborder href="#with-html-output">with-html-output</a> (*http-stream*)
+ (:table :border 0 :cellpadding 4
+ (loop for i below 25 by 5
+ do (<a class=noborder href="#htm">htm</a>
+ (:tr :align "right"
+ (loop for j from i below (+ i 5)
+ do (<a class=noborder href="#htm">htm</a>
+ (:td :bgcolor (if (oddp j)
+ "pink"
+ "green")
+ (fmt "~@R" (1+ j))))))))))
+</pre></td>
+
+<td valign=top rowspan=2>
+<table border='0' cellpadding='4'><tr align='right'><td bgcolor='green'>I</td><td bgcolor='pink'>II</td><td bgcolor='green'>III</td><td bgcolor='pink'>IV</td><td bgcolor='green'>V</td></tr><tr align='right'><td bgcolor='pink'>VI</td><td bgcolor='green'>VII</td><td bgcolor='pink'>VIII</td><td bgcolor='green'>IX</td><td bgcolor='pink'>X</td></tr><tr align='right'><td bgcolor='green'>XI</td><td bgcolor='pink'>XII</td><td bgcolor='green'>XIII</td><td bgcolor='pink'>XIV</td><td bgcolor='green'>XV</td></tr><tr align='right'><td bgcolor='pink'>XVI</td><td bgcolor='green'>XVII</td><td bgcolor='pink'>XVIII</td><td bgcolor='green'>XIX</td><td bgcolor='pink'>XX</td></tr><tr align='right'><td bgcolor='green'>XXI</td><td bgcolor='pink'>XXII</td><td bgcolor='green'>XXIII</td><td bgcolor='pink'>XXIV</td><td bgcolor='green'>XXV</td></tr></table>
+</td>
+</tr>
+
+<tr>
+<td bgcolor="#e0e0e0" valign=top><pre>
+<font color="orange">;; Code generated by CL-WHO</font>
+
+(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*)))
+</pre></td>
+</tr>
+
+<tr>
+<td bgcolor="#e0e0e0" valign=top><pre>
+(<a class=noborder href="#with-html-output">with-html-output</a> (*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 (<a class=noborder href="#htm">htm</a>
+ (:p :style (<a href="#conc">conc</a> "background-color:" (case (mod i 3)
+ ((0) "red")
+ ((1) "orange")
+ ((2) "blue")))
+ (<a class=noborder href="#htm">htm</a> (<a href="#esc">esc</a> string))))))
+</pre></td>
+<td valign=top rowspan=2>
+<h4>Look at the character entities generated by this example</h4><p style='background-color:red'>Fête</p><p style='background-color:orange'>Sørensen</p><p style='background-color:blue'>naïve</p><p style='background-color:red'>Hühner</p><p style='background-color:orange'>Straße</p>
+</td>
+</tr>
+
+<tr>
+<td bgcolor="#e0e0e0" valign=top><pre>
+<font color="orange">;; Code generated by CL-WHO</font>
+
+(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 (<a class=noborder href="#conc">conc</a> "background-color:"
+ (case (mod i 3)
+ ((0) "red")
+ ((1) "orange")
+ ((2) "blue")))
+ *http-stream*)
+ (write-string "'>" *http-stream*)
+ (progn (write-string (<a class=noborder href="#escape-string">escape-string</a> string) *http-stream*))
+ (write-string "</p>" *http-stream*)))))
+</pre></td>
+</tr>
+
+
+</table>
+
+<br> <br><h3><a name="install" class=none>Download and installation</a></h3>
+
+CL-WHO together with this documentation can be downloaded from <a
+href="http://weitz.de/files/cl-who.tar.gz">http://weitz.de/files/cl-who.tar.gz</a>. The
+current version is 0.11.0.
+<p>
+The preferred method to compile and load Hunchentoot is via <a href="http://www.cliki.net/asdf">ASDF</a>.
+<p>
+If you're on <a href="http://www.debian.org/">Debian</a> you can
+probably use
+the <a
+href="http://packages.debian.org/cgi-bin/search_packages.pl?keywords=cl-who&searchon=names&version=all&release=all">cl-who
+Debian package</a> which is available thanks to Kevin
+Rosenberg. There's also a port
+for <a
+href="http://www.gentoo.org/proj/en/common-lisp/index.xml">Gentoo
+Linux</a> thanks to Matthew Kennedy. In both cases, check if they have the newest version available.
+<p>
+Luís Oliveira maintains a <a href="http://darcs.net/">darcs</a>
+repository of CL-WHO
+at <a
+href="http://common-lisp.net/~loliveira/ediware/">http://common-lisp.net/~loliveira/ediware/</a>.
+
+<br> <br><h3><a name="mail" class=none>Support and mailing lists</a></h3>
+
+For questions, bug reports, feature requests, improvements, or patches
+please use the <a
+href="http://common-lisp.net/mailman/listinfo/cl-who-devel">cl-who-devel
+mailing list</a>. If you want to be notified about future releases
+subscribe to the <a
+href="http://common-lisp.net/mailman/listinfo/cl-who-announce">cl-who-announce
+mailing list</a>. These mailing lists were made available thanks to
+the services of <a href="http://common-lisp.net/">common-lisp.net</a>.
+<p>
+If you want to send patches, please <a href="http://weitz.de/patches.html">read this first</a>.
+
+<br> <br><h3><a name="syntax" class=none>Syntax and Semantics</a></h3>
+
+CL-WHO is essentially just one <a
+href="http://cl-cookbook.sourceforge.net/macros.html">macro</a>, <a
+href="#with-html-output"><code>WITH-HTML-OUTPUT</code></a>, which
+transforms the body of code it encloses into something else obeying the
+following rules (which we'll call <em>transformation rules</em>) for the body's forms:
+
+<ul>
+
+ <li>A string will be printed verbatim. To be
+more precise, it is transformed into a form which'll print this
+string to the stream the user provides.
+
+<table border=0 cellpadding=2 cellspacing=3><tr><td><pre>"foo" <font color="red">=></font> (write-string "foo" s)</pre></td></tr></table>
+
+ (Here and for the rest of this document the <em>red arrow</em> means '... will be converted to code equivalent to ...' where <em>equivalent</em> means that all output is sent to the "right" stream.)
+
+ <li>Each list beginning with a <a
+href="http://www.lispworks.com/reference/HyperSpec/Body/t_kwd.htm"><em>keyword</em></a>
+is transformed into an (X)HTML <b>tag</b> of the same (usually <href="#*downcase-tokens-p*">downcased</a>) name by the following rules:
+
+ <ul>
+
+ <li>If the list contains nothing but the keyword, the resulting tag
+ will be empty.
+
+ <table border=0 cellpadding=2 cellspacing=3><tr><td><pre>(:br) <font color="red">=></font> (write-string "<br />" s)</pre></td></tr></table>
+ With <a href="#html-mode"><code>HTML-MODE</code></a> set to <code>:SGML</code> an empty element is written this way:
+ <table border=0 cellpadding=2 cellspacing=3><tr><td><pre>(:br) <font color="red">=></font> (write-string "<br>" s)</pre></td></tr></table>
+
+ <li>The initial keyword can be followed by another keyword which will be interpreted as the name of an <b>attribute</b>. The next form which will be taken as the attribute's <b>value</b>. (If there's no next form it'll be as if the next form had been <code>NIL</code>.) The form denoting the attribute's value will be treated as follows. (Note that the behaviour with respect to attributes is <em>incompatible</em> with versions earlier than 0.3.0!)
+ <ul>
+ <li>If it is a string it will be printed literally.
+
+ <table border=0 cellpadding=2 cellspacing=3><tr><td><pre>(:td :bgcolor "red") <font color="red">=></font> (write-string "<td bgcolor='red' />" s)</pre></td></tr></table>
+
+ <li>If it is <code>T</code> and <a href="#html-mode"><code>HTML-MODE</code></a> is <code>:XML</code> (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).
+
+ <table border=0 cellpadding=2 cellspacing=3><tr><td><pre>(:td :nowrap t) <font color="red">=></font> (write-string "<td nowrap='nowrap' />" s)</pre></td></tr></table>
+
+ With <a href="#html-mode"><code>HTML-MODE</code></a> set to <code>:SGML</code>:
+
+ <table border=0 cellpadding=2 cellspacing=3><tr><td><pre>(:td :nowrap t) <font color="red">=></font> (write-string "<td nowrap>" s)</pre></td></tr></table>
+
+ <li>If it is <code>NIL</code> the attribute will be left out completely.
+
+ <table border=0 cellpadding=2 cellspacing=3><tr><td><pre>(:td :nowrap nil) <font color="red">=></font> (write-string "<td />" s)</pre></td></tr></table>
+
+ <li>If it is a <a
+ href="http://www.lispworks.com/reference/HyperSpec/Body/26_glo_c.htm#constant_form"><em>constant form</em></a>, the result of evaluating it will be inserted into the resulting string as if printed with the <a
+ href="http://www.lispworks.com/reference/HyperSpec/Body/26_glo_c.htm#constant_form">format string</a> <code>"~A"</code> at macro expansion time.
+
+ <table border=0 cellpadding=2 cellspacing=3><tr><td><pre>(:table :border 3) <font color="red">=></font> (write-string "<table border='3' />" s)</pre></td></tr></table>
+
+ <li>If it is any other form it will be left as is and later evaluated at run time and printed with <a
+ href="http://www.lispworks.com/reference/HyperSpec/Body/f_wr_pr.htm"><code>PRINC</code></a> <em>unless</em> the value is <code>T</code> or <code>NIL</code> which will be treated as above. (It is the application developer's job to provide the correct <a href="http://www.lispworks.com/reference/HyperSpec/Body/26_glo_p.htm#printer_control_variable">printer control variables</a>.)
+
+ <table border=0 cellpadding=2 cellspacing=3><tr><td><pre><font color="orange">;; simplified example, see function CHECKBOX below
+;; note that this form is not necessarily CONSTANTP in all Lisps</font>
+
+(:table :border (+ 1 2)) <font color="red">=></font> (write-string "<table border='" s)
+ (princ (+ 1 2) s)
+ (write-string "' />" s)</pre></td></tr></table>
+ </ul>
+
+ <li>Once an attribute/value pair has been worked up another one can follow, i.e. if the form following an attribute's value is again a keyword it will again be treated as an attribute and so on.
+
+ <table border=0 cellpadding=2 cellspacing=3><tr><td><pre>(:table :border 0 :cellpadding 5 :cellspacing 5)
+ <font color="red">=></font> (write-string "<table border='0' cellpadding='5' cellspacing='5' />" s)</pre></td></tr></table>
+
+ <li>The first form following either the tag's name itself or an attribute value which is <em>not</em> a keyword determines the beginning of the tag's <b>content</b>. This and all the following forms are subject to the transformation rules we're just describing.
+
+ <table border=0 cellpadding=2 cellspacing=3><tr><td><pre>(:p "Paragraph") <font color="red">=></font> (write-string "<p>Paragraph</p>" s)
+(:p :class "foo" "Paragraph") <font color="red">=></font> (write-string "<p class='foo'>Paragraph</p>" s)
+(:p :class "foo" "One" " " "long" " " "sentence") <font color="red">=></font> (write-string "<p class='foo'>One long sentence</p>" s)
+(:p :class "foo" "Visit " (:a :href "http://www.cliki.net/" "CLiki"))
+ <font color="red">=></font> (write-string "<p class='foo'>Visit <a href='http://www.cliki.net/'>CLiki</a></p>" s)</pre></td></tr></table>
+
+ <li>Beginning with <a href="#install">version 0.4.0</a> you can also use a syntax like that of <a href="http://opensource.franz.com/xmlutils/xmlutils-dist/phtml.htm">LHTML</a> where the tag and all attribute/value pairs are enclosed in an additional list:
+
+ <table border=0 cellpadding=2 cellspacing=3><tr><td><pre>((:p) "Paragraph") <font color="red">=></font> (write-string "<p>Paragraph</p>" s)
+((:p :class "foo") "Paragraph") <font color="red">=></font> (write-string "<p class='foo'>Paragraph</p>" s)
+((:p :class "foo" :name "humpty-dumpty") "One" " " "long" " " "sentence")
+ <font color="red">=></font> (write-string "<p class='foo' name='humpty-dumpty'>One long sentence</p>" s)
+((:p :class "foo") "Visit " ((:a :href "http://www.cliki.net/") "CLiki"))
+ <font color="red">=></font> (write-string "<p class='foo'>Visit <a href='http://www.cliki.net/'>CLiki</a></p>" s)</pre></td></tr></table>
+
+ </ul>
+
+ Here's a slightly more elaborate example:
+<pre>
+* (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' />"
+</pre>
+
+ <li>A keyword alone will be treated like a list containing only this keyword.
+
+<table border=0 cellpadding=2 cellspacing=3><tr><td><pre>:hr <font color="red">=></font> (write-string "<hr />" s)</pre></td></tr></table>
+
+ <li>A form which is neither a string nor a keyword nor a list beginning with a keyword will be left as is except for the following <em>substitutions</em>:
+ <ul>
+ <li>Forms that look like <code>(<b>str</b> <i>form1</i> <i>form*</i>)</code> will be substituted with
+ <span style="white-space: nowrap"><code>(let ((result <i>form1</i>)) (when result (princ result s)))</code></span>. <br>
+ (Note that all forms behind <code><i>form1</i></code> are ignored.)
+
+<table border=0 cellpadding=2 cellspacing=3><tr><td><pre>(loop for i below 10 do (str i)) <font color="red">=></font>
+(loop for i below 10 do
+ (let ((#:result i))
+ (when #:result (princ #:result *standard-output*))))</pre></td></tr></table>
+
+ <li>Forms that look like <code>(<b>fmt</b> <i>form*</i>)</code> will be substituted with <code>(format s <i>form*</i>)</code>.
+
+<table border=0 cellpadding=2 cellspacing=3><tr><td><pre>(loop for i below 10 do (fmt "~R" i)) <font color="red">=></font> (loop for i below 10 do (format s "~R" i))</pre></td></tr></table>
+ <li>Forms that look like <code>(<b>esc</b> <i>form1</i> <i>form*</i>)</code> will be substituted with
+ <span style="white-space: nowrap"><code>(let ((result <i>form1</i>)) (when result (write-string (<a href="#escape-string">escape-string</a> result s))))</code></span>.
+
+ <li>If a form looks like <code>(<b>htm</b> <i>form*</i>)</code> then each of the <code><i>forms</i></code> will be subject to the transformation rules we're just describing.
+
+<table border=0 cellpadding=2 cellspacing=3><tr><td><pre>(loop for i below 100 do (htm (:b "foo") :br))
+ <font color="red">=></font> (loop for i below 100 do (progn (write-string "<b>foo</b><br />" s)))</pre></td></tr></table>
+
+
+ </ul>
+
+ <li>That's all. Note in particular that CL-WHO knows <em>nothing</em> about HTML or XHTML, i.e. it doesn't check whether you mis-spelled tag names or use attributes which aren't allowed. CL-WHO doesn't care if you use, say, <code>:foobar</code> instead of <code>:hr</code>.
+</ul>
+
+<br> <br><h3><a class=none name="dictionary">The CL-WHO dictionary</a></h3>
+
+CL-WHO exports the following symbols:
+
+<p><br>[Macro]
+<br><a class=none name="with-html-output"><b>with-html-output</b> <i>(var <tt>&optional</tt> stream <tt>&key</tt> prologue indent) declaration* form*</i> => <i>result*</i></a>
+
+<blockquote><br>
+This is the main macro of CL-WHO. It will transform its body by the transformation rules described in <a href="#syntax"><em>Syntax and Semantics</em></a> such that the output generated is sent to the stream denoted by <code><i>var</i></code> and <code><i>stream</i></code>. <code><i>var</i></code> must be a symbol. If <code><i>stream</i></code> is <code>NIL</code> it is assumed that <code><i>var</i></code> is already bound to a stream, if <code><i>stream</i></code> is not <code>NIL</code> <code><i>var</i></code> will be bound to the form <code><i>stream</i></code> which will be evaluated at run time. <code><i>prologue</i></code> should be a string (or <code>NIL</code> for 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. If <code><i>prologue</i></code> is <code>T</code> the prologue string is the value of <a href="#*prologue*"><code>*PROLOGUE*</code></a>. CL-WHO will usually try not to insert any unnecessary whitespace in order to save bandwidth. However, if <code><i>indent</i></code> is <em>true</em> line breaks will be inserted and nested tags will be intended properly. The value of <code><i>indent</i></code> - if it is an integer - will be taken as the initial indentation. If it is not an integer it is assumed to mean <code>0</code>. The <code><i>results</i></code> are the values returned by the <code><i>forms</i></code>.
+<p>
+Note that the keyword arguments <code><i>prologue</i></code> and <code><i>indent</i></code> are used at macro expansion time.
+
+<pre>
+* (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>
+</pre>
+</blockquote>
+
+<p><br>[Macro]
+<br><a class=none name="with-html-output-to-string"><b>with-html-output-to-string</b> <i>(var <tt>&optional</tt> string-form <tt>&key</tt> element-type prologue indent) declaration* form*</i> => <i>result*</i></a>
+
+<blockquote><br>
+This is just a thin wrapper around <a href="#with-html-output"><code>WITH-HTML-OUTPUT</code></a>. Indeed, the wrapper is so thin that the best explanation probably is to show its definition:
+<pre>
+(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 :elementy-type ,element-type)
+ (with-html-output (,var nil :prologue ,prologue :indent ,indent)
+ , at body)))
+</pre>
+Note that the <code><i>results</i></code> of this macro are determined by the behaviour of <a href="http://www.lispworks.com/reference/HyperSpec/Body/m_w_out_.htm"><code>WITH-OUTPUT-TO-STRING</code></a>.
+</blockquote>
+
+<p><br>[Macro]
+<br><a class=none name="show-html-expansion"><b>show-html-expansion</b> <i>(var <tt>&optional</tt> stream <tt>&key</tt> prologue indent) declaration* form*</i> => <tt><no values></tt></a>
+
+<blockquote><br>
+This macro is intended for debugging purposes. It'll print to <code>*STANDARD-OUTPUT*</code> the code which would have been generated by <a href="#with-html-output"><code>WITH-HTML-OUTPUT</code></a> had it been invoked with the same arguments.
+
+<pre>
+* (show-html-expansion (s)
+ (:html
+ (:body :bgcolor "white"
+ (:table
+ (:tr
+ (dotimes (i 5)
+ (htm (:td :align "left"
+ (str i)))))))))
+(LET ((S S))
+ (PROGN
+ (WRITE-STRING
+ "<html><body bgcolor='white'><table><tr>" S)
+ (DOTIMES (I 5)
+ (PROGN
+ (WRITE-STRING "<td align='left'>" S)
+ (PRINC I S)
+ (WRITE-STRING "</td>" S)))
+ (WRITE-STRING "</tr></table></body></html>" S)))
+</pre>
+</blockquote>
+
+<p><br>[Special variable]
+<br><a class=none name="*attribute-quote-char*"><b>*attribute-quote-char*</b></a>
+
+<blockquote><br>
+This character is used as the quote character when building attributes. Defaults to the single quote <code>#\'</code>. Only other reasonable character is the double quote <code>#\"</code>.
+</blockquote>
+
+<p><br>[Special variable]
+<br><a class=none name="*prologue*"><b>*prologue*</b></a>
+
+<blockquote><br>
+This is the prologue string which will be printed if the <code><i>prologue</i></code> keyword argument to <a href="#with-html-output"><code>WITH-HTML-OUTPUT</code></a> is <code>T</code>. Gets changed when you set <a href="#html-mode"><code>HTML-MODE</code></a>. Its initial value is
+
+<pre>"<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\" \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">"</pre>
+</blockquote>
+
+<p><br>[Special variable]
+<br><a class=none name="*html-empty-tag-aware-p*"><b>*html-empty-tag-aware-p*</b></a>
+
+<blockquote><br>
+Set this to <code>NIL</code> to if you want to use CL-WHO as a strict XML
+generator. Otherwise, CL-WHO will only write empty tags listed in
+<a href="#*html-empty-tags*"><code>*HTML-EMPTY-TAGS*</code></a> as <code><tag/></code> (XHTML mode) or <code><tag></code> (SGML mode). For
+all other tags, it will always generate <code><tag></tag></code>. The initial value of this variable is <code>T</code>.
+</blockquote>
+
+<p><br>[Special variable]
+<br><a class=none name="*html-empty-tags*"><b>*html-empty-tags*</b></a>
+
+<blockquote><br>
+The list of HTML tags that should be output as empty tags. See
+<a href="#*html-empty-tag-aware-p*"><code>*HTML-EMPTY-TAG-AWARE-P*</code></a>.
+The initial value is the list
+<pre>
+(:area :atop :audioscope :base :basefont :br :choose :col :frame
+ :hr :img :input :isindex :keygen :left :limittext :link :meta
+ :nextid :of :over :param :range :right :spacer :spot :tab :wbr)
+</pre>
+</blockquote>
+
+<p><br>[Special variable]
+<br><a class=none name="*downcase-tokens-p*"><b>*downcase-tokens-p*</b></a>
+
+<blockquote><br>
+If the value of this variable is <code>NIL</code>, 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 is <code>T</code>.
+</blockquote>
+
+<p><br>[Symbol]
+<br><a class=none name="esc"><b>esc</b></a>
+<br>[Symbol]
+<br><a class=none name="fmt"><b>fmt</b></a>
+<br>[Symbol]
+<br><a class=none name="htm"><b>htm</b></a>
+<br>[Symbol]
+<br><a class=none name="str"><b>str</b></a>
+
+<blockquote><br>
+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 <a href="#syntax"><em>Syntax and Semantics</em></a>.
+</blockquote>
+
+<p><br>[Accessor]
+<br><a class=none name="html-mode"><b>html-mode</b></a> <i>=> mode</i>
+<br><tt>(setf (</tt><b>html-mode</b>) <i>mode</i><tt>)</tt>
+<blockquote><br>
+The function <code>HTML-MODE</code> returns the current mode for generating HTML. The default is <code>:XML</code> for XHTML. You can change this by setting it with <code>(SETF (HTML-MODE) :SGML)</code> to pre-XML HTML mode.
+<p>
+Setting it to SGML HTML sets the <a href="#*prologue*"><code>*prologue*</code></a> to the doctype string for HTML 4.01 transitional:
+<pre><!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd"></pre>
+Code generation in SGML HTML is slightly different from XHTML - there's no need to end empty elements with <code>/></code> and empty attributes are allowed.
+</blockquote>
+
+<p><br>[Function]
+<br><a class=none name="escape-string"><b>escape-string</b></a> <i>string <tt>&key</tt> test</i> => <i>escaped-string</i>
+
+<blockquote><br>
+This function will accept a string <code><i>string</i></code> and will replace every character for which <code><i>test</i></code> returns <em>true</em> with its character entity. The numeric character entities use decimal instead of hexadecimal values when <a href="#html-mode"><code>HTML-MODE</code></a> is set to <code>:SGML</code> because of compatibility reasons with old clients. <code><i>test</i></code> must be a function of one argument which accepts a character and returns a <a href="http://www.lispworks.com/reference/HyperSpec/Body/26_glo_g.htm#generalized_boolean">generalized boolean</a>. The default is the value of <a href="#*escape-char-p*"><code>*ESCAPE-CHAR-P*</code></a>. Note the <a href="#esc"><code>ESC</code></a> shortcut described in <a href="#syntax"><em>Syntax and Semantics</em></a>.
+
+<pre>
+* (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>"
+</pre>
+</blockquote>
+
+<p><br>[Function]
+<br><a class=none name="escape-char"><b>escape-char</b></a> <i>character <tt>&key</tt> test</i> => <i>escaped-string</i>
+
+<blockquote><br>
+This function works identical to <a href="#escape-string"><code>ESCAPE-STRING</code></a>, except that it operates on characters instead of strings.
+</blockquote>
+
+<p><br>[Special variable]
+<br><a class=none name="*escape-char-p*"><b>*escape-char-p*</b></a>
+
+<blockquote><br>
+This is the default for the <code><i>test</i></code> keyword argument to <a href="#escape-string"><code>ESCAPE-STRING</code></a> and <a href="#escape-char"><code>ESCAPE-CHAR</code></a>. Its initial value is
+
+<pre>
+#'(lambda (char)
+ (or (find char "<>&'\"")
+ (> (char-code char) 127)))
+</pre>
+</blockquote>
+
+<p><br>[Function]
+<br><a class=none name="escape-string-minimal"><b>escape-string-minimal</b> <i>string</i> => <i>escaped-string</i></a>
+<br>[Function]
+<br><a class=none name="escape-string-minimal-plus-quotes"><b>escape-string-minimal-plus-quotes</b> <i>string</i> => <i>escaped-string</i></a>
+<br>[Function]
+<br><a class=none name="escape-string-iso-8859-1"><b>escape-string-iso-8859-1</b> <i>string</i> => <i>escaped-string</i></a>
+<br>[Function]
+<br><a class=none name="escape-string-iso-8859"><b>escape-string-iso-8859</b> <i>string</i> => <i>escaped-string</i></a>
+<br>[Function]
+<br><a class=none name="escape-string-all"><b>escape-string-all</b> <i>string</i> => <i>escaped-string</i></a>
+<br>[Function]
+<br><a class=none name="escape-char-minimal"><b>escape-char-minimal</b> <i>character</i> => <i>escaped-string</i></a>
+<br>[Function]
+<br><a class=none name="escape-char-minimal-plus-quotes"><b>escape-char-minimal-plus-quotes</b> <i>character</i> => <i>escaped-string</i></a>
+<br>[Function]
+<br><a class=none name="escape-char-iso-8859-1"><b>escape-char-iso-8859-1</b> <i>character</i> => <i>escaped-string</i></a>
+<br>[Function]
+<br><a class=none name="escape-char-all"><b>escape-char-all</b> <i>character</i> => <i>escaped-string</i></a>
+
+<blockquote><br> These are convenience function based
+on <a href="#escape-string"><code>ESCAPE-STRING</code></a>
+and <a href="#escape-char"><code>ESCAPE-CHAR</code></a>. The string
+functions are defined in a way similar to this one:
+
+<pre>
+(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-iso-8859 (string)
+ "Identical to ESCAPE-STRING-ISO-8859-1. Kept for backward compatibility."
+ (escape-string-iso-8859-1 string))
+
+(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)))))
+</pre>
+The character functions are defined in an analogous manner.
+</blockquote>
+
+<p><br>[Function]
+<br><a class=none name="conc"><b>conc</b> <i><tt>&rest</tt> string-list</i> => <i>string</i></a>
+
+<blockquote><br>
+Utility function to concatenate all arguments (which should be strings) into one string. Meant to be used mainly with attribute values.
+
+<pre>
+* (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>"
+</pre>
+</blockquote>
+
+<p><br>[Generic Function]
+<br><a class=none name="convert-tag-to-string-list"><b>convert-tag-to-string-list</b></a> <i>tag attr-list body body-fn</i> => <i>strings-or-forms</i>
+
+<blockquote><br>
+
+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.
+<p>
+<code><i>tag</i></code> is a keyword symbol naming the outer tag,
+<code><i>attr-list</i></code> is an alist of its attributes (the car
+is the attribute's name as a keyword, the cdr is its value),
+<code><i>body</i></code> is the tag's body, and
+<code><i>body-fn</i></code> is a function which should be applied to
+the body to further process it. Of course, if you define your own
+methods you can ignore <code><i>body-fn</i></code> if you want.
+<p>
+Here are some simple examples:
+<pre>
+* (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"
+ (<a class=noborder href="#convert-attributes">convert-attributes</a> (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
+ <font color=orange>;; you could as well invoke CALL-NEXT-METHOD here, of course</font>
+ (nconc (cons "<table "
+ (<a class=noborder href="#convert-attributes">convert-attributes</a> 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)))
+</pre>
+
+</blockquote>
+
+<p><br>[Function]
+<br><a class=none name="convert-attributes"><b>convert-attributes</b></a> <i>attr-list</i> => <i>strings-or-forms</i>
+
+<blockquote><br>
+
+This is a helper function which can be called from
+<a href="#convert-tag-to-string-list"><code>CONVERT-TAG-TO-STRING-LIST</code></a> to process the list of attributes.
+
+</blockquote>
+
+<br> <br><h3><a class=none name="ack">Acknowledgements</a></h3>
+
+Thanks to Tim Bradshaw and John Foderaro for the inspiration provided
+by their libraries mentioned <a href="#abstract">above</a>. Thanks to
+Jörg-Cyril Höhle for his suggestions with respect to
+attribute values. Thanks to Kevin Rosenberg for the LHTML patch.
+Thanks to Stefan Scholl for the 'old school' patch. Thanks to Mac
+Chan for several useful additions.
+
+<p>
+$Header: /usr/local/cvsrep/cl-who/doc/index.html,v 1.58 2007/08/24 08:01:40 edi Exp $
+<p><a href="http://weitz.de/index.html">BACK TO MY HOMEPAGE</a>
+
+</body>
+</html>
Added: branches/trunk-reorg/thirdparty/cl-who-0.11.0/packages.lisp
===================================================================
--- branches/trunk-reorg/thirdparty/cl-who-0.11.0/packages.lisp 2007-10-07 23:19:21 UTC (rev 2231)
+++ branches/trunk-reorg/thirdparty/cl-who-0.11.0/packages.lisp 2007-10-08 04:39:27 UTC (rev 2232)
@@ -0,0 +1,65 @@
+;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-USER; Base: 10 -*-
+;;; $Header: /usr/local/cvsrep/cl-who/packages.lisp,v 1.17 2007/08/24 08:01:37 edi Exp $
+
+;;; Copyright (c) 2003-2007, 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)
+ (:export :*attribute-quote-char*
+ :*escape-char-p*
+ :*prologue*
+ :*downcase-tokens-p*
+ :*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
+ :escape-string-iso-8859-1
+ :escape-string-minimal
+ :escape-string-minimal-plus-quotes
+ :fmt
+ :htm
+ :html-mode
+ :show-html-expansion
+ :str
+ :with-html-output
+ :with-html-output-to-string))
+
+(pushnew :cl-who *features*)
\ No newline at end of file
Added: branches/trunk-reorg/thirdparty/cl-who-0.11.0/specials.lisp
===================================================================
--- branches/trunk-reorg/thirdparty/cl-who-0.11.0/specials.lisp 2007-10-07 23:19:21 UTC (rev 2231)
+++ branches/trunk-reorg/thirdparty/cl-who-0.11.0/specials.lisp 2007-10-08 04:39:27 UTC (rev 2232)
@@ -0,0 +1,113 @@
+;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package:CL-WHO; Base: 10 -*-
+;;; $Header: /usr/local/cvsrep/cl-who/specials.lisp,v 1.2 2007/08/24 08:01:37 edi Exp $
+
+;;; Copyright (c) 2003-2007, 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*
+ "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\" \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">"
+ "This is the first line that'll be printed if the :PROLOGUE keyword
+argument is T")
+
+(defparameter *escape-char-p*
+ #'(lambda (char)
+ (or (find char "<>&'\"")
+ (> (char-code char) 127)))
+ "Used by ESCAPE-STRING to test whether a character should be escaped.")
+
+(defparameter *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.")
+
+(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.")
+
+(defparameter *attribute-quote-char* #\'
+ "Quote character for attributes.")
+
+(defparameter *empty-tag-end* " />"
+ "End of an empty tag. Default is XML style.")
+
+(defparameter *html-empty-tags*
+ '(:area
+ :atop
+ :audioscope
+ :base
+ :basefont
+ :br
+ :choose
+ :col
+ :frame
+ :hr
+ :img
+ :input
+ :isindex
+ :keygen
+ :left
+ :limittext
+ :link
+ :meta
+ :nextid
+ :of
+ :over
+ :param
+ :range
+ :right
+ :spacer
+ :spot
+ :tab
+ :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 <tag/> \(XHTML mode) or <tag> \(SGML
+mode). For all other tags, it will always generate
+<tag></tag>.")
+
+(defconstant +newline+ (make-string 1 :initial-element #\Newline)
+ "Used for indentation.")
+
+(defconstant +spaces+ (make-string 2000
+ :initial-element #\Space
+ :element-type 'base-char)
+ "Used for indentation.")
+
Property changes on: branches/trunk-reorg/thirdparty/cl-who-0.11.0/specials.lisp
___________________________________________________________________
Name: svn:executable
+ *
Added: branches/trunk-reorg/thirdparty/cl-who-0.11.0/who.lisp
===================================================================
--- branches/trunk-reorg/thirdparty/cl-who-0.11.0/who.lisp 2007-10-07 23:19:21 UTC (rev 2231)
+++ branches/trunk-reorg/thirdparty/cl-who-0.11.0/who.lisp 2007-10-08 04:39:27 UTC (rev 2232)
@@ -0,0 +1,499 @@
+;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package:CL-WHO; Base: 10 -*-
+;;; $Header: /usr/local/cvsrep/cl-who/who.lisp,v 1.35 2007/08/24 08:01:37 edi Exp $
+
+;;; Copyright (c) 2003-2007, 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)
+
+(defmacro n-spaces (n)
+ "A string with N spaces - used by indentation."
+ `(make-array ,n
+ :element-type 'base-char
+ :displaced-to +spaces+
+ :displaced-index-offset 0))
+
+(defun html-mode ()
+ "Returns the current HTML mode. :SGML for (SGML-)HTML and
+:XML for XHTML."
+ *html-mode*)
+
+(defun (setf html-mode) (mode)
+ "Sets the output mode to XHTML or \(SGML-)HTML. MODE can be
+:SGML for HTML or :XML for XHTML."
+ (ecase mode
+ ((:sgml)
+ (setf *html-mode* :sgml
+ *empty-tag-end* ">"
+ *prologue* "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\" \"http://www.w3.org/TR/html4/loose.dtd\">"))
+ ((:xml)
+ (setf *html-mode* :xml
+ *empty-tag-end* " />"
+ *prologue* "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\" \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">"))))
+
+(declaim (inline escape-char))
+(defun escape-char (char &key (test *escape-char-p*))
+ (declare (optimize speed))
+ "Returns an escaped version of the character CHAR if CHAR satisfies
+the predicate TEST. Always returns a string."
+ (if (funcall test char)
+ (case char
+ (#\< "<")
+ (#\> ">")
+ (#\& "&")
+ (#\' "'")
+ (#\" """)
+ (t (format nil (if (eq *html-mode* :xml) "&#x~x;" "&#~d;")
+ (char-code char))))
+ (make-string 1 :initial-element char)))
+
+(defun escape-string (string &key (test *escape-char-p*))
+ (declare (optimize speed))
+ "Escape all characters in STRING which pass TEST. This function is
+not guaranteed to return a fresh string. Note that you can pass NIL
+for STRING which'll just be returned."
+ (let ((first-pos (position-if test string))
+ (format-string (if (eq *html-mode* :xml) "&#x~x;" "&#~d;")))
+ (if (not first-pos)
+ ;; nothing to do, just return STRING
+ string
+ (with-output-to-string (s)
+ (loop with len = (length string)
+ for old-pos = 0 then (1+ pos)
+ for pos = first-pos
+ then (position-if test string :start old-pos)
+ ;; now the characters from OLD-POS to (excluding) POS
+ ;; don't have to be escaped while the next character has to
+ for char = (and pos (char string pos))
+ while pos
+ do (write-sequence string s :start old-pos :end pos)
+ (case char
+ ((#\<)
+ (write-sequence "<" s))
+ ((#\>)
+ (write-sequence ">" s))
+ ((#\&)
+ (write-sequence "&" s))
+ ((#\')
+ (write-sequence "'" s))
+ ((#\")
+ (write-sequence """ s))
+ (otherwise
+ (format s format-string (char-code char))))
+ while (< (1+ pos) len)
+ finally (unless pos
+ (write-sequence string s :start old-pos)))))))
+
+(flet ((minimal-escape-char-p (char) (find char "<>&")))
+ (defun escape-char-minimal (char)
+ "Escapes only #\<, #\>, and #\& characters."
+ (escape-char char :test #'minimal-escape-char-p))
+ (defun escape-string-minimal (string)
+ "Escapes only #\<, #\>, and #\& in STRING."
+ (escape-string string :test #'minimal-escape-char-p)))
+
+(flet ((minimal-plus-quotes-escape-char-p (char) (find char "<>&'\"")))
+ (defun escape-char-minimal-plus-quotes (char)
+ "Like ESCAPE-CHAR-MINIMAL but also escapes quotes."
+ (escape-char char :test #'minimal-plus-quotes-escape-char-p))
+ (defun escape-string-minimal-plus-quotes (string)
+ "Like ESCAPE-STRING-MINIMAL but also escapes quotes."
+ (escape-string string :test #'minimal-plus-quotes-escape-char-p)))
+
+(flet ((iso-8859-1-escape-char-p (char)
+ (or (find char "<>&'\"")
+ (> (char-code char) 255))))
+ (defun escape-char-iso-8859-1 (char)
+ "Escapes characters that aren't defined in ISO-8859-9."
+ (escape-char char :test #'iso-8859-1-escape-char-p))
+ (defun escape-string-iso-8859-1 (string)
+ "Escapes all characters in STRING which aren't defined in ISO-8859-1."
+ (escape-string string :test #'iso-8859-1-escape-char-p)))
+
+(defun escape-string-iso-8859 (string)
+ "Identical to ESCAPE-STRING-8859-1. Kept for backward compatibility."
+ (escape-string-iso-8859-1 string))
+
+(flet ((non-7bit-ascii-escape-char-p (char)
+ (or (find char "<>&'\"")
+ (> (char-code char) 127))))
+ (defun escape-char-all (char)
+ "Escapes characters which aren't in the 7-bit ASCII character set."
+ (escape-char char :test #'non-7bit-ascii-escape-char-p))
+ (defun escape-string-all (string)
+ "Escapes all characters in STRING which aren't in the 7-bit ASCII
+character set."
+ (escape-string string :test #'non-7bit-ascii-escape-char-p)))
+
+(defun process-tag (sexp body-fn)
+ (declare (optimize speed space))
+ "Returns a string list corresponding to the `HTML' \(in CL-WHO
+syntax) in SEXP. Uses the generic function CONVERT-TO-STRING-LIST
+internally. Utility function used by TREE-TO-TEMPLATE."
+ (let (tag attr-list body)
+ (cond
+ ((keywordp sexp)
+ (setq tag sexp))
+ ((atom (first sexp))
+ (setq tag (first sexp))
+ ;; collect attribute/value pairs into ATTR-LIST and tag body (if
+ ;; any) into BODY
+ (loop for rest on (cdr sexp) by #'cddr
+ if (keywordp (first rest))
+ collect (cons (first rest) (second rest)) into attr
+ else
+ do (progn (setq attr-list attr)
+ (setq body rest)
+ (return))
+ finally (setq attr-list attr)))
+ ((listp (first sexp))
+ (setq tag (first (first sexp)))
+ (loop for rest on (cdr (first sexp)) by #'cddr
+ if (keywordp (first rest))
+ collect (cons (first rest) (second rest)) into attr
+ finally (setq attr-list attr))
+ (setq body (cdr sexp))))
+ (convert-tag-to-string-list tag attr-list body body-fn)))
+
+(defun convert-attributes (attr-list)
+ "Helper function for CONVERT-TAG-TO-STRING-LIST which converts the
+alist ATTR-LIST of attributes into a list of strings and/or Lisp
+forms."
+ (declare (optimize speed space))
+ (loop with =var= = (gensym)
+ with attribute-quote = (string *attribute-quote-char*)
+ for (orig-attr . val) in attr-list
+ for attr = (if *downcase-tokens-p*
+ (string-downcase orig-attr)
+ (string orig-attr))
+ unless (null val) ;; no attribute at all if VAL is NIL
+ if (constantp val)
+ if (and (eq *html-mode* :sgml) (eq val t)) ; special case for SGML
+ nconc (list " " attr)
+ else
+ nconc (list " "
+ ;; name of attribute
+ attr
+ (format nil "=~C" *attribute-quote-char*)
+ ;; value of attribute
+ (cond ((stringp val)
+ ;; a string, just use it - this case is
+ ;; actually not necessary because of
+ ;; the last case
+ val)
+ ((eq val t)
+ ;; VAL is T, use attribute's name
+ attr)
+ (t
+ ;; constant form, PRINC it -
+ ;; EVAL is OK here because of CONSTANTP
+ (format nil "~A" (eval val))))
+ attribute-quote)
+ end
+ else
+ ;; do the same things as above but at runtime
+ nconc (list `(let ((,=var= ,val))
+ (cond ((null ,=var=))
+ ((eq ,=var= t)
+ ,(case *html-mode*
+ (:sgml
+ `(htm ,(format nil " ~A" attr)))
+ ;; otherwise default to :xml mode
+ (t
+ `(htm ,(format nil " ~A=~C~A~C"
+ attr
+ *attribute-quote-char*
+ attr
+ *attribute-quote-char*)))))
+ (t
+ (htm ,(format nil " ~A=~C" attr *attribute-quote-char*)
+ (str ,=var=)
+ ,attribute-quote)))))))
+
+(defgeneric convert-tag-to-string-list (tag attr-list body body-fn)
+ (:documentation "Used by PROCESS-TAG to convert `HTML' into a list
+of strings. TAG is a keyword symbol naming the outer tag, ATTR-LIST
+is an alist of its attributes \(the car is the attribute's name as a
+keyword, the cdr is its value), BODY is the tag's body, and BODY-FN is
+a function which should be applied to BODY. The function must return
+a list of strings or Lisp forms."))
+
+(defmethod convert-tag-to-string-list (tag attr-list body body-fn)
+ "The standard method which is not specialized. The idea is that you
+can use EQL specializers on the first argument."
+ (declare (optimize speed space))
+ (let ((tag (if *downcase-tokens-p* (string-downcase tag) (string tag))))
+ (nconc
+ (if *indent*
+ ;; indent by *INDENT* spaces
+ (list +newline+ (n-spaces *indent*)))
+ ;; tag name
+ (list "<" tag)
+ ;; attributes
+ (convert-attributes attr-list)
+ ;; body
+ (if body
+ (append
+ (list ">")
+ ;; now hand over the tag's body to TREE-TO-TEMPLATE, increase
+ ;; *INDENT* by 2 if necessary
+ (if *indent*
+ (let ((*indent* (+ 2 *indent*)))
+ (funcall body-fn body))
+ (funcall body-fn body))
+ (if *indent*
+ ;; indentation
+ (list +newline+ (n-spaces *indent*)))
+ ;; closing tag
+ (list "</" tag ">"))
+ ;; no body, so no closing tag unless defined in *HTML-EMPTY-TAGS*
+ (if (or (not *html-empty-tag-aware-p*)
+ (member tag *html-empty-tags* :test #'string-equal))
+ (list *empty-tag-end*)
+ (list ">" "</" tag ">"))))))
+
+(defun apply-to-tree (function test tree)
+ (declare (optimize speed space))
+ (declare (type function function test))
+ "Apply FUNCTION recursively to all elements of the tree TREE \(not
+only leaves) which pass TEST."
+ (cond
+ ((funcall test tree)
+ (funcall function tree))
+ ((consp tree)
+ (cons
+ (apply-to-tree function test (car tree))
+ (apply-to-tree function test (cdr tree))))
+ (t tree)))
+
+(defun replace-htm (tree transformation)
+ (declare (optimize speed space))
+ "Replace all subtrees of TREE starting with the symbol HTM with the
+same subtree after TRANSFORMATION has been applied to it. Utility
+function used by TREE-TO-TEMPLATE and TREE-TO-COMMANDS-AUX."
+ (apply-to-tree #'(lambda (element)
+ (cons 'htm (funcall transformation (cdr element))))
+ #'(lambda (element)
+ (and (consp element)
+ (eq (car element) 'htm)))
+ tree))
+
+(defun tree-to-template (tree)
+ "Transforms an HTML tree into an intermediate format - mainly a
+flattened list of strings. Utility function used by TREE-TO-COMMANDS-AUX."
+ (loop for element in tree
+ nconc (cond ((or (keywordp element)
+ (and (listp element)
+ (keywordp (first element)))
+ (and (listp element)
+ (listp (first element))
+ (keywordp (first (first element)))))
+ ;; normal tag
+ (process-tag element #'tree-to-template))
+ ((listp element)
+ ;; most likely a normal Lisp form - check if we
+ ;; have nested HTM subtrees
+ (list
+ (replace-htm element #'tree-to-template)))
+ (t
+ (if *indent*
+ (list +newline+ (n-spaces *indent*) element)
+ (list element))))))
+
+(defun string-list-to-string (string-list)
+ (declare (optimize speed space))
+ "Concatenates a list of strings to one string."
+ ;; note that we can't use APPLY with CONCATENATE here because of
+ ;; CALL-ARGUMENTS-LIMIT
+ (let ((total-size 0))
+ (dolist (string string-list)
+ (incf total-size (length string)))
+ (let ((result-string (make-sequence 'simple-string total-size))
+ (curr-pos 0))
+ (dolist (string string-list)
+ (replace result-string string :start1 curr-pos)
+ (incf curr-pos (length string)))
+ result-string)))
+
+(defun conc (&rest string-list)
+ "Concatenates all arguments which should be string into one string."
+ (funcall #'string-list-to-string string-list))
+
+(defun tree-to-commands-aux (tree stream)
+ (declare (optimize speed space))
+ "Transforms the intermediate representation of an HTML tree into
+Lisp code to print the HTML to STREAM. Utility function used by
+TREE-TO-COMMANDS."
+ (let ((in-string t)
+ collector
+ string-collector)
+ (flet ((emit-string-collector ()
+ "Generate a WRITE-STRING statement for what is currently
+in STRING-COLLECTOR."
+ (list 'write-string
+ (string-list-to-string (nreverse string-collector))
+ stream))
+ (tree-to-commands-aux-internal (tree)
+ "Same as TREE-TO-COMMANDS-AUX but with closed-over STREAM
+for REPLACE-HTM."
+ (tree-to-commands-aux tree stream)))
+ (unless (listp tree)
+ (return-from tree-to-commands-aux tree))
+ (loop for element in tree
+ do (cond ((and in-string (stringp element))
+ ;; this element is a string and the last one
+ ;; also was (or this is the first element) -
+ ;; collect into STRING-COLLECTOR
+ (push element string-collector))
+ ((stringp element)
+ ;; the last one wasn't a string so we start
+ ;; with an empty STRING-COLLECTOR
+ (setq string-collector (list element)
+ in-string t))
+ (string-collector
+ ;; not a string but STRING-COLLECTOR isn't
+ ;; empty so we have to emit the collected
+ ;; strings first
+ (push (emit-string-collector) collector)
+ (setq in-string nil
+ string-collector '())
+ ;; collect this element but walk down the
+ ;; subtree first
+ (push (replace-htm element #'tree-to-commands-aux-internal)
+ collector))
+ (t
+ ;; not a string and empty STRING-COLLECTOR
+ (push (replace-htm element #'tree-to-commands-aux-internal)
+ collector)))
+ finally (return (if string-collector
+ ;; finally empty STRING-COLLECTOR if
+ ;; there's something in it
+ (nreverse (cons (emit-string-collector)
+ collector))
+ (nreverse collector)))))))
+
+(defun tree-to-commands (tree stream &optional prologue)
+ (declare (optimize speed space))
+ "Transforms an HTML tree into code to print the HTML to STREAM."
+ ;; use TREE-TO-TEMPLATE, then TREE-TO-COMMANDS-AUX, and finally
+ ;; replace the special symbols ESC, STR, FMT, and HTM
+ (apply-to-tree #'(lambda (x)
+ (case (first x)
+ ((esc)
+ ;; (ESC form ...)
+ ;; --> (LET ((RESULT form))
+ ;; (WHEN RESULT
+ ;; (WRITE-STRING (ESCAPE-STRING RESULT STREAM))))
+ (let ((result (gensym)))
+ `(let ((,result ,(second x)))
+ (when ,result (write-string (escape-string ,result) ,stream)))))
+ ((str)
+ ;; (STR form ...)
+ ;; --> (LET ((RESULT form))
+ ;; (WHEN RESULT (PRINC RESULT STREAM)))
+ (let ((result (gensym)))
+ `(let ((,result ,(second x)))
+ (when ,result (princ ,result ,stream)))))
+ ((fmt)
+ ;; (FMT form*) --> (FORMAT STREAM form*)
+ (list* 'format stream (rest x)))))
+ #'(lambda (x)
+ (and (consp x)
+ (member (first x)
+ '(esc str fmt)
+ :test #'eq)))
+ ;; wrap PROGN around the HTM forms
+ (apply-to-tree (constantly 'progn)
+ #'(lambda (x)
+ (and (atom x)
+ (eq x 'htm)))
+ (tree-to-commands-aux
+ (if prologue
+ (list* 'htm prologue +newline+
+ (tree-to-template tree))
+ (cons 'htm (tree-to-template tree)))
+ stream))))
+
+(defmacro with-html-output ((var &optional stream
+ &key prologue
+ ((:indent *indent*) *indent*))
+ &body body)
+ "Transform the enclosed BODY consisting of HTML as s-expressions
+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."
+ (when (and *indent*
+ (not (integerp *indent*)))
+ (setq *indent* 0))
+ (when (eq prologue t)
+ (setq prologue *prologue*))
+ `(let ((,var ,(or stream var)))
+ ,(tree-to-commands body var prologue)))
+
+(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
+ #-(or :ecl :cmu :sbcl) :element-type
+ #-(or :ecl :cmu :sbcl) ,element-type)
+ (with-html-output (,var nil :prologue ,prologue :indent ,indent)
+ , at body)))
+
+(defmacro show-html-expansion ((var &optional stream
+ &key prologue
+ ((:indent *indent*) *indent*))
+ &body body)
+ "Show the macro expansion of WITH-HTML-OUTPUT."
+ (when (and *indent*
+ (not (integerp *indent*)))
+ (setq *indent* 0))
+ (when (eq prologue t)
+ (setq prologue *prologue*))
+ `(pprint '(let ((,var ,(or stream var)))
+ ,(tree-to-commands body var prologue))))
+
+;; stuff for Nikodemus Siivola's HYPERDOC
+;; see <http://common-lisp.net/project/hyperdoc/>
+;; and <http://www.cliki.net/hyperdoc>
+;; also used by LW-ADD-ONS
+
+(defvar *hyperdoc-base-uri* "http://weitz.de/cl-who/")
+
+(let ((exported-symbols-alist
+ (loop for symbol being the external-symbols of :cl-who
+ collect (cons symbol
+ (concatenate 'string
+ "#"
+ (string-downcase symbol))))))
+ (defun hyperdoc-lookup (symbol type)
+ (declare (ignore type))
+ (cdr (assoc symbol
+ exported-symbols-alist
+ :test #'eq))))
More information about the Bknr-cvs
mailing list