r11859: Canonicalize whitespace
authorKevin M. Rosenberg <kevin@rosenberg.net>
Fri, 31 Aug 2007 18:04:31 +0000 (18:04 +0000)
committerKevin M. Rosenberg <kevin@rosenberg.net>
Fri, 31 Aug 2007 18:04:31 +0000 (18:04 +0000)
apache-dir.lisp
base.lisp
downloads.lisp
files.lisp
htmlgen.lisp
package.lisp
read-macro.lisp
stdsite.lisp
utils.lisp

index 0730653..9cd155a 100644 (file)
 
 (defun universal-time-to-apache-date (utime)
   (multiple-value-bind
-       (second minute hour day-of-month month year day-of-week daylight-p zone)
+        (second minute hour day-of-month month year day-of-week daylight-p zone)
       (decode-universal-time utime)
     (declare (ignore second day-of-week daylight-p zone))
     (format nil
-           (formatter "~2,'0D-~3/kmrcl::monthname/-~4,'0D ~2,'0D:~2,'0D")
-           day-of-month month year hour minute)))
-  
+            (formatter "~2,'0D-~3/kmrcl::monthname/-~4,'0D ~2,'0D:~2,'0D")
+            day-of-month month year hour minute)))
+
 (defun sort-dir-entries (entries sort-field direct)
   (case sort-field
     (:name
      (sort entries
-          (lambda (a b)
-            (funcall (if (eq direct :asc) #'string-lessp #'string-greaterp) 
-                     (aif (third a) it "")
-                     (aif (third b) it "")))))
+           (lambda (a b)
+             (funcall (if (eq direct :asc) #'string-lessp #'string-greaterp)
+                      (aif (third a) it "")
+                      (aif (third b) it "")))))
     (:modified
      (sort entries
-          (lambda (a b)
-            (funcall (if (eq direct :asc) #'< #'>)
-                     (aif (fourth a) it 0)
-                     (aif (fourth b) it 0)))))
+           (lambda (a b)
+             (funcall (if (eq direct :asc) #'< #'>)
+                      (aif (fourth a) it 0)
+                      (aif (fourth b) it 0)))))
     (:size
      (sort entries
-          (lambda (a b)
-            (funcall (if (eq direct :asc) #'< #'>)
-                     (aif (fifth a) it 0)
-                     (aif (fifth b) it 0)))))
+           (lambda (a b)
+             (funcall (if (eq direct :asc) #'< #'>)
+                      (aif (fifth a) it 0)
+                      (aif (fifth b) it 0)))))
     (:description
      (sort entries
-          (lambda (a b)
-            (funcall (if (eq direct :asc) #'string-lessp #'string-greaterp)
-                     (aif (sixth a) it "")
-                     (aif (sixth b) it "")))))
+           (lambda (a b)
+             (funcall (if (eq direct :asc) #'string-lessp #'string-greaterp)
+                      (aif (sixth a) it "")
+                      (aif (sixth b) it "")))))
     (t
      entries)))
-     
+
 (defun write-html-apache-directory (stream title entries this-url &key parent address query-string
-                                   icon-base)
+                                    icon-base)
   (let* ((query (when query-string (split-uri-query-string query-string)))
-        (sort-field (if query
-                        (cond
-                          ((string-equal (caar query) "N") :name)
-                          ((string-equal (caar query) "M") :modified)
-                          ((string-equal (caar query) "S") :size)
-                          ((string-equal (caar query) "D") :description)
-                          (t :name))
-                        :name))
-        (dir (cond
-               ((and query (string-equal (cdr (first query)) "D") :desc))
-               (t :asc))))
+         (sort-field (if query
+                         (cond
+                           ((string-equal (caar query) "N") :name)
+                           ((string-equal (caar query) "M") :modified)
+                           ((string-equal (caar query) "S") :size)
+                           ((string-equal (caar query) "D") :description)
+                           (t :name))
+                         :name))
+         (dir (cond
+                ((and query (string-equal (cdr (first query)) "D") :desc))
+                (t :asc))))
     (setq entries (sort-dir-entries entries sort-field dir))
-    
+
     (html-stream
      stream
      "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.0 Transitional//EN\" \"http://www.w3.org/TR/REC-html40/loose.dtd\">"
       ((:body :bgcolor "#FFFFFF" :text "#000000")
        :newline
        (:table
-       (:tr
-        ((:td :bgcolor "#FFFFFF" :class "title")
-         ((:font :size "+3" :face "Hevetica,Arial,sans-serif")
-          (:b (:princ title))))))
+        (:tr
+         ((:td :bgcolor "#FFFFFF" :class "title")
+          ((:font :size "+3" :face "Hevetica,Arial,sans-serif")
+           (:b (:princ title))))))
        :newline
        (:pre
-       (when icon-base
-         (html-stream
-          stream
-          ((:img :border "0"
-                 :src (format nil "~Ablank.png" icon-base)
-                 :alt "     "))))
-       " "
-       ((:a :href (format nil "~A?N=~A" this-url
-                          (if (and (eq sort-field :name) (eq dir :asc))
-                              "D" "A")))
-        "Name")
-       (:princ (format nil "~20A" ""))
-       " "
-       ((:a :href (format nil "~A?M=~A" this-url
-                          (if (and (eq sort-field :modified) (eq dir :asc))
-                              "D" "A")))
-        "Last modified")
-       "      "
-       ((:a :href (format nil "~A?S=~A" this-url
-                          (if (and (eq sort-field :size) (eq dir :asc))
-                              "D" "A")))
-        "Size")
-       "   "
-       ((:a :href (format nil "~A?D=~A" this-url 
-                          (if (and (eq sort-field :description) (eq dir :asc))
-                              "D" "A")))
-        "Description")
-       :newline
-       (:princ "<hr noshade align=\"left\" width=\"80%\">")
-       :newline
-       (when parent
-         (html-stream
-          stream
-          (when icon-base
-            (html-stream
-             stream
-             ((:img :border "0" 
-                    :src (format nil "~Aback.png" icon-base)
-                    :alt "[DIR]"))))
-          " "
-          (write-name-link stream (first parent) (second parent))
-          " "
-          (print-n-chars #\space 17 stream)
-          "     -"
-          :newline))
-       (dolist (entry entries)
-         (html-stream
-          stream
-          (when icon-base
-            (html-stream
-             stream
-             ((:img :border "0"
-                    :src
-                    (case (car entry)
-                      (:dir (format nil "~Afolder.png" icon-base))
-                      (:text (format nil "~Atext.png" icon-base))
-                      (t (format nil "~Af.png" icon-base)))
-                    :alt
-                    (case (car entry)
-                      (:dir "[DIR]")
-                      (:text "[TXT]")
-                      (t "[FIL]"))))))
-          " "
-          (write-name-link stream (second entry) (third entry))
-          " "
-          (:princ (universal-time-to-apache-date (fourth entry)))
-          (:princ
-           (cond
-             ((or (eq :dir (first entry))
-                  (null (fifth entry)))
-              "     -")
-             ((< (fifth entry) (* 1024 1024))
-              (format nil "~5,' Dk" (round (fifth entry) 1024)))
-             ((< (fifth entry) (* 1024 1024 1024))
-              (format nil "~5,' Dm" (round (fifth entry) (* 1024 1024))))
-             (t
-              (format nil "~5,' Dg" (round (fifth entry) (* 1024 1024 1024))))
-             ))
-          " "
-          (:princ
-           (if (sixth entry)
-               (sixth entry)
-               ""))
-          :newline)))
+        (when icon-base
+          (html-stream
+           stream
+           ((:img :border "0"
+                  :src (format nil "~Ablank.png" icon-base)
+                  :alt "     "))))
+        " "
+        ((:a :href (format nil "~A?N=~A" this-url
+                           (if (and (eq sort-field :name) (eq dir :asc))
+                               "D" "A")))
+         "Name")
+        (:princ (format nil "~20A" ""))
+        " "
+        ((:a :href (format nil "~A?M=~A" this-url
+                           (if (and (eq sort-field :modified) (eq dir :asc))
+                               "D" "A")))
+         "Last modified")
+        "      "
+        ((:a :href (format nil "~A?S=~A" this-url
+                           (if (and (eq sort-field :size) (eq dir :asc))
+                               "D" "A")))
+         "Size")
+        "   "
+        ((:a :href (format nil "~A?D=~A" this-url
+                           (if (and (eq sort-field :description) (eq dir :asc))
+                               "D" "A")))
+         "Description")
+        :newline
+        (:princ "<hr noshade align=\"left\" width=\"80%\">")
+        :newline
+        (when parent
+          (html-stream
+           stream
+           (when icon-base
+             (html-stream
+              stream
+              ((:img :border "0"
+                     :src (format nil "~Aback.png" icon-base)
+                     :alt "[DIR]"))))
+           " "
+           (write-name-link stream (first parent) (second parent))
+           " "
+           (print-n-chars #\space 17 stream)
+           "     -"
+           :newline))
+        (dolist (entry entries)
+          (html-stream
+           stream
+           (when icon-base
+             (html-stream
+              stream
+              ((:img :border "0"
+                     :src
+                     (case (car entry)
+                       (:dir (format nil "~Afolder.png" icon-base))
+                       (:text (format nil "~Atext.png" icon-base))
+                       (t (format nil "~Af.png" icon-base)))
+                     :alt
+                     (case (car entry)
+                       (:dir "[DIR]")
+                       (:text "[TXT]")
+                       (t "[FIL]"))))))
+           " "
+           (write-name-link stream (second entry) (third entry))
+           " "
+           (:princ (universal-time-to-apache-date (fourth entry)))
+           (:princ
+            (cond
+              ((or (eq :dir (first entry))
+                   (null (fifth entry)))
+               "     -")
+              ((< (fifth entry) (* 1024 1024))
+               (format nil "~5,' Dk" (round (fifth entry) 1024)))
+              ((< (fifth entry) (* 1024 1024 1024))
+               (format nil "~5,' Dm" (round (fifth entry) (* 1024 1024))))
+              (t
+               (format nil "~5,' Dg" (round (fifth entry) (* 1024 1024 1024))))
+              ))
+           " "
+           (:princ
+            (if (sixth entry)
+                (sixth entry)
+                ""))
+           :newline)))
        (:princ "<hr noshade align=\"left\" width=\"80%\">")
        :newline
        (when address
-        (html-stream
-         stream
-         (:address address))))))))
+         (html-stream
+          stream
+          (:address address))))))))
 
