From: Mark Wooding <mdw@distorted.org.uk>
Date: Wed, 17 May 2006 19:15:16 +0000 (+0100)
Subject: optparse: Make enum opthandler take an evaluated list.
X-Git-Url: https://git.distorted.org.uk/~mdw/lisp/commitdiff_plain/a8bbb2e72e8c8f9168520d92c7d8a01377928e91

optparse: Make enum opthandler take an evaluated list.

... rather than an unevaluated &rest argument.  This makes it rather
more suitable for dynamic lists of things.
---

diff --git a/optparse-test b/optparse-test
index 0fe74b9..b5fe41f 100755
--- a/optparse-test
+++ b/optparse-test
@@ -53,7 +53,7 @@
 	    (#\k "keywword" (:arg "KEYWORD") (keyword opt-keyword)
 		 ("Set an arbitrary keyword."))
 	    (#\e "enumeration" (:arg "ENUM")
-		 (keyword opt-enum :apple :apple-pie :abacus :banana)
+		 (keyword opt-enum (list :apple :apple-pie :abacus :banana))
 		 ("Set a keyword from a fixed set."))
 	    (#\x "xray" (:arg "WAVELENGTH")
 		 "Report an option immediately.")
diff --git a/optparse.lisp b/optparse.lisp
index 9f835fc..5f28365 100644
--- a/optparse.lisp
+++ b/optparse.lisp
@@ -571,29 +571,38 @@ Ambiguous long option `~A' -- could be any of:~{~%  --~A~}"
   "Stores ARG in VAR, just as it is."
   (setf var arg))
 
-(defopthandler keyword (var arg) (&rest valid)
-  (if (null valid)
-      (setf var (intern (string-upcase arg) :keyword))
-      (let ((matches nil)
-	    (guess (string-upcase arg))
-	    (len (length arg)))
-	(dolist (k valid)
-	  (let* ((kn (symbol-name k))
-		 (klen (length kn)))
-	    (cond ((string= kn guess)
-		   (setf matches (list k))
-		   (return))
-		  ((and (< len klen)
-			(string= guess kn :end2 len))
-		   (push k matches)))))
-	(case (length matches)
-	  (0 (option-parse-error "Argument `~A' invalid: must be one of:~
-                                   ~{~%~8T~(~A~)~}"
-				 arg valid))
-	  (1 (setf var (car matches)))
-	  (t (option-parse-error "Argument `~A' ambiguous: may be any of:~
-                                   ~{~%~8T~(~A~)~}"
-				 arg matches))))))
+(defopthandler keyword (var arg) (&optional (valid t))
+  "Converts ARG into a keyword.  If VALID is t, then any ARG string is
+   acceptable: the argument is uppercased and interned in the keyword
+   package.  If VALID is a list, then we ensure that ARG matches one of the
+   elements of the list; unambigious abbreviations are allowed."
+  (etypecase valid
+    ((member t)
+     (setf var (intern (string-upcase arg) :keyword)))
+    (list
+     (let ((matches nil)
+	   (guess (string-upcase arg))
+	   (len (length arg)))
+       (dolist (k valid)
+	 (let* ((kn (symbol-name k))
+		(klen (length kn)))
+	   (cond ((string= kn guess)
+		  (setf matches (list k))
+		  (return))
+		 ((and (< len klen)
+		       (string= guess kn :end2 len))
+		  (push k matches)))))
+       (cond
+	 ((null matches)
+	  (option-parse-error "Argument `~A' invalid: must be one of:~
+			       ~{~%~8T~(~A~)~}"
+			      arg valid))
+	 ((null (cdr matches))
+	  (setf var (car matches)))
+	 (t
+	  (option-parse-error "Argument `~A' ambiguous: may be any of:~
+			       ~{~%~8T~(~A~)~}"
+			      arg matches)))))))
 
 (defopthandler list (var arg) (&optional handler &rest handler-args)
   "Collect ARGs in a list at VAR.  ARGs are translated by the HANDLER first,