;;; -*-lisp-*-
;;;
-;;; $Id$
-;;;
;;; Option parser, standard issue
;;;
;;; (c) 2005 Straylight/Edgeware
;;; Packages.
(defpackage #:optparse
- (:use #:common-lisp #:mdw.base #:mdw.sys-base)
- (:export #:exit #:*program-name* #:*command-line*
- #:moan #:die
- #:option #:optionp #:make-option
- #:opt-short-name #:opt-long-name #:opt-tag #:opt-negated-tag
- #:opt-arg-name #:opt-arg-optional-p #:opt-documentation
- #:option-parser #:make-option-parser #:option-parser-p
- #:op-options #:op-non-option #:op-long-only-p #:op-numeric-p
- #:op-negated-numeric-p #:op-negated-p
- #:option-parse-error
- #:option-parse-remainder #:option-parse-next #:option-parse-try
- #:with-unix-error-reporting #:option-parse-return
- #:defopthandler #:invoke-option-handler
- #:set #:clear #:inc #:dec #:read #:int #:string
- #:keyword #:list
- #:parse-option-form #:options
- #:simple-usage #:show-usage #:show-version #:show-help
- #:sanity-check-option-list
- #:*help* #:*version* #:*usage* #:*options*
- #:do-options #:help-options
- #:define-program #:do-usage #:die-usage))
+ (:use #:common-lisp #:mdw.base #:mdw.sys-base))
(in-package #:optparse)
+;; Re-export symbols from sys-base.
+(export '(exit *program-name* *command-line*))
+
;;;--------------------------------------------------------------------------
;;; Standard error-reporting functions.
+(export 'moan)
(defun moan (msg &rest args)
"Report an error message in the usual way."
(format *error-output* "~&~A: ~?~%" *program-name* msg args))
+(export 'die)
(defun die (&rest args)
"Report an error message and exit."
(apply #'moan args)
;;;--------------------------------------------------------------------------
;;; The main option parser.
+(export '*options*)
(defvar *options* nil)
+(export '(option optionp make-option
+ opt-short-name opt-long-name opt-tag opt-negated-tag
+ opt-arg-name opt-arg-optional-p opt-documentation))
(defstruct (option
(:predicate optionp)
(:conc-name opt-)
text.
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)
- (short-name nil :type (or null character))
- (arg-name nil :type (or null string))
- (arg-optional-p nil :type t)
- (documentation nil :type (or null string)))
-
+ (long-name nil :type (or null string) :read-only t)
+ (tag nil :type t :read-only t)
+ (negated-tag nil :type t :read-only t)
+ (short-name nil :type (or null character) :read-only t)
+ (arg-name nil :type (or null string) :read-only t)
+ (arg-optional-p nil :type t :read-only t)
+ (documentation nil :type (or null string)) :read-only t)
+
+(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))
(defstruct (option-parser
(:conc-name op-)
(:constructor make-option-parser
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)))
+ (options nil :type list :read-only t)
+ (non-option :skip :type (or function (member :skip :stop :return))
+ :read-only t)
(next nil :type list)
(short-opt nil :type (or null string))
(short-opt-index 0 :type fixnum)
(short-opt-neg-p nil :type t)
- (long-only-p nil :type t)
- (numeric-p nil :type t)
- (negated-numeric-p nil :type t)
- (negated-p nil :type t))
+ (long-only-p nil :type t :read-only t)
+ (numeric-p nil :type t :read-only t)
+ (negated-numeric-p nil :type t :read-only t)
+ (negated-p nil :type t) :read-only t)
+(export 'option-parse-error)
(define-condition option-parse-error (error simple-condition)
()
(:documentation
:format-control msg
:format-arguments args)))
+(export 'option-parse-remainder)
(defun option-parse-remainder (op)
"Returns the unparsed remainder of the command line."
(cdr (op-args op)))
+(export 'option-parse-return)
(defun option-parse-return (tag &optional argument)
"Should be called from an option handler: forces a return from the
immediately enclosing `option-parse-next' with the given TAG and
ARGUMENT."
(throw 'option-parse-return (values tag argument)))
+(export 'option-parse-next)
(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
(op-short-opt-index op) 1
(op-short-opt-neg-p op) negp))))))))))))))
+(export 'option-parse-try)
(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
(setf ,retcode nil)))
,retcode)))
+(export 'with-unix-error-reporting)
(defmacro with-unix-error-reporting ((&key) &body body)
"Evaluate BODY with errors reported in the standard Unix fashion."
(with-gensyms (cond)
;;;--------------------------------------------------------------------------
;;; Standard option handlers.
+(export 'defopthandler)
(defmacro defopthandler (name (var &optional (arg (gensym)))
(&rest args)
&body body)
(t
(get-radix start radix +1)))))
+(export 'invoke-option-handler)
(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."
;;;--------------------------------------------------------------------------
;;; Built-in option handlers.
+(export 'set)
(defopthandler set (var) (&optional (value t))
"Sets VAR to VALUE; defaults to t."
(setf var value))
+(export 'clear)
(defopthandler clear (var) (&optional (value 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), but not greater than MAX (default
nil for no maximum). No errors are signalled."
(when (>= var max)
(setf var max)))
+(export 'dec)
(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."
(when (<= var min)
(setf var min)))
+(export 'read)
(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 (cond)
(option-parse-error (format nil "~A" cond)))))
+(export 'int)
(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
arg min max))
(setf var v)))
+(export 'string)
(defopthandler string (var arg) ()
"Stores ARG in VAR, just as it is."
(setf var arg))
+(export 'keyword)
(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 uppercased and interned in the keyword
"~{~%~8T~(~A~)~}")
arg matches)))))))
+(export 'list)
(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'."
;;;--------------------------------------------------------------------------
;;; Option descriptions.
+(export 'defoptmacro)
(defmacro defoptmacro (name args &body body)
"Defines an option macro NAME. Option macros should produce a list of
expressions producing one option structure each."
(setf (get ',name 'optmacro) (lambda ,args ,@body))
',name))
+(export 'parse-option-form)
(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."
,@(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:
(#\] (when (plusp nest) (decf nest))))))
(incf i))))))
+(export 'simple-usage)
(defun simple-usage (opts &optional mandatory-args)
"Build a simple usage list from a list of options, and (optionally)
mandatory argument names."
:key #'opt-long-name)))
(listify mandatory-args)))))
+(export 'show-usage)
(defun show-usage (prog usage &optional (stream *standard-output*))
"Basic usage-showing function. PROG is the program name, probably from
*command-line*. USAGE is a list of possible usages of the program, each
(print-text doc stream))
(terpri stream)))))))
+(export 'show-help)
(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
(terpri stream)
(show-options-help opts stream))
+(export 'sanity-check-options-list)
(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.
;;;--------------------------------------------------------------------------
;;; Full program descriptions.
+(export '(*help* *version* *usage))
(defvar *help* nil)
(defvar *version* "<unreleased>")
(defvar *usage* nil)
+(export 'do-usage)
(defun do-usage (&optional (stream *standard-output*))
(show-usage *program-name* *usage* stream))
+(export 'die-usage)
(defun die-usage ()
(do-usage *error-output*)
(exit 1))
(do-usage)
(exit 0))
+(export 'help-options)
(defoptmacro help-options (&key (short-help #\h)
(short-version #\v)
(short-usage #\u))
(,@(shortform short-usage) "usage" #'opt-usage
("Show a very brief usage summary for ~A." *program-name*))))))
+(export 'define-program)
(defun define-program (&key
(program-name nil progp)
(help nil helpp)
(usagep (setf *usage* (simple-usage *options* usage)))
(fullp (setf *usage* full-usage))))
+(export 'do-options)
(defmacro do-options ((&key (parser '(make-option-parser)))
&body clauses)
"Handy all-in-one options parser macro. PARSER defaults to a new options
~mdw / lisp / blobdiff