Reformat all the docstrings.

Indent subsequent lines.  Makes the code look prettier, and makes diff
function headers more useful.

diff --git a/anaphora.lisp b/anaphora.lisp
index c7a4b08..9d5ccd2 100644 (file)
--- 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)))))
   "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)))
 (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)))
   "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)))
 (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
 
 (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))
   (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
                  
 (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))
   (labels ((foo (clauses)
             (when clauses
               (let ((tmp (gensym))

diff --git a/collect.lisp b/collect.lisp
index 5fc1cb9..28986e0 100644 (file)
--- 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 --
 
 (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)
   (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
 
 (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
   `(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*
        (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)
   (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
 
 (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)))
   `(progn
      (setf (cddr ,name) ,x)
      (setf (cdr ,name) nil)))

diff --git a/factorial.lisp b/factorial.lisp
index 0155e07..59892fe 100644 (file)
--- 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
 
 (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))
   (when (minusp n)
     (error "negative factorial argument ~A" n))
   (let ((stack nil))

diff --git a/infix.lisp b/infix.lisp
index f71758c..a0d320d 100644 (file)
--- 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
 (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))
   (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
   "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.
 
 ;;;--------------------------------------------------------------------------
 ;;; The tokenizer.


@@ -164,8 +164,8 @@ minprec restriction.")
 
 (defun flushops (prec)
   "Flush out operators on the operator stack with precedecnce higher than or
 
 (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))
   (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
 
 (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)))
   (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
 
 (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
   (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))))
   (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
 
 (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))
   `(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
 
 (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 ()
   (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
        ',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
   (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))
 
 ;;;--------------------------------------------------------------------------
   (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,
 
 (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
   (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.,
   (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
   (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))
   (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
 
 (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))))
   (pushval (list name (popval))))

+

 (defun unop-apply-toggle (name)
   "As for `unop-apply', but if the top item has the form (NAME X) already,
 (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)
   (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
 
 (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)
   (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
 
 (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)))
   (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
 
 (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)
   (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:
 
 (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))
   (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:
 
 (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
   (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.
 
 (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)
   (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
 
 (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))
   (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 (file)
--- 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
 
 (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)))
 
   `(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;
 
 (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))
   (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:
 
 (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))
   (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
 (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
   (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)
   (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
 
 (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))
   (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.
 
 (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)
   (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
 
 (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)
   (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
 
 (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)
   (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
 
 (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))
   (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 (file)
--- a/optparse.lisp
+++ b/optparse.lisp
@@ -95,32 +95,34 @@
                                  (documentation doc))))
   "Describes a command-line option.  Slots:
 
                                  (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)
   (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:
 
                                                         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)))
   (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)
   ()
 
 (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."
 
 (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,
 
 (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)))
   (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
 
 (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
   (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
                         (&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)
   (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
 
 (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
   (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
 
 (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
   (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
 
 (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
   (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
   (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)
   (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
 
 (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))
   (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,
 
 (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))))
   (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
 
 (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
   `(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))
   (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
 
 (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)
   `(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
                   (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))
   (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)
 
 (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)
   (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
 
 (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))
   (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
 
 (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)
   (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
 
 (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)))
   (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
                       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))
   (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)
        (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
   (with-gensyms (tparser)
     `(let ((,tparser ,parser))
        (loop

diff --git a/safely.lisp b/safely.lisp
index abb2fb2..60dd683 100644 (file)
--- 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
 
 (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.
   (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
   (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
 
 (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)))
   (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
 
 (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))
   (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
 
 (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))
   (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
 
 (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
   `(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
 
 (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
   (with-gensyms safe
     `(safely (,safe)
        (let ((,stream (apply #'safely-open-output-stream

diff --git a/str.lisp b/str.lisp
index 9f43ed8..1cb0cc7 100644 (file)
--- 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
 
 (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
   (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
 
 (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)
   (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
 
 (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))
   (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 (file)
--- 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
 #+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
   (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
 #+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))
 
   (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 (file)
--- 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
 
 (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))
   (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
                                     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)))
   (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,
 
 (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
   (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,
                       (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)
 
 (macrolet ((doit (doc slots)
             `(defstruct (stat (:predicate statp)


@@ -132,12 +133,12 @@ signal the unix-error condition, with FUNC and ARGS."
                ,doc
                ,@slots)))
   (doit
                ,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
    (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
   (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
 
 (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
   `(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
 
 (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
   (let ((st (sys-stat from)))
     (with-unix-open (in from unix:O_RDONLY)
       (with-unix-open (out