(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)
(: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)
(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)))
(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)
(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))
(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)))
(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.
(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))