index 7054761..208e1a7 100644 (file)
--- a/base.lisp
+++ b/base.lisp
@@ -20,8 +20,8 @@
 (defun lml-format (str &rest args)
   (when (streamp *html-stream*)
     (if args
-       (apply #'format *html-stream* str args)
-       (write-string str *html-stream*))))
+        (apply #'format *html-stream* str args)
+        (write-string str *html-stream*))))
 
 (defun lml-princ (s)
   (princ s *html-stream*))
   (lml-write-string (date-string date)))
 
 (defun xml-header-stream (stream &key (version "1.0") (standalone :unspecified)
-                  (encoding :unspecified))
+                   (encoding :unspecified))
   (format stream "<?xml version=\"~A\"~A~A ?>"
-         version
-         (if (eq standalone :unspecified)
-             ""
-             (format nil " standalone=\"~A\"" standalone))
-         (if (eq encoding :unspecified)
-             ""
-             (format nil " encoding=\"~A\"" encoding))))
-         
+          version
+          (if (eq standalone :unspecified)
+              ""
+              (format nil " standalone=\"~A\"" standalone))
+          (if (eq encoding :unspecified)
+              ""
+              (format nil " encoding=\"~A\"" encoding))))
+
 (defun dtd-prologue (&optional (format :xhtml11) &key entities)
   (case format
     ((:xhtml :xhtml11 :xhtml10-strict :xhtml10-transitional :xhtml10-frameset :xml)
      (lml-write-char #\newline)
      (case format
        ((:xhtml11 :xhtml)
-       (lml-write-string +xhtml11-dtd-string+))
+        (lml-write-string +xhtml11-dtd-string+))
        (:xhtml10-strict
-       (lml-write-string +xhtml10-strict-dtd-string+))
+        (lml-write-string +xhtml10-strict-dtd-string+))
        (:xhtml10-transitional
-       (lml-write-string +xhtml10-transitional-dtd-string+))
+        (lml-write-string +xhtml10-transitional-dtd-string+))
        (:xhtml10-frameset
-       (lml-write-string +xhtml10-frameset-dtd-string+)))
+        (lml-write-string +xhtml10-frameset-dtd-string+)))
      (when entities
        (lml-write-char #\space)
        (lml-write-char #\[)
 
 
 (defmacro html-file-page ((out-file &key (format :xhtml11))
-                         &body body)
+                          &body body)
   `(with-open-file (*html-stream*
-                   (lml-file-name ',out-file :output)
-                   :direction :output
-                   :if-exists :supersede)
+                    (lml-file-name ',out-file :output)
+                    :direction :output
+                    :if-exists :supersede)
      (dtd-prologue ,format)
      (html
       ((:html :xmlns "http://www.w3.org/1999/xhtml")
        ,@body))))
-                    
+
 
 (defmacro alink (url desc)
   `(html
index 855505b..21473d1 100644 (file)
 
 (defun strip-dl-base (file base)
   (let ((fdir (pathname-directory file))
-       (bdir (pathname-directory base)))
+        (bdir (pathname-directory base)))
     (make-pathname
      :name (pathname-name file)
      :type (pathname-type file)
-     :directory 
+     :directory
      (when (> (length fdir) (length bdir))
-       (append '(:absolute) 
-              (subseq fdir (length bdir) (length fdir)))))))
-     
+       (append '(:absolute)
+               (subseq fdir (length bdir) (length fdir)))))))
+
 (defun print-file (file dl-data)
   (let ((size 0)
-       (modtime (date-string (file-write-date file)))
-       (basename (namestring
-                  (make-pathname :name (pathname-name file)
-                                 :type (pathname-type file))))
-       (dl-name (strip-dl-base file (dl-data-base dl-data)))
-       (sig-path (concatenate 'string (namestring file) ".asc")))
+        (modtime (date-string (file-write-date file)))
+        (basename (namestring
+                   (make-pathname :name (pathname-name file)
+                                  :type (pathname-type file))))
+        (dl-name (strip-dl-base file (dl-data-base dl-data)))
+        (sig-path (concatenate 'string (namestring file) ".asc")))
     (when (plusp (length basename))
       (with-open-file (strm file :direction :input)
-                     (setq size (round (/ (file-length strm) 1024))))
+                      (setq size (round (/ (file-length strm) 1024))))
       (lml-format "<a href=\"~A~A\">~A</a>"
-                 (dl-data-url dl-data) dl-name basename)
+                  (dl-data-url dl-data) dl-name basename)
       (lml-princ "<span class=\"modtime\">")
       (lml-format " (~A, <b>~:D <span style=\"font-size:90%;\">KB</span></b>)</span>" modtime size)
       (when (probe-file sig-path)
-       (setf (dl-data-signed dl-data) t)
-       (lml-format " [<a href=\"~A~A.asc\">Signature</a>]"
-                   (dl-data-url dl-data) dl-name))
+        (setf (dl-data-signed dl-data) t)
+        (lml-format " [<a href=\"~A~A.asc\">Signature</a>]"
+                    (dl-data-url dl-data) dl-name))
       (html :br))))
 
 (defun display-header (name url)
     (lml-princ "<h3>GPG Public Key</h3>")
     (lml-princ "Use this <a href=\"https://www.b9.com/kevin.gpg.asc\">key</a> to verify file signtatures"))
   (lml-princ "</div>"))
-  
+
 (defun print-sect-title (title dl-data)
   (lml-format "<h~D>~A</h~D>"
-             (dl-data-indent dl-data) title (dl-data-indent dl-data)))
+              (dl-data-indent dl-data) title (dl-data-indent dl-data)))
 
 (defun match-base-name? (name base-name)
   (let ((len-base-name (length base-name)))
@@ -80,7 +80,7 @@
 
 (defun match-base-name-latest? (name base-name)
   (let* ((latest (concatenate 'string base-name "-latest"))
-        (len-latest (length latest)))
+         (len-latest (length latest)))
     (when (>= (length name) len-latest)
       (string= name latest :end1 len-latest :end2 len-latest))))
 
@@ -99,9 +99,9 @@
 
 (defun display-one-section (title pat dl-data)
   (let ((files (sort-pathnames
-               (filter-latest
-                (filter-against-base (directory pat) (dl-data-name dl-data))
-                (dl-data-name dl-data)))))
+                (filter-latest
+                 (filter-against-base (directory pat) (dl-data-name dl-data))
+                 (dl-data-name dl-data)))))
     (when files
       (print-sect-title title dl-data)
       (lml-princ "<div style=\"padding-left: 20pt;\">")
 (defun display-sections (sects dl-data)
   (when sects
     (let ((title (car sects))
-         (value (cadr sects)))
+          (value (cadr sects)))
       (if (consp title)
-         (dolist (sect sects)
-           (display-sections sect dl-data))
-       (if (consp value)
-           (progn
-             (print-sect-title title dl-data)
-             (incf (dl-data-indent dl-data))
-             (display-sections value dl-data)
-             (decf (dl-data-indent dl-data)))
-         (display-one-section title value dl-data))))))
-      
+          (dolist (sect sects)
+            (display-sections sect dl-data))
+        (if (consp value)
+            (progn
+              (print-sect-title title dl-data)
+              (incf (dl-data-indent dl-data))
+              (display-sections value dl-data)
+              (decf (dl-data-indent dl-data)))
+          (display-one-section title value dl-data))))))
+
 (defun display-page (pkg-name pkg-base dl-base dl-url sects)
   (let ((dl-data (make-dl-data :indent 3
-                              :base dl-base
-                              :url dl-url
-                              :name pkg-base
-                              :signed nil)))
+                               :base dl-base
+                               :url dl-url
+                               :name pkg-base
+                               :signed nil)))
     (display-header pkg-name dl-url)
     (dolist (sect sects)
       (display-sections sect dl-data))
 (defun std-dl-page (pkg-name pkg-base dl-base dl-url)
   (let ((base (parse-namestring dl-base)))
     (let ((tgz-path (make-pathname :defaults base :type "gz" :name :wild))
-         (zip-path (make-pathname :defaults base :type "zip" :name :wild))
-         (doc-path (make-pathname :defaults base :type "pdf" :name :wild)))
+          (zip-path (make-pathname :defaults base :type "zip" :name :wild))
+          (doc-path (make-pathname :defaults base :type "pdf" :name :wild)))
       (display-page pkg-name pkg-base dl-base dl-url
-                   `(("Manual" ,doc-path)
-                     ("Source Code"
-                      (("Unix (.tar.gz)" ,tgz-path)
-                       ("Windows (.zip)" ,zip-path))))))))
-  
+                    `(("Manual" ,doc-path)
+                      ("Source Code"
+                       (("Unix (.tar.gz)" ,tgz-path)
+                        ("Windows (.zip)" ,zip-path))))))))
+
 (defun full-dl-page (pkg-name pkg-base dl-base dl-url)
   (let ((base (parse-namestring dl-base)))
     (let ((tgz-path (make-pathname :defaults base :type "gz" :name :wild))
-         (zip-path (make-pathname :defaults base :type "zip" :name :wild))
-         (doc-path (make-pathname :defaults base :type "pdf" :name :wild))
-         (deb-path (merge-pathnames
-                    (make-pathname :directory '(:relative "linux-debian")
-                                   :type :wild :name :wild)
-                    base))
-         (rpm-path (merge-pathnames
-                    (make-pathname :directory '(:relative "linux-rpm")
-                                   :type :wild :name :wild)
-                    base))
-         (w32-path (merge-pathnames
-                    (make-pathname :directory '(:relative "win32")
-                                   :type :wild :name :wild)
-                    base)))
+          (zip-path (make-pathname :defaults base :type "zip" :name :wild))
+          (doc-path (make-pathname :defaults base :type "pdf" :name :wild))
+          (deb-path (merge-pathnames
+                     (make-pathname :directory '(:relative "linux-debian")
+                                    :type :wild :name :wild)
+                     base))
+          (rpm-path (merge-pathnames
+                     (make-pathname :directory '(:relative "linux-rpm")
+                                    :type :wild :name :wild)
+                     base))
+          (w32-path (merge-pathnames
+                     (make-pathname :directory '(:relative "win32")
+                                    :type :wild :name :wild)
+                     base)))
       (display-page pkg-name pkg-base dl-base dl-url
-                   `(("Manual" ,doc-path)
-                     ("Source Code"
-                      (("Unix (.tar.gz)" ,tgz-path)
-                       ("Windows (.zip)" ,zip-path)))
-                     ("Binaries" 
-                      (("Linux Binaries"
-                        (("Debian Linux" ,deb-path)
-                         ("RedHat Linux" ,rpm-path)))
-                       ("Windows Binaries" ,w32-path))))))))
+                    `(("Manual" ,doc-path)
+                      ("Source Code"
+                       (("Unix (.tar.gz)" ,tgz-path)
+                        ("Windows (.zip)" ,zip-path)))
+                      ("Binaries"
+                       (("Linux Binaries"
+                         (("Debian Linux" ,deb-path)
+                          ("RedHat Linux" ,rpm-path)))
+                        ("Windows Binaries" ,w32-path))))))))
index 9c5dd2e..068347c 100644 (file)
     (unless (position #\. f)
       (setq f (concatenate 'string f ".html"))))
   (if (or (and (eq type :source) *sources-dir*)
-         (and (eq type :output) *output-dir*))
+          (and (eq type :output) *output-dir*))
       (merge-pathnames
        (make-pathname :name (pathname-name f)
-                     :type (pathname-type f)
-                     :directory (pathname-directory f))
+                      :type (pathname-type f)
+                      :directory (pathname-directory f))
        (ecase type
-        (:source *sources-dir*)
-        (:output *output-dir*)))
+         (:source *sources-dir*)
+         (:output *output-dir*)))
       (if (stringp f)
-         (parse-namestring f)
-         f)))
+          (parse-namestring f)
+          f)))
 
 (defmacro with-dir ((output &key sources) &body body)
   (let ((output-dir (gensym))
-       (sources-dir (gensym)))
+        (sources-dir (gensym)))
   `(let ((,output-dir ,output)
-        (,sources-dir ,sources))
+         (,sources-dir ,sources))
     (when (stringp ,output-dir)
       (setq ,output-dir (parse-namestring ,output-dir)))
     (when (stringp ,sources-dir)
     (unless ,sources-dir
       (setq ,sources-dir ,output-dir))
     (let ((*output-dir* ,output-dir)
-         (*sources-dir* ,sources-dir))
+          (*sources-dir* ,sources-dir))
       ,@body))))
 
 (defun lml-load-path (file &key optional)
   (if (probe-file file)
       (with-open-file (in file :direction :input)
         (do ((form (read in nil 'eof) (read in nil 'eof)))
-           ((eq form 'eof))
-         (eval form)))
+            ((eq form 'eof))
+          (eval form)))
     (unless optional
       (format *trace-output* "Warning: unable to load LML file ~S" file))))
 
 (defun process-dir (dir &key sources)
   (with-dir (dir :sources sources)
     (let ((lml-files (directory
-                     (make-pathname :defaults *sources-dir*
-                                    :name :wild
-                                    :type "lml"))))
+                      (make-pathname :defaults *sources-dir*
+                                     :name :wild
+                                     :type "lml"))))
       (dolist (file lml-files)
-       (format *trace-output* "~&; Processing ~A~%" file)
-       (lml-load-path file)))))
+        (format *trace-output* "~&; Processing ~A~%" file)
+        (lml-load-path file)))))
 
 (defun lml-load (file &key optional)
   (lml-load-path (eval `(lml-file-name ,file :source)) :optional optional))
