(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)
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)))
(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."
(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)))
(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
(&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)
(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
(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
(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)
(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))
(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))))
(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))
(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)
(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))
(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)
(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))
(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)
(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)))
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))
(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
~mdw / lisp / blobdiff