collect: Whitespace rearrangement.

[lisp] / optparse.lisp

diff --git a/optparse.lisp b/optparse.lisp
index e337fc0..d5e2f10 100644 (file)
--- a/optparse.lisp
+++ b/optparse.lisp
@@ -941,31 +941,19 @@ and respond to them properly."
        (full-usage (setf *usage* full-usage))))
 
 (defmacro do-options ((&key (parser '(make-option-parser))) &body clauses)
-  (with-gensyms (topt targ tparser)
-    (flet ((frob (clause)
-            (destructuring-bind
-                (case (&optional arg) &rest forms)
-                clause
-              (and case 
-                   (list `(,case ,@(if arg
-                                       `(let ((,arg ,targ)) ,@forms)
-                                       forms)))))))
-      `(let ((,tparser ,parser))
-        (loop
-          (multiple-value-bind (,topt ,targ) (option-parse-next ,tparser)
-            (declare (ignorable ,targ))
-            (unless ,topt (return))
-            (case ,topt
-              ,@(mapcan #'frob clauses))))
-        ,@(let ((tail (find nil clauses :key #'car)))
-            (and tail
-                 (destructuring-bind
-                     ((&optional arg) &rest forms)
-                     (cdr tail)
-                   (list (if arg
-                             `(let ((,arg (option-parse-remainder
-                                           ,tparser)))
-                                ,@forms)
-                             forms)))))))))
+  (with-gensyms (tparser)
+    `(let ((,tparser ,parser))
+       (loop
+        (,(if (find t clauses :key #'car) 'case2 'ecase2)
+            (option-parse-next ,tparser)
+          ((nil) () (return))
+          ,@(remove-if #'null clauses :key #'car)))
+       ,@(let ((tail (find nil clauses :key #'car)))
+          (and tail
+               (destructuring-bind ((&optional arg) &rest forms) (cdr tail)
+                 (if arg
+                     (list `(let ((,arg (option-parse-remainder ,tparser)))
+                              ,@forms))
+                     forms)))))))
 
 ;;;----- That's all, folks --------------------------------------------------