Changed process-html-forms-lhtml loop in lib/ps-html.lisp from 'loop'
[clinton/parenscript.git] / src / lib / ps-html.lisp
index 39214c1..c690b34 100644 (file)
@@ -1,14 +1,14 @@
 (in-package "PARENSCRIPT")
 
-(defvar *html-empty-tag-aware-p* t)
-(defvar *html-mode* :sgml "One of :sgml or :xml")
+(defvar *ps-html-empty-tag-aware-p* t)
+(defvar *ps-html-mode* :sgml "One of :sgml or :xml")
 
 (defvar *html-empty-tags* '(:area :atop :audioscope :base :basefont :br :choose :col :frame
                             :hr :img :input :isindex :keygen :left :limittext :link :meta
                             :nextid :of :over :param :range :right :spacer :spot :tab :wbr))
 
 (defun empty-tag-p (tag)
-  (and *html-empty-tag-aware-p*
+  (and *ps-html-empty-tag-aware-p*
        (member tag *html-empty-tags*)))
 
 (defun concat-constant-strings (str-list)
 (defun process-html-forms-lhtml (forms)
   (let ((r ()))
     (labels ((process-attrs (attrs)
-               (loop while attrs
-                  for attr-name = (pop attrs)
-                  for attr-test = (when (not (keywordp attr-name))
-                                    (let ((test attr-name))
-                                      (setf attr-name (pop attrs))
-                                      test))
-                  for attr-val = (pop attrs)
-                  do
-                    (if attr-test
-                        (push `(if ,attr-test
-                                   (concat-string ,(format nil " ~A=\"" attr-name) ,attr-val "\"")
-                                   "")
-                              r)
-                        (progn
-                          (push (format nil " ~A=\"" attr-name) r)
-                          (push attr-val r)
-                          (push "\"" r)))))
+               (do (attr-test attr-name attr-val)
+                   ((not attrs))
+                 (setf attr-name (pop attrs)
+                       attr-test (when (not (keywordp attr-name))
+                                   (let ((test attr-name))
+                                     (setf attr-name (pop attrs))
+                                     test))
+                       attr-val (pop attrs))
+                 (if attr-test
+                     (push `(if ,attr-test
+                                (concat-string ,(format nil " ~A=\"" attr-name) ,attr-val "\"")
+                                "")
+                           r)
+                     (progn
+                       (push (format nil " ~A=\"" attr-name) r)
+                       (push attr-val r)
+                       (push "\"" r)))))
              (process-form% (tag attrs content)
                (push (format nil "<~A" tag) r)
                (process-attrs attrs)
@@ -45,7 +45,7 @@
                    (progn (push ">" r)
                           (map nil #'process-form content)
                           (push (format nil "</~A>" tag) r))
-                   (progn (when (eql *html-mode* :xml)
+                   (progn (when (eql *ps-html-mode* :xml)
                             (push "/" r))
                           (push ">" r))))
              (process-form (form)
@@ -79,7 +79,7 @@
                               (progn (push ">" r)
                                      (when content (map nil #'process-form content))
                                      (push (format nil "</~A>" (car form)) r))
-                              (progn (when (eql *html-mode* :xml)
+                              (progn (when (eql *ps-html-mode* :xml)
                                    (push "/" r))
                                  (push ">" r))))))
                      (t (push form r)))))