(defvar opt-keyword nil)
(defvar opt-enum nil)
(defvar opt-counter 2)
+(defvar opt-object nil)
-(defconstant options
- (options
- "Help options"
- (#\h "help"
- (lambda (arg)
- (declare (ignore arg))
- (show-help *program-name* "1.0.0" "usage-blah" options)
- (exit 0))
- ("Show this help text."))
- ( "version"
- (lambda (arg)
- (declare (ignore arg))
- (format t "~A, version ~A~%" *program-name* "1.0.0")
- (exit 0))
- ("Show ~A's version number." *program-name*))
- "Test options"
- (#\b "boolean" (set opt-bool) (clear opt-bool)
- ("Set (or clear, if negated) the boolean flag."))
- (#\i "integer" (:arg "INT") (int opt-int :min -10 :max 10)
- ("Set an integer between -10 and +10."))
- (#\l "list" (:arg "STRING") (list opt-list)
- ("Stash an item in the string list."))
- (#\I "int-list" (:arg "INT")
- (list opt-int-list 'int :min -10 :max 10)
- ("Stash an integer between -10 and +10 in the int list."))
- (#\s "string" (:arg "STRING") (string opt-string)
- ("Set a string."))
- (#\q "quiet" (dec opt-counter 0)
- ("Be more quiet."))
- (#\v "verbose" (inc opt-counter 5)
- ("Be more verbose."))
- (#\Q "very-quiet" (dec opt-counter 0 3)
- ("Be much more quiet."))
- (#\V "very-verbose" (inc opt-counter 5 3)
- ("Be much more verbose."))
- (#\k "keywword" (:arg "KEYWORD") (keyword opt-keyword)
- ("Set an arbitrary keyword."))
- (#\e "enumeration" (:arg "ENUM")
- (keyword opt-enum :apple :apple-pie :abacus :banana)
- ("Set a keyword from a fixed set."))))
+(define-program
+ :help "This program exists to test the Lisp options parser."
+ :usage "ARGUMENTS..."
+ :version "1.0.0"
+ :options (options
+ (help-options :short-version nil)
+ "Test options"
+ (#\b "boolean" (set opt-bool) (clear opt-bool)
+ ("Set (or clear, if negated) the boolean flag."))
+ (#\i "integer" (:arg "INT") (int opt-int :min -10 :max 10)
+ ("Set an integer between -10 and +10."))
+ (#\l "list" (:arg "STRING") (list opt-list)
+ ("Stash an item in the string list."))
+ (#\I "int-list" (:arg "INT")
+ (list opt-int-list 'int :min -10 :max (+ 5 5))
+ ("Stash an integer between -10 and +10 in the int list."))
+ (#\s "string" (:arg "STRING") (string opt-string)
+ ("Set a string."))
+ (#\q "quiet" (dec opt-counter 0)
+ ("Be more quiet."))
+ (#\v "verbose" (inc opt-counter 5)
+ ("Be more verbose."))
+ (#\Q "very-quiet" (dec opt-counter 0 3)
+ ("Be much more quiet."))
+ (#\V "very-verbose" (inc opt-counter 5 3)
+ ("Be much more verbose."))
+ ((:short-name #\o)
+ (:long-name "object")
+ (:arg "OBJECT")
+ (read opt-object)
+ (:doc (concatenate 'string
+ "Read object ("
+ (format-universal-time nil
+ (get-universal-time)
+ :style :iso8601)
+ ")")))
+ (#\k "keywword" (:arg "KEYWORD") (keyword opt-keyword)
+ ("Set an arbitrary keyword."))
+ (#\e "enumeration" (:arg "ENUM")
+ (keyword opt-enum :apple :apple-pie :abacus :banana)
+ ("Set a keyword from a fixed set."))
+ (#\x "xray" (:arg "WAVELENGTH")
+ "Report an option immediately.")
+ (#\y "yankee" :yankee :no-yankee
+ "Report an option immediately.")
+ (#\z "zulu" (:opt-arg "TRIBE")
+ (lambda (arg)
+ (when (and (plusp (length arg))
+ (char-equal (char arg 0) #\z))
+ (option-parse-return :zzulu arg))
+ (format t "Ignoring insufficiently zeddy Zulu ~A~%" arg))
+ "Report an option immediately.")))
(defun test (args)
- (let ((op (make-option-parser :args (cdr args) :options options)))
- (unless (option-parse-try
- (loop
- (multiple-value-bind (opt arg) (option-parse-next op)
- (unless opt (return))
- (format t "Option ~S: `~A'~%" opt arg))))
- (exit 1))
- (format t "Non-option arguments: ~S~%" (option-parse-remainder op))
- (format t "boolean: ~S~%" opt-bool)
- (format t "integer: ~S~%" opt-int)
- (format t "list: ~S~%" opt-list)
- (format t "int-list: ~S~%" opt-int-list)
- (format t "string : ~S~%" opt-string)
- (format t "counter: ~S~%" opt-counter)
- (format t "keyword: ~S~%" opt-keyword)
- (format t "enum: ~S~%" opt-enum)))
-(test *command-line-strings*)
+ (unless (option-parse-try
+ (do-options (:parser (make-option-parser :args args))
+ (:xray (arg)
+ (format t "Emitting X-ray of wavelength ~A nm~%" arg))
+ (t (opt arg)
+ (format t "Option ~S: `~A'~%" opt arg))
+ (nil (rest)
+ (format t "Non-option arguments: ~S~%" rest))))
+ (die-usage))
+ (format t "boolean: ~S~%" opt-bool)
+ (format t "integer: ~S~%" opt-int)
+ (format t "list: ~S~%" opt-list)
+ (format t "int-list: ~S~%" opt-int-list)
+ (format t "string : ~S~%" opt-string)
+ (format t "counter: ~S~%" opt-counter)
+ (format t "keyword: ~S~%" opt-keyword)
+ (format t "enum: ~S~%" opt-enum)
+ (format t "object: ~S~%" opt-object))
+(test (cdr *command-line-strings*))
#:op-negated-numeric-p #:op-negated-p
#:option-parse-error
#:option-parse-remainder #:option-parse-next #:option-parse-try
- #:with-unix-error-reporting
+ #:with-unix-error-reporting #:option-parse-return
#:defopthandler #:invoke-option-handler
#:set #:clear #:inc #:dec #:read #:int #:string
#:keyword #:list
#:simple-usage #:show-usage #:show-version #:show-help
#:sanity-check-option-list
#:*help* #:*version* #:*usage* #:*options*
- #:do-options #:help-opts #:define-program #:do-usage #:die-usage))
+ #:do-options #:help-options
+ #:define-program #:do-usage #:die-usage))
(in-package #:optparse)
;;;--------------------------------------------------------------------------
;;; The main option parser.
-(defvar *options*)
+(defvar *options* nil)
(defstruct (option (:predicate optionp)
(:conc-name opt-)
"Returns the unparsed remainder of the command line."
(cdr (op-args op)))
+(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)))
+
(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
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.)
+ want. See `option-parse-return' for a way of doing this.)
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)))
- (finished ()
- (setf (op-next op) nil)
- (ret nil nil))
- (peek-arg ()
- (cadr (op-next op)))
- (more-args-p ()
- (and (op-next op)
- (cdr (op-next op))))
- (skip-arg ()
- (setf (op-next op) (cdr (op-next op))))
- (eat-arg ()
- (setf (cdr (op-next op)) (cddr (op-next op))))
- (get-arg ()
- (prog1 (peek-arg) (eat-arg)))
- (process-option (o name negp &key arg argfunc)
- (cond ((not (opt-arg-name o))
- (when arg
- (option-parse-error
- "Option `~A' does not accept arguments"
- name)))
- (arg)
- (argfunc
- (setf arg (funcall argfunc)))
- ((opt-arg-optional-p o))
- ((more-args-p)
- (setf arg (get-arg)))
- (t
- (option-parse-error "Option `~A' requires an argument"
- name)))
- (let ((how (if negp (opt-negated-tag o) (opt-tag o))))
- (if (functionp how)
- (funcall how arg)
- (ret how arg))))
- (process-long-option (arg start negp)
- (when (and (not negp)
- (op-negated-p op)
- (> (length arg) (+ start 3))
- (string= arg "no-"
- :start1 start :end1 (+ start 3)))
- (incf start 3)
- (setf negp t))
- (let* ((matches nil)
- (eqpos (position #\= arg :start start))
- (len (or eqpos (length arg)))
- (optname (subseq arg 0 len))
- (len-2 (- len start)))
- (dolist (o (op-options op))
- (cond ((or (not (stringp (opt-long-name o)))
- (and negp (not (opt-negated-tag o)))
- (< (length (opt-long-name o)) len-2)
- (string/= optname (opt-long-name o)
- :start1 start :end2 len-2)))
- ((= (length (opt-long-name o)) len-2)
- (setf matches (list o))
- (return))
- (t
- (push o matches))))
- (cond ((null matches)
- (option-parse-error "Unknown option `~A'" optname))
- ((cdr matches)
- (option-parse-error
- "~
+ (labels ((ret (opt &optional arg)
+ (return-from option-parse-next (values opt arg)))
+ (finished ()
+ (setf (op-next op) nil)
+ (ret nil nil))
+ (peek-arg ()
+ (cadr (op-next op)))
+ (more-args-p ()
+ (and (op-next op)
+ (cdr (op-next op))))
+ (skip-arg ()
+ (setf (op-next op) (cdr (op-next op))))
+ (eat-arg ()
+ (setf (cdr (op-next op)) (cddr (op-next op))))
+ (get-arg ()
+ (prog1 (peek-arg) (eat-arg)))
+ (process-option (o name negp &key arg argfunc)
+ (cond ((not (opt-arg-name o))
+ (when arg
+ (option-parse-error
+ "Option `~A' does not accept arguments"
+ name)))
+ (arg)
+ (argfunc
+ (setf arg (funcall argfunc)))
+ ((opt-arg-optional-p o))
+ ((more-args-p)
+ (setf arg (get-arg)))
+ (t
+ (option-parse-error "Option `~A' requires an argument"
+ name)))
+ (let ((how (if negp (opt-negated-tag o) (opt-tag o))))
+ (if (functionp how)
+ (funcall how arg)
+ (ret how arg))))
+ (process-long-option (arg start negp)
+ (when (and (not negp)
+ (op-negated-p op)
+ (> (length arg) (+ start 3))
+ (string= arg "no-"
+ :start1 start :end1 (+ start 3)))
+ (incf start 3)
+ (setf negp t))
+ (let* ((matches nil)
+ (eqpos (position #\= arg :start start))
+ (len (or eqpos (length arg)))
+ (optname (subseq arg 0 len))
+ (len-2 (- len start)))
+ (dolist (o (op-options op))
+ (cond ((or (not (stringp (opt-long-name o)))
+ (and negp (not (opt-negated-tag o)))
+ (< (length (opt-long-name o)) len-2)
+ (string/= optname (opt-long-name o)
+ :start1 start :end2 len-2)))
+ ((= (length (opt-long-name o)) len-2)
+ (setf matches (list o))
+ (return))
+ (t
+ (push o matches))))
+ (cond ((null matches)
+ (option-parse-error "Unknown option `~A'" optname))
+ ((cdr matches)
+ (option-parse-error
+ "~
Ambiguous long option `~A' -- could be any of:~{~% --~A~}"
- optname
- (mapcar #'opt-long-name matches))))
- (process-option (car matches)
- optname
- negp
- :arg (and eqpos
- (subseq arg (1+ eqpos)))))))
- (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)))
- (setf (op-short-opt op) nil)
- (let* ((str (op-short-opt op))
- (i (op-short-opt-index op))
- (ch (char str i))
- (negp (op-short-opt-neg-p op))
- (name (format nil "~C~A" (if negp #\+ #\-) ch))
- (o (find ch (op-options op) :key #'opt-short-name)))
- (incf i)
- (setf (op-short-opt-index op) i)
- (when (or (not o)
- (and negp (not (opt-negated-tag o))))
- (option-parse-error "Unknown option `~A'" name))
- (process-option o
- name
- negp
- :argfunc
- (and (< i (length str))
- (lambda ()
- (prog1
- (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) #\-)
- (or (char/= (char arg 0) #\+)
- (not (op-negated-p op)))))
- (case (op-non-option op)
- (:skip (skip-arg))
- (:stop (finished))
- (:return (eat-arg)
- (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)
- (or (char= (char arg 0) #\-)
- (op-negated-numeric-p op))
- (or (and (digit-char-p (char arg 1))
- (every #'digit-char-p (subseq arg 2)))
- (and (or (char= (char arg 1) #\-)
- (char= (char arg 1) #\+))
- (>= (length arg) 3)
- (digit-char-p (char arg 2))
- (every #'digit-char-p (subseq arg 3)))))
- (eat-arg)
- (let ((negp (char= (char arg 0) #\+))
- (num (parse-integer arg :start 1)))
- (when (and negp (eq (op-negated-numeric-p op) :-))
- (setf num (- num))
- (setf negp nil))
- (let ((how (if negp
- (op-negated-numeric-p op)
- (op-numeric-p op))))
- (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)
- (let ((negp (char= (char arg 0) #\+))
- (ch (char arg 1)))
- (cond ((and (op-long-only-p op)
- (not (member ch (op-options op)
- :key #'opt-short-name)))
- (process-long-option arg 1 negp))
- (t
- (setf (op-short-opt op) arg
- (op-short-opt-index op) 1
- (op-short-opt-neg-p op) negp)))))))))))))
+ optname
+ (mapcar #'opt-long-name matches))))
+ (process-option (car matches)
+ optname
+ negp
+ :arg (and eqpos
+ (subseq arg (1+ eqpos)))))))
+ (catch 'option-parse-return
+ (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)))
+ (setf (op-short-opt op) nil)
+ (let* ((str (op-short-opt op))
+ (i (op-short-opt-index op))
+ (ch (char str i))
+ (negp (op-short-opt-neg-p op))
+ (name (format nil "~C~A" (if negp #\+ #\-) ch))
+ (o (find ch (op-options op) :key #'opt-short-name)))
+ (incf i)
+ (setf (op-short-opt-index op) i)
+ (when (or (not o)
+ (and negp (not (opt-negated-tag o))))
+ (option-parse-error "Unknown option `~A'" name))
+ (process-option o
+ name
+ negp
+ :argfunc
+ (and (< i (length str))
+ (lambda ()
+ (prog1
+ (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) #\-)
+ (or (char/= (char arg 0) #\+)
+ (not (op-negated-p op)))))
+ (case (op-non-option op)
+ (:skip (skip-arg))
+ (:stop (finished))
+ (:return (eat-arg)
+ (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)
+ (or (char= (char arg 0) #\-)
+ (op-negated-numeric-p op))
+ (or (and (digit-char-p (char arg 1))
+ (every #'digit-char-p (subseq arg 2)))
+ (and (or (char= (char arg 1) #\-)
+ (char= (char arg 1) #\+))
+ (>= (length arg) 3)
+ (digit-char-p (char arg 2))
+ (every #'digit-char-p (subseq arg 3)))))
+ (eat-arg)
+ (let ((negp (char= (char arg 0) #\+))
+ (num (parse-integer arg :start 1)))
+ (when (and negp (eq (op-negated-numeric-p op) :-))
+ (setf num (- num))
+ (setf negp nil))
+ (let ((how (if negp
+ (op-negated-numeric-p op)
+ (op-numeric-p op))))
+ (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)
+ (let ((negp (char= (char arg 0) #\+))
+ (ch (char arg 1)))
+ (cond ((and (op-long-only-p op)
+ (not (member ch (op-options op)
+ :key #'opt-short-name)))
+ (process-long-option arg 1 negp))
+ (t
+ (setf (op-short-opt op) arg
+ (op-short-opt-index op) 1
+ (op-short-opt-neg-p op) negp))))))))))))))
(defmacro option-parse-try (&body body)
"Report errors encountered while parsing options, and continue struggling
(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))
(...) A full option-form. See below.
- Full option-forms are as follows.
+ Full option-forms are a list of the following kinds of items.
+
+ (:short-name CHAR)
+ (:long-name STRING)
+ (:arg STRING)
+ (:tag TAG)
+ (:negated-tag TAG)
+ (:doc STRING)
+ Set the appropriate slot of the option to the given value.
+ The argument is evaluated.
- KEYWORD or FUNCTION
+ (:doc FORMAT-CONTROL ARGUMENTS...)
+ As for (:doc (format nil FORMAT-CONTROL ARGUMENTS...)).
+
+ KEYWORD, (function ...), (lambda ...)
If no TAG is set yet, then as a TAG; otherwise as the
NEGATED-TAG.
and rationals, the item is converted to a string and squashed
to lower-case.
- CHARACTER The SHORT-NAME.
+ CHARACTER If no SHORT-NAME, then the SHORT-NAME.
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...).
+ as for (:doc STRING STUFF...)
- (:ARG NAME) Set the ARG-NAME.
-
- (:OPT-ARG NAME)
+ (: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."
+
`(list ,@(mapcan (lambda (form)
(multiple-value-bind
(sym args)
;;;--------------------------------------------------------------------------
;;; Full program descriptions.
-(defvar *help*)
-(defvar *version*)
-(defvar *usage*)
+(defvar *help* nil)
+(defvar *version* "<unreleased>")
+(defvar *usage* nil)
+
+(defun do-usage (&optional (stream *standard-output*))
+ (show-usage *program-name* *usage* stream))
+
+(defun die-usage ()
+ (do-usage *error-output*)
+ (exit 1))
(defun opt-help (arg)
(declare (ignore arg))
((or function symbol) (terpri) (funcall *help*)))
(format t "~&")
(exit 0))
-
(defun opt-version (arg)
(declare (ignore arg))
(format t "~A, version ~A~%" *program-name* *version*)
(exit 0))
-
-(defun do-usage (&optional (stream *standard-output*))
- (show-usage *program-name* *usage* stream))
-
-(defun die-usage ()
- (do-usage *error-output*)
- (exit 1))
-
(defun opt-usage (arg)
(declare (ignore arg))
(do-usage)
(exit 0))
-(defoptmacro help-opts (&key (short-help #\h)
- (short-version #\v)
- (short-usage #\u))
- (mapcar #'parse-option-form
- `("Help options"
- (,@(and short-help (list short-help))
- "help"
- #'opt-help
- "Show this help message.")
- (,@(and short-version (list short-version))
- "version"
- #'opt-version
- ("Show ~A's version number." *program-name*))
- (,@(and short-usage (list short-usage))
- "usage"
- #'opt-usage
- ("Show a very brief usage summary for ~A." *program-name*)))))
+(defoptmacro help-options (&key (short-help #\h)
+ (short-version #\v)
+ (short-usage #\u))
+ "Inserts a standard help options collection in an options list."
+ (flet ((shortform (char)
+ (and char (list char))))
+ (mapcar
+ #'parse-option-form
+ `("Help options"
+ (,@(shortform short-help) "help" #'opt-help
+ "Show this help message.")
+ (,@(shortform short-version) "version" #'opt-version
+ ("Show ~A's version number." *program-name*))
+ (,@(shortform short-usage) "usage" #'opt-usage
+ ("Show a very brief usage summary for ~A." *program-name*))))))
(defun define-program (&key
- program-name
- help
- version
- usage full-usage
- options)
+ (program-name nil progp)
+ (help nil helpp)
+ (version nil versionp)
+ (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."
- (when program-name (setf *program-name* program-name))
- (when help (setf *help* help))
- (when version (setf *version* version))
- (when options (setf *options* options))
- (cond ((and usage full-usage) (error "conflicting options"))
- (usage (setf *usage* (simple-usage *options* usage)))
- (full-usage (setf *usage* full-usage))))
-
-(defmacro do-options ((&key (parser '(make-option-parser))) &body clauses)
+ (when progp (setf *program-name* program-name))
+ (when helpp (setf *help* help))
+ (when versionp (setf *version* version))
+ (when optsp (setf *options* options))
+ (cond ((and usagep fullp) (error "conflicting options"))
+ (usagep (setf *usage* (simple-usage *options* usage)))
+ (fullp (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))
+ (let*/gensyms (parser)
+ `(progn
(loop
(,(if (find t clauses :key #'car) 'case2 'ecase2)
- (option-parse-next ,tparser)
+ (option-parse-next ,parser)
((nil) () (return))
,@(remove-if #'null clauses :key #'car)))
,@(let ((tail (find nil clauses :key #'car)))
(and tail
(destructuring-bind ((&optional arg) &rest forms) (cdr tail)
(if arg
- (list `(let ((,arg (option-parse-remainder ,tparser)))
- ,@forms))
+ (list `(let ((,arg (option-parse-remainder ,parser)))
+ ,@forms))
forms)))))))
;;;----- That's all, folks --------------------------------------------------
~mdw / lisp / commitdiff