optparse: Hack pretty-printing for CLisp.
[lisp] / optparse.lisp
index 4207933..1322e10 100644 (file)
 ;;; it under the terms of the GNU General Public License as published by
 ;;; the Free Software Foundation; either version 2 of the License, or
 ;;; (at your option) any later version.
-;;; 
+;;;
 ;;; This program is distributed in the hope that it will be useful,
 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 ;;; GNU General Public License for more details.
-;;; 
+;;;
 ;;; You should have received a copy of the GNU General Public License
 ;;; along with this program; if not, write to the Free Software Foundation,
 ;;; Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
@@ -28,7 +28,7 @@
 
 (defpackage #:optparse
   (:use #:common-lisp #:mdw.base #:mdw.sys-base #:mdw.str)
-  (:export #:exit #:*program-name* #:*command-line-strings*
+  (:export #:exit #:*program-name* #:*command-line*
           #:moan #:die
           #:option #:optionp #:make-option
             #:opt-short-name #:opt-long-name #:opt-tag #:opt-negated-tag
                    (lambda (o s k)
                      (declare (ignore k))
                      (format s
-          "#<option~@[ -~C,~]~@[ --~A~]~:[~2*~;~:[=~A~;[=~A]~]~]~@[ ~S~]>"
+                             #.(concatenate 'string
+                                            "#<option"
+                                            "~@[ -~C,~]"
+                                            "~@[ --~A~]"
+                                            "~:[~2*~;~:[=~A~;[=~A]~]~]"
+                                            "~@[ ~S~]"
+                                            ">")
                              (opt-short-name o)
                              (opt-long-name o)
                              (opt-arg-name o)
 
    NEGATED-TAG  As for TAG, but used if the negated form of the option is
                found.  If this is nil (the default), the option cannot be
-               negated. 
+               negated.
 
    SHORT-NAME   The option's short name.  This must be a single character, or
                nil if the option has no short name.
                          (:constructor make-option-parser
                                        (&key
                                         ((:args argstmp)
-                                         (cdr *command-line-strings*))
+                                         (cdr *command-line*))
                                         (options *options*)
                                         (non-option :skip)
                                         ((:numericp numeric-p))
   "An option parser object.  Slots:
 
    ARGS                The arguments to be parsed.  Usually this will be
-               *command-line-strings*.
+               *command-line*.
 
    OPTIONS      List of option structures describing the acceptable options.
 
                      (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)
@@ -565,7 +573,9 @@ Ambiguous long option `~A' -- could be any of:~{~%  --~A~}"
     (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 +606,18 @@ Ambiguous long option `~A' -- could be any of:~{~%  --~A~}"
                  (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)
@@ -702,7 +716,7 @@ Ambiguous long option `~A' -- could be any of:~{~%  --~A~}"
    STRING      A banner to print.
 
    SYMBOL or (SYMBOL STUFF...)
-               If SYMBOL is an optform macro, the result of invoking it.
+               If SYMBOL is an optform macro, the result of invoking it.
 
    (...)       A full option-form.  See below.
 
@@ -840,24 +854,19 @@ Ambiguous long option `~A' -- could be any of:~{~%  --~A~}"
 
 (defun show-usage (prog usage &optional (stream *standard-output*))
   "Basic usage-showing function.  PROG is the program name, probably from
-   *command-line-strings*.  USAGE is a list of possible usages of the
-   program, each of which is a list of items to be supplied by the user.  In
-   simple cases, a single string is sufficient."
+   *command-line*.  USAGE is a list of possible usages of the program, each
+   of which is a list of items to be supplied by the user.  In simple cases,
+   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))))
 
-(defun show-help (prog ver usage opts &optional (stream *standard-output*))
-  "Basic help-showing function.  PROG is the program name, probably from
-   *command-line-strings*.  VER is the program's version number.  USAGE is a
-   list of the possible usages of the program, each of which may be a list of
-   items to be supplied.  OPTS is the list of supported options, as provided
-   to the options parser.  STREAM is the stream to write on."
-  (format stream "~A, version ~A~2%" prog ver)
-  (show-usage prog usage stream)
-  (terpri stream)
+(defun show-options-help (opts &optional (stream *standard-output*))
+  "Write help for OPTS to the STREAM.  This is the core of the `show-help'
+   function."
   (let (newlinep)
     (dolist (o opts)
       (let ((doc (opt-documentation o)))
@@ -872,7 +881,6 @@ Ambiguous long option `~A' -- could be any of:~{~%  --~A~}"
              (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))
@@ -882,9 +890,21 @@ Ambiguous long option `~A' -- could be any of:~{~%  --~A~}"
                           (opt-arg-name o)))
                 (write-string "  " stream)
                 (pprint-tab :line 30 1 stream)
+                (pprint-indent :block 30 stream)
                 (print-text doc stream))
               (terpri stream)))))))
 
+(defun show-help (prog ver usage opts &optional (stream *standard-output*))
+  "Basic help-showing function.  PROG is the program name, probably from
+   *command-line*.  VER is the program's version number.  USAGE is a list of
+   the possible usages of the program, each of which may be a list of items
+   to be supplied.  OPTS is the list of supported options, as provided to the
+   options parser.  STREAM is the stream to write on."
+  (format stream "~A, version ~A~2%" prog ver)
+  (show-usage prog usage stream)
+  (terpri stream)
+  (show-options-help opts stream))
+
 (defun sanity-check-option-list (opts)
   "Check the option list OPTS for basic sanity.  Reused short and long option
    names are diagnosed.  Maybe other problems will be reported later.
@@ -926,6 +946,7 @@ Ambiguous long option `~A' -- could be any of:~{~%  --~A~}"
   (show-help *program-name* *version* *usage* *options*)
   (typecase *help*
     (string (terpri) (write-string *help*))
+    (null nil)
     ((or function symbol) (terpri) (funcall *help*)))
   (format t "~&")
   (exit 0))