Whitespace cleanups across the board.

[lisp] / optparse.lisp

diff --git a/optparse.lisp b/optparse.lisp
index 6e06fc0b11d9d49cfa78730d853e5a3c3bfdfd62..73d961932952c00be22783e30cb2040858027d16 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,32 +68,29 @@ (defun die (&rest args)
 
 (defvar *options* nil)
 
-(defstruct (option (:predicate optionp)
-                  (:conc-name opt-)
-                  (:print-function
-                   (lambda (o s k)
-                     (declare (ignore k))
-                     (format s
-          "#<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
@@ -132,23 +129,20 @@ (defstruct (option (:predicate optionp)
   (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
@@ -256,7 +250,7 @@ (defun option-parse-next (op)
                    (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)
@@ -289,8 +283,10 @@ (defun option-parse-next (op)
                      (option-parse-error "Unknown option `~A'" optname))
                     ((cdr matches)
                      (option-parse-error
-                      "~
-Ambiguous long option `~A' -- could be any of:~{~%  --~A~}"
+                      #.(concatenate 'string
+                                     "Ambiguous long option `~A' -- "
+                                     "could be any of:"
+                                     "~{~%~8T--~A~}")
                       optname
                       (mapcar #'opt-long-name matches))))
               (process-option (car matches)
@@ -430,8 +426,8 @@ (defmacro with-unix-error-reporting ((&key) &body body)
         (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)))))
 
@@ -565,7 +561,9 @@ (defopthandler int (var arg) (&key radix min max)
     (when (or (and min (< v min))
              (and max (> v max)))
       (option-parse-error
-       "Integer ~A out of range (must have ~@[~D <= ~]x~@[ <= ~D~])"
+       #.(concatenate 'string
+                     "Integer ~A out of range "
+                     "(must have ~@[~D <= ~]x~@[ <= ~D~])")
        arg min max))
     (setf var v)))
 
@@ -596,14 +594,18 @@ (defopthandler keyword (var arg) (&optional (valid t))
                  (push k matches)))))
        (cond
         ((null matches)
-         (option-parse-error "Argument `~A' invalid: must be one of:~
-                              ~{~%~8T~(~A~)~}"
+         (option-parse-error #.(concatenate 'string
+                                            "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~)~}"
+         (option-parse-error #.(concatenate 'string
+                                            "Argument `~A' ambiguous: "
+                                            "may be any of:"
+                                            "~{~%~8T~(~A~)~}")
                              arg matches)))))))
 
 (defopthandler list (var arg) (&optional handler &rest handler-args)
@@ -690,10 +692,10 @@ (compile-time-defun parse-option-form (form)
                     (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
@@ -845,7 +847,8 @@ (defun show-usage (prog usage &optional (stream *standard-output*))
    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))))
 
@@ -866,7 +869,6 @@ (defun show-options-help (opts &optional (stream *standard-output*))
              (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))
@@ -876,6 +878,7 @@ (defun show-options-help (opts &optional (stream *standard-output*))
                           (opt-arg-name o)))
                 (write-string "  " stream)
                 (pprint-tab :line 30 1 stream)
+                (pprint-indent :block 30 stream)
                 (print-text doc stream))
               (terpri stream)))))))