Dev version

git-svn-id: svn://bknr.net/svn/trunk/thirdparty/cl-who@4336 4281704c-cde7-0310-8518-8e2dc76b1ff0

10 files changed, 839 insertions, 352 deletions

diff --git a/CHANGELOG b/CHANGELOG
index 34aef45..5cd4524 100644
--- a/CHANGELOG
+++ b/CHANGELOG
@@ -1,3 +1,15 @@
+Version 1.0.0
+2009-0x-xx
+Refactored internals and made STR etc. local macros
+Added test suite
+	todo: repla s-h-texp with walk in docs
+Removed deprecated ESCAPE-STRING-ISO-8859 function
+Removed SHOW-HTML-EXPANSION
+
+Version 0.11.1
+2008-03-28
+Replaced T with t to be friendly to AllegroCL's "modern" mode (thanks to John Maraist)
+
 Version 0.11.0
 2007-08-24
 Replaces *DOWNCASE-TAGS-P* with *DOWNCASE-TOKENS-P* (thanks to Osei Poku)
diff --git a/cl-who.asd b/cl-who.asd
index 814fc5a..a1432e7 100644
--- a/cl-who.asd
+++ b/cl-who.asd
@@ -1,7 +1,7 @@
 ;;; -*- 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 $
+;;; $Header: /usr/local/cvsrep/cl-who/cl-who.asd,v 1.24 2009/01/26 11:10:49 edi Exp $
 
-;;; Copyright (c) 2003-2007, Dr. Edmund Weitz.  All rights reserved.
+;;; 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
@@ -28,8 +28,20 @@
 ;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 
 (asdf:defsystem :cl-who
-  :version "0.11.0"
+  :version "0.11.1"
   :serial t
   :components ((:file "packages")
                (:file "specials")
+               (:file "util")
                (:file "who")))
