From 0ff9df03bb54ba792cefa551face51748ae34259 Mon Sep 17 00:00:00 2001 From: Mark Wooding Date: Sun, 23 Apr 2006 16:18:21 +0100 Subject: [PATCH] Reformat all the docstrings. Indent subsequent lines. Makes the code look prettier, and makes diff function headers more useful. --- anaphora.lisp | 6 +- collect.lisp | 18 ++--- factorial.lisp | 2 +- infix.lisp | 138 ++++++++++++++++---------------- mdw-base.lisp | 74 +++++++++--------- optparse.lisp | 243 ++++++++++++++++++++++++++++++--------------------------- safely.lisp | 20 ++--- str.lisp | 22 +++--- sys-base.lisp | 4 +- unix.lisp | 27 ++++--- 10 files changed, 286 insertions(+), 268 deletions(-) diff --git a/anaphora.lisp b/anaphora.lisp index c7a4b08..9d5ccd2 100644 --- a/anaphora.lisp +++ b/anaphora.lisp @@ -34,6 +34,7 @@ "Bind `it' to result of COND when evaluating THEN or ELSE." `(let ((it ,cond)) (if it ,then ,@(and else (list else))))) + (defmacro aif2 (cond then &optional else) "Bind `it' to first value of COND; switch on second." (let ((tmp (gensym))) @@ -45,6 +46,7 @@ "Bind `it' to result of COND when evaluating BODY." `(let ((it ,cond)) (when it ,@body))) + (defmacro awhen2 (cond &body body) "Bind `it' to first value of COND; switch on second." (let ((tmp (gensym))) @@ -72,7 +74,7 @@ (defmacro asetf (&rest pairs &environment env) "Set PLACE to value of FORM; in FORM, `it' is bound to current value of -PLACE." + PLACE." (labels ((foo (pairs) (when pairs (let ((place (car pairs)) @@ -90,7 +92,7 @@ PLACE." (defmacro acond (&rest clauses) "Like `cond', but in each clause the consequent has `it' bound to the value -of its guard." + of its guard." (labels ((foo (clauses) (when clauses (let ((tmp (gensym)) diff --git a/collect.lisp b/collect.lisp index 5fc1cb9..28986e0 100644 --- a/collect.lisp +++ b/collect.lisp @@ -37,10 +37,10 @@ (defmacro collecting (vars &body body) "Collect items into lists. The VARS are a list of collection variables -- -their values are unspecified, except that they may be passed to `collect' and -`collect-tail' If VARS is empty then *collecting-anon-list-name* is used. -VARS may be an atom instead of a singleton list. The form produces multiple -values, one for each list constructed." + their values are unspecified, except that they may be passed to `collect' + and `collect-tail' If VARS is empty then *collecting-anon-list-name* is + used. VARS may be an atom instead of a singleton list. The form produces + multiple values, one for each list constructed." (cond ((null vars) (setf vars (list *collecting-anon-list-name*))) ((atom vars) (setf vars (list vars)))) `(let ,(mapcar (lambda (v) `(,v (make-collector))) vars) @@ -49,15 +49,15 @@ values, one for each list constructed." (defmacro with-collection (vars collection &body body) "Collect items into lists VARS according to the form COLLECTION; then -evaluate BODY with VARS bound to those lists." + evaluate BODY with VARS bound to those lists." `(multiple-value-bind - ,(listify vars) + ,(listify vars) (collecting ,vars ,collection) ,@body)) (defmacro collect (x &optional (name *collecting-anon-list-name*)) "Add item X to the `collecting' list NAME (or *collecting-anon-list-name* -by default)." + by default)." (with-gensyms tmp `(let ((,tmp (cons ,x nil))) (setf (cddr ,name) ,tmp) @@ -65,8 +65,8 @@ by default)." (defmacro collect-tail (x &optional (name *collecting-anon-list-name*)) "Make item X be the tail of `collecting' list NAME (or -*collecting-anon-list-name* by default). It is an error to continue trying -to add stuff to the list." + *collecting-anon-list-name* by default). It is an error to continue + trying to add stuff to the list." `(progn (setf (cddr ,name) ,x) (setf (cdr ,name) nil))) diff --git a/factorial.lisp b/factorial.lisp index 0155e07..59892fe 100644 --- a/factorial.lisp +++ b/factorial.lisp @@ -28,7 +28,7 @@ (defun factorial (n) "Compute a factorial. This is a little bit optimized: we try to multiply -values which are similar in size." + values which are similar in size." (when (minusp n) (error "negative factorial argument ~A" n)) (let ((stack nil)) diff --git a/infix.lisp b/infix.lisp index f71758c..a0d320d 100644 --- a/infix.lisp +++ b/infix.lisp @@ -58,14 +58,14 @@ (defstruct (operator (:predicate operatorp) (:conc-name op-)) "An operator object. The name serves mainly for documentation. The left -and right precedences control operator stacking behaviour. The function is -called when this operator is popped off the stack. - -If the left precedence is not nil, then operators currently on the stack -whose /right/-precedence is greater than or equal to this operator's -/left/-precedence are popped before this operator can be pushed. If the -right precedence is nil, then this operator is not in fact pushed, but -processed immediately." + and right precedences control operator stacking behaviour. The function + is called when this operator is popped off the stack. + + If the left precedence is not nil, then operators currently on the stack + whose /right/-precedence is greater than or equal to this operator's + /left/-precedence are popped before this operator can be pushed. If the + right precedence is nil, then this operator is not in fact pushed, but + processed immediately." (name nil :type symbol) (lprec nil :type (or fixnum null)) (rprec nil :type (or fixnum null)) @@ -88,7 +88,7 @@ processed immediately." "The current token. Could be any Lisp object.") (defvar *paren-depth* 0 "Depth of parentheses in the current `parse-infix'. Used to override the -minprec restriction.") + minprec restriction.") ;;;-------------------------------------------------------------------------- ;;; The tokenizer. @@ -164,8 +164,8 @@ minprec restriction.") (defun flushops (prec) "Flush out operators on the operator stack with precedecnce higher than or -equal to PREC. This is used when a new operator is pushed, to ensure that -higher-precedence operators snarf their arguments." + equal to PREC. This is used when a new operator is pushed, to ensure that + higher-precedence operators snarf their arguments." (loop (when (null *opstk*) (return)) @@ -177,8 +177,9 @@ higher-precedence operators snarf their arguments." (defun pushop (op) "Push the operator OP onto the stack. If the operator has a -left-precedence, then operators with higher precedence are flushed (see -`flushops'). If the operator has no left-precedence, the operator is invoked immediately." + left-precedence, then operators with higher precedence are flushed (see + `flushops'). If the operator has no left-precedence, the operator is + invoked immediately." (let ((lp (op-lprec op))) (when lp (flushops lp))) @@ -191,20 +192,20 @@ left-precedence, then operators with higher precedence are flushed (see (defun infix-done () "Signal that `parse-infix' has reached the end of an expression. This is -primarily used by the `)' handler function if it finds there are no -parentheses." + primarily used by the `)' handler function if it finds there are no + parentheses." (throw 'infix-done nil)) (defun parse-infix (&optional minprec) "Parses an infix expression and return the resulting Lisp form. This is -the heart of the whole thing. + the heart of the whole thing. -Expects a token to be ready in *token*; leaves *token* as the first token -which couldn't be parsed. + Expects a token to be ready in *token*; leaves *token* as the first token + which couldn't be parsed. -The syntax parsed by this function doesn't fit nicely into a BNF, since we -parsing is effected by the precedences of the various operators. We have -low-precedence prefix operators such as `not', for example." + The syntax parsed by this function doesn't fit nicely into a BNF, since we + parsing is effected by the precedences of the various operators. We have + low-precedence prefix operators such as `not', for example." (flet ((lookup (items) (dolist (item items (values nil nil)) (let ((op (get *token* (car item)))) @@ -271,10 +272,10 @@ low-precedence prefix operators such as `not', for example." (defmacro defopfunc (op kind &body body) "Defines a magical operator. The operator's name is the symbol OP. The -KIND must be one of the symbols `infix', `prefix' or `postfix'. The body is -evaluated when the operator is parsed, and must either push appropriate -things on the operator stack or do its own parsing and push a result on the -value stack." + KIND must be one of the symbols `infix', `prefix' or `postfix'. The body + is evaluated when the operator is parsed, and must either push appropriate + things on the operator stack or do its own parsing and push a result on + the value stack." `(progn (setf (get ',op ',kind) (lambda () ,@body)) @@ -282,21 +283,21 @@ value stack." (defmacro definfix (op prec &body body) "Defines an infix operator. The operator's name is the symbol OP. The -operator's precedence is specified by PREC, which may be one of the -following: + operator's precedence is specified by PREC, which may be one of the + following: - * PREC -- equivalent to (:lassoc PREC) - * (:lassoc PREC) -- left-associative with precedence PREC - * (:rassoc PREC) -- right-associative with precedence PREC - * (LPREC . RPREC) -- independent left- and right-precedences - * (LPREC RPREC) -- synonym for the dotted form + * PREC -- equivalent to (:lassoc PREC) + * (:lassoc PREC) -- left-associative with precedence PREC + * (:rassoc PREC) -- right-associative with precedence PREC + * (LPREC . RPREC) -- independent left- and right-precedences + * (LPREC RPREC) -- synonym for the dotted form -In fact, (:lassoc PREC) is the same as (PREC . PREC), and (:rassoc PREC) is -the same as (PREC . (1- PREC)). + In fact, (:lassoc PREC) is the same as (PREC . PREC), and (:rassoc PREC) + is the same as (PREC . (1- PREC)). -The BODY is evaluated when the operator's arguments are fully resolved. It -should pop off two arguments and push one result. Nobody will check that -this is done correctly." + The BODY is evaluated when the operator's arguments are fully resolved. + It should pop off two arguments and push one result. Nobody will check + that this is done correctly." (multiple-value-bind (lprec rprec) (flet ((bad () @@ -341,15 +342,15 @@ this is done correctly." ',op))) (defmacro defprefix (op prec &body body) "Defines a prefix operator. The operator's name is the symbol OP. The -operator's (right) precedence is PREC. The body is evaluated with the -operator's argument is fully determined. It should pop off one argument and -push one result." + operator's (right) precedence is PREC. The body is evaluated with the + operator's argument is fully determined. It should pop off one argument + and push one result." (do-defunary 'prefix op prec body)) (defmacro defpostfix (op prec &body body) "Defines a postfix operator. The operator's name is the symbol OP. The -operator's (left) precedence is PREC. The body is evaluated with the -operator's argument is fully determined. It should pop off one argument and -push one result." + operator's (left) precedence is PREC. The body is evaluated with the + operator's argument is fully determined. It should pop off one argument + and push one result." (do-defunary 'postfix op prec body)) ;;;-------------------------------------------------------------------------- @@ -357,26 +358,26 @@ push one result." (defun delim (delim &key (requiredp t)) "Parse DELIM, and read the next token. Returns t if the DELIM was found, -or nil if not (and requiredp was nil)." + or nil if not (and requiredp was nil)." (cond ((eq *token* delim) (get-token) t) (requiredp (error "expected `~(~A~)'; found ~S" delim *token*)) (t nil))) (defun errfunc (&rest args) "Returns a function which reports an error. Useful when constructing -operators by hand." + operators by hand." (lambda () (apply #'error args))) (defun binop-apply (name) "Apply the Lisp binop NAME to the top two items on the value stack; i.e., -if the top two items are Y and X, then we push (NAME X Y)." + if the top two items are Y and X, then we push (NAME X Y)." (let ((y (popval)) (x (popval))) (pushval (list name x y)))) (defun binop-apply-append (name) "As for `binop-apply' but if the second-from-top item on the stack has the -form (NAME SOMETHING ...) then fold the top item into the form rather than -buidling another." + form (NAME SOMETHING ...) then fold the top item into the form rather than + buidling another." (let ((y (popval)) (x (popval))) (pushval (if (and (consp x) (eq (car x) name)) (append x (list y)) @@ -384,11 +385,12 @@ buidling another." (defun unop-apply (name) "Apply the Lisp unop NAME to the top item on the value stack; i.e., if the -top item is X, then push (NAME X)." + top item is X, then push (NAME X)." (pushval (list name (popval)))) + (defun unop-apply-toggle (name) "As for `unop-apply', but if the top item has the form (NAME X) already, -then push just X." + then push just X." (let ((x (popval))) (pushval (if (and (consp x) (eq (car x) name) @@ -399,8 +401,8 @@ then push just X." (defun strip-progn (form) "Return a version of FORM suitable for putting somewhere where there's an -implicit `progn'. If FORM has the form (PROGN . FOO) then return FOO, -otherwise return (FORM)." + implicit `progn'. If FORM has the form (PROGN . FOO) then return FOO, + otherwise return (FORM)." (if (and (consp form) (eq (car form) 'progn)) (cdr form) @@ -488,9 +490,9 @@ otherwise return (FORM)." (defun push-paren (right) "Pushes a funny parenthesis operator. Since this operator has no left -precedence, and very low right precedence, it is pushed over any stack of -operators and can only be popped by magic or end-of-file. In the latter -case, cause an error." + precedence, and very low right precedence, it is pushed over any stack of + operators and can only be popped by magic or end-of-file. In the latter + case, cause an error." (pushop (make-operator :name right :lprec nil :rprec -1000 :func (errfunc "missing `~A'" right))) @@ -499,8 +501,8 @@ case, cause an error." (defun pop-paren (right) "Pops a parenthesis. If there are no parentheses, maybe they belong to the -caller's syntax. Otherwise, pop off operators above the current funny -parenthesis operator, and then remove it." + caller's syntax. Otherwise, pop off operators above the current funny + parenthesis operator, and then remove it." (when (zerop *paren-depth*) (infix-done)) (flushops -999) @@ -528,10 +530,10 @@ parenthesis operator, and then remove it." (defopfunc if operand "Parse an `if' form. Syntax: - IF ::= `if' CONDITION `then' CONSEQUENCE [`else' ALTERNATIVE] + IF ::= `if' CONDITION `then' CONSEQUENCE [`else' ALTERNATIVE] -We parse this into an `if' where sensible, or into a `cond' if we see an -`else if' pair. The usual `dangling else' rule is followed." + We parse this into an `if' where sensible, or into a `cond' if we see an + `else if' pair. The usual `dangling else' rule is followed." (get-token) (let (cond cons) (setf cond (parse-infix)) @@ -566,11 +568,11 @@ We parse this into an `if' where sensible, or into a `cond' if we see an (defun do-letlike (kind) "Parse a `let' form. Syntax: - LET ::= `let' | `let*' VARS `in' EXPR - VARS ::= VAR | VARS `,' VAR - VAR ::= NAME [`=' VALUE] + LET ::= `let' | `let*' VARS `in' EXPR + VARS ::= VAR | VARS `,' VAR + VAR ::= NAME [`=' VALUE] -Translates into the obvious Lisp code." + Translates into the obvious Lisp code." (let ((clauses nil) name value) (get-token) (loop @@ -703,8 +705,8 @@ Translates into the obvious Lisp code." (defun read-infix (&optional (*stream* *standard-input*) &key (delim eof)) "Reads an infix expression from STREAM and returns the corresponding Lisp. -Requires the expression to be delimited properly by DELIM (by default -end-of-file)." + Requires the expression to be delimited properly by DELIM (by default + end-of-file)." (let (*token*) (prog2 (get-token) @@ -714,8 +716,8 @@ end-of-file)." (defun install-infix-reader (&optional (char #\$)) "Installs a macro character `$ INFIX... $' for translating infix notation -to Lisp forms. You also want to (use-package :infix-keywords) if you do -this." + to Lisp forms. You also want to (use-package :infix-keywords) if you do + this." (let ((delim (intern (string #\$) 'infix-keywords))) (set-macro-character char (lambda (stream ch) (declare (ignore ch)) diff --git a/mdw-base.lisp b/mdw-base.lisp index 1f5a3eb..cde1d7a 100644 --- a/mdw-base.lisp +++ b/mdw-base.lisp @@ -45,7 +45,7 @@ (defmacro compile-time-defun (name args &body body) "Define a function which can be used by macros during the compilation -process." + process." `(eval-when (:compile-toplevel :load-toplevel) (defun ,name ,args ,@body))) @@ -58,8 +58,8 @@ process." (defun stringify (str) "Return a string representation of STR. Strings are returned unchanged; -symbols are converted to their names (unqualified!). Other objects are -converted to their print representations." + symbols are converted to their names (unqualified!). Other objects are + converted to their print representations." (typecase str (string str) (symbol (symbol-name str)) @@ -81,12 +81,12 @@ converted to their print representations." (compile-time-defun fix-pair (x &optional (y nil defaultp)) "Return two values extracted from X. It works as follows: - (A) -> A, Y - (A B) -> A, B - (A B . C) -> error - (A . B) -> A, B - A -> A, Y -where Y defaults to A if not specified." + (A) -> A, Y + (A B) -> A, B + (A B . C) -> error + (A . B) -> A, B + A -> A, Y + where Y defaults to A if not specified." (do-fix-pair x y defaultp)) (compile-time-defun pairify (x &optional (y nil defaultp)) @@ -102,14 +102,15 @@ where Y defaults to A if not specified." (declaim (ftype (function nil ()) slot-unitialized)) (defun slot-uninitialized () "A function which signals an error. Can be used as an initializer form in -structure definitions without doom ensuing." + structure definitions without doom ensuing." (error "No initializer for slot.")) (compile-time-defun parse-body (body) "Given a BODY (a list of forms), parses it into three sections: a -docstring, a list of declarations (forms beginning with the symbol `declare') -and the body forms. The result is returned as three lists (even the -docstring), suitable for interpolation into a backquoted list using `@,'." + docstring, a list of declarations (forms beginning with the symbol + `declare') and the body forms. The result is returned as three lists + (even the docstring), suitable for interpolation into a backquoted list + using `@,'." (multiple-value-bind (doc body) (if (and (consp body) @@ -134,9 +135,9 @@ docstring), suitable for interpolation into a backquoted list using `@,'." (defmacro let*/gensyms (binds &body body) "A macro helper. BINDS is a list of binding pairs (VAR VALUE), where VALUE -defaults to VAR. The result is that BODY is evaluated in a context where -each VAR is bound to a gensym, and in the final expansion, each of those -gensyms will be bound to the corresponding VALUE." + defaults to VAR. The result is that BODY is evaluated in a context where + each VAR is bound to a gensym, and in the final expansion, each of those + gensyms will be bound to the corresponding VALUE." (labels ((more (binds) (let ((tmp (gensym "TMP")) (bind (car binds))) `((let ((,tmp ,(cadr bind)) @@ -188,11 +189,11 @@ gensyms will be bound to the corresponding VALUE." (defmacro case2 (vform &body clauses) "VFORM is a form which evaluates to two values, SCRUTINEE and ARGUMENT. -The CLAUSES have the form (CASES ([VAR]) FORMS...), where a standard `case' -clause has the form (CASES FORMS...). The `case2' form evaluates the VFORM, -and compares the SCRUTINEE to the various CASES, in order, just like `case'. -If there is a match, then the corresponding FORMs are evaluated with VAR (if -specified) bound to the value of ARGUMENT." + The CLAUSES have the form (CASES ([VAR]) FORMS...), where a standard + `case' clause has the form (CASES FORMS...). The `case2' form evaluates + the VFORM, and compares the SCRUTINEE to the various CASES, in order, just + like `case'. If there is a match, then the corresponding FORMs are + evaluated with VAR (if specified) bound to the value of ARGUMENT." (do-case2-like 'case vform clauses)) (defmacro ecase2 (vform &body clauses) @@ -213,10 +214,10 @@ specified) bound to the value of ARGUMENT." (defmacro with-places ((&key environment) places &body body) "A hairy helper, for writing setf-like macros. PLACES is a list of binding -pairs (VAR PLACE), where PLACE defaults to VAR. The result is that BODY is -evaluated in a context where each VAR is bound to a gensym, and in the final -expansion, each of those gensyms will be bound to a symbol-macro capable of -reading or setting the value of the corresponding PLACE." + pairs (VAR PLACE), where PLACE defaults to VAR. The result is that BODY + is evaluated in a context where each VAR is bound to a gensym, and in the + final expansion, each of those gensyms will be bound to a symbol-macro + capable of reading or setting the value of the corresponding PLACE." (if (null places) `(progn ,@body) (let*/gensyms (environment) @@ -278,10 +279,10 @@ reading or setting the value of the corresponding PLACE." (defmacro locf (place &environment env) "Slightly cheesy locatives. (locf PLACE) returns an object which, using -the `ref' function, can be used to read or set the value of PLACE. It's -cheesy because it uses closures rather than actually taking the address of -something. Also, unlike Zetalisp, we don't overload `car' to do our dirty -work." + the `ref' function, can be used to read or set the value of PLACE. It's + cheesy because it uses closures rather than actually taking the address of + something. Also, unlike Zetalisp, we don't overload `car' to do our dirty + work." (multiple-value-bind (valtmps valforms newtmps setform getform) (get-setf-expansion place env) @@ -301,13 +302,14 @@ work." (defmacro with-locatives (locs &body body) "LOCS is a list of items of the form (SYM [LOC-EXPR]), where SYM is a -symbol and LOC-EXPR evaluates to a locative. If LOC-EXPR is omitted, it -defaults to SYM. As an abbreviation for a common case, LOCS may be a symbol -instead of a list. The BODY is evaluated in an environment where each SYM is -a symbol macro which expands to (ref LOC-EXPR) -- or, in fact, something -similar which doesn't break if LOC-EXPR has side-effects. Thus, references, -including `setf' forms, fetch or modify the thing referred to by the -LOC-EXPR. Useful for covering over where something uses a locative." + symbol and LOC-EXPR evaluates to a locative. If LOC-EXPR is omitted, it + defaults to SYM. As an abbreviation for a common case, LOCS may be a + symbol instead of a list. The BODY is evaluated in an environment where + each SYM is a symbol macro which expands to (ref LOC-EXPR) -- or, in fact, + something similar which doesn't break if LOC-EXPR has side-effects. Thus, + references, including `setf' forms, fetch or modify the thing referred to + by the LOC-EXPR. Useful for covering over where something uses a + locative." (setf locs (mapcar #'pairify (listify locs))) (let ((tt (mapcar (lambda (l) (declare (ignore l)) (gensym)) locs)) (ll (mapcar #'cadr locs)) diff --git a/optparse.lisp b/optparse.lisp index d5e2f10..acbe11f 100644 --- a/optparse.lisp +++ b/optparse.lisp @@ -95,32 +95,34 @@ (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) @@ -148,32 +150,32 @@ Usually, one won't use make-option, but use the option macro instead." 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))) @@ -188,8 +190,9 @@ LONG-ONLY-P A misnomer inherited from GNU getopt. Whether to allow (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." @@ -203,18 +206,19 @@ not that useful.")) (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))) @@ -392,8 +396,8 @@ Ambiguous long option `~A' -- could be any of:~{~% --~A~}" (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 @@ -430,8 +434,9 @@ completed successfully, or nil if errors occurred." (&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) @@ -443,11 +448,12 @@ some parameters (the ARGS) and the value of an option-argument named ARG." (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 @@ -491,7 +497,7 @@ sensible parse), and the index following the characters of the integer." (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 @@ -511,22 +517,22 @@ ARG, and the remaining ARGS." (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) @@ -538,10 +544,11 @@ of type option-parse-error is signalled." (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)) @@ -582,7 +589,7 @@ MAX (either of which may be nil if no lower resp. upper bound is wanted)." (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)))) @@ -592,14 +599,14 @@ if specified. If not, it's as if you asked for `string'." (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)) @@ -667,46 +674,45 @@ the `option' macro for details of the syntax." (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) @@ -730,8 +736,8 @@ Full option-forms are as follows. (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)) @@ -764,7 +770,7 @@ this makes usage messages work better." (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) @@ -806,9 +812,9 @@ mandatory argument names." (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)) @@ -817,10 +823,10 @@ cases, a single string is sufficient." (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) @@ -853,8 +859,8 @@ the options parser. STREAM is the stream to write on." (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))) @@ -931,7 +937,7 @@ list of warning strings." 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)) @@ -941,6 +947,11 @@ and respond to them properly." (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 diff --git a/safely.lisp b/safely.lisp index abb2fb2..60dd683 100644 --- a/safely.lisp +++ b/safely.lisp @@ -45,15 +45,15 @@ (defun fresh-file-name (base tag) "Return a fresh file name constructed from BASE and TAG in the current -directory. Do not assume that this filename will be good by the time you try -to create the file." + directory. Do not assume that this filename will be good by the time you + try to create the file." (let ((name (format nil "~A.~A-~X" base tag (random most-positive-fixnum)))) (if (probe-file name) (fresh-file-name base tag) name))) (defun safely-open-output-stream (safe file &rest open-args) "Create an output stream which will be named FILE when SAFE is committed. -Other OPEN-ARGS are passed to open." + Other OPEN-ARGS are passed to open." (let* ((new (fresh-file-name file "new")) (stream (apply #'open new @@ -73,7 +73,7 @@ Other OPEN-ARGS are passed to open." (defun rename-file-without-moaning (old new) "Rename OLD to NEW, ignoring errors, and without doing any stupid name -mangling." + mangling." (with-errno-handlers () (sys-rename old new) (ENOENT nil))) @@ -101,7 +101,7 @@ mangling." (defun safely-bail (safe) "Abort the operations in SAFE, unwinding all the things that have been -done. Streams are closed, new files are removed." + done. Streams are closed, new files are removed." (dolist (stream (safely-streams safe)) (close stream :abort t)) (safely-unwind (safely-trail safe)) @@ -109,9 +109,9 @@ done. Streams are closed, new files are removed." (defun safely-commit (safe) "Commit SAFE. The files deleted by safely-delete-file are deleted; the -files created by safely-open-output-stream are renamed over the old versions, -if any. If a problem occurs during this stage, everything is rewound and no -changes are made." + files created by safely-open-output-stream are renamed over the old + versions, if any. If a problem occurs during this stage, everything is + rewound and no changes are made." (let ((trail (safely-trail safe)) (revert nil) (cleanup nil)) @@ -147,7 +147,7 @@ changes are made." (defmacro safely ((safe &key) &body body) "Do stuff within the BODY safely. If BODY completes without errors, the -SAFE is committed; otherwise it's bailed." + SAFE is committed; otherwise it's bailed." `(let ((,safe (make-safely))) (unwind-protect (progn @@ -159,7 +159,7 @@ SAFE is committed; otherwise it's bailed." (defmacro safely-writing ((stream file &rest open-args) &body body) "Simple macro for writing a single file safely. STREAM is opened onto a -temporary file, and if BODY completes, it is renamed to FILE." + temporary file, and if BODY completes, it is renamed to FILE." (with-gensyms safe `(safely (,safe) (let ((,stream (apply #'safely-open-output-stream diff --git a/str.lisp b/str.lisp index 9f43ed8..1cb0cc7 100644 --- a/str.lisp +++ b/str.lisp @@ -30,8 +30,8 @@ (defun join-strings (del strs) "Join together the strings STRS with DEL between them. All the arguments -are first converted to strings, as if by `stringify'. Otherwise, this is -like Perl's join operator." + are first converted to strings, as if by `stringify'. Otherwise, this is + like Perl's join operator." (setf del (stringify del)) (with-output-to-string (s) (when strs @@ -43,10 +43,10 @@ like Perl's join operator." (defun str-next-word (string &key quotedp start end) "Extract a whitespace-delimited word from STRING, returning it and the -index to continue parsing from. If no word is found, return nil twice. If -QUOTEDP, then allow quoting and backslashifying; otherwise don't. The START -and END arguments limit the portion of the string to be processed; the -default to 0 and nil (end of string), as usual." + index to continue parsing from. If no word is found, return nil twice. + If QUOTEDP, then allow quoting and backslashifying; otherwise don't. The + START and END arguments limit the portion of the string to be processed; + the default to 0 and nil (end of string), as usual." (unless start (setf start 0)) (unless end (setf end (length string))) (let ((i start) @@ -110,11 +110,11 @@ default to 0 and nil (end of string), as usual." (defun str-split-words (string &key quotedp start end max) "Break STRING into words, like str-next-word does, returning the list of -the individual words. If QUOTEDP, then allow quoting and backslashifying; -otherwise don't. No more than MAX `words' are returned: if the maximum is -hit, then the last `word' is unbroken, and may still contain quotes and -escape characters. The START and END arguments limit the portion of the -string to be processed in the usual way." + the individual words. If QUOTEDP, then allow quoting and backslashifying; + otherwise don't. No more than MAX `words' are returned: if the maximum is + hit, then the last `word' is unbroken, and may still contain quotes and + escape characters. The START and END arguments limit the portion of the + string to be processed in the usual way." (when (equal max 0) (return-from str-split-words nil)) (let ((l nil) (n 0)) diff --git a/sys-base.lisp b/sys-base.lisp index 47ef2fb..f5f8341 100644 --- a/sys-base.lisp +++ b/sys-base.lisp @@ -36,7 +36,7 @@ #+cmu (defun exit (&optional (code 0)) "Polite way to end a program. If running in an interactive Lisp, just -return to the top-level REPL." + return to the top-level REPL." (if *batch-mode* (throw 'lisp::%end-of-the-world code) (progn @@ -47,7 +47,7 @@ return to the top-level REPL." #+cmu (defun hard-exit (&optional (code 0)) "Stops the program immediately in its tracks. Does nothing else. Use -after fork, for example, to avoid flushing buffers." + after fork, for example, to avoid flushing buffers." (declare (type (unsigned-byte 32) code)) (unix::void-syscall ("_exit" c-call:int) code)) diff --git a/unix.lisp b/unix.lisp index 4465740..b4d0208 100644 --- a/unix.lisp +++ b/unix.lisp @@ -37,7 +37,7 @@ (defmacro with-buffer ((var len) &body body) "Evaluate BODY with VAR bound to a pointer (a SAP, if you must know) to a -buffer of LEN bytes." + buffer of LEN bytes." (with-gensyms lenvar `(let ((,lenvar ,len) (,var nil)) @@ -69,8 +69,8 @@ buffer of LEN bytes." errstring) form &rest clauses) "Evaluate FORM but trap Unix errors according to CLAUSES. Each clause has -the form of a `case' clause, but may contain symbolic errno names as well as -numbers." + the form of a `case' clause, but may contain symbolic errno names as well + as numbers." (flet ((fix (sw) (cond ((eq sw t) 't) ((atom sw) (list (errno-value sw))) @@ -111,7 +111,7 @@ numbers." (defun syscall* (name func &rest args) "Call Unix system call FUNC, passing it ARGS. If it returns an error, -signal the unix-error condition, with NAME and ARGS." + signal the unix-error condition, with NAME and ARGS." (multiple-value-call (lambda (rc &rest stuff) (unless rc (error 'unix-error @@ -122,8 +122,9 @@ signal the unix-error condition, with NAME and ARGS." (apply func args))) (defmacro syscall (func &rest args) "Call Unix system call FUNC, passing it ARGS. If it returns an error, -signal the unix-error condition, with FUNC and ARGS." - `(syscall* ',func #',func ,@args)) + signal the unix-error condition, with FUNC and ARGS." + `(syscall* ',func + #',func ,@args)) (macrolet ((doit (doc slots) `(defstruct (stat (:predicate statp) @@ -132,12 +133,12 @@ signal the unix-error condition, with FUNC and ARGS." ,doc ,@slots))) (doit - "Structure representing all the useful information `stat' returns about -a file." + "Structure representing all the useful information `stat' returns about a + file." (dev ino mode nlink uid gid rdev size atime mtime ctime blksize blocks))) (defun sys-stat (file) "Return information about FILE in a structure rather than as inconvenient -multiple values." + multiple values." (multiple-value-call (lambda (rc &rest results) (unless rc @@ -164,8 +165,8 @@ multiple values." (defmacro with-unix-open ((fd file how &optional (mode #o666)) &body body) "Evaluate BODY with FD bound to a file descriptor obtained from a Unix -`open' syscall with arguments FILE, HOW and MODE. Close the file descriptor -when BODY is done." + `open' syscall with arguments FILE, HOW and MODE. Close the file + descriptor when BODY is done." `(let (,fd) (unwind-protect (progn @@ -175,8 +176,8 @@ when BODY is done." (defun copy-file (from to &optional (how 0)) "Make a copy of the file FROM called TO. The copy has the same permissions -and timestamps (except for ctime) and attempts to have the same owner and -group as the original." + and timestamps (except for ctime) and attempts to have the same owner and + group as the original." (let ((st (sys-stat from))) (with-unix-open (in from unix:O_RDONLY) (with-unix-open (out -- 2.11.0