index 97287b2..4fa517e 100644 (file)
@@ -2,7 +2,7 @@
 ;;
 ;; $Id$
 ;;
-;; copyright (c) 1986-2000 Franz Inc, Berkeley, CA 
+;; copyright (c) 1986-2000 Franz Inc, Berkeley, CA
 ;; copyright (c) 2003 Kevin Rosenberg
 ;;
 ;; Main changes from Allegro version:
 ;;    - lowercase symbol names for attributes
 ;;    - Add custom tags such as :jscript, :insert-file, :load-file, :nbsp
 ;;    - removal of if* macro
-;;    - Add attribute conditions 
+;;    - Add attribute conditions
 ;;    - Automatic conversion to strings for attribute values
 ;;    - Convert some comments to function doc strings
 ;;
 ;; This code is free software; you can redistribute it and/or
 ;; modify it under the terms of the version 2.1 of
-;; the GNU Lesser General Public License as published by 
+;; the GNU Lesser General Public License as published by
 ;; the Free Software Foundation, as clarified by the LLGPL
 
 
 
 
 (defstruct (html-process (:type list) (:constructor
-                                      make-html-process (key has-inverse
-                                                             macro special
-                                                             print
-                                                             name-attr
-                                                             )))
-  key          ; keyword naming this tag
-  has-inverse  ; t if the / form is used
-  macro        ; the macro to define this
+                                       make-html-process (key has-inverse
+                                                              macro special
+                                                              print
+                                                              name-attr
+                                                              )))
+  key           ; keyword naming this tag
+  has-inverse   ; t if the / form is used
+  macro         ; the macro to define this
   special       ; if true then call this to process the keyword and return
                 ; the macroexpansion
   print         ; function used to handle this in html-print
@@ -39,7 +39,7 @@
   )
 
 
