[araneida: clean up html-stream and add comment tags
Alan-Shields@omrf.ouhsc.edu**20051111211823
 I wanted to be able to do:
 '(p (comment ((a :href "blah") "this is a link")))
 
 to yield:
 
 <p><!--
 <a href="blah">this is a link</a>
 -->
 
 As I'm into that sort of thing. I ended up doing a slight refactoring of
 html-stream and html-escaped-stream.
 
 You can also do
 '(p ((comment "now with extra commenty goodness!") ((a :href "blah") "this is a link")))
 
 to yield:
 
 <p><!-- now with extra commenty goodness!
 <a href="blah">this is a link</a>
 -->
 
 So enjoy!
] {
hunk ./html.lisp 95
-(defun html-stream (stream things &optional inline-elements)
-  "Format supplied argument as HTML.  Argument may be a string
+; I admit, this is a rather goofy way to write this. There's just so much code they have in common
+; and this lets me modify them rather easily.
+(macrolet ((html-stream-body ()
+	     `(progn
+	       (cond ((and (consp things) (not (stringp (car things))))
+		      (let* ((tag (if (consp (car things)) (caar things) (car things)))
+			     (attrs (if (consp (car things)) (cdar things) ()))
+			     (content (cdr things)))
+			(cond ((equal "COMMENT" (symbol-name tag))
+			       (progn
+				 (format stream "<!-- ~{~A ~}~%" attrs)
+				 (dolist (c content)
+				   (call-self stream c inline-elements))
+				 (format stream " -->~%")))
+			      ((not (empty-element-p tag))
+			       (progn
+				 (format stream "<~A~A>" (string-downcase (symbol-name tag)) (attr-printer attrs))
+				 (dolist (c content)
+				   (call-self stream c inline-elements))
+				 (format stream "</~A>~:[~;~%~]" (string-downcase (symbol-name tag)) (not (member tag inline-elements)))))
+			      (t
+			       (format stream "<~A~A>" (string-downcase (symbol-name tag)) (attr-printer attrs))))))
+		     ((consp things)
+		      (dolist (thing things) (princ thing stream)))
+		     ((keywordp things)
+		      (format stream "<~A>" (string-downcase (symbol-name things))))
+		     ((functionp things)
+		      (funcall things stream))
+		     (t
+		      (princ (thing-printer things) stream)))
+	       t)))
+  (defun html-stream (stream things &optional inline-elements)
+    "Format supplied argument as HTML.  Argument may be a string
hunk ./html.lisp 133
-  (declare (optimize (speed 3))
-           (type stream stream))
-  (cond ((and (consp things) (not (stringp (car things))))
-         (let* ((tag (if (consp (car things)) (caar things) (car things)))
-                (attrs (if (consp (car things)) (cdar things) ()))
-                (content (cdr things)))
-           (if (not (empty-element-p tag))
-               (progn
-                 (format stream "<~A~A>" (string-downcase (symbol-name tag)) (html-attr attrs))
-                 (dolist (c content)
-                   (html-stream stream c inline-elements))
-                 (format stream "</~A>~:[~;~%~]" (string-downcase (symbol-name tag)) (not (member tag inline-elements))))
-               (format stream "<~A~A>" (string-downcase (symbol-name tag)) (html-attr attrs)))))
-        ((consp things)
-         (dolist (thing things) (princ thing stream)))
-        ((keywordp things)
-         (format stream "<~A>" (string-downcase (symbol-name things))))
-	((functionp things)
-	 (funcall things stream))
-        (t
-         (princ things stream)))
-  t)
+    (declare (optimize (speed 3))
+	     (type stream stream))
+    (macrolet ((attr-printer (attrs)
+		 `(html-attr ,attrs))
+               (call-self (stream things &optional inline-elements)
+                 `(html-stream ,stream ,things ,inline-elements))
+               (thing-printer (things)
+                 things))
+      (html-stream-body)))
hunk ./html.lisp 143
-(defun html-escaped-stream (stream things &optional inline-elements)
-  "Format supplied argument as HTML, escaping properly.
+  (defun html-escaped-stream (stream things &optional inline-elements)
+    "Format supplied argument as HTML, escaping properly.
hunk ./html.lisp 149
-  (declare (optimize (speed 3))
-           (type stream stream))
-  (cond ((and (consp things) (not (stringp (car things))))
-         (let* ((tag (if (consp (car things)) (caar things) (car things)))
-                (attrs (if (consp (car things)) (cdar things) ()))
-                (content (cdr things)))
-           (if (not (empty-element-p tag))
-               (progn
-                 (format stream "<~A~A>" (string-downcase (symbol-name tag)) (html-attr-escaped attrs))
-                 (dolist (c content)
-                   (html-escaped-stream stream c inline-elements))
-                 (format stream "</~A>~:[~;~%~]" (string-downcase (symbol-name tag)) (not (member tag inline-elements))))
-               (format stream "<~A~A>" (string-downcase (symbol-name tag)) (html-attr-escaped attrs)))))
-        ((consp things)
-         (dolist (thing things) (princ thing stream)))
-        ((keywordp things)
-         (format stream "<~A>" (string-downcase (symbol-name things))))
-	((functionp things)
-	 (funcall things stream))
-        (t
-         (princ (html-escape things) stream)))
-  t)
+    (declare (optimize (speed 3))
+	     (type stream stream))
+    (macrolet ((attr-printer (attrs)
+		 `(html-attr-escaped ,attrs))
+	       (call-self (stream things &optional inline-elements)
+		 `(html-escaped-stream ,stream ,things ,inline-elements))
+	       (thing-printer (things)
+		 `(html-escape ,things)))
+      (html-stream-body))))
}