Index: doc/index.html =================================================================== --- doc/index.html (revision 1057) +++ doc/index.html (working copy) @@ -539,6 +539,15 @@
"<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\" \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">"+
[Special variable]
+
*downcase-tag*
+
+
+
+ If NIL, keyword symbol representing a tagname will not be +automatically converted to lowercase. It is useful when one needs to +output case sensitive xml tags. Default to T. +
[Symbol]
esc
[Symbol]
Index: packages.lisp
===================================================================
--- packages.lisp (revision 1057)
+++ packages.lisp (working copy)
@@ -35,6 +35,7 @@
(:export #:*attribute-quote-char*
#:*escape-char-p*
#:*prologue*
+ #:*downcase-tag*
#:conc
#:convert-attributes
#:convert-tag-to-string-list
@@ -58,6 +59,7 @@
(:export "*ATTRIBUTE-QUOTE-CHAR*"
"*ESCAPE-CHAR-P*"
"*PROLOGUE*"
+ "*DOWNCASE-TAG*"
"CONC"
"ESC"
"ESCAPE-STRING"
Index: who.lisp
===================================================================
--- who.lisp (revision 1057)
+++ who.lisp (working copy)
@@ -47,6 +47,11 @@
(defvar *html-mode* :xml
":SGML for \(SGML-)HTML, :XML \(default) for XHTML.")
+(defvar *downcase-tag* T
+ "If NIL, keyword symbol representing a tagname will not be
+automatically converted to lowercase. It is useful when one needs to
+output case sensitive xml tags.")
+
(defparameter *attribute-quote-char* #\'
"Quote character for attributes.")
@@ -239,31 +244,32 @@
"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-tag* (string-downcase tag) (string tag))))
(nconc
(if *indent*
- ;; indent by *INDENT* spaces
- (list +newline+ (n-spaces *indent*)))
+ ;; indent by *INDENT* spaces
+ (list +newline+ (n-spaces *indent*)))
;; tag name
- (list "<" (string-downcase tag))
+ (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 "" (string-downcase tag) ">"))
- ;; no body, so no closing tag
- (list *empty-tag-end*))))
+ (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
+ (list *empty-tag-end*)))))
(defun apply-to-tree (function test tree)
(declare (optimize speed space))