-(defparameter *html-process-table* 
+(defparameter *html-process-table*
     (make-hash-table :test #'equal) ; #'eq is accurate but want to avoid rehashes
   )
 
   "KMR: Walk through forms and combine write-strings"
   (let (res strs last-stream)
     (flet ((flush-strings ()
-            (when strs
-              (push `(write-string ,strs ,last-stream) res)
-              (setq strs nil)
-              (setq last-stream nil))))             
+             (when strs
+               (push `(write-string ,strs ,last-stream) res)
+               (setq strs nil)
+               (setq last-stream nil))))
       (do* ((forms input-forms (cdr forms))
-           (form (car forms) (car forms)))
-          ((null forms)
-           (flush-strings)
-           (nreverse res))
-       (cond
-         ((atom form)
-          (flush-strings)
-          (push form res))
-         ((and (eq (car form) 'cl:write-string)
-               (stringp (cadr form)))
-          (if strs
-              (if (eq last-stream (third form))
-                  (setq strs (concatenate 'string strs (second form)))
-                  (progn
-                    (flush-strings)
-                    (setq strs (second form))
-                    (setq last-stream (third form))))
-              (progn
-                (setq strs (second form))
-                (setq last-stream (third form)))))
-         (t
-          (flush-strings)
-          (push (post-process-html-forms form) res)))))))
-  
+            (form (car forms) (car forms)))
+           ((null forms)
+            (flush-strings)
+            (nreverse res))
+        (cond
+          ((atom form)
+           (flush-strings)
+           (push form res))
+          ((and (eq (car form) 'cl:write-string)
+                (stringp (cadr form)))
+           (if strs
+               (if (eq last-stream (third form))
+                   (setq strs (concatenate 'string strs (second form)))
+                   (progn
+                     (flush-strings)
+                     (setq strs (second form))
+                     (setq last-stream (third form))))
+               (progn
+                 (setq strs (second form))
+                 (setq last-stream (third form)))))
+          (t
+           (flush-strings)
+           (push (post-process-html-forms form) res)))))))
+
 
 (defmacro html-out-stream-check (stream)
   ;; ensure that a real stream is passed to this function
 (defun process-html-forms (forms env)
   (let (res)
     (flet ((do-ent (ent args argsp body)
-            ;; ent is an html-process object associated with the 
-            ;;     html tag we're processing
-            ;; args is the list of values after the tag in the form
-            ;;     ((:tag &rest args) ....)
-            ;; argsp is true if this isn't a singleton tag  (i.e. it has
-            ;;     a body) .. (:tag ...) or ((:tag ...) ...)
-            ;; body is the body if any of the form
-            ;;
-            (let (spec)
-              (cond
-               ((setq spec (html-process-special ent))
-                ;; do something different
-                (push (funcall spec ent args argsp body) res))
-               ((null argsp)
-                ;; singleton tag, just do the set
-                (push `(,(html-process-macro ent) :set) res)
-                nil)
-               (t
-                (cond ((equal args '(:unset))
-                       ;; ((:tag :unset)) is a special case.
-                       ;; that allows us to close off singleton tags
-                       ;; printed earlier.
-                       (push `(,(html-process-macro ent) :unset) res)
-                       nil)
-                      (t
-                       ;; some args
-                       (push `(,(html-process-macro ent)
-                               ,args
-                               ,(process-html-forms body env))
-                             res)
-                       nil)))))))
-                   
+             ;; ent is an html-process object associated with the
+             ;;     html tag we're processing
+             ;; args is the list of values after the tag in the form
+             ;;     ((:tag &rest args) ....)
+             ;; argsp is true if this isn't a singleton tag  (i.e. it has
+             ;;     a body) .. (:tag ...) or ((:tag ...) ...)
+             ;; body is the body if any of the form
+             ;;
+             (let (spec)
+               (cond
+                ((setq spec (html-process-special ent))
+                 ;; do something different
+                 (push (funcall spec ent args argsp body) res))
+                ((null argsp)
+                 ;; singleton tag, just do the set
+                 (push `(,(html-process-macro ent) :set) res)
+                 nil)
+                (t
+                 (cond ((equal args '(:unset))
+                        ;; ((:tag :unset)) is a special case.
+                        ;; that allows us to close off singleton tags
+                        ;; printed earlier.
+                        (push `(,(html-process-macro ent) :unset) res)
+                        nil)
+                       (t
+                        ;; some args
+                        (push `(,(html-process-macro ent)
+                                ,args
+                                ,(process-html-forms body env))
+                              res)
+                        nil)))))))
+
 
       (do* ((xforms forms (cdr xforms))
-           (form (car xforms) (car xforms)))
-         ((null xforms))
-
-       (setq form (macroexpand form env))
-       
-       (if (atom form)
-           (cond
-            ((keywordp form)
-             (let ((ent (gethash form *html-process-table*)))
-               (if (null ent)
-                   (error "unknown html keyword ~s" form)
-                 (do-ent ent nil nil nil))))
-            ((stringp form)
-             ;; turn into a print of it
-             (push `(write-string ,form *html-stream*) res))
-            (t
-             (push form res)))
-         (let ((first (car form)))
-           (cond
-            ((keywordp first)
-             ;; (:xxx . body) form
-             (let ((ent (gethash first
-                                 *html-process-table*)))
-               (if (null ent)
-                   (error "unknown html keyword ~s" form)
-                 (do-ent ent nil t (cdr form)))))
-            ((and (consp first) (keywordp (car first)))
-             ;; ((:xxx args ) . body)
-             (let ((ent (gethash (car first)
-                                 *html-process-table*)))
-               (if (null ent)
-                   (error "unknown html keyword ~s" form)
-                 (do-ent ent (cdr first) t (cdr form)))))
-            (t
-             (push form res)))))))
+            (form (car xforms) (car xforms)))
+          ((null xforms))
+
+        (setq form (macroexpand form env))
+
+        (if (atom form)
+            (cond
+             ((keywordp form)
+              (let ((ent (gethash form *html-process-table*)))
+                (if (null ent)
+                    (error "unknown html keyword ~s" form)
+                  (do-ent ent nil nil nil))))
+             ((stringp form)
+              ;; turn into a print of it
+              (push `(write-string ,form *html-stream*) res))
+             (t
+              (push form res)))
+          (let ((first (car form)))
+            (cond
+             ((keywordp first)
+              ;; (:xxx . body) form
+              (let ((ent (gethash first
+                                  *html-process-table*)))
+                (if (null ent)
+                    (error "unknown html keyword ~s" form)
+                  (do-ent ent nil t (cdr form)))))
+             ((and (consp first) (keywordp (car first)))
+              ;; ((:xxx args ) . body)
+              (let ((ent (gethash (car first)
+                                  *html-process-table*)))
+                (if (null ent)
+                    (error "unknown html keyword ~s" form)
+                  (do-ent ent (cdr first) t (cdr form)))))
+             (t
+              (push form res)))))))
     `(progn ,@(nreverse res))))
 
 
 (defun html-atom-check (args open close body)
   (when (and args (atom args))
     (let ((ans (case args
-                (:set `(write-string  ,open *html-stream*))
-                (:unset `(write-string  ,close *html-stream*))
-                (t (error "illegal arg ~s to ~s" args open)))))
+                 (:set `(write-string  ,open *html-stream*))
+                 (:unset `(write-string  ,close *html-stream*))
+                 (t (error "illegal arg ~s to ~s" args open)))))
       (if (and ans body)
-         (error "can't have a body form with this arg: ~s" args)
-       ans))))
+          (error "can't have a body form with this arg: ~s" args)
+        ans))))
 
 (defun html-body-form (open close body)
   ;; used when args don't matter
   `(progn (write-string  ,open *html-stream*)
-         ,@body
-         (write-string  ,close *html-stream*)))
+          ,@body
+          (write-string  ,close *html-stream*)))
 
 
 (defun attribute-name-string (name)
 
 (defun process-attributes (args)
   (flet ((write-attribute-name-forms (name)
-          `((write-char #\space *html-stream*)
-            (write-string ,(attribute-name-string name)
-                          *html-stream*)))
-        (write-separator-forms ()
-          '((write-char #\= *html-stream*)
-            (write-char #\" *html-stream*))))
+           `((write-char #\space *html-stream*)
+             (write-string ,(attribute-name-string name)
+                           *html-stream*)))
+         (write-separator-forms ()
+           '((write-char #\= *html-stream*)
+             (write-char #\" *html-stream*))))
     (do* ((xx args (cddr xx))
-         (res)
-         (name (first xx) (first xx))
-         (value (second xx) (second xx)))
-       ((null xx)
-        (nreverse res))
+          (res)
+          (name (first xx) (first xx))
+          (value (second xx) (second xx)))
+        ((null xx)
+         (nreverse res))
       (case name
-       (:fformat
-        (unless (and (listp value)
-                     (>= (length value) 2))
-          (error ":fformat must be given a list at least 2 elements"))
-        (mapcar (lambda (f) (push f res))
-                (write-attribute-name-forms (first value)))
-        (mapcar (lambda (f) (push f res))
-                (write-separator-forms))
-        (push `(fformat *html-stream* ,(second value) ,@(cddr value)) 
-              res)
-        (push `(write-char #\" *html-stream*) res))
+        (:fformat
+         (unless (and (listp value)
+                      (>= (length value) 2))
+           (error ":fformat must be given a list at least 2 elements"))
+         (mapcar (lambda (f) (push f res))
+                 (write-attribute-name-forms (first value)))
+         (mapcar (lambda (f) (push f res))
+                 (write-separator-forms))
+         (push `(fformat *html-stream* ,(second value) ,@(cddr value))
+               res)
+         (push `(write-char #\" *html-stream*) res))
       (:format
        (unless (and (listp value) (>= (length value) 2))
-        (error ":format must be given a list at least 2 elements"))
+         (error ":format must be given a list at least 2 elements"))
        (mapcar (lambda (f) (push f res))
-              (write-attribute-name-forms (first value)))
+               (write-attribute-name-forms (first value)))
        (push `(prin1-safe-http-string
-              (format nil ,(second value) ,@(cddr value)))
-            res))
+               (format nil ,(second value) ,@(cddr value)))
+             res))
       (:optional
        (let ((eval-if (gensym "EVAL-IF-")))
-        (push `(let ((,eval-if ,(second value)))
-                 (when ,eval-if
-                    ,@(write-attribute-name-forms (first value))
-                    (prin1-safe-http-string ,eval-if)))
-              res)))
+         (push `(let ((,eval-if ,(second value)))
+                  (when ,eval-if
+                     ,@(write-attribute-name-forms (first value))
+                     (prin1-safe-http-string ,eval-if)))
+               res)))
       (:if
-         (unless (and (listp value)
-                      (>= (length value) 3)
-                      (<= (length value) 4))
-           (error ":if must be given a list with 3 and 4 elements"))
-         (let ((eval-if (gensym "EVAL-IF-")))
-           (push `(let ((,eval-if ,(second value)))
-                    ,@(write-attribute-name-forms (first value))
-                    (prin1-safe-http-string 
-                     (if ,eval-if
-                         ,(third value)
-                       ,(fourth value))))
-                 res)))
+          (unless (and (listp value)
+                       (>= (length value) 3)
+                       (<= (length value) 4))
+            (error ":if must be given a list with 3 and 4 elements"))
+          (let ((eval-if (gensym "EVAL-IF-")))
+            (push `(let ((,eval-if ,(second value)))
+                     ,@(write-attribute-name-forms (first value))
+                     (prin1-safe-http-string
+                      (if ,eval-if
+                          ,(third value)
+                        ,(fourth value))))
+                  res)))
       (:when
-         (unless (and (listp value)
-                      (= (length value) 3))
-           (error ":when must be given a list with 3 elements"))
-       (push `(when ,(second value)
-                ,@(write-attribute-name-forms (first value))
-                (prin1-safe-http-string ,(third value)))
-             res))
+          (unless (and (listp value)
+                       (= (length value) 3))
+            (error ":when must be given a list with 3 elements"))
+        (push `(when ,(second value)
+                 ,@(write-attribute-name-forms (first value))
+                 (prin1-safe-http-string ,(third value)))
+              res))
       (t
        (mapcar (lambda (f) (push f res))
-              (write-attribute-name-forms name))
+               (write-attribute-name-forms name))
        (push `(prin1-safe-http-string ,value) res))))))
 
 (defun html-body-key-form (string-code has-inv args body)
   ;; do what's needed to handle given keywords in the args
   ;; then do the body
   (when (and args (atom args))
-    ;; single arg 
+    ;; single arg
     (return-from html-body-key-form
       (case args
-       (:set (if has-inv
-                 `(write-string  ,(format nil "<~a>" string-code)
-                                 *html-stream*)
-               `(write-string  ,(format nil "<~a />" string-code)
-                               *html-stream*)))
-       (:unset (when has-inv
-                 `(write-string  ,(format nil "</~a>" string-code)
-                                 *html-stream*)))
-       (t (error "illegal arg ~s to ~s" args string-code)))))
-  
+        (:set (if has-inv
+                  `(write-string  ,(format nil "<~a>" string-code)
+                                  *html-stream*)
+                `(write-string  ,(format nil "<~a />" string-code)
+                                *html-stream*)))
+        (:unset (when has-inv
+                  `(write-string  ,(format nil "</~a>" string-code)
+                                  *html-stream*)))
+        (t (error "illegal arg ~s to ~s" args string-code)))))
+
   (unless (evenp (length args))
     (warn "arg list ~s isn't even" args))
-  
-  
+
+
   (if args
       `(progn (write-string ,(format nil "<~a" string-code)
-                           *html-stream*)
-
-             ,@(process-attributes args)
-             
-             ,(unless has-inv `(write-string " /" *html-stream*))
-             (write-string ">" *html-stream*)
-             ,@body
-             ,(when (and body has-inv)
-                `(write-string ,(format nil "</~a>" string-code)
-                               *html-stream*)))
+                            *html-stream*)
+
+              ,@(process-attributes args)
+
+              ,(unless has-inv `(write-string " /" *html-stream*))
+              (write-string ">" *html-stream*)
+              ,@body
+              ,(when (and body has-inv)
+                 `(write-string ,(format nil "</~a>" string-code)
+                                *html-stream*)))
     (if has-inv
-       `(progn (write-string ,(format nil "<~a>" string-code)
-                             *html-stream*)
-               ,@body
-               ,(when body
-                  `(write-string ,(format nil "</~a>" string-code)
-                                 *html-stream*)))
+        `(progn (write-string ,(format nil "<~a>" string-code)
+                              *html-stream*)
+                ,@body
+                ,(when body
+                   `(write-string ,(format nil "</~a>" string-code)
+                                  *html-stream*)))
       `(progn (write-string ,(format nil "<~a />" string-code)
-                           *html-stream*)))))
+                            *html-stream*)))))
 
 
 
   ;; symbols are turned into their name
   ;;
   ;; non-string and non-symbols are written to a string and quoted
-  
+
   (unless (and (symbolp val)
-              (equal "" (symbol-name val)))
+               (equal "" (symbol-name val)))
     (write-char #\= *html-stream*)
     (when (not (or (stringp val)
-                  (symbolp val)))
+                   (symbolp val)))
       (setq val (write-to-string val)))
     (if (or (stringp val)
-           (and (symbolp val) 
-                (setq val (string-downcase
-                           (symbol-name val)))))
-       (progn
-         (write-char #\" *html-stream*)
-         (emit-safe *html-stream* val)
-         (write-char #\" *html-stream*))
+            (and (symbolp val)
+                 (setq val (string-downcase
+                            (symbol-name val)))))
+        (progn
+          (write-char #\" *html-stream*)
+          (emit-safe *html-stream* val)
+          (write-char #\" *html-stream*))
       (prin1-safe-http val))))
 
 
   "Send the string to the http response stream watching out for
   special html characters and encoding them appropriately."
   (do* ((i 0 (1+ i))
-       (start i)
-       (end (length string)))
+        (start i)
+        (end (length string)))
       ((>= i end)
        (when (< start i)
-        (write-sequence string stream :start start :end i)))
-      
+         (write-sequence string stream :start start :end i)))
+
     (let* ((ch (schar string i))
-          (cvt (case ch
-                 (#\< "&lt;")
-                 (#\> "&gt;")
-                 (#\& "&amp;")
-                 (#\" "&quot;"))))
+           (cvt (case ch
+                  (#\< "&lt;")
+                  (#\> "&gt;")
+                  (#\& "&amp;")
+                  (#\" "&quot;"))))
       (when cvt
-        ;; must do a conversion, emit previous chars first
-       (when (< start i)
-         (write-sequence string stream :start start :end i))
-       (write-string cvt stream)
-       (setq start (1+ i))))))
-       
-               
+         ;; must do a conversion, emit previous chars first
+        (when (< start i)
+          (write-sequence string stream :start start :end i))
+        (write-string cvt stream)
+        (setq start (1+ i))))))
+
+
 
 (defun html-print-list (list-of-forms stream &key unknown)
   ;; html print a list of forms
 (defun html-print-subst (form subst stream unknown)
   ;; Print the given lhtml form to the given stream
   (assert (streamp stream))
-    
-              
+
+
   (let* ((attrs)
-        (attr-name)
-        (name)
-        (possible-kwd (cond 
-                       ((atom form) form)
-                       ((consp (car form))
-                        (setq attrs (cdar form))
-                        (caar form))
-                       (t (car form))))
-        print-handler
-        ent)
+         (attr-name)
+         (name)
+         (possible-kwd (cond
+                        ((atom form) form)
+                        ((consp (car form))
+                         (setq attrs (cdar form))
+                         (caar form))
+                        (t (car form))))
+         print-handler
+         ent)
     (when (keywordp possible-kwd)
       (if (null (setq ent (gethash possible-kwd *html-process-table*)))
-         (if unknown
-             (return-from html-print-subst
-               (funcall unknown form stream))
-           (error "unknown html tag: ~s" possible-kwd))
-       ;; see if we should subst
-       (when (and subst 
-                  attrs 
-                  (setq attr-name (html-process-name-attr ent))
-                  (setq name (getf attrs attr-name))
-                  (setq attrs (html-find-value name subst)))
-         (return-from html-print-subst
-           (if (functionp (cdr attrs))
-               (funcall (cdr attrs) stream)
-             (html-print-subst
-              (cdr attrs)
-              subst
-              stream
-              unknown)))))
-      
+          (if unknown
+              (return-from html-print-subst
+                (funcall unknown form stream))
+            (error "unknown html tag: ~s" possible-kwd))
+        ;; see if we should subst
+        (when (and subst
+                   attrs
+                   (setq attr-name (html-process-name-attr ent))
+                   (setq name (getf attrs attr-name))
+                   (setq attrs (html-find-value name subst)))
+          (return-from html-print-subst
+            (if (functionp (cdr attrs))
+                (funcall (cdr attrs) stream)
+              (html-print-subst
+               (cdr attrs)
+               subst
+               stream
+               unknown)))))
+
       (setq print-handler
-       (html-process-print ent)))
-    
+        (html-process-print ent)))
+
     (cond
      ((atom form)
       (cond
        ((keywordp form)
-       (funcall print-handler ent :set nil nil nil nil stream))
+        (funcall print-handler ent :set nil nil nil nil stream))
        ((stringp form)
-       (write-string form stream))
+        (write-string form stream))
        (t
-       (princ form stream))))
+        (princ form stream))))
      (ent
-      (funcall print-handler 
-              ent
-              :full
-              (when (consp (car form)) (cdr (car form)))
-              form 
-              subst
-              unknown
-              stream))
+      (funcall print-handler
+               ent
+               :full
+               (when (consp (car form)) (cdr (car form)))
+               form
+               subst
+               unknown
+               stream))
      (t
       (error "Illegal form: ~s" form)))))
 
-  
+
 (defun html-find-value (key subst)
   ; find the (key . value) object in the subst list.
   ; A subst list is an assoc list ((key . value) ....)
   ; but instead of a (key . value) cons you may have an assoc list
   ;
   (let ((to-process nil)
-       (alist subst))
+        (alist subst))
     (loop
       (do* ((entlist alist (cdr entlist))
-           (ent (car entlist) (car entlist)))
-         ((null entlist) (setq alist nil))
-       (cond
-        ((consp (car ent))
-         ;; this is another alist
-         (when (cdr entlist)
-           (push (cdr entlist) to-process))
-         (setq alist ent)
-         (return))                     ; exit do*
-        ((equal key (car ent))
-         (return-from html-find-value ent))))
-              
+            (ent (car entlist) (car entlist)))
+          ((null entlist) (setq alist nil))
+        (cond
+         ((consp (car ent))
+          ;; this is another alist
+          (when (cdr entlist)
+            (push (cdr entlist) to-process))
+          (setq alist ent)
+          (return))                     ; exit do*
+         ((equal key (car ent))
+          (return-from html-find-value ent))))
+
       (when (null alist)
-        ;; we need to find a new alist to process
-       (if to-process
-           (setq alist (pop to-process))
-         (return))))))
+         ;; we need to find a new alist to process
+        (if to-process
+            (setq alist (pop to-process))
+          (return))))))
 
 (defun html-standard-print (ent cmd args form subst unknown stream)
   ;; the print handler for the normal html operators
     (:full ; set, do body and then unset
      (let (iter)
        (if args
-          (cond
-           ((and (setq iter (getf args :iter))
-                 (setq iter (html-find-value iter subst)))
-             ;; remove the iter and pre
-            (setq args (copy-list args))
-            (remf args :iter)
-            (funcall (cdr iter)
-                     (cons (cons (caar form)
-                                 args)
-                           (cdr form))
-                     subst
-                     stream)
-            (return-from html-standard-print))
-           (t
-            (format stream "<~a" (html-process-key ent))
-            (do ((xx args (cddr xx)))
-                ((null xx))
-                                       ; assume that the arg is already escaped 
-                                       ; since we read it
-                                       ; from the parser
-              (format stream " ~a=\"~a\"" (car xx) (cadr xx)))
-            (format stream ">")))
-        (format stream "<~a>" (html-process-key ent)))
+           (cond
+            ((and (setq iter (getf args :iter))
+                  (setq iter (html-find-value iter subst)))
+              ;; remove the iter and pre
+             (setq args (copy-list args))
+             (remf args :iter)
+             (funcall (cdr iter)
+                      (cons (cons (caar form)
+                                  args)
+                            (cdr form))
+                      subst
+                      stream)
+             (return-from html-standard-print))
+            (t
+             (format stream "<~a" (html-process-key ent))
+             (do ((xx args (cddr xx)))
+                 ((null xx))
+                                        ; assume that the arg is already escaped
+                                        ; since we read it
+                                        ; from the parser
+               (format stream " ~a=\"~a\"" (car xx) (cadr xx)))
+             (format stream ">")))
+         (format stream "<~a>" (html-process-key ent)))
        (dolist (ff (cdr form))
-        (html-print-subst ff subst stream unknown)))
+         (html-print-subst ff subst stream unknown)))
      (when (html-process-has-inverse ent)
        ;; end the form
        (format stream "</~a>" (html-process-key ent))))))
