r7819: more getopt improvements, tests

[kmrcl.git] / getopt.lisp

diff --git a/getopt.lisp b/getopt.lisp
index 48ec91be9a17d362e0dbdb66a26f0e8e6973a961..96e5f6fa46e2ba300a455b3224394344862bff89 100644 (file)
--- a/getopt.lisp
+++ b/getopt.lisp
@@ -55,12 +55,19 @@
          (values option-type base arg))
        (values :arg arg nil))))
 
-    
+
+(defun find-option (name options)
+  "Find an option in option list. Handles using unique abbreviations"
+  (let* ((option-names (mapcar #'car options))
+        (pos (match-unique-abbreviation name option-names)))
+    (when pos
+      (nth pos options))))
+
 (defun match-option (arg options)
   "Matches an argument to an option. Returns option-list,option-type,base-name,argument"
   (multiple-value-bind (option-type base-name argument) (analyze-arg arg)
-    (let ((match (find base-name options :key #'car :test #'equal)))
-      (values match option-type base-name argument))))
+    (let ((match (find-option base-name options)))
+      (values match option-type (when match (car match)) argument))))
 
 (defun getopt (args options)
   "Processes a list of arguments and options. Returns filtered argument
@@ -106,5 +113,7 @@ opts is a list of option lists. The fields of the list are
                          (push (cons base-name (second pos)) out-opts)
                          (setq pos (cdr pos))))))))
            (t
-            (push arg out-args)))))))))
+            (if (in option-type :long :short)
+                (push (nth-value 0 (arg->base-name arg option-type)) errors)
+                (push arg out-args))))))))))