- Add *RCSID*
authorMatthew Mondor <mmondor@pulsar-zone.net>
Sat, 27 Aug 2011 00:47:53 +0000 (00:47 +0000)
committerMatthew Mondor <mmondor@pulsar-zone.net>
Sat, 27 Aug 2011 00:47:53 +0000 (00:47 +0000)
- Use high SAFETY to avoid some segfaults experienced at level 1
- Disable *PRINT-PRETTY*
- Fix LISPP to also reject lists starting with a string

mmsoftware/cl/server/html.lisp

index dc92d8b..7d774f3 100644 (file)
@@ -1,4 +1,4 @@
-;;;; $Id: html.lisp,v 1.3 2011/08/19 13:05:10 mmondor Exp $
+;;;; $Id: html.lisp,v 1.4 2011/08/27 00:47:53 mmondor Exp $
 
 #|
 
@@ -34,7 +34,8 @@ THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 ;;;;   or unescape them).
 
 
-(declaim (optimize (speed 3) (safety 1) (debug 1)))
+;;; XXX If SAFETY is 1 compiling code using DO-HTML may segfault!
+(declaim (optimize (speed 3) (safety 3) (debug 1)))
 
 (defpackage :html
   (:use :cl)
@@ -47,6 +48,9 @@ THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 
 (in-package :html)
 
+(defparameter *rcsid*
+  "$Id: html.lisp,v 1.4 2011/08/27 00:47:53 mmondor Exp $")
+
 
 (defparameter *html-mode* :xhtml
   "Affects the HTML output format; expected values are :XHTML or :HTML.")
@@ -66,7 +70,8 @@ THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
        (not (stringp item))
        (or (atom item)
           (and (listp item)
-               (not (keywordp (first item)))))))
+               (not (keywordp (first item)))
+               (not (stringp (first item)))))))
 
 ;;; Parses tag and its attributes if any, starting at LIST.
 ;;; Returns the tag name, if it must be matched by a closing tag,
@@ -211,7 +216,7 @@ generated printing code.
 Note that tags and attributes are represented using keyword symbols and
 that sublists are used for content.  Tags are automatically closed unless
 the tag keyword symbol begins with a '/'.  Likewise, attributes without
-a value (such as OPTION's SELECTED attribute) must also be prefixed with
+a value \(such as OPTION's SELECTED attribute\) must also be prefixed with
 '/', and will be expanded according to *HTML-MODE*.  Literal text content
 should consist of double-quoted strings, and CL atoms and list forms may
 be used as placeholders for dynamic content to be generated at printing
@@ -221,20 +226,21 @@ HEAD, single attributes are expanded redundantly, and non-closing tags
 are suffixed with ' /', automatically."
   (let ((list (html-coalesce (reverse (html-parse-r tree))))
        (s-stream (gensym)))
-    (if stream
-       `(let ((,s-stream ,stream))
-          ,@(mapcar #'(lambda (i)
-                        (if (stringp i)
-                            `(write-string ,i ,s-stream)
-                            `(format ,s-stream "~A" ,i)))
-                    list)
-          nil)
-       `(with-output-to-string (,s-stream)
-          ,@(mapcar #'(lambda (i)
-                        (if (stringp i)
-                            `(write-string ,i ,s-stream)
-                            `(format ,s-stream "~A" ,i)))
-                    list)))))
+    `(let ((*print-pretty* nil))
+       ,(if stream
+           `(let ((,s-stream ,stream))
+              ,@(mapcar #'(lambda (i)
+                            (if (stringp i)
+                                `(write-string ,i ,s-stream)
+                                `(format ,s-stream "~A" ,i)))
+                        list)
+              nil)
+           `(with-output-to-string (,s-stream)
+              ,@(mapcar #'(lambda (i)
+                            (if (stringp i)
+                                `(write-string ,i ,s-stream)
+                                `(format ,s-stream "~A" ,i)))
+                        list))))))
 
 (defmacro do-html-loop ((&body loop-clauses) &body body)
   "This macro provides an easy interface to produce HTML markup with loops.