X-Git-Url: https://git.distorted.org.uk/~mdw/lisp/blobdiff_plain/b3bc37457df55c92cabc8aeeb42bc67d3fb8af12..d6caa73bc6253f7a0461406a939865a207bad7c8:/optparse.lisp diff --git a/optparse.lisp b/optparse.lisp index 9f835fc..37d27de 100644 --- a/optparse.lisp +++ b/optparse.lisp @@ -13,12 +13,12 @@ ;;; it under the terms of the GNU General Public License as published by ;;; the Free Software Foundation; either version 2 of the License, or ;;; (at your option) any later version. -;;; +;;; ;;; This program is distributed in the hope that it will be useful, ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;;; GNU General Public License for more details. -;;; +;;; ;;; You should have received a copy of the GNU General Public License ;;; along with this program; if not, write to the Free Software Foundation, ;;; Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. @@ -105,7 +105,7 @@ 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. SHORT-NAME The option's short name. This must be a single character, or nil if the option has no short name. @@ -446,13 +446,15 @@ Ambiguous long option `~A' -- could be any of:~{~% --~A~}" 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 ,func (,var ,arg ,@args) - (with-locatives ,var - (declare (ignorable ,arg)) - ,@body)) - ',name))) + (with-parsed-body (body decls docs) body + `(progn + (setf (get ',name 'opthandler) ',func) + (defun ,func (,var ,arg ,@args) + ,@docs ,@decls + (with-locatives ,var + (declare (ignorable ,arg)) + ,@body)) + ',name)))) (defun parse-c-integer (string &key radix (start 0) end) "Parse STRING, or at least the parts of it between START and END, according @@ -462,7 +464,7 @@ Ambiguous long option `~A' -- could be any of:~{~% --~A~}" 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))) + (setf-default end (length string)) (labels ((simple (i r goodp sgn) (multiple-value-bind (a i) @@ -571,29 +573,38 @@ Ambiguous long option `~A' -- could be any of:~{~% --~A~}" "Stores ARG in VAR, just as it is." (setf var arg)) -(defopthandler keyword (var arg) (&rest valid) - (if (null valid) - (setf var (intern (string-upcase arg) :keyword)) - (let ((matches nil) - (guess (string-upcase arg)) - (len (length arg))) - (dolist (k valid) - (let* ((kn (symbol-name k)) - (klen (length kn))) - (cond ((string= kn guess) - (setf matches (list k)) - (return)) - ((and (< len klen) - (string= guess kn :end2 len)) - (push k matches))))) - (case (length matches) - (0 (option-parse-error "Argument `~A' invalid: must be one of:~ - ~{~%~8T~(~A~)~}" - arg valid)) - (1 (setf var (car matches))) - (t (option-parse-error "Argument `~A' ambiguous: may be any of:~ - ~{~%~8T~(~A~)~}" - arg matches)))))) +(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 + package. If VALID is a list, then we ensure that ARG matches one of the + elements of the list; unambigious abbreviations are allowed." + (etypecase valid + ((member t) + (setf var (intern (string-upcase arg) :keyword))) + (list + (let ((matches nil) + (guess (string-upcase arg)) + (len (length arg))) + (dolist (k valid) + (let* ((kn (symbol-name k)) + (klen (length kn))) + (cond ((string= kn guess) + (setf matches (list k)) + (return)) + ((and (< len klen) + (string= guess kn :end2 len)) + (push k matches))))) + (cond + ((null matches) + (option-parse-error "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~)~}" + arg matches))))))) (defopthandler list (var arg) (&optional handler &rest handler-args) "Collect ARGs in a list at VAR. ARGs are translated by the HANDLER first, @@ -691,7 +702,7 @@ Ambiguous long option `~A' -- could be any of:~{~% --~A~}" STRING A banner to print. SYMBOL or (SYMBOL STUFF...) - If SYMBOL is an optform macro, the result of invoking it. + If SYMBOL is an optform macro, the result of invoking it. (...) A full option-form. See below. @@ -762,8 +773,7 @@ Ambiguous long option `~A' -- could be any of:~{~% --~A~}" (flet ((emit () (write-string string stream :start start :end i) (setf start i))) - (unless end - (setf end (length string))) + (setf-default end (length string)) (loop (unless (< i end) (emit) @@ -839,15 +849,9 @@ Ambiguous long option `~A' -- could be any of:~{~% --~A~}" (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))) @@ -875,6 +879,17 @@ Ambiguous long option `~A' -- could be any of:~{~% --~A~}" (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-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) + (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. @@ -916,6 +931,7 @@ Ambiguous long option `~A' -- could be any of:~{~% --~A~}" (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))