+
+(defsystem :cl-who-test
+  :depends-on (:cl-who :flexi-streams)
+  :components ((:module "test"
+                        :serial t
+                        :components ((:file "packages")
+                                     (:file "tests")))))
+
+(defmethod perform ((o test-op) (c (eql (find-system :cl-who))))
+  (operate 'load-op :cl-who-test)
+  (funcall (intern (symbol-name :run-all-tests) (find-package :cl-who-test))))
diff --git a/doc/index.html b/doc/index.html
index 62a5bfd..91c9ec6 100644
--- a/doc/index.html
+++ b/doc/index.html
@@ -48,7 +48,7 @@ href="http://weitz.de/html-template/">HTML-TEMPLATE</a>.
 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
+HTML generation facilities</a> 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
@@ -60,8 +60,7 @@ 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
+constant strings. CL-WHO's output is
 either XHTML (default) or 'plain' (SGML) HTML &mdash; depending on
 what you've set <a href="#html-mode"><code>HTML-MODE</code></a> to.
 <p>
@@ -74,7 +73,7 @@ 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>.
+CL-WHO is for example used by <a href="http://clutu.com/">clutu</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>.
@@ -90,7 +89,6 @@ CL-WHO is used by <a href="http://clutu.com/">clutu</a>, <a href="http://ergoweb
   <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>
@@ -106,7 +104,6 @@ CL-WHO is used by <a href="http://clutu.com/">clutu</a>, <a href="http://ergoweb
     <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>
@@ -146,7 +143,7 @@ together with the Lisp code generated by CL-WHO and the resulting HTML output.
 
 <tr>
 <td bgcolor="#e0e0e0" valign=top><pre>
-<font color="orange">;; Code generated by CL-WHO</font>
+<font color="orange">;; code generated by CL-WHO (simplified)</font>
 
 (let ((*http-stream* *http-stream*))
   (progn
@@ -185,7 +182,7 @@ together with the Lisp code generated by CL-WHO and the resulting HTML output.
 
 <tr>
 <td bgcolor="#e0e0e0" valign=top><pre>
-<font color="orange">;; Code generated by CL-WHO</font>
+<font color="orange">;; code generated by CL-WHO (simplified)</font>
 
 (let ((*http-stream* *http-stream*))
   (progn
@@ -226,7 +223,7 @@ together with the Lisp code generated by CL-WHO and the resulting HTML output.
 
 <tr>
 <td bgcolor="#e0e0e0" valign=top><pre>
-<font color="orange">;; Code generated by CL-WHO</font>
+<font color="orange">;; code generated by CL-WHO (simplified)</font>
 
 (let ((*http-stream* *http-stream*))
   (progn
@@ -256,9 +253,9 @@ together with the Lisp code generated by CL-WHO and the resulting HTML output.
 
 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.
+current version is 0.2.0.
 <p>
-The preferred method to compile and load Hunchentoot is via <a href="http://www.cliki.net/asdf">ASDF</a>.
+The preferred method to compile and load CL-WHO 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
@@ -274,6 +271,12 @@ Lu&iacute;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>.
+<p>
+You can run a test suite which tests <em>some</em> (but
+not <em>all</em>) aspects of the library with
+<pre>
+(asdf:oos 'asdf:test-op :cl-who)
+</pre>
 
 <br>&nbsp;<br><h3><a name="mail" class=none>Support and mailing lists</a></h3>
 
@@ -343,7 +346,7 @@ is transformed into an (X)HTML <b>tag</b> of the same (usually <href="#*downcase
 
   <table border=0 cellpadding=2 cellspacing=3><tr><td><pre>(:table :border 3) <font color="red">=&gt;</font> (write-string &quot;&lt;table border='3' /&gt;&quot; 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
+         <li>If it is any other form it will be left as is and later evaluated at run time and printed like 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
@@ -403,11 +406,10 @@ CHECKBOX
 
 <table border=0 cellpadding=2 cellspacing=3><tr><td><pre>:hr <font color="red">=&gt;</font> (write-string &quot;&lt;hr /&gt;&quot; 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>:
+  <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 <a href="http://www.lispworks.com/documentation/HyperSpec/Body/s_flet_.htm#macrolet">local macros</a>:
     <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.)
+      <li>Forms that look like <code>(<b>str</b> <i>form</i>)</code> will be substituted with
+	  <span style="white-space: nowrap"><code>(let ((result <i>form</i>)) (when result (princ result s)))</code></span>.
 
 <table border=0 cellpadding=2 cellspacing=3><tr><td><pre>(loop for i below 10 do (str i)) <font color="red">=&gt;</font> 
 (loop for i below 10 do
@@ -417,10 +419,10 @@ CHECKBOX
       <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">=&gt;</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>Forms that look like <code>(<b>esc</b> <i>form</i>)</code> will be substituted with
+	  <span style="white-space: nowrap"><code>(let ((result <i>form</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.
+      <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, i.e. this is the body is wrapped with another invocation of <a href="#with-html-output"><code>WITH-HTML-OUTPUT</code></a>.
 
 <table border=0 cellpadding=2 cellspacing=3><tr><td><pre>(loop for i below 100 do (htm (:b &quot;foo&quot;) :br))
     <font color="red">=&gt;</font> (loop for i below 100 do (progn (write-string &quot;&lt;b&gt;foo&lt;/b&gt;&lt;br /&gt;&quot; s)))</pre></td></tr></table>
@@ -438,8 +440,35 @@ 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>&amp;optional</tt> stream <tt>&amp;key</tt> prologue indent) declaration* form*</i> =&gt; <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>.
+<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 indented
+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>. (But note that
+indentation might change the semantics of the generated HTML.  This is
+for example the case for the <code>PRE</code>
+and <code>TEXTAREA</code> tags, and in certain situations additional
+whitespace might also change the layout of tables.)
+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.
 
@@ -473,7 +502,7 @@ Note that the keyword arguments <code><i>prologue</i></code> and <code><i>indent
 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 &amp;optional string-form
-                                           &amp;key (element-type 'character)
+                                           &amp;key (element-type ''character)
                                                 prologue
                                                 indent)
                                       &amp;body body)
@@ -486,34 +515,6 @@ into Lisp code which creates the corresponding HTML as a string.&quot;
 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>&amp;optional</tt> stream <tt>&amp;key</tt> prologue indent) declaration* form*</i> =&gt;  <tt>&lt;no values&gt;</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 &quot;white&quot;
-      (:table
-       (:tr
-        (dotimes (i 5)
-          (htm (:td :align "left"
-                (str i)))))))))
-(LET ((S S))
-  (PROGN
-    (WRITE-STRING
-      &quot;&lt;html&gt;&lt;body bgcolor='white'&gt;&lt;table&gt;&lt;tr&gt;&quot; S)
-    (DOTIMES (I 5)
-      (PROGN
-        (WRITE-STRING &quot;&lt;td align='left'&gt;&quot; S)
-        (PRINC I S)
-        (WRITE-STRING &quot;&lt;/td&gt;&quot; S)))
-    (WRITE-STRING &quot;&lt;/tr&gt;&lt;/table&gt;&lt;/body&gt;&lt;/html&gt;&quot; S)))
-</pre>
-</blockquote>
-
 <p><br>[Special variable]
 <br><a class=none name="*attribute-quote-char*"><b>*attribute-quote-char*</b></a>
 
@@ -629,8 +630,6 @@ This is the default for the <code><i>test</i></code> keyword argument to <a href
 <br>[Function]
 <br><a class=none name="escape-string-iso-8859-1"><b>escape-string-iso-8859-1</b> <i>string</i> =&gt; <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> =&gt; <i>escaped-string</i></a>
-<br>[Function]
 <br><a class=none name="escape-string-all"><b>escape-string-all</b> <i>string</i> =&gt; <i>escaped-string</i></a>
 <br>[Function]
 <br><a class=none name="escape-char-minimal"><b>escape-char-minimal</b> <i>character</i> =&gt; <i>escaped-string</i></a>
@@ -661,10 +660,6 @@ functions are defined in a way similar to this one:
                                   (or (find char &quot;&lt;&gt;&amp;'\&quot;&quot;)
                                       (&gt; (char-code char) 255)))))
 
-(defun escape-string-iso-8859 (string)
-  &quot;Identical to ESCAPE-STRING-ISO-8859-1.  Kept for backward compatibility.&quot;
-  (escape-string-iso-8859-1 string))
-
 (defun escape-string-all (string)
   &quot;Escapes all characters in STRING which aren't in the 7-bit ASCII
 character set.&quot;
@@ -800,7 +795,7 @@ 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 $
+$Header: /usr/local/cvsrep/cl-who/doc/index.html,v 1.68 2009/03/09 21:54:11 edi Exp $
 <p><a href="http://weitz.de/index.html">BACK TO MY HOMEPAGE</a>
 
 </body>
diff --git a/packages.lisp b/packages.lisp
index 1d9bdec..89d56de 100644
--- a/packages.lisp
+++ b/packages.lisp
@@ -1,7 +1,7 @@
 ;;; -*- 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 $
+;;; $Header: /usr/local/cvsrep/cl-who/packages.lisp,v 1.21 2009/01/26 11:10:49 edi Exp $
 
-;;; Copyright (c) 2003-2007, Dr. Edmund Weitz. All rights reserved.
+;;; 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
@@ -50,14 +50,12 @@
            :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))
diff --git a/specials.lisp b/specials.lisp
index 2df1adb..71aad3c 100755
--- a/specials.lisp
+++ b/specials.lisp
@@ -1,7 +1,7 @@
 ;;; -*- 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 $
+;;; $Header: /usr/local/cvsrep/cl-who/specials.lisp,v 1.6 2009/01/26 11:10:49 edi Exp $
 
-;;; Copyright (c) 2003-2007, Dr. Edmund Weitz. All rights reserved.
+;;; 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
@@ -40,13 +40,13 @@
   "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)))
+(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.")
 
-(defparameter *indent* nil
+(defvar *indent* nil
   "Whether to insert line breaks and indent. Also controls amount of
 indentation dynamically.")
 
@@ -58,13 +58,13 @@ indentation dynamically.")
 not be automatically converted to lowercase.  This is useful when one
 needs to output case sensitive XML.")
 
-(defparameter *attribute-quote-char* #\'
+(defvar *attribute-quote-char* #\'
   "Quote character for attributes.")
 
-(defparameter *empty-tag-end* " />"
+(defvar *empty-tag-end* " />"
   "End of an empty tag.  Default is XML style.")
 
-(defparameter *html-empty-tags*
+(defvar *html-empty-tags*
   '(:area
     :atop
     :audioscope
@@ -96,7 +96,7 @@ needs to output case sensitive XML.")
   "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
+(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
diff --git a/test/packages.lisp b/test/packages.lisp
new file mode 100644
index 0000000..b41a38e
--- /dev/null
+++ b/test/packages.lisp
@@ -0,0 +1,34 @@
+;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-USER; Base: 10 -*-
+;;; $Header: /usr/local/cvsrep/cl-who/test/packages.lisp,v 1.3 2009/01/26 11:10:52 edi Exp $
+
+;;; Copyright (c) 2008-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-test
+  (:use :cl :cl-who)
+  (:export :run-all-tests))
\ No newline at end of file
diff --git a/test/simple b/test/simple
new file mode 100644
index 0000000..128c62b
--- /dev/null
+++ b/test/simple
@@ -0,0 +1,240 @@
+;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-WHO-TEST; Base: 10 -*-
+;;; $Header: /usr/local/cvsrep/cl-who/test/simple,v 1.4 2009/01/26 11:10:52 edi Exp $
+
+;;; some simple tests for CL-WHO - entered manually and to be read
+;;; in the CL-WHO-TEST package; all forms are expected to return a
+;;; true value on success when EVALuated
+
+(string= (with-output-to-string (out)
+           (with-html-output (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))))
+         "<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 />")
+
+(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))))
+         "<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 />")
+
+(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))))
+         "<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 />")
+
+(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)))
+         "<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 />")
+
+(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)))
+         "<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 />")
+
+(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)))
+         "<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 />")
+
+(eq (array-element-type
+     (with-html-output-to-string (out nil :element-type 'base-char)
+       (:br)))
+    'base-char)
+
+(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))))
+         "<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 />")
+
+(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)))
+         "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\" \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">
+<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 />")
+
+(string= (with-html-output-to-string
+             (out nil :prologue "<!DOCTYPE math SYSTEM \"http://www.w3.org/Math/DTD/mathml1/mathml.dtd\">")
+           (:apply (:factorial) (:cn "3")))
+         "<!DOCTYPE math SYSTEM \"http://www.w3.org/Math/DTD/mathml1/mathml.dtd\">
+<apply><factorial></factorial><cn>3</cn></apply>")
+
+(string= (let ((*prologue* "<!DOCTYPE math SYSTEM \"http://www.w3.org/Math/DTD/mathml1/mathml.dtd\">"))
+           (with-html-output-to-string (out nil :prologue t)
+             (:apply (:factorial) (:cn "3"))))
+         "<!DOCTYPE math SYSTEM \"http://www.w3.org/Math/DTD/mathml1/mathml.dtd\">
+<apply><factorial></factorial><cn>3</cn></apply>")
+
+(string= (with-html-output-to-string (out nil :indent 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)))
+         "
+<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 />")
+
+(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)))
+         "
+<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 />")
+
+(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)))
+         "
+   <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 />")
+
+(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))))))))))
+         "<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>")
+
+(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))))))
+         "<h4>Look at the character entities generated by this example</h4><p style='background-color:red'>F&#xEA;te</p><p style='background-color:orange'>S&#xF8;rensen</p><p style='background-color:blue'>na&#xEF;ve</p><p style='background-color:red'>H&#xFC;hner</p><p style='background-color:orange'>Stra&#xDF;e</p>")
+
+(flet ((checkbox (stream name checked &optional value)
+         (with-html-output (stream)
+           (:input :type "checkbox" :name name :checked checked :value value))))
+  (and (string= (with-output-to-string (s) (checkbox s "foo" t))
+                "<input type='checkbox' name='foo' checked='checked' />")
+       (string= (with-output-to-string (s) (checkbox s "foo" nil))
+                "<input type='checkbox' name='foo' />")
+       (string= (with-output-to-string (s) (checkbox s "foo" nil "bar"))
+                "<input type='checkbox' name='foo' value='bar' />")
+       (string= (with-output-to-string (s) (checkbox s "foo" t "bar"))         
+                "<input type='checkbox' name='foo' checked='checked' value='bar' />")))
+
+(string= (with-html-output-to-string (out)
+           (:p))
+         "<p></p>")
+
+(string= (let ((*html-empty-tag-aware-p* nil))
+           (with-html-output-to-string (out)
+             (:p)))
+         "<p />")
+
+(string= (let ((*html-empty-tag-aware-p* t)
+               (*html-empty-tags* '(:p)))
+           (with-html-output-to-string (out)
+             (:p)))
+         "<p />")
+
+(string= (with-html-output-to-string (out)
+           (:|Foo| :bar 42))
+         "<foo bar='42'></foo>")
+
+(string= (let ((*downcase-tokens-p* nil))
+           (with-html-output-to-string (out)
+             (:|Foo| :bar 42)))
+         "<Foo BAR='42'></Foo>")
+
+(string= (let* ((list (list (make-string-output-stream) (make-string-output-stream)))
+                (stream (first list)))
+           (with-html-output (var (pop list))
+             (progn (htm (:br))))
+           (get-output-stream-string stream))
+         "<br />")
\ No newline at end of file
diff --git a/test/tests.lisp b/test/tests.lisp
new file mode 100644
index 0000000..44ea411
--- /dev/null
+++ b/test/tests.lisp
@@ -0,0 +1,150 @@
+;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package:CL-WHO-TEST; Base: 10 -*-
+;;; $Header: /usr/local/cvsrep/cl-who/test/tests.lisp,v 1.5 2009/01/26 11:10:52 edi Exp $
+
+;;; Copyright (c) 2008-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-test)
+
+(defvar *initial-settings*
+  (list #\'
+        t
+        (lambda (char)
+          (or (find char "<>&'\"")
+              (> (char-code char) 127)))
+        t
+        '(: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)
+        "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\" \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">"))
+
+(defvar *this-file* (load-time-value
+                     (or #.*compile-file-pathname* *load-pathname*))
+  "The location of this source file.")
+
+(defmacro do-tests ((name &optional show-progress-p) &body body)
+  "Helper macro which repeatedly executes BODY until the code in body
+calls the function DONE.  It is assumed that each invocation of BODY
+will be the execution of one test which returns NIL in case of success
+and list of string describing errors otherwise.
+
+The macro prints a simple progress indicator \(one dots for ten tests)
+to *STANDARD-OUTPUT* unless SHOW-PROGRESS-P is NIL and returns a true
+value iff all tests succeeded.  Errors in BODY are caught and reported
+\(and counted as failures)."
+  `(let ((successp t)
+         (testcount 1))
+     (block test-block
+       (flet ((done ()
+                (return-from test-block successp)))
+         (format t "~&Test: ~A~%" ,name)
+         (loop
+          (when (and ,show-progress-p (zerop (mod testcount 1)))
+            (format t ".")
+            (when (zerop (mod testcount 10))
+              (terpri))
+            (force-output))
+          (let ((errors
+                 (handler-case
+                     (progn ,@body)
+                   (error (msg)
+                     (list (format nil "~&got an unexpected error: ~A" msg))))))
+            (setq successp (and successp (null errors)))
+            (when errors
+              (format t "~&~4@A:~{~&   ~A~}~%" testcount errors))
+            (incf testcount)))))
+     successp))
+
+(defun simple-tests (&key (file-name
+                           (make-pathname :name "simple"
+                                          :type nil :version nil
+                                          :defaults *this-file*))
+                          (external-format '(:latin-1 :eol-style :lf))
+                          verbose)
+  "Loops through all the forms in the file FILE-NAME and executes each
+of them using EVAL.  It is assumed that each FORM specifies a test
+which returns a true value iff it succeeds.  Prints each test form to
+*STANDARD-OUTPUT* if VERBOSE is true and shows a simple progress
+indicator otherwise.  EXTERNAL-FORMAT is the FLEXI-STREAMS external
+format which is used to read the file.  Returns a true value iff all
+tests succeeded."
+  (with-open-file (binary-stream file-name :element-type 'flex:octet)
+    (let ((stream (flex:make-flexi-stream binary-stream :external-format external-format))
+          (*package* (find-package :cl-who-test))
+          (html-mode (html-mode)))
+      (unwind-protect
+          (destructuring-bind (*attribute-quote-char*
+                               *downcase-tokens-p*
+                               *escape-char-p*
+                               *html-empty-tag-aware-p*
+                               *html-empty-tags*
+                               *prologue*)
+              *initial-settings*
+            (setf (html-mode) :xml)
+            (do-tests ((format nil "Simple tests from file ~S" (file-namestring file-name))
+                       (not verbose))
+              (let ((form (or (read stream nil) (done))))
+                (when verbose
+                  (format t "~&~S" form))
+                (cond ((eval form) nil)
+                      (t (list (format nil "~S returned NIL" form)))))))
+        (setf (html-mode) html-mode)))))
+
+(defun run-all-tests (&key verbose)
+  "Runs all tests for CL-WHO and returns a true value iff all tests
+succeeded.  VERBOSE is interpreted by the individual test suites."
+  (let ((successp t))
+    (macrolet ((run-test-suite (&body body)
+                 `(unless (progn ,@body)
+                    (setq successp nil))))
+      (run-test-suite (simple-tests :verbose verbose)))
+    (format t "~2&~:[Some tests failed~;All tests passed~]." successp)
+    successp))
\ No newline at end of file
diff --git a/util.lisp b/util.lisp
new file mode 100644
index 0000000..aee8efe
--- /dev/null
+++ b/util.lisp
@@ -0,0 +1,230 @@
+;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package:CL-WHO; Base: 10 -*-
+;;; $Header: /usr/local/cvsrep/cl-who/util.lisp,v 1.4 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)
+
+#+:lispworks
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (import 'lw:with-unique-names))
+
+#-:lispworks
+(defmacro with-unique-names ((&rest bindings) &body body)
+  "Syntax: WITH-UNIQUE-NAMES ( { var | (var x) }* ) declaration* form*
+
+Executes a series of forms with each VAR bound to a fresh,
+uninterned symbol. The uninterned symbol is as if returned by a call
+to GENSYM with the string denoted by X - or, if X is not supplied, the
+string denoted by VAR - as argument.
+
+The variable bindings created are lexical unless special declarations
+are specified. The scopes of the name bindings and declarations do not
+include the Xs.
+
+The forms are evaluated in order, and the values of all but the last
+are discarded \(that is, the body is an implicit PROGN)."
+  ;; reference implementation posted to comp.lang.lisp as
+  ;; <cy3bshuf30f.fsf@ljosa.com> by Vebjorn Ljosa - see also
+  ;; <http://www.cliki.net/Common%20Lisp%20Utilities>
+  `(let ,(mapcar #'(lambda (binding)
+                     (check-type binding (or cons symbol))
+                     (if (consp binding)
+                       (destructuring-bind (var x) binding
+                         (check-type var symbol)
+                         `(,var (gensym ,(etypecase x
+                                          (symbol (symbol-name x))
+                                          (character (string x))
+                                          (string x)))))
+                       `(,binding (gensym ,(symbol-name binding)))))
+                 bindings)
+         ,@body))
+
+#+:lispworks
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (setf (macro-function 'with-rebinding)
+          (macro-function 'lw:rebinding)))
+
+#-:lispworks
+(defmacro with-rebinding (bindings &body body)
+  "WITH-REBINDING ( { var | (var prefix) }* ) form*
+
+Evaluates a series of forms in the lexical environment that is
+formed by adding the binding of each VAR to a fresh, uninterned
+symbol, and the binding of that fresh, uninterned symbol to VAR's
+original value, i.e., its value in the current lexical environment.
+
+The uninterned symbol is created as if by a call to GENSYM with the
+string denoted by PREFIX - or, if PREFIX is not supplied, the string
+denoted by VAR - as argument.
+
+The forms are evaluated in order, and the values of all but the last
+are discarded \(that is, the body is an implicit PROGN)."
+  ;; reference implementation posted to comp.lang.lisp as
+  ;; <cy3wv0fya0p.fsf@ljosa.com> by Vebjorn Ljosa - see also
+  ;; <http://www.cliki.net/Common%20Lisp%20Utilities>
+  (loop for binding in bindings
+        for var = (if (consp binding) (car binding) binding)
+        for name = (gensym)
+        collect `(,name ,var) into renames
+        collect ``(,,var ,,name) into temps
+        finally (return `(let ,renames
+                          (with-unique-names ,bindings
+                            `(let (,,@temps)
+                              ,,@body))))))
+
+;; TODO...
+#+(or)
+(defun apply-to-tree (function test tree)
+  (declare (optimize speed space))
+  (declare (type function function test))
+  "Applies 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)))
+
+(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))
+
+(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
+      (#\< "&lt;")
+      (#\> "&gt;")
+      (#\& "&amp;")
+      (#\' "&#039;")
+      (#\" "&quot;")
+      (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 "&lt;" s))
+                   ((#\>)
+                     (write-sequence "&gt;" s))
+                   ((#\&)
+                     (write-sequence "&amp;" s))
+                   ((#\')
+                     (write-sequence "&#039;" s))
+                   ((#\")
+                     (write-sequence "&quot;" s))
+                   (otherwise
+                     (format s format-string (char-code char))))
+              while (< (1+ pos) len)
+              finally (unless pos
+                        (write-sequence string s :start old-pos)))))))
+
+(defun minimal-escape-char-p (char)
+  "Helper function for the ESCAPE-FOO-MINIMAL functions to determine
+whether CHAR must be escaped."
+  (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))
+
+(defun minimal-plus-quotes-escape-char-p (char)
+  "Helper function for the ESCAPE-FOO-MINIMAL-PLUS-QUOTES functions to
+determine whether CHAR must be escaped."
+  (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))
+
+(defun iso-8859-1-escape-char-p (char)
+  "Helper function for the ESCAPE-FOO-ISO-8859-1 functions to
+determine whether CHAR must be escaped."
+  (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 non-7bit-ascii-escape-char-p (char)
+  "Helper function for the ESCAPE-FOO-ISO-8859-1 functions to
+determine whether CHAR must be escaped."
+  (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))
+
diff --git a/who.lisp b/who.lisp
index f154427..39ce788 100644
--- a/who.lisp
+++ b/who.lisp
@@ -1,7 +1,7 @@
 ;;; -*- 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 $
+;;; $Header: /usr/local/cvsrep/cl-who/who.lisp,v 1.42 2009/01/26 11:10:49 edi Exp $
 
-;;; Copyright (c) 2003-2007, Dr. Edmund Weitz. All rights reserved.
+;;; 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
@@ -29,15 +29,8 @@
 
 (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
+  "Returns the current HTML mode. :SGML for \(SGML-)HTML and
 :XML for XHTML."
   *html-mode*)
 
@@ -54,100 +47,6 @@
            *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
-      (#\< "&lt;")
-      (#\> "&gt;")
-      (#\& "&amp;")
-      (#\' "&#039;")
-      (#\" "&quot;")
-      (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 "&lt;" s))
-                   ((#\>)
-                     (write-sequence "&gt;" s))
-                   ((#\&)
-                     (write-sequence "&amp;" s))
-                   ((#\')
-                     (write-sequence "&#039;" s))
-                   ((#\")
-                     (write-sequence "&quot;" 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
@@ -184,7 +83,6 @@ 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)
@@ -199,19 +97,14 @@ forms."
                           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)
+                          (cond ((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)
+                          (string *attribute-quote-char*))
             end
           else
             ;; do the same things as above but at runtime
@@ -219,19 +112,21 @@ forms."
                           (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*)))))
+                                    (:sgml
+                                     `(fmt " ~A" attr))
+                                    ;; otherwise default to :xml mode
+                                    (t
+                                     `(fmt " ~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)))))))
+                                 (fmt " ~A=~C~A~C"
+                                      ,attr
+                                      *attribute-quote-char*
+                                      ,=var=
+                                      *attribute-quote-char*)))))))
 
 (defgeneric convert-tag-to-string-list (tag attr-list body body-fn)
   (:documentation "Used by PROCESS-TAG to convert `HTML' into a list
@@ -275,53 +170,21 @@ can use EQL specializers on the first argument."
          (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))))))
+        when (or (keywordp element)
+                 (and (listp element)
+                      (keywordp (first element)))
+                 (and (listp element)
+                      (listp (first element))
+                      (keywordp (first (first element)))))
+        ;; the syntax for a tag - process it
+        nconc (process-tag element #'tree-to-template)
+        else
+        ;; something else - insert verbatim
+        collect element))
 
 (defun string-list-to-string (string-list)
   (declare (optimize speed space))
@@ -331,7 +194,9 @@ flattened list of strings. Utility function used by TREE-TO-COMMANDS-AUX."
   (let ((total-size 0))
     (dolist (string string-list)
       (incf total-size (length string)))
-    (let ((result-string (make-sequence 'simple-string total-size))
+    (let ((result-string (make-string total-size
+                                      #+:lispworks #+:lispworks
+                                      :element-type 'lw:simple-char))
           (curr-pos 0))
       (dolist (string string-list)
         (replace result-string string :start1 curr-pos)
@@ -342,119 +207,83 @@ flattened list of strings. Utility function used by TREE-TO-COMMANDS-AUX."
   "Concatenates all arguments which should be string into one string."
   (funcall #'string-list-to-string string-list))
 
-(defun tree-to-commands-aux (tree stream)
+(defun tree-to-commands (tree stream &key prologue ((:indent *indent*) *indent*))
   (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)
+  (when (and *indent*
+             (not (integerp *indent*)))
+    (setq *indent* 0))
+  (let ((in-string-p t)
         collector
-        string-collector)
+        string-collector
+        (template (tree-to-template tree)))
+    (when prologue
+      (push +newline+ template)
+      (when (eq prologue t)
+        (setq prologue *prologue*))
+      (push prologue template))
     (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))))
+                   stream)))
+      (dolist (element template)
+        (cond ((and in-string-p (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-p 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-p nil
+                     string-collector '())
+               (push element collector))
+              (t
+               ;; not a string and empty STRING-COLLECTOR
+               (push element collector))))
+      (if string-collector
+        ;; finally empty STRING-COLLECTOR if
+        ;; there's something in it
+        (nreverse (cons (emit-string-collector)
+                        collector))
+        (nreverse collector)))))
 
 (defmacro with-html-output ((var &optional stream
-                                 &key prologue
-                                      ((:indent *indent*) *indent*))
+                                 &rest rest
+                                 &key prologue 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*))
+  (declare (ignore prologue))
   `(let ((,var ,(or stream var)))
-    ,(tree-to-commands body var prologue)))
+     (macrolet ((htm (&body body)
+                  `(with-html-output (,',var nil :prologue nil :indent ,,indent)
+                     ,@body))
+                (fmt (&rest args)                        
+                  `(format ,',var ,@args))
+                (esc (thing)
+                  (with-unique-names (result)
+                    `(let ((,result ,thing))
+                       (when ,result (write-string (escape-string ,result) ,',var)))))
+                (str (thing)
+                  (with-unique-names (result)
+                    `(let ((,result ,thing))
+                       (when ,result (princ ,result ,',var))))))
+       ,@(apply 'tree-to-commands body var rest))))
 
 (defmacro with-html-output-to-string ((var &optional string-form
-                                           &key (element-type ''character)
+                                           &key (element-type #-:lispworks ''character
+                                                              #+:lispworks ''lw:simple-char)
                                                 prologue
                                                 indent)
                                       &body body)
@@ -466,19 +295,6 @@ into Lisp code which creates the corresponding HTML as a string."
     (with-html-output (,var nil :prologue ,prologue :indent ,indent)
       ,@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>