X-Git-Url: https://www.chiark.greenend.org.uk/ucgi/~mdw/git/lisp/blobdiff_plain/2c13c1cd713e033763786de1ce9fc66565abb5df..abd5cb6f7e0e603753a39dbab541e152f9e682d5:/optparse.lisp diff --git a/optparse.lisp b/optparse.lisp index ff301ee..1322e10 100644 --- a/optparse.lisp +++ b/optparse.lisp @@ -13,12 +13,12 @@ ;;; 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 @@ -74,7 +74,13 @@ (defstruct (option (:predicate optionp) (lambda (o s k) (declare (ignore k)) (format s - "#" + #.(concatenate 'string + "#") (opt-short-name o) (opt-long-name o) (opt-arg-name o) @@ -105,7 +111,7 @@ (defstruct (option (:predicate optionp) 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. @@ -136,7 +142,7 @@ (defstruct (option-parser (:conc-name op-) (:constructor make-option-parser (&key ((:args argstmp) - (cdr *command-line-strings*)) + (cdr *command-line*)) (options *options*) (non-option :skip) ((:numericp numeric-p)) @@ -152,7 +158,7 @@ (defstruct (option-parser (:conc-name op-) "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. @@ -289,8 +295,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) @@ -446,7 +454,7 @@ (defmacro defopthandler (name (var &optional (arg (gensym))) on some parameters (the ARGS) and the value of an option-argument named ARG." (let ((func (intern (format nil "OPTHANDLER/~:@(~A~)" name)))) - (multiple-value-bind (docs decls body) (parse-body body) + (with-parsed-body (body decls docs) body `(progn (setf (get ',name 'opthandler) ',func) (defun ,func (,var ,arg ,@args) @@ -464,7 +472,7 @@ (defun parse-c-integer (string &key radix (start 0) end) if RADIX is nil. Returns two values: the integer parsed (or nil if there wasn't enough for a sensible parse), and the index following the characters of the integer." - (unless end (setf end (length string))) + (setf-default end (length string)) (labels ((simple (i r goodp sgn) (multiple-value-bind (a i) @@ -565,7 +573,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 +606,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) @@ -702,7 +716,7 @@ (defmacro options (&rest optlist) 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. @@ -773,8 +787,7 @@ (defun print-text (string (flet ((emit () (write-string string stream :start start :end i) (setf start i))) - (unless end - (setf end (length string))) + (setf-default end (length string)) (loop (unless (< i end) (emit) @@ -841,24 +854,19 @@ (defun simple-usage (opts &optional mandatory-args) (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))) @@ -873,7 +881,6 @@ (defun show-help (prog ver usage 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)) @@ -883,9 +890,21 @@ (defun show-help (prog ver usage 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))))))) +(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. @@ -927,6 +946,7 @@ (defun opt-help (arg) (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))