r11859: Canonicalize whitespace
authorKevin M. Rosenberg <kevin@rosenberg.net>
Fri, 31 Aug 2007 18:04:31 +0000 (18:04 +0000)
committerKevin M. Rosenberg <kevin@rosenberg.net>
Fri, 31 Aug 2007 18:04:31 +0000 (18:04 +0000)
main.lisp
tests.lisp

index b6b5070fa5ca15913dce2f11763a90d948a5bb43..311b73bf6960fb2aafb3aabc2a2471ec1b840e40 100644 (file)
--- a/main.lisp
+++ b/main.lisp
 (defun decompose-arg (arg option-type)
   "Returns base-name,argument"
   (let ((start (ecase option-type
-                (:long 2)
-                (:short 1)))
-       (name-end (position #\= arg)))
+                 (:long 2)
+                 (:short 1)))
+        (name-end (position #\= arg)))
 
     (values (subseq arg start name-end)
-           (when name-end (subseq arg (1+ name-end))))))
+            (when name-end (subseq arg (1+ name-end))))))
 
 (defun analyze-arg (arg)
   "Analyzes an argument. Returns option-type,base-name,argument"
   (let* ((option-type (cond ((is-short-option arg) :short)
-                           ((is-long-option arg) :long)
-                           (t :arg))))
+                            ((is-long-option arg) :long)
+                            (t :arg))))
     (if (or (eq option-type :short) (eq option-type :long))
-       (multiple-value-bind (base arg) (decompose-arg arg option-type)
-         (values option-type base arg))
-       (values :arg arg nil))))
+        (multiple-value-bind (base arg) (decompose-arg arg option-type)
+          (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)))
+         (pos (match-unique-abbreviation name option-names)))
     (when pos
       (nth pos options))))
 
   "Returns position of ABBR in STRINGS. ABBR may be a unique abbreviation.
 Returns NIL if no match found."
   (let ((len (length abbr))
-       (matches nil))
+        (matches nil))
     (dotimes (i (length strings))
       (let* ((s (nth i strings))
-            (l (length s)))
-       (cond
-         ((= len l)
-          (when (string= abbr s)
-            (push (cons s i) matches)))
-         ((< len l)
-          (when (string= abbr (subseq s 0 len))
-            (push (cons s i) matches))))))
+             (l (length s)))
+        (cond
+          ((= len l)
+           (when (string= abbr s)
+             (push (cons s i) matches)))
+          ((< len l)
+           (when (string= abbr (subseq s 0 len))
+             (push (cons s i) matches))))))
     (when (= 1 (length matches))
       (cdr (first matches)))))
 
@@ -106,31 +106,31 @@ opts is a list of option lists. The fields of the list are
       (setq finished-options t))
      (t
       (let ((arg (car pos)))
-       (multiple-value-bind (option-list option-type base-name argument)
-           (match-option (car pos) options)
-         (cond
-           ((and option-list (not (eq option-type :arg)))
-            (cond
-              (argument
-               (case (second option-list)
-                 (:none
-                  (push base-name errors))
-                 (t
-                  (push (cons base-name argument) out-opts))))
-              ((null argument)
-               (if (and (eq :required (second option-list)) (null (cdr pos)))
-                   (push base-name errors)
-                   (if (or (is-short-option (second pos))
-                           (is-long-option (second pos)))
-                       (if (eq :required (second option-list))
-                           (push base-name errors)
-                           (push (cons base-name (third option-list)) out-args))
-                       (progn
-                         (push (cons base-name (second pos)) out-opts)
-                         (setq pos (cdr pos))))))))
-           (t
-            (if (or (eq :long option-type)
-                    (eq :short option-type))
-                (push (nth-value 0 (decompose-arg arg option-type)) errors)
-              (push arg out-args))))))))))
+        (multiple-value-bind (option-list option-type base-name argument)
+            (match-option (car pos) options)
+          (cond
+            ((and option-list (not (eq option-type :arg)))
+             (cond
+               (argument
+                (case (second option-list)
+                  (:none
+                   (push base-name errors))
+                  (t
+                   (push (cons base-name argument) out-opts))))
+               ((null argument)
+                (if (and (eq :required (second option-list)) (null (cdr pos)))
+                    (push base-name errors)
+                    (if (or (is-short-option (second pos))
+                            (is-long-option (second pos)))
+                        (if (eq :required (second option-list))
+                            (push base-name errors)
+                            (push (cons base-name (third option-list)) out-args))
+                        (progn
+                          (push (cons base-name (second pos)) out-opts)
+                          (setq pos (cdr pos))))))))
+            (t
+             (if (or (eq :long option-type)
+                     (eq :short option-type))
+                 (push (nth-value 0 (decompose-arg arg option-type)) errors)
+               (push arg out-args))))))))))
 