-     
-  
-  
-                 
-                   
-  
-                                        
-                     
+
+
+
+
+
+
+
+
 ;; --  defining how html tags are handled. --
 ;;
 ;; most tags are handled in a standard way and the def-std-html
 ;; how these are handled.  The tags requiring special treatment
 ;; are the pseudo tags we added to control operations
 ;; in the html generator.
-;; 
+;;
 ;;
 ;; tags can be found in three ways:
-;;  :br                        - singleton, no attributes, no body
+;;  :br                 - singleton, no attributes, no body
 ;;  (:b "foo")          - no attributes but with a body
 ;;  ((:a href="foo") "balh")  - attributes and body
 ;;
-  
-  
+
+
 
 (defmacro def-special-html (kwd fcn print-fcn)
   ;; kwd - the tag we're defining behavior for.
   ;; fcn - function to compute the macroexpansion of a use of this
-  ;;       tag. args to fcn are: 
-  ;;           ent - html-process object holding info on this tag
-  ;;           args - list of attribute-values following tag
-  ;;           argsp - true if there is a body in this use of the tag
-  ;;           body - list of body forms.
-  ;; print-fcn - function to print an lhtml form with this tag 
-  ;;       args to fcn are:
-  ;;           ent - html-process object holding info on this tag
-  ;;           cmd - one of :set, :unset, :full
-  ;;           args - list of attribute-value pairs
-  ;;           subst - subsitution list
-  ;;           unknown - function to call for unknown tags
-  ;;           stream - stream to write to
-  ;;           
-  `(setf (gethash ,kwd *html-process-table*) 
+  ;;       tag. args to fcn are:
+  ;;            ent - html-process object holding info on this tag
+  ;;            args - list of attribute-values following tag
+  ;;            argsp - true if there is a body in this use of the tag
+  ;;            body - list of body forms.
+  ;; print-fcn - function to print an lhtml form with this tag
+  ;;        args to fcn are:
+  ;;            ent - html-process object holding info on this tag
+  ;;            cmd - one of :set, :unset, :full
+  ;;            args - list of attribute-value pairs
+  ;;            subst - subsitution list
+  ;;            unknown - function to call for unknown tags
+  ;;            stream - stream to write to
+  ;;
+  `(setf (gethash ,kwd *html-process-table*)
      (make-html-process ,kwd nil nil ,fcn ,print-fcn nil)))
 
 
   (declare (ignore name))
   `(function ,@body))
 
-          
-(def-special-html :newline 
+
+(def-special-html :newline
     (named-function html-newline-function
       (lambda (ent args argsp body)
-       (declare (ignore ent args argsp))
-       (when body
-         (error "can't have a body with :newline -- body is ~s" body))
-       `(terpri *html-stream*)))
-  
+        (declare (ignore ent args argsp))
+        (when body
+          (error "can't have a body with :newline -- body is ~s" body))
+        `(terpri *html-stream*)))
+
   (named-function html-newline-print-function
     (lambda (ent cmd args form subst unknown stream)
       (declare (ignore args ent unknown subst))
       (if (eq cmd :set)
-         (terpri stream)
-       (error ":newline in an illegal place: ~s" form)))))
+          (terpri stream)
+        (error ":newline in an illegal place: ~s" form)))))
 
 (def-special-html :princ
     (named-function html-princ-function
       (lambda (ent args argsp body)
-       (declare (ignore ent args argsp))
-       `(progn ,@(mapcar #'(lambda (bod)
-                             `(princ-http ,bod))
-                         body))))
-  
+        (declare (ignore ent args argsp))
+        `(progn ,@(mapcar #'(lambda (bod)
+                              `(princ-http ,bod))
+                          body))))
+
   (named-function html-princ-print-function
     (lambda (ent cmd args form subst unknown stream)
       (declare (ignore args ent unknown subst))
       (assert (eql 2 (length form)))
       (if (eq cmd :full)
-         (format stream "~a" (cadr form))
-       (error ":princ must be given an argument")))))
+          (format stream "~a" (cadr form))
+        (error ":princ must be given an argument")))))
 
-(def-special-html :princ-safe 
+(def-special-html :princ-safe
     (named-function html-princ-safe-function
       (lambda (ent args argsp body)
-       (declare (ignore ent args argsp))
-       `(progn ,@(mapcar #'(lambda (bod)
-                             `(princ-safe-http ,bod))
-                         body))))
+        (declare (ignore ent args argsp))
+        `(progn ,@(mapcar #'(lambda (bod)
+                              `(princ-safe-http ,bod))
+                          body))))
   (named-function html-princ-safe-print-function
     (lambda (ent cmd args form subst unknown stream)
       (declare (ignore args ent unknown subst))
       (assert (eql 2 (length form)))
       (if (eq cmd :full)
-         (emit-safe stream (format nil "~a" (cadr form)))
-       (error ":princ-safe must be given an argument")))))
+          (emit-safe stream (format nil "~a" (cadr form)))
+        (error ":princ-safe must be given an argument")))))
 
 (def-special-html :prin1
     (named-function html-prin1-function
       (lambda (ent args argsp body)
-       (declare (ignore ent args argsp))
-       `(progn ,@(mapcar #'(lambda (bod)
-                             `(prin1-http ,bod))
-                         body))))
+        (declare (ignore ent args argsp))
+        `(progn ,@(mapcar #'(lambda (bod)
+                              `(prin1-http ,bod))
+                          body))))
   (named-function html-prin1-print-function
     (lambda (ent cmd args form subst unknown stream)
       (declare (ignore ent args unknown subst))
       (assert (eql 2 (length form)))
       (if (eq cmd :full)
-         (format stream "~s" (cadr form))
-       (error ":prin1 must be given an argument")))))
+          (format stream "~s" (cadr form))
+        (error ":prin1 must be given an argument")))))
 
 (def-special-html :prin1-safe
     (named-function html-prin1-safe-function
       (lambda (ent args argsp body)
-       (declare (ignore ent args argsp))
-       `(progn ,@(mapcar #'(lambda (bod)
-                             `(prin1-safe-http ,bod))
-                         body))))
+        (declare (ignore ent args argsp))
+        `(progn ,@(mapcar #'(lambda (bod)
+                              `(prin1-safe-http ,bod))
+                          body))))
   (named-function html-prin1-safe-print-function
     (lambda (ent cmd args form subst unknown stream)
       (declare (ignore args ent subst unknown))
       (assert (eql 2 (length form)))
       (if (eq cmd :full)
-         (emit-safe stream (format nil "~s" (cadr form)))
-       (error ":prin1-safe must be given an argument")))))
+          (emit-safe stream (format nil "~s" (cadr form)))
+        (error ":prin1-safe must be given an argument")))))
 
 (def-special-html :comment
     (named-function html-comment-function
       (lambda (ent args argsp body)
-       ;; must use <!--   --> syntax
-       (declare (ignore ent args argsp))
-       `(progn (write-string "<!--" *html-stream*)
-               (html ,@body)
-               (write-string "-->" *html-stream*))))
+        ;; must use <!--   --> syntax
+        (declare (ignore ent args argsp))
+        `(progn (write-string "<!--" *html-stream*)
+                (html ,@body)
+                (write-string "-->" *html-stream*))))
   (named-function html-comment-print-function
     (lambda (ent cmd args form subst unknown stream)
       (declare (ignore ent cmd args subst unknown))
 
 (defmacro def-std-html (kwd has-inverse name-attrs)
   (let ((mac-name (intern (format nil "~a-~a" :with-html kwd)))
-       (string-code (string-downcase (string kwd))))
+        (string-code (string-downcase (string kwd))))
     `(progn (setf (gethash ,kwd *html-process-table*)
-             (make-html-process ,kwd ,has-inverse
-                                    ',mac-name
-                                    nil
-                                    #'html-standard-print
-                                    ',name-attrs))
-           (defmacro ,mac-name (args &rest body)
-             (html-body-key-form ,string-code ,has-inverse args body)))))
+              (make-html-process ,kwd ,has-inverse
+                                     ',mac-name
+                                     nil
+                                     #'html-standard-print
+                                     ',name-attrs))
+            (defmacro ,mac-name (args &rest body)
+              (html-body-key-form ,string-code ,has-inverse args body)))))
+
 
-    
 
 (def-std-html :a        t nil)
 (def-std-html :abbr     t nil)
 (def-std-html :ins     t nil)
 (def-std-html :isindex    nil nil)
 
-(def-std-html :kbd     t nil)
-(def-std-html :keygen          nil nil)
+(def-std-html :kbd      t nil)
+(def-std-html :keygen   nil nil)
 
-(def-std-html :label   t nil)
-(def-std-html :layer   t nil)
-(def-std-html :legend          t nil)
-(def-std-html :li      t nil)
-(def-std-html :link    nil nil)
+(def-std-html :label    t nil)
+(def-std-html :layer    t nil)
+(def-std-html :legend   t nil)
+(def-std-html :li       t nil)
+(def-std-html :link     nil nil)
 (def-std-html :listing  t nil)
 
-(def-std-html :map     t nil)
+(def-std-html :map      t nil)
 (def-std-html :marquee  t nil)
-(def-std-html :menu    t nil)
-(def-std-html :meta    nil nil)
+(def-std-html :menu     t nil)
+(def-std-html :meta     nil nil)
 (def-std-html :multicol t nil)
 
-(def-std-html :nobr    t nil)
+(def-std-html :nobr     t nil)
 (def-std-html :noembed  t nil)
 (def-std-html :noframes t nil)
 (def-std-html :noscript t nil)
 
-(def-std-html :object          t nil)
-(def-std-html :ol      t nil)
+(def-std-html :object   t nil)
+(def-std-html :ol       t nil)
 (def-std-html :optgroup t nil)
-(def-std-html :option          t nil)
+(def-std-html :option   t nil)
 
-(def-std-html :p       t nil)
-(def-std-html :param   t nil)
+(def-std-html :p        t nil)
+(def-std-html :param    t nil)
 (def-std-html :plaintext  nil nil)
-(def-std-html :pre     t nil)
-
-(def-std-html :q       t nil)
-
-(def-std-html :s       t nil)
-(def-std-html :samp    t nil)
-(def-std-html :script          t nil)
-(def-std-html :select          t nil)
-(def-std-html :server          t nil)
-(def-std-html :small   t nil)
-(def-std-html :spacer          nil nil)
-(def-std-html :span    t :id)
-(def-std-html :strike          t nil)
-(def-std-html :strong          t nil)
-(def-std-html :style    t nil)  
-(def-std-html :sub     t nil)
-(def-std-html :sup     t nil)
-
-(def-std-html :table   t :name)
-(def-std-html :tbody   t nil)
-(def-std-html :td      t nil)
+(def-std-html :pre      t nil)
+
+(def-std-html :q        t nil)
+
+(def-std-html :s        t nil)
+(def-std-html :samp     t nil)
+(def-std-html :script   t nil)
+(def-std-html :select   t nil)
+(def-std-html :server   t nil)
+(def-std-html :small    t nil)
+(def-std-html :spacer   nil nil)
+(def-std-html :span     t :id)
+(def-std-html :strike   t nil)
+(def-std-html :strong   t nil)
+(def-std-html :style    t nil)
+(def-std-html :sub      t nil)
+(def-std-html :sup      t nil)
+
+(def-std-html :table    t :name)
+(def-std-html :tbody    t nil)
+(def-std-html :td       t nil)
 (def-std-html :textarea  t nil)
-(def-std-html :tfoot   t nil)
-(def-std-html :th      t nil)
-(def-std-html :thead   t nil)
-(def-std-html :title   t nil)
-(def-std-html :tr      t nil)
-(def-std-html :tt      t nil)
+(def-std-html :tfoot    t nil)
+(def-std-html :th       t nil)
+(def-std-html :thead    t nil)
+(def-std-html :title    t nil)
+(def-std-html :tr       t nil)
+(def-std-html :tt       t nil)
 
-(def-std-html :u       t nil)
-(def-std-html :ul      t nil)
+(def-std-html :u        t nil)
+(def-std-html :ul       t nil)
 
-(def-std-html :var     t nil)
+(def-std-html :var      t nil)
 
-(def-std-html :wbr     nil nil)
+(def-std-html :wbr      nil nil)
 
-(def-std-html :xmp     t nil)
+(def-std-html :xmp      t nil)
 
 
 
 (def-special-html :jscript
     (named-function html-comment-function
       (lambda (ent args argsp body)
-       ;; must use <!--   --> syntax
-       (declare (ignore ent args argsp))
-       `(progn
-         #+ignore
-         (write-string "<script language=\"JavaScript\" type=\"text/javascript\">" *html-stream*)
-         (write-string "<script type=\"text/javascript\">" *html-stream*)
-         (write-char #\newline *html-stream*)
-         (write-string "// <![CDATA[" *html-stream*)
-         (write-char #\newline *html-stream*)
-         (html ,@body)
-         (write-char #\newline *html-stream*)
-         (write-string "// ]]>" *html-stream*)
-         (write-char #\newline *html-stream*)
-         (write-string "</script>" *html-stream*))))
+        ;; must use <!--   --> syntax
+        (declare (ignore ent args argsp))
+        `(progn
+          #+ignore
+          (write-string "<script language=\"JavaScript\" type=\"text/javascript\">" *html-stream*)
+          (write-string "<script type=\"text/javascript\">" *html-stream*)
+          (write-char #\newline *html-stream*)
+          (write-string "// <![CDATA[" *html-stream*)
+          (write-char #\newline *html-stream*)
+          (html ,@body)
+          (write-char #\newline *html-stream*)
+          (write-string "// ]]>" *html-stream*)
+          (write-char #\newline *html-stream*)
+          (write-string "</script>" *html-stream*))))
   (named-function html-comment-print-function
     (lambda (ent cmd args form subst unknown stream)
       (declare (ignore ent cmd args subst unknown))
       (format stream "<script language=\"JavaScript\" type=\"text/javascript\">~%// <![CDATA[~%~A~%// ]]>~%</script>"
-             (cadr form)))))
+              (cadr form)))))
 
-(def-special-html :nbsp 
+(def-special-html :nbsp
     (named-function html-nbsp-function
       (lambda (ent args argsp body)
-       (declare (ignore ent args argsp))
-       (when body
-         (error "can't have a body with :nbsp -- body is ~s" body))
-       `(write-string "&nbsp;" *html-stream*)))
-  
+        (declare (ignore ent args argsp))
+        (when body
+          (error "can't have a body with :nbsp -- body is ~s" body))
+        `(write-string "&nbsp;" *html-stream*)))
+
   (named-function html-nbsp-print-function
     (lambda (ent cmd args form subst unknown stream)
       (declare (ignore args ent unknown subst))
       (if (eq cmd :set)
-         (write-string "&nbsp;" stream)
-       (error ":nbsp in an illegal place: ~s" form)))))
+          (write-string "&nbsp;" stream)
+        (error ":nbsp in an illegal place: ~s" form)))))
 
 
 (def-special-html :load-file
     (named-function html-nbsp-function
       (lambda (ent args argsp body)
-       (declare (ignore ent args argsp))
-       (unless body
-         (error "must have a body with :load-file"))
-       `(progn ,@(mapcar #'(lambda (bod)
-                             `(lml-load ,bod))
-                         body))))
-  
+        (declare (ignore ent args argsp))
+        (unless body
+          (error "must have a body with :load-file"))
+        `(progn ,@(mapcar #'(lambda (bod)
+                              `(lml-load ,bod))
+                          body))))
+
   (named-function html-nbsp-print-function
     (lambda (ent cmd args form subst unknown stream)
       (declare (ignore ent unknown subst stream args))
       (assert (eql 2 (length form)))
       (if (eq cmd :full)
-         (lml-load (cadr form))
-       (error ":load-file must be given an argument")))))
+          (lml-load (cadr form))
+        (error ":load-file must be given an argument")))))
 
 (def-special-html :insert-file
     (named-function html-nbsp-function
       (lambda (ent args argsp body)
-       (declare (ignore ent args argsp))
-       (unless body
-         (error "must have a body with :insert-file"))
-       `(progn ,@(mapcar #'(lambda (bod)
-                             `(insert-file ,bod))
-                         body))))
-  
+        (declare (ignore ent args argsp))
+        (unless body
+          (error "must have a body with :insert-file"))
+        `(progn ,@(mapcar #'(lambda (bod)
+                              `(insert-file ,bod))
+                          body))))
+
   (named-function html-nbsp-print-function
     (lambda (ent cmd args form subst unknown stream)
       (declare (ignore ent unknown subst stream args))
       (assert (eql 2 (length form)))
       (if (eq cmd :full)
-         (insert-file (cadr form))
-       (error ":insert-file must be given an argument")))))
+          (insert-file (cadr form))
+        (error ":insert-file must be given an argument")))))
 
 (def-special-html :write-string
     (named-function html-write-string-function
       (lambda (ent args argsp body)
-       (declare (ignore ent args argsp))
-       (if (= (length body) 1)
-           `(write-string ,(car body) *html-stream*)
-         `(progn ,@(mapcar #'(lambda (bod)
-                               `(write-string ,bod *html-stream*))
-                           body)))))
-  
+        (declare (ignore ent args argsp))
+        (if (= (length body) 1)
+            `(write-string ,(car body) *html-stream*)
+          `(progn ,@(mapcar #'(lambda (bod)
+                                `(write-string ,bod *html-stream*))
+                            body)))))
+
   (named-function html-write-string-print-function
     (lambda (ent cmd args form subst unknown stream)
       (declare (ignore args ent unknown subst))
       (assert (eql 2 (length form)))
       (if (eq cmd :full)
-         (write-string (cadr form) stream)
-         (error ":write-string must be given an argument")))))
+          (write-string (cadr form) stream)
+          (error ":write-string must be given an argument")))))
 
 (def-special-html :write-char
     (named-function html-write-char-function
       (lambda (ent args argsp body)
-       (declare (ignore ent args argsp))
-       `(progn ,@(mapcar #'(lambda (bod)
-                             `(write-char ,bod *html-stream*))
-                         body))))
-  
+        (declare (ignore ent args argsp))
+        `(progn ,@(mapcar #'(lambda (bod)
+                              `(write-char ,bod *html-stream*))
+                          body))))
+
   (named-function html-write-char-print-function
     (lambda (ent cmd args form subst unknown stream)
       (declare (ignore args ent unknown subst))
       (assert (eql 2 (length form)))
       (if (eq cmd :full)
-         (write-char (cadr form) stream)
-         (error ":write-char must be given an argument")))))
+          (write-char (cadr form) stream)
+          (error ":write-char must be given an argument")))))
 
 
 
