X-Git-Url: https://git.distorted.org.uk/~mdw/lisp/blobdiff_plain/512c44e0714c4f1375e8c585b67951644fcf5268..0ff9df03bb54ba792cefa551face51748ae34259:/optparse.lisp diff --git a/optparse.lisp b/optparse.lisp index d5e2f10..acbe11f 100644 --- a/optparse.lisp +++ b/optparse.lisp @@ -95,32 +95,34 @@ (documentation doc)))) "Describes a command-line option. Slots: -LONG-NAME The option's long name. If this is null, the `option' is - just a banner to be printed in the program's help text. + LONG-NAME The option's long name. If this is null, the `option' is + just a banner to be printed in the program's help text. -TAG The value to be returned if this option is encountered. If - this is a function, instead, the function is called with the - option's argument or nil. + TAG The value to be returned if this option is encountered. If + this is a function, instead, the function is called with the + option's argument or nil. -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-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. -SHORT-NAME The option's short name. This must be a single character, or - nil if the option has no short name. + SHORT-NAME The option's short name. This must be a single character, or + nil if the option has no short name. -ARG-NAME The name of the option's argument, a string. If this is nil, - the option doesn't accept an argument. The name is shown in - the help text. + ARG-NAME The name of the option's argument, a string. If this is nil, + the option doesn't accept an argument. The name is shown in + the help text. -ARG-OPTIONAL-P If non-nil, the option's argument is optional. This is - ignored unless ARG-NAME is non-null. + ARG-OPTIONAL-P + If non-nil, the option's argument is optional. This is + ignored unless ARG-NAME is non-null. -DOCUMENTATION The help text for this option. It is automatically - line-wrapped. If nil, the option is omitted from the help - text. + DOCUMENTATION + The help text for this option. It is automatically line- + wrapped. If nil, the option is omitted from the help + text. -Usually, one won't use make-option, but use the option macro instead." + Usually, one won't use make-option, but use the option macro instead." (long-name nil :type (or null string)) (tag nil :type t) (negated-tag nil :type t) @@ -148,32 +150,32 @@ Usually, one won't use make-option, but use the option macro instead." options)))))) "An option parser object. Slots: -ARGS The arguments to be parsed. Usually this will be - *command-line-strings*. + ARGS The arguments to be parsed. Usually this will be + *command-line-strings*. -OPTIONS List of option structures describing the acceptable options. + OPTIONS List of option structures describing the acceptable options. -NON-OPTION Behaviour when encountering a non-option argument. The - default is :skip. Allowable values are: - :skip -- pretend that it appeared after the option - arguments; this is the default behaviour of GNU getopt - :stop -- stop parsing options, leaving the remaining - command line unparsed - :return -- return :non-option and the argument word + NON-OPTION Behaviour when encountering a non-option argument. The + default is :skip. Allowable values are: + :skip -- pretend that it appeared after the option + arguments; this is the default behaviour of GNU getopt + :stop -- stop parsing options, leaving the remaining + command line unparsed + :return -- return :non-option and the argument word -NUMERIC-P Non-nil tag (as for options) if numeric options (e.g., -43) - are to be allowed. The default is nil. (Anomaly: the - keyword for this argument is :numericp.) + NUMERIC-P Non-nil tag (as for options) if numeric options (e.g., -43) + are to be allowed. The default is nil. (Anomaly: the + keyword for this argument is :numericp.) -NEGATED-NUMERIC-P - Non-nil tag (as for options) if numeric options (e.g., -43) - can be negated. This is not the same thing as a negative - numeric option! + NEGATED-NUMERIC-P + Non-nil tag (as for options) if numeric options (e.g., -43) + can be negated. This is not the same thing as a negative + numeric option! -LONG-ONLY-P A misnomer inherited from GNU getopt. Whether to allow - long options to begin with a single dash. Short options are - still allowed, and may be cuddled as usual. The default is - nil." + LONG-ONLY-P A misnomer inherited from GNU getopt. Whether to allow + long options to begin with a single dash. Short options are + still allowed, and may be cuddled as usual. The default is + nil." (args nil :type list) (options nil :type list) (non-option :skip :type (or function (member :skip :stop :return))) @@ -188,8 +190,9 @@ LONG-ONLY-P A misnomer inherited from GNU getopt. Whether to allow (define-condition option-parse-error (error simple-condition) () - (:documentation "Indicates an error found while parsing options. Probably -not that useful.")) + (:documentation + "Indicates an error found while parsing options. Probably not that + useful.")) (defun option-parse-error (msg &rest args) "Signal an option-parse-error with the given message and arguments." @@ -203,18 +206,19 @@ not that useful.")) (defun option-parse-next (op) "The main option-parsing function. OP is an option-parser object, -initialized appropriately. Returns two values, OPT and ARG: OPT is the tag -of the next option read, and ARG is the argument attached to it, or nil if -there was no argument. If there are no more options, returns nil twice. -Options whose TAG is a function aren't returned; instead, the tag function is -called, with the option argument (or nil) as the only argument. It is safe -for tag functions to throw out of option-parse-next, if they desparately need -to. (This is the only way to actually get option-parse-next to return a -function value, should that be what you want.) - -While option-parse-next is running, there is a restart `skip-option' which -moves on to the next option. Error handlers should use this to resume after -parsing errors." + initialized appropriately. Returns two values, OPT and ARG: OPT is the + tag of the next option read, and ARG is the argument attached to it, or + nil if there was no argument. If there are no more options, returns nil + twice. Options whose TAG is a function aren't returned; instead, the tag + function is called, with the option argument (or nil) as the only + argument. It is safe for tag functions to throw out of option-parse-next, + if they desparately need to. (This is the only way to actually get + option-parse-next to return a function value, should that be what you + want.) + + While option-parse-next is running, there is a restart `skip-option' which + moves on to the next option. Error handlers should use this to resume + after parsing errors." (loop (labels ((ret (opt &optional arg) (return-from option-parse-next (values opt arg))) @@ -392,8 +396,8 @@ Ambiguous long option `~A' -- could be any of:~{~% --~A~}" (defmacro option-parse-try (&body body) "Report errors encountered while parsing options, and continue struggling -along. Also establishes a restart `stop-parsing'. Returns t if parsing -completed successfully, or nil if errors occurred." + along. Also establishes a restart `stop-parsing'. Returns t if parsing + completed successfully, or nil if errors occurred." (with-gensyms (retcode) `(let ((,retcode t)) (restart-case @@ -430,8 +434,9 @@ completed successfully, or nil if errors occurred." (&rest args) &body body) "Define an option handler function NAME. Option handlers update a -generalized variable, which may be referred to as VAR in the BODY, based on -some parameters (the ARGS) and the value of an option-argument named ARG." + generalized variable, which may be referred to as VAR in the BODY, based + on some parameters (the ARGS) and the value of an option-argument named + ARG." (let ((func (intern (format nil "OPTHANDLER/~:@(~A~)" name)))) `(progn (setf (get ',name 'opthandler) ',func) @@ -443,11 +448,12 @@ some parameters (the ARGS) and the value of an option-argument named ARG." (defun parse-c-integer (string &key radix (start 0) end) "Parse STRING, or at least the parts of it between START and END, according -to the standard C rules. Well, almost: the 0 and 0x prefixes are accepted, -but so too are 0o (Haskell) and 0b (original); also RADIX_DIGITS is accepted, -for any radix between 2 and 36. Prefixes are only accepted 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." + to the standard C rules. Well, almost: the 0 and 0x prefixes are + accepted, but so too are 0o (Haskell) and 0b (original); also RADIX_DIGITS + is accepted, for any radix between 2 and 36. Prefixes are only accepted + 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))) (labels ((simple (i r goodp sgn) (multiple-value-bind @@ -491,7 +497,7 @@ sensible parse), and the index following the characters of the integer." (defun invoke-option-handler (handler loc arg args) "Call the HANDLER function, giving it LOC to update, the option-argument -ARG, and the remaining ARGS." + ARG, and the remaining ARGS." (apply (if (functionp handler) handler (fdefinition (get handler 'opthandler))) loc @@ -511,22 +517,22 @@ ARG, and the remaining ARGS." (defopthandler inc (var) (&optional max (step 1)) "Increments VAR by STEP (defaults to 1), but not greater than MAX (default -nil for no maximum). No errors are signalled." + nil for no maximum). No errors are signalled." (incf var step) (when (>= var max) (setf var max))) (defopthandler dec (var) (&optional min (step 1)) "Decrements VAR by STEP (defaults to 1), but not less than MIN (default nil -for no maximum). No errors are signalled." + for no maximum). No errors are signalled." (decf var step) (when (<= var min) (setf var min))) (defopthandler read (var arg) () "Stores in VAR the Lisp object found by reading the ARG. Evaluation is -forbidden while reading ARG. If there is an error during reading, an error -of type option-parse-error is signalled." + forbidden while reading ARG. If there is an error during reading, an + error of type option-parse-error is signalled." (handler-case (let ((*read-eval* nil)) (multiple-value-bind (x end) (read-from-string arg t) @@ -538,10 +544,11 @@ of type option-parse-error is signalled." (defopthandler int (var arg) (&key radix min max) "Stores in VAR the integer read from the ARG. Integers are parsed -according to C rules, which is normal in Unix; the RADIX may be nil to allow -radix prefixes, or an integer between 2 and 36. An option-parse-error is -signalled if the ARG is not a valid integer, or if it is not between MIN and -MAX (either of which may be nil if no lower resp. upper bound is wanted)." + according to C rules, which is normal in Unix; the RADIX may be nil to + allow radix prefixes, or an integer between 2 and 36. An + option-parse-error is signalled if the ARG is not a valid integer, or if + it is not between MIN and MAX (either of which may be nil if no lower + resp. upper bound is wanted)." (multiple-value-bind (v end) (parse-c-integer arg :radix radix) (unless (and v (>= end (length arg))) (option-parse-error "Bad integer `~A'" arg)) @@ -582,7 +589,7 @@ MAX (either of which may be nil if no lower resp. upper bound is wanted)." (defopthandler list (var arg) (&optional handler &rest handler-args) "Collect ARGs in a list at VAR. ARGs are translated by the HANDLER first, -if specified. If not, it's as if you asked for `string'." + if specified. If not, it's as if you asked for `string'." (when handler (invoke-option-handler handler (locf arg) arg handler-args)) (setf var (nconc var (list arg)))) @@ -592,14 +599,14 @@ if specified. If not, it's as if you asked for `string'." (defmacro defoptmacro (name args &body body) "Defines an option macro NAME. Option macros should produce a list of -expressions producing one option structure each." + expressions producing one option structure each." `(progn (setf (get ',name 'optmacro) (lambda ,args ,@body)) ',name)) (compile-time-defun parse-option-form (form) "Does the heavy lifting for parsing an option form. See the docstring for -the `option' macro for details of the syntax." + the `option' macro for details of the syntax." (flet ((doc (form) (cond ((stringp form) form) ((null (cdr form)) (car form)) @@ -667,46 +674,45 @@ the `option' macro for details of the syntax." (defmacro options (&rest optlist) "More convenient way of initializing options. The OPTLIST is a list of -OPTFORMS. Each OPTFORM is one of the following: + OPTFORMS. Each OPTFORM is one of the following: - STRING - A banner to print. + STRING A banner to print. - SYMBOL or (SYMBOL STUFF...) - If SYMBOL is an optform macro, the result of invoking it. + SYMBOL or (SYMBOL STUFF...) + If SYMBOL is an optform macro, the result of invoking it. - (...) - A full option-form. See below. + (...) A full option-form. See below. -Full option-forms are as follows. + Full option-forms are as follows. - KEYWORD or FUNCTION - If no TAG is set yet, then as a TAG; otherwise as the NEGATED-TAG. + KEYWORD or FUNCTION + If no TAG is set yet, then as a TAG; otherwise as the + NEGATED-TAG. - STRING (or SYMBOL or RATIONAL) - If no LONG-NAME seen yet, then the LONG-NAME. For symbols and rationals, - the item is converted to a string and squashed to lower-case. + STRING (or SYMBOL or RATIONAL) + If no LONG-NAME seen yet, then the LONG-NAME. For symbols + and rationals, the item is converted to a string and squashed + to lower-case. - CHARACTER - The SHORT-NAME. + CHARACTER The SHORT-NAME. - STRING or (STRING STUFF...) - If no DOCUMENTATION set yet, then the DOCUMENTATION string, as for - (:DOC STRING STUFF...) + STRING or (STRING STUFF...) + If no DOCUMENTATION set yet, then the DOCUMENTATION string, + as for (:DOC STRING STUFF...) - (:DOC STRING STUFF...) - The DOCUMENATION string. With no STUFF, STRING is used as is; otherwise - the documentation string is computed by (format nil STRING STUFF...). + (:DOC STRING STUFF...) + The DOCUMENATION string. With no STUFF, STRING is used as + is;otherwise the documentation string is computed by (format + nil STRING STUFF...). - (:ARG NAME) - Set the ARG-NAME. + (:ARG NAME) Set the ARG-NAME. - (:OPT-ARG NAME) - Set the ARG-NAME, and also set ARG-OPTIONAL-P. + (:OPT-ARG NAME) + Set the ARG-NAME, and also set ARG-OPTIONAL-P. - (HANDLER VAR ARGS...) - If no TAG is set yet, attach the HANDLER to this option, giving it ARGS. - Otherwise, set the NEGATED-TAG." + (HANDLER VAR ARGS...) + If no TAG is set yet, attach the HANDLER to this option, + giving it ARGS. Otherwise, set the NEGATED-TAG." `(list ,@(mapcan (lambda (form) (multiple-value-bind (sym args) @@ -730,8 +736,8 @@ Full option-forms are as follows. (start 0) (end nil)) "Prints STRING to a pretty-printed STREAM, breaking it at whitespace and -newlines in the obvious way. Stuff between square brackets is not broken: -this makes usage messages work better." + newlines in the obvious way. Stuff between square brackets is not broken: + this makes usage messages work better." (let ((i start) (nest 0) (splitp nil)) @@ -764,7 +770,7 @@ this makes usage messages work better." (defun simple-usage (opts &optional mandatory-args) "Build a simple usage list from a list of options, and (optionally) -mandatory argument names." + mandatory argument names." (let (short-simple long-simple short-arg long-arg) (dolist (o opts) (cond ((not (and (opt-documentation o) @@ -806,9 +812,9 @@ mandatory argument names." (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-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." (pprint-logical-block (stream nil :prefix "Usage: ") (dolist (u (listify usage)) (pprint-logical-block (stream nil :prefix (format nil "~A " prog)) @@ -817,10 +823,10 @@ cases, a single string is sufficient." (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." + *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) @@ -853,8 +859,8 @@ the options parser. STREAM is the stream to write on." (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. Returns a -list of warning strings." + names are diagnosed. Maybe other problems will be reported later. + Returns a list of warning strings." (let ((problems nil) (longs (make-hash-table :test #'equal)) (shorts (make-hash-table))) @@ -931,7 +937,7 @@ list of warning strings." usage full-usage options) "Sets up all the required things a program needs to have to parse options -and respond to them properly." + and respond to them properly." (when program-name (setf *program-name* program-name)) (when help (setf *help* help)) (when version (setf *version* version)) @@ -941,6 +947,11 @@ and respond to them properly." (full-usage (setf *usage* full-usage)))) (defmacro do-options ((&key (parser '(make-option-parser))) &body clauses) + "Handy all-in-one options parser macro. PARSER defaults to a new options + parser using the preset default options structure. The CLAUSES are + `case2'-like clauses to match options, and must be exhaustive. If there + is a clause (nil (REST) FORMS...) then the FORMS are evaluated after + parsing is done with REST bound to the remaining command-line arguments." (with-gensyms (tparser) `(let ((,tparser ,parser)) (loop