index 5790baaa35ab825d6f370ae279a3dffc97dc4291..f8f657458420abcb2b47d83f5c6c3f2a11e7a082 100644 (file)
@@ -24,7 +24,7 @@
 (defun do-tests ()
   (with-tests (:name "GETOPT")
     (let ((*break-on-test-failures* nil))
-      
+
       ;; match-unique-abbreviation
       (test nil (match-unique-abbreviation "abc" nil))
       (test nil (match-unique-abbreviation "abc" '("ab")))
       (test nil (match-unique-abbreviation "ab" '("ab" "abc")))
       (test 1 (match-unique-abbreviation "ac" '("ab" "ac")))
       (test 1 (match-unique-abbreviation "ac" '("ab" "acb")))
-      
+
       ;; getopt
       (test-mv '(("argv") nil nil) (getopt '("argv") nil))
       (test-mv '(("argv" "2") nil nil) (getopt '("argv" "2") nil))
-      
+
       (test-mv '(("argv") (("c")) nil) (getopt '("argv" "-c") '(("c" :none))))
-      
-      (test-mv '(("argv") (("c" . "val")) nil) 
-              (getopt '("argv" "-c" "val") '(("c" :optional))))
-      (test-mv '(("argv" "v1") (("c" . "val")) nil) 
-              (getopt '("argv" "-c" "val" "v1") '(("c" :optional))))
-      (test-mv '(( "v1") (("colon" . "val")) nil) 
-              (getopt '("--colon" "val" "v1") '(("colon" :optional))))
-      (test-mv '(("ab" "-c") (("colon" . "val")) nil) 
-              (getopt '("ab" "--colon" "val" "--" "-c") 
-                      '(("colon" :optional) ("-c" :none))))
-      (test-mv '(("argv") (("c" . "cd")) nil) 
-              (getopt '("argv" "-c" "cd") '(("c" :required))))
-      (test-mv '(("argv") nil ("c")) 
-              (getopt '("argv" "-c") '(("c" :required))))
-      (test-mv '(("argv") (("c" . "10")) nil) 
-              (getopt '("argv" "-c=10") '(("c" :required))))
-      (test-mv '(("argv") nil ("c")) 
-              (getopt '("argv" "-c=10") '(("c" :none))))
-      (test-mv '(nil (("along" . "10")) nil) 
-              (getopt '("--along=10") '(("along" :optional))))
-      (test-mv '(nil nil ("along")) 
-              (getopt '("--along=10") '(("along" :none)))) 
-      (test-mv '(nil (("along" . "10")) nil) 
-              (getopt '("--a=10") '(("along" :optional)))) 
+
+      (test-mv '(("argv") (("c" . "val")) nil)
+               (getopt '("argv" "-c" "val") '(("c" :optional))))
+      (test-mv '(("argv" "v1") (("c" . "val")) nil)
+               (getopt '("argv" "-c" "val" "v1") '(("c" :optional))))
+      (test-mv '(( "v1") (("colon" . "val")) nil)
+               (getopt '("--colon" "val" "v1") '(("colon" :optional))))
+      (test-mv '(("ab" "-c") (("colon" . "val")) nil)
+               (getopt '("ab" "--colon" "val" "--" "-c")
+                       '(("colon" :optional) ("-c" :none))))
+      (test-mv '(("argv") (("c" . "cd")) nil)
+               (getopt '("argv" "-c" "cd") '(("c" :required))))
+      (test-mv '(("argv") nil ("c"))
+               (getopt '("argv" "-c") '(("c" :required))))
+      (test-mv '(("argv") (("c" . "10")) nil)
+               (getopt '("argv" "-c=10") '(("c" :required))))
+      (test-mv '(("argv") nil ("c"))
+               (getopt '("argv" "-c=10") '(("c" :none))))
+      (test-mv '(nil (("along" . "10")) nil)
+               (getopt '("--along=10") '(("along" :optional))))
+      (test-mv '(nil nil ("along"))
+               (getopt '("--along=10") '(("along" :none))))
+      (test-mv '(nil (("along" . "10")) nil)
+               (getopt '("--a=10") '(("along" :optional))))
       (test-mv '(nil nil ("a"))
-              (getopt '("--a=10") '(("along" :optional) ("aboot" :optional))))
+               (getopt '("--a=10") '(("along" :optional) ("aboot" :optional))))
       (test-mv '(("a") nil nil)
                (getopt '("a") '(("a" :none))))
       ))