optparse.lisp: Light reformatting.
authorMark Wooding <mdw@distorted.org.uk>
Wed, 1 Jun 2011 21:31:20 +0000 (22:31 +0100)
committerMark Wooding <mdw@distorted.org.uk>
Wed, 1 Jun 2011 21:31:20 +0000 (22:31 +0100)
Also, use PRINT-UNREADABLE-OBJECT in the printer for OPTION, rather than
printing the delimiters by hand.  Nothing especially substantial,
though.

optparse.lisp

index 1322e10..09050f6 100644 (file)
@@ -27,7 +27,7 @@
 ;;; Packages.
 
 (defpackage #:optparse
-  (:use #:common-lisp #:mdw.base #:mdw.sys-base #:mdw.str)
+  (:use #:common-lisp #:mdw.base #:mdw.sys-base)
   (:export #:exit #:*program-name* #:*command-line*
           #:moan #:die
           #:option #:optionp #:make-option
 
 (defvar *options* nil)
 
-(defstruct (option (:predicate optionp)
-                  (:conc-name opt-)
-                  (:print-function
-                   (lambda (o s k)
-                     (declare (ignore k))
-                     (format s
-                             #.(concatenate 'string
-                                            "#<option"
-                                            "~@[ -~C,~]"
-                                            "~@[ --~A~]"
-                                            "~:[~2*~;~:[=~A~;[=~A]~]~]"
-                                            "~@[ ~S~]"
-                                            ">")
-                             (opt-short-name o)
-                             (opt-long-name o)
-                             (opt-arg-name o)
-                             (opt-arg-optional-p o)
-                             (opt-arg-name o)
-                             (opt-documentation o))))
-                  (:constructor %make-option)
-                  (:constructor make-option
-                                (long-name
-                                 short-name
-                                 &optional
-                                 arg-name
-                                 &key
-                                 (tag (intern (string-upcase long-name)
-                                              :keyword))
-                                 negated-tag
-                                 arg-optional-p
-                                 doc
-                                 (documentation doc))))
+(defstruct (option
+            (:predicate optionp)
+            (:conc-name opt-)
+            (:print-function
+             (lambda (o s k)
+               (declare (ignore k))
+               (print-unreadable-object (o s :type t)
+                 (format s "~@[-~C, ~]~@[--~A~]~
+                            ~*~@[~2:*~:[=~A~;[=~A]~]~]~
+                            ~@[ ~S~]"
+                         (opt-short-name o)
+                         (opt-long-name o)
+                         (opt-arg-optional-p o)
+                         (opt-arg-name o)
+                         (opt-documentation o)))))
+            (:constructor %make-option)
+            (:constructor make-option
+                (long-name short-name
+                 &optional arg-name
+                 &key (tag (intern (string-upcase long-name) :keyword))
+                      negated-tag
+                      arg-optional-p
+                      doc (documentation doc))))
   "Describes a command-line option.  Slots:
 
    LONG-NAME   The option's long name.  If this is null, the `option' is
   (arg-optional-p nil :type t)
   (documentation nil :type (or null string)))
 
-(defstruct (option-parser (:conc-name op-)
-                         (:constructor make-option-parser
-                                       (&key
-                                        ((:args argstmp)
-                                         (cdr *command-line*))
-                                        (options *options*)
-                                        (non-option :skip)
-                                        ((:numericp numeric-p))
-                                        negated-numeric-p
-                                        long-only-p
-                                        &aux
-                                        (args (cons nil argstmp))
-                                        (next args)
-                                        (negated-p (or negated-numeric-p
-                                                       (some
-                                                        #'opt-negated-tag
-                                                        options))))))
+(defstruct (option-parser
+            (:conc-name op-)
+            (:constructor make-option-parser
+                (&key ((:args argstmp) (cdr *command-line*))
+                      (options *options*)
+                      (non-option :skip)
+                      ((:numericp numeric-p))
+                      negated-numeric-p
+                      long-only-p
+                 &aux (args (cons nil argstmp))
+                      (next args)
+                      (negated-p (or negated-numeric-p
+                                     (some #'opt-negated-tag
+                                           options))))))
   "An option parser object.  Slots:
 
    ARGS                The arguments to be parsed.  Usually this will be
                    (setf arg (get-arg)))
                   (t
                    (option-parse-error "Option `~A' requires an argument"
-                    name)))
+                                       name)))
             (let ((how (if negp (opt-negated-tag o) (opt-tag o))))
               (if (functionp how)
                   (funcall how arg)
                     (t
                      (error "Unexpected thing ~S in option form." f))))
             `(make-option ,long-name ,short-name ,arg-name
-              ,@(and arg-optional-p `(:arg-optional-p t))
-              ,@(and tag `(:tag ,tag))
-              ,@(and negated-tag `(:negated-tag ,negated-tag))
-              ,@(and doc `(:documentation ,doc))))))))
+                          ,@(and arg-optional-p `(:arg-optional-p t))
+                          ,@(and tag `(:tag ,tag))
+                          ,@(and negated-tag `(:negated-tag ,negated-tag))
+                          ,@(and doc `(:documentation ,doc))))))))
 
 (defmacro options (&rest optlist)
   "More convenient way of initializing options.  The OPTLIST is a list of