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 0fe74b94dc39ec5426c6a1c6fb01a0db3ab40202..b5fe41f47be56e617c97888d984e26bfbe487f41 100755 (executable)
--- 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 9f835fca7315071a7374562f19f042a8e0a10335..5f28365a5b8cbe80edefb392168cde18aec9756d 100644 (file)
--- a/optparse.lisp
+++ b/optparse.lisp
@@ -571,29 +571,38 @@ (defopthandler string (var arg) ()
   "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,