index a1a4420..5d93991 100644 (file)
@@ -23,7 +23,7 @@
 
    ;; data.lisp
    #:*html-stream*
-   
+
    ;; base.lisp
    #:html-file-page
    #:dtd-prologue
@@ -35,7 +35,7 @@
    #:lml-print-date
    #:alink
    #:alink-c
-   
+
    ;; htmlgen.lisp
    #:html #:html-print #:html-print-subst #:html-print-list #:html-print-list-subst
    #:html-stream #:*html-stream*
@@ -53,7 +53,7 @@
    #:std-body
    #:std-head
    #:titled-pre-section
-   
+
    ;; downloads.lisp
    #:std-dl-page
    #:full-dl-page
index 8e97b9d..0e173eb 100644 (file)
   #'(lambda (stream char)
       (declare (ignore char))
       (let ((forms '())
-           (curr-string (new-string))
-           (paren-level 0)
-           (got-comma nil))
-       (declare (type fixnum paren-level))
-       (do ((ch (read-char stream t nil t) (read-char stream t nil t)))
-           ((eql ch #\]))
-         (if got-comma
-             (if (eql ch #\()
-                 ;; Starting top-level ,(
-                 (progn
-                   #+cmu
-                   (setf curr-string (coerce curr-string `(simple-array character (*))))
-       
-                   (push `(lml2-princ ,curr-string) forms)
-                   (setq curr-string (new-string))
-                   (setq got-comma nil)
-                   (vector-push #\( curr-string)
-                   (do ((ch (read-char stream t nil t) (read-char stream t nil t)))
-                       ((and (eql ch #\)) (zerop paren-level)))
-                     (when (eql ch #\])
-                       (format *trace-output* "Syntax error reading #\]")
-                       (return nil))
-                     (case ch
-                       (#\(
-                        (incf paren-level))
-                       (#\)
-                        (decf paren-level)))
-                     (vector-push-extend ch curr-string))
-                   (vector-push-extend #\) curr-string)
-                   (let ((eval-string (read-from-string curr-string))
-                         (res (gensym)))
-                     (push
-                      `(let ((,res ,eval-string))
-                         (when ,res
-                           (lml2-princ ,res)))
-                      forms))
-                   (setq curr-string (new-string)))
-               ;; read comma, then non #\( char
-               (progn
-                 (unless (eql ch #\,)
-                   (setq got-comma nil))
-                 (vector-push-extend #\, curr-string) ;; push previous command
-                 (vector-push-extend ch curr-string)))
-           ;; previous character is not a comma
-           (if (eql ch #\,)
-               (setq got-comma t)
-             (progn
-               (setq got-comma nil)
-               (vector-push-extend ch curr-string)))))
+            (curr-string (new-string))
+            (paren-level 0)
+            (got-comma nil))
+        (declare (type fixnum paren-level))
+        (do ((ch (read-char stream t nil t) (read-char stream t nil t)))
+            ((eql ch #\]))
+          (if got-comma
+              (if (eql ch #\()
+                  ;; Starting top-level ,(
+                  (progn
+                    #+cmu
+                    (setf curr-string (coerce curr-string `(simple-array character (*))))
 
-       #+cmu
-       (setf curr-string (coerce curr-string `(simple-array character (*))))
-       
-       (push `(lml2-princ ,curr-string) forms)
-       `(progn ,@(nreverse forms)))))
+                    (push `(lml2-princ ,curr-string) forms)
+                    (setq curr-string (new-string))
+                    (setq got-comma nil)
+                    (vector-push #\( curr-string)
+                    (do ((ch (read-char stream t nil t) (read-char stream t nil t)))
+                        ((and (eql ch #\)) (zerop paren-level)))
+                      (when (eql ch #\])
+                        (format *trace-output* "Syntax error reading #\]")
+                        (return nil))
+                      (case ch
+                        (#\(
+                         (incf paren-level))
+                        (#\)
+                         (decf paren-level)))
+                      (vector-push-extend ch curr-string))
+                    (vector-push-extend #\) curr-string)
+                    (let ((eval-string (read-from-string curr-string))
+                          (res (gensym)))
+                      (push
+                       `(let ((,res ,eval-string))
+                          (when ,res
+                            (lml2-princ ,res)))
+                       forms))
+                    (setq curr-string (new-string)))
+                ;; read comma, then non #\( char
+                (progn
+                  (unless (eql ch #\,)
+                    (setq got-comma nil))
+                  (vector-push-extend #\, curr-string) ;; push previous command
+                  (vector-push-extend ch curr-string)))
+            ;; previous character is not a comma
+            (if (eql ch #\,)
+                (setq got-comma t)
+              (progn
+                (setq got-comma nil)
+                (vector-push-extend ch curr-string)))))
+
+        #+cmu
+        (setf curr-string (coerce curr-string `(simple-array character (*))))
+
+        (push `(lml2-princ ,curr-string) forms)
+        `(progn ,@(nreverse forms)))))
index 14fb961..ac3ee63 100644 (file)
@@ -30,7 +30,7 @@
 
 (defmacro std-head (title &body body)
   `(html
-    (:head 
+    (:head
      (:title (:princ ,title))
      (lml-load "header.lml_")
      ,@body)))
   (html
    ((:div :class "disclaimsec")
     (let ((src-file (make-pathname
-                    :defaults *sources-dir*
-                    :type "lml"
-                    :name (pathname-name file))))       
+                     :defaults *sources-dir*
+                     :type "lml"
+                     :name (pathname-name file))))
       (when (probe-file src-file)
-       (html
-        ((:div :class "lastmod")
-         (lml-format  "Last modified: ~A" (date-string (file-write-date src-file)))))))
+        (html
+         ((:div :class "lastmod")
+          (lml-format  "Last modified: ~A" (date-string (file-write-date src-file)))))))
     (lml-load "footer.lml_"))))
 
 
     (:body
      (lml-load "banner.lml_")
      ((:table :class "stdbodytable" :border "0" :cellpadding "3")
-      (:tbody 
+      (:tbody
        ((:tr :valign "top")
-       ((:td :class "stdcontentcell")
-        (lml-load "contents.lml_"))
-       ((:td :valign "top")
-        ,@body
-        (std-footer ,file))
+        ((:td :class "stdcontentcell")
+         (lml-load "contents.lml_"))
+        ((:td :valign "top")
+         ,@body
+         (std-footer ,file))
         ((:td :valign "top")
          (lml-load "rightcol.lml_" :optional t)))))
      (lml-load "final.lml_" :optional t))))
-  
+
 
 (defmacro print-std-page (file title format &body body)
   `(progn
        (std-body ,file ,@body)))))
 
 (defmacro std-page ((out-file title &key (format :xhtml11))
-                   &body body)
+                    &body body)
   `(let ((*indent* 0))
      (with-open-file (*html-stream* (lml-file-name ',out-file :output)
-                     :direction :output
-                     :if-exists :supersede)
+                      :direction :output
+                      :if-exists :supersede)
        (print-std-page (lml-file-name ',out-file :source) ,title ,format ,@body))))
 
 (defmacro titled-pre-section (title &body body)
index 16f3e26..6cfb904 100644 (file)
@@ -29,4 +29,4 @@
   (if stream
       `(funcall (formatter ,control-string) ,stream ,@args)
       `(format nil ,control-string ,@args)))
-  
+