X-Git-Url: https://git.distorted.org.uk/~mdw/lisp/blobdiff_plain/93f0472497372859d9cb9bf7690044bd0e66f0ad..560e118666d0a7c41a43e2d86e2f38e3b931ef14:/optparse.lisp

diff --git a/optparse.lisp b/optparse.lisp
index e337fc0..d5e2f10 100644
--- 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 --------------------------------------------------