X-Git-Url: https://git.distorted.org.uk/~mdw/sod/blobdiff_plain/684d95c7eb6ec755d38efacbc377e9e60ba7044e..refs/heads/mdw/progfmt:/src/optparse.lisp?ds=inline diff --git a/src/optparse.lisp b/src/optparse.lisp index 3b4b263..a258699 100644 --- a/src/optparse.lisp +++ b/src/optparse.lisp @@ -155,18 +155,18 @@ 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. + 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 + 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. - 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 @@ -174,7 +174,7 @@ DOCUMENTATION The help text for this option. It is automatically line- - wrapped. If nil, the option is omitted from the help + wrapped. If `nil', the option is omitted from the help text. Usually, one won't use `make-option', but use the `option' macro instead." @@ -188,14 +188,15 @@ (define-access-wrapper opt-documentation opt-%documentation) (export '(option-parser option-parser-p make-option-parser - op-options op-non-option op-long-only-p op-numeric-p - op-negated-numeric-p op-negated-p)) + op-options op-non-option op-long-only-p + op-numeric-p op-negated-numeric-p op-negated-p)) (defstruct (option-parser (:conc-name op-) (:constructor make-option-parser (&key ((:args argstmp) (cdr *command-line*)) (options *options*) - (non-option :skip) + (non-option (if (uiop:getenv "POSIXLY_CORRECT") :stop + :skip)) ((:numericp numeric-p)) negated-numeric-p long-only-p @@ -214,25 +215,25 @@ NON-OPTION Behaviour when encountering a non-option argument. The default is :skip. Allowable values are: - :skip -- pretend that it appeared after the option + `:skip' -- pretend that it appeared after the option arguments; this is the default behaviour of GNU getopt - :stop -- stop parsing options, leaving the remaining + `:stop' -- stop parsing options, leaving the remaining command line unparsed - :return -- return :non-option and the argument word + `: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.) + 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! - LONG-ONLY-P A misnomer inherited from GNU getopt. Whether to allow + 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." + `nil'." (args nil :type list) (%options nil :type list) (non-option :skip :type (or function (member :skip :stop :return))) @@ -255,7 +256,7 @@ Probably not that useful.")) (defun option-parse-error (msg &rest args) - "Signal an option-parse-error with the given message and arguments." + "Signal an `option-parse-error' with the given message and arguments." (error (make-condition 'option-parse-error :format-control msg :format-arguments args))) @@ -279,10 +280,10 @@ This is 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 + `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. See `option-parse-return' for a way of doing @@ -372,7 +373,7 @@ (loop (with-simple-restart (skip-option "Skip this bogus option.") (cond - ;; + ;; We're embroiled in short options: handle them. ((op-short-opt op) (if (>= (op-short-opt-index op) (length (op-short-opt op))) @@ -398,16 +399,16 @@ (subseq str i) (setf (op-short-opt op) nil)))))))) - ;; + ;; End of the list. Say we've finished. ((not (more-args-p)) (finished)) - ;; + ;; Process the next option. (t (let ((arg (peek-arg))) (cond - ;; + ;; Non-option. Decide what to do. ((or (<= (length arg) 1) (and (char/= (char arg 0) #\-) @@ -420,12 +421,12 @@ (ret :non-option arg)) (t (eat-arg) (funcall (op-non-option op) arg)))) - ;; + ;; Double-hyphen. Stop right now. ((string= arg "--") (eat-arg) (finished)) - ;; + ;; Numbers. Check these before long options, since `--43' ;; is not a long option. ((and (op-numeric-p op) @@ -450,14 +451,14 @@ (if (functionp how) (funcall how num) (ret (if negp :negated-numeric :numeric) num))))) - ;; + ;; Long option. Find the matching option-spec and process ;; it. ((and (char= (char arg 0) #\-) (char= (char arg 1) #\-)) (eat-arg) (process-long-option arg 2 nil)) - ;; + ;; Short options. All that's left. (t (eat-arg) @@ -476,8 +477,8 @@ (defmacro option-parse-try (&body body) "Report errors encountered while parsing options, and try to continue. - Also establishes a restart `stop-parsing'. Returns t if parsing completed - successfully, or nil if errors occurred." + 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 @@ -544,11 +545,12 @@ (defun parse-c-integer (string &key radix (start 0) end) "Parse (a substring of) STRING 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." + 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 @@ -612,14 +614,14 @@ (export 'clear) (defopthandler clear (var) (&optional (value nil)) - "Sets VAR to VALUE; defaults to `'nil'." + "Sets VAR to VALUE; defaults to `nil'." (setf var value)) (export 'inc) (defopthandler inc (var) (&optional max (step 1)) "Increments VAR by STEP (defaults to 1). - If MAX is not nil then VAR will not be made larger than MAX. No errors + If MAX is not `nil' then VAR will not be made larger than MAX. No errors are signalled." (incf var step) (when (and max (>= var max)) @@ -629,8 +631,8 @@ (defopthandler dec (var) (&optional min (step 1)) "Decrements VAR by STEP (defaults to 1). - If MIN is not nil, then VAR will not be made smaller than MIN. No errors - are signalled." + If MIN is not `nil', then VAR will not be made smaller than MIN. No + errors are signalled." (decf var step) (when (and min (<= var min)) (setf var min))) @@ -640,7 +642,7 @@ "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." + 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) @@ -655,10 +657,10 @@ "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 - or upper bound is wanted)." + 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 or 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)) @@ -680,7 +682,7 @@ (defopthandler keyword (var arg) (&optional (valid t)) "Converts ARG into a keyword. - If VALID is t, then any ARG string is acceptable: the argument is + If VALID is `t', then any ARG string is acceptable: the argument is uppercased and interned in the keyword package. If VALID is a list, then we ensure that ARG matches one of the elements of the list; unambigious abbreviations are allowed." @@ -733,7 +735,7 @@ (defmacro defoptmacro (name args &body body) "Defines an option macro NAME. - Option macros should produce a list of expressions producing one option + Option macros should produce a list of expressions producing one `option' structure each." (multiple-value-bind (docs decls body) (parse-body body) `(progn @@ -759,80 +761,81 @@ "Does the heavy lifting for parsing an option form. See the docstring for the `option' macro for details of the syntax." - (flet ((doc (form) - (cond ((stringp form) form) - ((null (cdr form)) (car form)) - (t `(format nil ,@form)))) - (docp (form) - (or (stringp form) - (and (consp form) - (stringp (car form)))))) - (cond ((stringp form) - `(%make-option :documentation ,form)) - ((not (listp form)) - (error "option form must be string or list")) - ((and (docp (car form)) (null (cdr form))) - `(%make-option :documentation ,(doc (car form)))) - (t - (let (long-name short-name - arg-name arg-optional-p - tag negated-tag - doc) - (dolist (f form) - (cond ((and (or (not tag) (not negated-tag)) - (or (keywordp f) - (and (consp f) - (member (car f) '(lambda function))))) - (if tag - (setf negated-tag f) - (setf tag f))) - ((and (not long-name) - (or (rationalp f) - (symbolp f) - (stringp f))) - (setf long-name (if (stringp f) f - (format nil "~(~A~)" f)))) - ((and (not short-name) - (characterp f)) - (setf short-name f)) - ((and (not doc) - (docp f)) - (setf doc (doc f))) - ((and (consp f) (symbolp (car f))) - (case (car f) - (:short-name (setf short-name (cadr f))) - (:long-name (setf long-name (cadr f))) - (:tag (setf tag (cadr f))) - (:negated-tag (setf negated-tag (cadr f))) - (:arg (setf arg-name (cadr f))) - (:opt-arg (setf arg-name (cadr f)) - (setf arg-optional-p t)) - (:doc (setf doc (doc (cdr f)))) - (t (let ((handler (get (car f) - 'opthandler-function))) - (unless handler - (error "No handler `~S' defined." (car f))) - (let* ((var (cadr f)) - (arg (gensym)) - (thunk `#'(lambda (,arg) - (,handler (locf ,var) - ,arg - ,@(cddr f))))) - (if tag - (setf negated-tag thunk) - (setf tag thunk))))))) - (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))))))))) + (flet ((doc (form) + (cond ((stringp form) form) + ((null (cdr form)) (car form)) + (t `(format nil ,@form)))) + (docp (form) + (or (stringp form) + (and (consp form) + (stringp (car form)))))) + (cond ((stringp form) + `(%make-option :documentation ,form)) + ((not (listp form)) + (error "option form must be string or list")) + ((and (docp (car form)) (null (cdr form))) + `(%make-option :documentation ,(doc (car form)))) + (t + (let (long-name short-name + arg-name arg-optional-p + tag negated-tag + doc) + (dolist (f form) + (cond ((and (or (not tag) (not negated-tag)) + (or (keywordp f) + (and (consp f) + (member (car f) '(lambda function))))) + (if tag + (setf negated-tag f) + (setf tag f))) + ((and (not long-name) + (or (rationalp f) + (symbolp f) + (stringp f))) + (setf long-name (if (stringp f) f + (format nil "~(~A~)" f)))) + ((and (not short-name) + (characterp f)) + (setf short-name f)) + ((and (not doc) + (docp f)) + (setf doc (doc f))) + ((and (consp f) (symbolp (car f))) + (case (car f) + (:short-name (setf short-name (cadr f))) + (:long-name (setf long-name (cadr f))) + (:tag (setf tag (cadr f))) + (:negated-tag (setf negated-tag (cadr f))) + (:arg (setf arg-name (cadr f))) + (:opt-arg (setf arg-name (cadr f)) + (setf arg-optional-p t)) + (:doc (setf doc (doc (cdr f)))) + (t (let ((handler (get (car f) + 'opthandler-function))) + (unless handler + (error "No handler `~S' defined." (car f))) + (let* ((var (cadr f)) + (arg (gensym)) + (thunk `#'(lambda (,arg) + (,handler (locf ,var) + ,arg + ,@(cddr f))))) + (if tag + (setf negated-tag thunk) + (setf tag thunk))))))) + (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))))))))) (export 'options) (defmacro options (&rest optlist) - "More convenient way of initializing options. The OPTLIST is a list of - OPTFORMS. Each OPTFORM is one of the following: + "A more convenient way of initializing options. + + The OPTLIST is a list of OPTFORMS. Each OPTFORM is one of the following: STRING A banner to print. @@ -897,7 +900,7 @@ (defun print-text (string &optional (stream *standard-output*) &key (start 0) (end nil)) - "Prints and line-breaks STRING to a pretty-printed STREAM. + "Print and line-break STRING to a pretty-printed STREAM. The string is broken at whitespace and newlines in the obvious way. Stuff between square brackets is not broken: this makes usage messages @@ -937,7 +940,7 @@ The usage list is constructed from a list OPTS of `option' values, and a list MANDATORY-ARGS of mandatory argument names; the latter defaults to - nil if omitted." + `nil' if omitted." (let (short-simple long-simple short-arg long-arg) (dolist (o opts) (cond ((not (and (opt-documentation o) @@ -1125,8 +1128,15 @@ (usage nil usagep) (full-usage nil fullp) (options nil optsp)) - "Sets up all the required things a program needs to have to parse options - and respond to them properly." + "Sets up all the required things a program needs to have to parse options. + + This is a simple shorthand for setting `*program-name*', `*help*', + `*version*', `*options*', and `*usage*' from the corresponding arguments. + If an argument is not given then the corresponding variable is left alone. + + The USAGE argument should be a list of mandatory argument names to pass to + `simple-usage'; FULL-USAGE should be a complete usage-token list. An + error will be signalled if both USAGE and FULL-USAGE are provided." (when progp (setf *program-name* program-name)) (when helpp (setf *help* help)) (when versionp (setf *version* version))