optparse.lisp: Move `ignorable' declaration into the right place.

[lisp] / optparse.lisp

diff --git a/optparse.lisp b/optparse.lisp
index b490b37..a949128 100644 (file)
--- a/optparse.lisp
+++ b/optparse.lisp
@@ -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
@@ -68,38 +68,29 @@
 
 (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
@@ -138,23 +129,20 @@
   (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
@@ -262,7 +250,7 @@
                    (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)
@@ -438,8 +426,8 @@
         (progn ,@body)
        (simple-condition (,cond)
         (apply #'die
-               (simple-condition-format-control ,cond)
-               (simple-condition-format-arguments ,cond)))
+               (simple-condition-format-control ,cond)
+               (simple-condition-format-arguments ,cond)))
        (error (,cond)
         (die "~A" ,cond)))))
 
@@ -459,8 +447,8 @@
         (setf (get ',name 'opthandler) ',func)
         (defun ,func (,var ,arg ,@args)
           ,@docs ,@decls
+          (declare (ignorable ,arg))
           (with-locatives ,var
-            (declare (ignorable ,arg))
             ,@body))
         ',name))))
 
@@ -704,10 +692,10 @@
                     (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
@@ -859,7 +847,8 @@
    a single string is sufficient."
   (pprint-logical-block (stream nil :prefix "Usage: ")
     (dolist (u (listify usage))
-      (pprint-logical-block (stream nil :prefix (format nil "~A " prog))
+      (pprint-logical-block (stream nil
+                                   :prefix (concatenate 'string prog " "))
        (format stream "~{~A ~:_~}" (listify u)))
       (pprint-newline :mandatory stream))))
 
@@ -880,7 +869,6 @@
              (t
               (setf newlinep t)
               (pprint-logical-block (stream nil :prefix "  ")
-                (pprint-indent :block 30 stream)
                 (format stream "~:[   ~;-~:*~C,~] --~A"
                         (opt-short-name o)
                         (opt-long-name o))
@@ -890,6 +878,7 @@
                           (opt-arg-name o)))
                 (write-string "  " stream)
                 (pprint-tab :line 30 1 stream)
+                (pprint-indent :block 30 stream)
                 (print-text doc stream))
               (terpri stream)))))))