From: Vladimir Sedach <vsedach@gmail.com>
Date: Mon, 25 May 2009 00:53:03 +0000 (-0600)
Subject: Changed process-html-forms-lhtml loop in lib/ps-html.lisp from 'loop'
X-Git-Url: https://git.hcoop.net/clinton/parenscript.git/commitdiff_plain/467e94fdca82df268844ed880beffdda040a46f1

Changed process-html-forms-lhtml loop in lib/ps-html.lisp from 'loop'
to 'do' due to bug in CLISP's 'loop' implementation (this also made
the code shorter).

Thanks to Olaf Ruppert <oruppert@googlemail.com> for the bug report.
---

diff --git a/src/lib/ps-html.lisp b/src/lib/ps-html.lisp
index cc30dae..c690b34 100644
--- a/src/lib/ps-html.lisp
+++ b/src/lib/ps-html.lisp
@@ -21,23 +21,23 @@
 (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)