style(3p/lisp): expand tabs in npg, mime4cl and sclf r/3675

Done using

    find third_party/lisp/{sclf,mime4cl,npg} \
      -name '*.lisp' -or -name '*.asd' \
      -exec bash -c 'expand -i -t 8 "$0" | sponge "$0"' {} \;

Change-Id: If84afac9c1d5cbc74e137a5aa0ae61472f0f1e90
Reviewed-on: https://cl.tvl.fyi/c/depot/+/5066
Tested-by: BuildkiteCI
Reviewed-by: sterni <sternenseemann@systemli.org>

1 files changed, 485 insertions, 485 deletions

diff --git a/third_party/lisp/sclf/sclf.lisp b/third_party/lisp/sclf/sclf.lisp
index 0d587da8eb69..dfbc2078c829 100644
--- a/third_party/lisp/sclf/sclf.lisp
+++ b/third_party/lisp/sclf/sclf.lisp
@@ -63,22 +63,22 @@
 (defmacro be (&rest bindings-and-body)
   "Less-parenthetic let."
   (let ((bindings
-	 (loop
-	    while (and (symbolp (car bindings-and-body))
-		       (cdr bindings-and-body))
-	    collect (list (pop bindings-and-body)
-			  (pop bindings-and-body)))))
+         (loop
+            while (and (symbolp (car bindings-and-body))
+                       (cdr bindings-and-body))
+            collect (list (pop bindings-and-body)
+                          (pop bindings-and-body)))))
     `(let ,bindings
        ,@bindings-and-body)))
 
 (defmacro be* (&rest bindings-and-body)
   "Less-parenthetic let*."
   (let ((bindings
-	 (loop
-	    while (and (symbolp (car bindings-and-body))
-		       (cdr bindings-and-body))
-	    collect (list (pop bindings-and-body)
-			  (pop bindings-and-body)))))
+         (loop
+            while (and (symbolp (car bindings-and-body))
+                       (cdr bindings-and-body))
+            collect (list (pop bindings-and-body)
+                          (pop bindings-and-body)))))
     `(let* ,bindings
        ,@bindings-and-body)))
 
@@ -93,7 +93,7 @@ useless.  This macro works around that problem."
   "Gensym all SYMBOLS and make them available in BODY.
 See also LET-GENSYMS."
   `(let ,(mapcar #'(lambda (s)
-		     (list s '(gensym))) symbols)
+                     (list s '(gensym))) symbols)
      ,@body))
 
 (defun s+ (&rest strings)
@@ -103,14 +103,14 @@ See also LET-GENSYMS."
 (defun string-starts-with (prefix string &optional (compare #'string=))
   (be prefix-length (length prefix)
     (and (>= (length string) prefix-length)
-	 (funcall compare prefix string :end2 prefix-length))))
+         (funcall compare prefix string :end2 prefix-length))))
 
 (defun string-ends-with (postfix string &optional (compare #'string=))
   "Return true if STRING's last characters are the same as POSTFIX."
   (be postfix-length (length postfix)
       string-length (length string)
     (and (>= string-length postfix-length)
-	 (funcall compare postfix string :start2 (- string-length postfix-length)))))
+         (funcall compare postfix string :start2 (- string-length postfix-length)))))
 
 (defun string-substitute (from to sequence &key (start 0) end (test #'eql))
   "Replace in SEQUENCE occurrences of FROM with TO.  FROM and TO don't
@@ -119,13 +119,13 @@ need to be the same length."
     (with-output-to-string (out)
       (write-string sequence out :start 0 :end start)
       (loop
-	 for position = (search from sequence :start2 start :end2 end :test test)
-	 while position
-	 do
-	   (write-string sequence out :start start :end position)
-	   (write-string to out)
-	   (setf start (+ position from-length))
-	 finally (write-string (subseq sequence start) out)))))
+         for position = (search from sequence :start2 start :end2 end :test test)
+         while position
+         do
+           (write-string sequence out :start start :end position)
+           (write-string to out)
+           (setf start (+ position from-length))
+         finally (write-string (subseq sequence start) out)))))
 
 (defun string-escape (string character &key (escape-character #\\) (escape-escape t))
   "Prepend all occurences of CHARACTER in STRING with a
@@ -134,8 +134,8 @@ ESCAPE-CHARACTER."
     (loop
        for c across string
        when (or (char= c character)
-		(and escape-escape
-		     (char= c escape-character)))
+                (and escape-escape
+                     (char= c escape-character)))
        do (write-char escape-character stream)
        do (write-char c stream))))
 
@@ -144,8 +144,8 @@ ESCAPE-CHARACTER."
 (defmacro aif (test then &optional else)
   `(be it ,test
      (if it
-	 ,then
-	 ,else)))
+         ,then
+         ,else)))
 
 (defmacro awhen (test &body then)
   `(be it ,test
@@ -155,13 +155,13 @@ ESCAPE-CHARACTER."
 (defmacro acond (&body forms)
   (when forms
     `(aif ,(caar forms)
-	  (progn ,@(cdar forms))
-	  (acond ,@(cdr forms)))))
+          (progn ,@(cdar forms))
+          (acond ,@(cdr forms)))))
 
 (defmacro aand (&rest args)
   (cond ((null args) t)
-	((null (cdr args)) (car args))
-	(t `(aif ,(car args) (aand ,@(cdr args))))))
+        ((null (cdr args)) (car args))
+        (t `(aif ,(car args) (aand ,@(cdr args))))))
 
 (defmacro acase (condition &body forms)
   `(be it ,condition
@@ -190,20 +190,20 @@ ESCAPE-CHARACTER."
   "Return SEQUENCE if it's not empty, otherwise NIL.
 NIL is indeed empty."
   (when (or (listp sequence)
-	    (not (zerop (length sequence))))
+            (not (zerop (length sequence))))
       sequence))
 
 (defun position-any (bag sequence &rest position-args)
   "Find any element of bag in sequence and return its position.
 Accept any argument accepted by the POSITION function."
   (apply #'position-if #'(lambda (element)
-			   (find element bag)) sequence position-args))
+                           (find element bag)) sequence position-args))
 
 (defun find-any (bag sequence &rest find-args)
   "Find any element of bag in sequence.  Accept any argument
 accepted by the FIND function."
   (apply #'find-if #'(lambda (element)
-			   (find element bag)) sequence find-args))
+                           (find element bag)) sequence find-args))
 
 (defun split-at (bag sequence &key (start 0) key)
   "Split SEQUENCE at occurence of any element from BAG.
@@ -211,15 +211,15 @@ Contiguous occurences of elements from BAG are considered atomic;
 so no empty sequence is returned."
   (be len (length sequence)
     (labels ((split-from (start)
-	       (unless (>= start len)
-		 (be sep (position-any bag sequence :start start :key key)
-		   (cond ((not sep)
-			  (list (subseq sequence start)))
-			 ((> sep start)
-			  (cons (subseq sequence start sep)
-				(split-from (1+ sep))))
-			 (t
-			  (split-from (1+ start))))))))
+               (unless (>= start len)
+                 (be sep (position-any bag sequence :start start :key key)
+                   (cond ((not sep)
+                          (list (subseq sequence start)))
+                         ((> sep start)
+                          (cons (subseq sequence start sep)
+                                (split-from (1+ sep))))
+                         (t
+                          (split-from (1+ start))))))))
       (split-from start))))
 
 (defun split-string-at-char (string separator &key escape skip-empty)
@@ -229,12 +229,12 @@ not nil then split at SEPARATOR only if it's not preceded by ESCAPE."
   (declare (type string string) (type character separator))
   (labels ((next-separator (beg)
              (be pos (position separator string :start beg)
-	       (if (and escape
-			pos
-			(plusp pos)
-			(char= escape (char string (1- pos))))
-		   (next-separator (1+ pos))
-		   pos)))
+               (if (and escape
+                        pos
+                        (plusp pos)
+                        (char= escape (char string (1- pos))))
+                   (next-separator (1+ pos))
+                   pos)))
            (parse (beg)
              (cond ((< beg (length string))
                     (let* ((end (next-separator beg))
@@ -244,11 +244,11 @@ not nil then split at SEPARATOR only if it's not preceded by ESCAPE."
                             ((not end)
                              (list substring))
                             (t
-			     (cons substring (parse (1+ end)))))))
+                             (cons substring (parse (1+ end)))))))
                    (skip-empty
-		    '())
+                    '())
                    (t
-		    (list "")))))
+                    (list "")))))
     (parse 0)))
 
 (defun copy-stream (in out)
@@ -262,15 +262,15 @@ not nil then split at SEPARATOR only if it's not preceded by ESCAPE."
   (unless (pathnamep pathname)
     (setf pathname (pathname pathname)))
   (cond ((pathname-name pathname)
-	 pathname)
-	((stringp (car (last (pathname-directory pathname))))
-	 (be name (parse-native-namestring (car (last (pathname-directory pathname))))
-	   (make-pathname :directory (butlast (pathname-directory pathname))
-			  :name (pathname-name name)
-			  :type (pathname-type name)
-			  :defaults pathname)))
-	;; it can't be done?
-	(t pathname)))
+         pathname)
+        ((stringp (car (last (pathname-directory pathname))))
+         (be name (parse-native-namestring (car (last (pathname-directory pathname))))
+           (make-pathname :directory (butlast (pathname-directory pathname))
+                          :name (pathname-name name)
+                          :type (pathname-type name)
+                          :defaults pathname)))
+        ;; it can't be done?
+        (t pathname)))
 
 (defun copy-file (file copy-file &key (if-exists :error))
   (with-open-file (in file)
@@ -279,7 +279,7 @@ not nil then split at SEPARATOR only if it's not preceded by ESCAPE."
 
 (defun symlink-file (src dst &key (if-exists :error))
   (when (and (eq :supersede if-exists)
-	     (probe-file dst))
+             (probe-file dst))
     (delete-file dst))
   #+sbcl (sb-posix:symlink src dst)
   #+cmu(unix:unix-symlink (native-namestring src) (native-namestring dst))
@@ -302,8 +302,8 @@ signalling an error."
      for line = (read-line stream nil)
      for i from 0
      while (and line
-		(or (not n)
-		    (< i n)))
+                (or (not n)
+                    (< i n)))
      collect line))
 
 (defun read-file (pathname &key (element-type 'character) (if-does-not-exist :error) default)
@@ -311,24 +311,24 @@ signalling an error."
 can be a string, a vector of bytes, or whatever you specify as
 ELEMENT-TYPE."
   (with-open-file (in pathname
-		      :element-type element-type
-		      :if-does-not-exist (unless (eq :value if-does-not-exist)
-					   :error))
+                      :element-type element-type
+                      :if-does-not-exist (unless (eq :value if-does-not-exist)
+                                           :error))
     (if in
-	(be seq (make-array (file-length in) :element-type element-type)
-	  (read-sequence seq in)
-	  seq)
-	default)))
+        (be seq (make-array (file-length in) :element-type element-type)
+          (read-sequence seq in)
+          seq)
+        default)))
 
 (defun write-file (pathname contents &key (if-exists :error))
   "Read the whole content of file and return it as a sequence which
 can be a string, a vector of bytes, or whatever you specify as
 ELEMENT-TYPE."
   (with-open-file (out pathname
-		       :element-type (if (stringp contents)
-					 'character
-					 (array-element-type contents))
-		       :if-exists if-exists)
+                       :element-type (if (stringp contents)
+                                         'character
+                                         (array-element-type contents))
+                       :if-exists if-exists)
     (write-sequence contents out)))
 
 (defun read-from-file (pathname &key (on-error :error) default)
@@ -343,9 +343,9 @@ DEFAULT is returned."
        (read in)))
     (:value
      (handler-case (with-open-file (in pathname)
-		     (read in))
+                     (read in))
        (t ()
-	 default)))))
+         default)))))
 
 (defun write-to-file (object pathname &key (if-exists :error) pretty)
   "Similar to WRITE-TO-STRING but for files.  Write OBJECT to a file
@@ -357,10 +357,10 @@ with pathname PATHNAME."
   "Concatenate the strings in LIST interposing SEPARATOR (default
 nothing) between them."
   (reduce #'(lambda (&rest args)
-	      (if args
-		  (s+ (car args) separator (cadr args))
-		  ""))
-	  list))
+              (if args
+                  (s+ (car args) separator (cadr args))
+                  ""))
+          list))
 
 ;; to indent it properly: (put 'gcase 'lisp-indent-function 1)
 (defmacro gcase ((value &optional (test 'equalp)) &rest cases)
@@ -369,18 +369,18 @@ but use TEST as the comparison function, which defaults to EQUALP."
   (with-gensyms (val)
     `(be ,val ,value
        ,(cons 'cond
-	      (mapcar #'(lambda (case-desc)
-			  (destructuring-bind (vals &rest forms) case-desc
-			    `(,(cond ((consp vals)
-				      (cons 'or (mapcar #'(lambda (v)
-							    (list test val v))
-							vals)))
-				     ((or (eq vals 'otherwise)
-					  (eq vals t))
-				      t)
-				     (t (list test val vals)))
-			       ,@forms)))
-		      cases)))))
+              (mapcar #'(lambda (case-desc)
+                          (destructuring-bind (vals &rest forms) case-desc
+                            `(,(cond ((consp vals)
+                                      (cons 'or (mapcar #'(lambda (v)
+                                                            (list test val v))
+                                                        vals)))
+                                     ((or (eq vals 'otherwise)
+                                          (eq vals t))
+                                      t)
+                                     (t (list test val vals)))
+                               ,@forms)))
+                      cases)))))
 
 (defun string-truncate (string max-length)
   "If STRING is longer than MAX-LENGTH, return a shorter version.
@@ -393,10 +393,10 @@ Otherwise return the same string unchanged."
 (defmacro until (test &body body)
   (with-gensyms (result)
     `(loop
-	for ,result = ,test
-	until ,result
-	do (progn ,@body)
-	finally (return ,result))))
+        for ,result = ,test
+        until ,result
+        do (progn ,@body)
+        finally (return ,result))))
 
 (defun keywordify (string)
   (intern (string-upcase string) :keyword))
@@ -419,7 +419,7 @@ to make sure that the returned pathname doesn't identify an
 already existing file.  If missing DEFAULT defaults to
 *TMP-FILE-DEFAULTS*."
   (make-pathname :defaults default
-		 :name (format nil "~36R" (random #.(expt 36 10)))))
+                 :name (format nil "~36R" (random #.(expt 36 10)))))
 
 (defun open-temp-file (&optional default-pathname &rest open-args)
   "Open a new temporary file and return a stream to it.  This function
@@ -435,14 +435,14 @@ file, otherwise *TMP-FILE-DEFAULTS* is used."
   ;; purpose of this function, otherwise make it default to :OUTPUT
   (aif (getf open-args :direction)
        (unless (member it '(:output :io))
-	 (error "Can't create temporary file with open direction ~A." it))
+         (error "Can't create temporary file with open direction ~A." it))
        (setf open-args (append '(:direction :output)
-			       open-args)))
+                               open-args)))
   (do* ((name #1=(temp-file-name default-pathname) #1#)
-	(stream #2=(apply #'open  name
-			  :if-exists nil
-			  :if-does-not-exist :create
-			  open-args) #2#))
+        (stream #2=(apply #'open  name
+                          :if-exists nil
+                          :if-does-not-exist :create
+                          open-args) #2#))
        (stream stream)))
 
 (defmacro with-temp-file ((stream &rest open-temp-args) &body body)
@@ -451,11 +451,11 @@ a STREAM open on a unique temporary file name.  OPEN-TEMP-ARGS are
 passed verbatim to OPEN-TEMP-FILE."
   `(be ,stream (open-temp-file ,@open-temp-args)
      (unwind-protect
-	  (progn ,@body)
+          (progn ,@body)
        (close ,stream)
        ;; body may decide to rename the file so we must ignore the errors
        (ignore-errors
-	 (delete-file (pathname ,stream))))))
+         (delete-file (pathname ,stream))))))
 
 (defmacro with-hidden-temp-file ((stream &rest open-args) &body body)
   "Just like WITH-TEMP-FILE but unlink (delete) the temporary file
@@ -468,17 +468,17 @@ may likely decide to crash, take all your data with it and, in the
 meanwhile, report you to the NSA as terrorist."
   `(be ,stream (open-temp-file ,@open-args)
      (unwind-protect
-	  (progn (delete-file (pathname ,stream))
-		 ,@body)
+          (progn (delete-file (pathname ,stream))
+                 ,@body)
        (close ,stream))))
 
 (defun insert-in-order (item seq &key (test #'<) key)
   "Destructively insert ITEM in LIST in order by TEST.  Return
 the new list.  This is a simple wrapper around MERGE."
   (merge (if seq
-	     (type-of seq)
-	     'list)
-	 (list item) seq test :key key))
+             (type-of seq)
+             'list)
+         (list item) seq test :key key))
 
 (defmacro f++ (x &optional (delta 1))
   "Same as INCF but hopefully optimised for fixnums."
@@ -500,46 +500,46 @@ Examples:
    (soundex \"Ladd\") => \"L300\""
   (declare (type string word))
   (flet ((translate-char (char)
-	   (awhen (position char "BFPVCGJKQSXZDTLMNR")
-	     (elt "111122222222334556" it))))
+           (awhen (position char "BFPVCGJKQSXZDTLMNR")
+             (elt "111122222222334556" it))))
     (let ((key (make-string key-length :initial-element #\0))
-	  (word-length (length word)))
+          (word-length (length word)))
       (setf (elt key 0) (elt word 0))
       (loop
-	 with previous-sound = (translate-char (char-upcase (elt word 0)))
-	 with j = 1
-	 for i from 1 by 1 below word-length
-	 for c = (char-upcase (elt word i))
-	 while (< j key-length)
-	 do (be sound (translate-char c)
-	      (cond ((not (eq sound previous-sound))
-		     (unless (member c '(#\H #\W))
-		       (setf previous-sound sound))
-		     (when sound
-		       (setf (elt key j) sound)
-		       (incf j))))))
+         with previous-sound = (translate-char (char-upcase (elt word 0)))
+         with j = 1
+         for i from 1 by 1 below word-length
+         for c = (char-upcase (elt word i))
+         while (< j key-length)
+         do (be sound (translate-char c)
+              (cond ((not (eq sound previous-sound))
+                     (unless (member c '(#\H #\W))
+                       (setf previous-sound sound))
+                     (when sound
+                       (setf (elt key j) sound)
+                       (incf j))))))
       key)))
 
 (defun string-soundex= (string1 string2)
   (let ((l1 (split-at +whitespace+ string1))
-	(l2 (split-at +whitespace+ string2)))
+        (l2 (split-at +whitespace+ string2)))
     (and (= (length l1) (length l2))
-	 (every #'string= (mapcar #'soundex l1) (mapcar #'soundex l2)))))
+         (every #'string= (mapcar #'soundex l1) (mapcar #'soundex l2)))))
 
 #+(OR)
 (defun soundex-test ()
   (let* ((words1 '("Euler" "Gauss" "Hilbert" "Knuth" "Lloyd" "Lukasiewicz" "Wachs"))
-	 (words2 '("Ellery" "Ghosh" "Heilbronn" "Kant" "Ladd" "Lissajous" "Waugh"))
-	 (results '("E460" "G200" "H416" "K530" "L300" "L222" "W200")))
+         (words2 '("Ellery" "Ghosh" "Heilbronn" "Kant" "Ladd" "Lissajous" "Waugh"))
+         (results '("E460" "G200" "H416" "K530" "L300" "L222" "W200")))
     (mapc #'(lambda (w1 w2 r)
-	      (let ((r1 (soundex w1))
-		    (r2 (soundex w2)))
-		(format t "~A = ~A, ~A = ~A => ~A~%" w1 r1 w2 r2
-			(if (and (string= r1 r2)
-				 (string= r r1))
-			    "OK"
-			    (format nil "ERROR (expected ~A)" r)))))
-	  words1 words2 results)
+              (let ((r1 (soundex w1))
+                    (r2 (soundex w2)))
+                (format t "~A = ~A, ~A = ~A => ~A~%" w1 r1 w2 r2
+                        (if (and (string= r1 r2)
+                                 (string= r r1))
+                            "OK"
+                            (format nil "ERROR (expected ~A)" r)))))
+          words1 words2 results)
     (values)))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -596,17 +596,17 @@ one (if any)."
 (defun dle-map (function dle-object)
   (when dle-object
     (make-double-linked-element :value (funcall function (dle-value dle-object))
-				:previous (dle-previous dle-object)
-				:next (dle-map function (dle-next dle-object)))))
+                                :previous (dle-previous dle-object)
+                                :next (dle-map function (dle-next dle-object)))))
 
 (defmacro do-dle ((var dle &optional (result nil)) &body body)
   "Iterate over a list of DOUBLE-LINKED-ELEMENTs and map body to
 each element's value.  Bind VAR to the value on each iteration."
   (be cursor (gensym)
     `(do ((,cursor ,dle (dle-next ,cursor)))
-	 ((not ,cursor) ,result)
+         ((not ,cursor) ,result)
        (be ,var (dle-value ,cursor)
-	 ,@body))))
+         ,@body))))
 
 (defmacro do-dle* ((var dle &optional (result nil)) &body body)
   "Same as DO-DLE but VAR is a symbol macro, so that BODY can
@@ -614,14 +614,14 @@ modify the element's value."
   (be cursor (gensym)
     `(symbol-macrolet ((,var (dle-value ,cursor)))
        (do ((,cursor ,dle (dle-next ,cursor)))
-	   ((not ,cursor) ,result)
-	 ,@body))))
+           ((not ,cursor) ,result)
+         ,@body))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (defclass double-linked-list ()
   ((elements :type double-linked-element
-	     :documentation "The actual list of elements held by this object.")
+             :documentation "The actual list of elements held by this object.")
    (last-element :type double-linked-element))
   (:documentation
    "A double linked list where elements can be added or removed
@@ -632,13 +632,13 @@ from either end."))
   (call-next-method)
   (with-slots (last-element elements) object
     (setf last-element (make-double-linked-element)
-	  elements last-element)))
+          elements last-element)))
 
 (defmethod print-object ((object double-linked-list) stream)
   (print-unreadable-object (object stream :type t)
     (be elements '()
       (do-dle (e (slot-value object 'elements))
-	(push e elements))
+        (push e elements))
       (format stream "elements=~S" (nreverse elements)))))
 
 (defgeneric pop-first (double-linked-list)
@@ -672,8 +672,8 @@ from either end."))
   (with-slots (elements) list
     (when (dle-next elements)
       (prog1 (dle-value elements)
-	(setf (dle-previous (dle-next elements)) nil
-	      elements (dle-next elements))))))
+        (setf (dle-previous (dle-next elements)) nil
+              elements (dle-next elements))))))
 
 (defmethod push-first (value (list double-linked-list))
   (with-slots (elements) list
@@ -687,11 +687,11 @@ from either end."))
 
 (defmethod list-map (function (list double-linked-list))
   (labels ((map-dll (dle)
-	     (when (dle-next dle)
-	       (make-double-linked-element
-		:value (funcall function (dle-value dle))
-		:previous (dle-previous dle)
-		:next (map-dll (dle-next dle))))))
+             (when (dle-next dle)
+               (make-double-linked-element
+                :value (funcall function (dle-value dle))
+                :previous (dle-previous dle)
+                :next (map-dll (dle-next dle))))))
     (map-dll (slot-value list 'elements))))
 
 (defmethod dll-find-cursor (object (list double-linked-list) &key (test #'eql) (key #'identity))
@@ -699,7 +699,7 @@ from either end."))
       ((not (dle-next cursor)))
     (be value (dle-value cursor)
       (when (funcall test (funcall key value) object)
-	(return cursor)))))
+        (return cursor)))))
 
 (defmethod dll-find (object (list double-linked-list) &key (test #'eql) (key #'identity))
   (awhen (dll-find-cursor object list :test test :key key)
@@ -708,9 +708,9 @@ from either end."))
 (defmethod dll-remove ((cursor double-linked-element) (list double-linked-list))
   (with-slots (elements) list
     (if (dle-previous cursor)
-	(dle-remove cursor)
-	(setf (dle-previous (dle-next elements)) nil
-	      elements (dle-next elements))))
+        (dle-remove cursor)
+        (setf (dle-previous (dle-next elements)) nil
+              elements (dle-next elements))))
   list)
 
 (defmacro do-dll ((var list &optional (result nil)) &body body)
@@ -718,9 +718,9 @@ from either end."))
 value.  Bind VAR to the value on each iteration."
   (be cursor (gensym)
     `(do ((,cursor (slot-value ,list 'elements) (dle-next ,cursor)))
-	 ((not (dle-next ,cursor)) ,result)
+         ((not (dle-next ,cursor)) ,result)
        (be ,var (dle-value ,cursor)
-	 ,@body))))
+         ,@body))))
 
 (defmacro do-dll* ((var list &optional (result nil)) &body body)
   "Same as DO-DLL but VAR is a symbol macro, so that BODY can
@@ -728,21 +728,21 @@ modify the element's value."
   (be cursor (gensym)
     `(symbol-macrolet ((,var (dle-value ,cursor)))
        (do ((,cursor (slot-value ,list 'elements) (dle-next ,cursor)))
-	   ((not (dle-next ,cursor)) ,result)
-	 ,@body))))
+           ((not (dle-next ,cursor)) ,result)
+         ,@body))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (defclass limited-list (double-linked-list)
   ((max-size :initform nil
-	     :initarg :size
-	     :reader max-size
-	     :type (or integer null)
-	     :documentation "Size limit to which the list is allowed to grow to.  NIL = no limit.")
+             :initarg :size
+             :reader max-size
+             :type (or integer null)
+             :documentation "Size limit to which the list is allowed to grow to.  NIL = no limit.")
    (size :initform 0
-	 :reader size
-	 :type integer
-	 :documentation "Current number of elements in the list."))
+         :reader size
+         :type integer
+         :documentation "Current number of elements in the list."))
   (:documentation
    "A double linked list where the maximum number of elements can
 be limited."))
@@ -750,9 +750,9 @@ be limited."))
 (defun dll-member-p (dle list)
   (with-slots (elements size) list
     (do ((e elements (dle-next e)))
-	((not e))
+        ((not e))
       (when (eq e dle)
-	(return t)))))
+        (return t)))))
 
 (defmethod dll-remove ((cursor double-linked-element) (list limited-list))
   (with-slots (size) list
@@ -780,9 +780,9 @@ full."
   (prog1 (call-next-method)
     (with-slots (max-size size last-element) list
       (if (or (not max-size)
-	      (< size max-size))
-	  (incf size)
-	  (dle-remove (dle-previous last-element))))))
+              (< size max-size))
+          (incf size)
+          (dle-remove (dle-previous last-element))))))
 
 (defmethod push-last (value (list limited-list))
   "Add at the end of the list and drop the first element if list
@@ -791,16 +791,16 @@ is full."
   (prog1 (call-next-method)
     (with-slots (max-size size elements) list
       (if (or (not max-size)
-	      (< size max-size))
-	(incf size)
-	(setf (dle-previous (dle-next elements)) nil
-	      elements (dle-next elements))))))
+              (< size max-size))
+        (incf size)
+        (setf (dle-previous (dle-next elements)) nil
+              elements (dle-next elements))))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (defclass sorted-list (limited-list)
   ((test :type function
-	 :initarg :test))
+         :initarg :test))
   (:documentation
    "A double linked list where elements are inserted in a
 sorted order."))
@@ -816,25 +816,25 @@ Returns two values, the modified list and the cursor to the new
 element."
   (with-slots (max-size size elements test last-element) sl
     (do ((cursor elements (dle-next cursor)))
-	((or (not (dle-next cursor))
-	     (funcall test item (dle-value cursor)))
-	 (if (dle-previous cursor)
-	     (cons-dle item (dle-previous cursor) cursor)
-	     (setf elements (cons-dle item nil cursor)))
-	 (if (or (not max-size)
-		  (< size max-size))
-	     (incf size)
-	     (dle-remove (dle-previous last-element)))
-	 (values sl (dle-previous cursor))))))
+        ((or (not (dle-next cursor))
+             (funcall test item (dle-value cursor)))
+         (if (dle-previous cursor)
+             (cons-dle item (dle-previous cursor) cursor)
+             (setf elements (cons-dle item nil cursor)))
+         (if (or (not max-size)
+                  (< size max-size))
+             (incf size)
+             (dle-remove (dle-previous last-element)))
+         (values sl (dle-previous cursor))))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (defclass heap ()
   ((less-than :type function
-	      :initarg :test
-	      :documentation "The heap invariant.")
+              :initarg :test
+              :documentation "The heap invariant.")
    (data :type array
-	 :documentation "The heap tree representation.")))
+         :documentation "The heap tree representation.")))
 
 (defmethod initialize-instance ((heap heap) &rest args)
   (declare (ignore args))
@@ -850,7 +850,7 @@ element."
        for current = pos then parent
        for parent = (truncate (1- current) 2)
        until (or (zerop current)
-		 (funcall less-than (aref data parent) (aref data current)))
+                 (funcall less-than (aref data parent) (aref data current)))
        do (rotatef (aref data current) (aref data parent)))))
 
 (defmethod heap-add ((heap heap) item)
@@ -879,13 +879,13 @@ element."
        for left-child = (+ 1 (* 2 current))
        for right-child = (+ 2 (* 2 current))
        for child = (cond ((>= left-child end)
-			  (return))
-			 ((>= right-child end)
-			  left-child)
-			 ((funcall less-than (aref data left-child) (aref data right-child))
-			  left-child)
-			 (t
-			  right-child))
+                          (return))
+                         ((>= right-child end)
+                          left-child)
+                         ((funcall less-than (aref data left-child) (aref data right-child))
+                          left-child)
+                         (t
+                          right-child))
        while (funcall less-than (aref data child) (aref data current))
        do (rotatef (aref data current) (aref data child)))))
 
@@ -901,7 +901,7 @@ element."
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (defstruct (lru-cache-slot (:include double-linked-element)
-			   (:conc-name lruc-slot-))
+                           (:conc-name lruc-slot-))
   key)
 
 (defmethod print-object ((object lru-cache-slot) stream)
@@ -914,24 +914,24 @@ time.")
 
 (defclass lru-cache ()
   ((max-size :initform *default-cache-size*
-	     :initarg :size
-	     :reader max-size
-	     :type (or integer null)
-	     :documentation
-	     "Maximum number of elements that the cache can fit.")
+             :initarg :size
+             :reader max-size
+             :type (or integer null)
+             :documentation
+             "Maximum number of elements that the cache can fit.")
    (elements-list :type lru-cache-slot
-		  :documentation "The list of elements held by the cache.")
+                  :documentation "The list of elements held by the cache.")
    (elements-hash :type hash-table
-		  :documentation "The hash table of the elements held bye the cache.")
+                  :documentation "The hash table of the elements held bye the cache.")
    (last-element :type lru-cache-slot)
    (size :initform 0
-	 :reader size
-	 :type integer
-	 :documentation "Current number of elements in the cache.")
+         :reader size
+         :type integer
+         :documentation "Current number of elements in the cache.")
    (finalizer :initform nil
-	      :initarg :finalizer
-	      :documentation
-	      "Procedure to call when elements are dropped from cache."))
+              :initarg :finalizer
+              :documentation
+              "Procedure to call when elements are dropped from cache."))
   (:documentation
    "An objects cache that keeps the elements used more often and
 drops those that are used less often.  The usage is similar to an
@@ -945,10 +945,10 @@ is required."))
   (call-next-method)
   (with-slots (last-element elements-list elements-hash) object
     (setf last-element (make-lru-cache-slot)
-	  elements-list last-element
-	  elements-hash (if test
-			    (make-hash-table :test test)
-			    (make-hash-table)))))
+          elements-list last-element
+          elements-hash (if test
+                            (make-hash-table :test test)
+                            (make-hash-table)))))
 
 (defgeneric getcache (key cache)
   (:documentation
@@ -966,7 +966,7 @@ is required."))
   "Relocate slot to the front of the elements list in cache.
 This will stretch its lifespan in the cache."
   (declare (type lru-cache-slot slot)
-	   (type lru-cache cache))
+           (type lru-cache cache))
   (with-slots (elements-list) cache
     ;; unless it's already the first
     (unless (eq slot elements-list)
@@ -974,9 +974,9 @@ This will stretch its lifespan in the cache."
       (dle-remove slot)
       ;; ... and add it in front of the list
       (setf (lruc-slot-next slot) elements-list
-	    (lruc-slot-previous slot) nil
-	    (lruc-slot-previous elements-list) slot
-	    elements-list slot))))
+            (lruc-slot-previous slot) nil
+            (lruc-slot-previous elements-list) slot
+            elements-list slot))))
 
 (defun drop-last-cache-element (cache)
   "Drop the last element in the list of the cache object."
@@ -985,20 +985,20 @@ This will stretch its lifespan in the cache."
     (let ((second-last (lruc-slot-previous last-element)))
       (assert second-last)
       (when finalizer
-	(funcall finalizer (lruc-slot-value second-last)))
+        (funcall finalizer (lruc-slot-value second-last)))
       (dle-remove second-last)
       (remhash (lruc-slot-key second-last) elements-hash))))
 
 (defun add-to-cache (slot cache)
   (declare (type lru-cache-slot slot)
-	   (type lru-cache cache))
+           (type lru-cache cache))
   (move-in-front-of-cache-list slot cache)
   (with-slots (max-size size elements-hash) cache
     (setf (gethash (lruc-slot-key slot) elements-hash) slot)
     (if (and max-size
-	     (< size max-size))
-	(incf size)
-	(drop-last-cache-element cache))))
+             (< size max-size))
+        (incf size)
+        (drop-last-cache-element cache))))
 
 (defmethod getcache (key (cache lru-cache))
   (multiple-value-bind (slot found?) (gethash key (slot-value cache 'elements-hash))
@@ -1010,37 +1010,37 @@ This will stretch its lifespan in the cache."
   (with-slots (elements-hash elements-list) cache
     (multiple-value-bind (slot found?) (gethash key elements-hash)
       (if found?
-	  (progn
-	    (move-in-front-of-cache-list slot cache)
-	    (setf (lruc-slot-value slot) value))
-	  (add-to-cache (make-lru-cache-slot :key key :value value) cache))
+          (progn
+            (move-in-front-of-cache-list slot cache)
+            (setf (lruc-slot-value slot) value))
+          (add-to-cache (make-lru-cache-slot :key key :value value) cache))
       value)))
 
 (defmethod remcache (key (cache lru-cache))
   (with-slots (elements-hash size elements-list finalizer) cache
     (multiple-value-bind (slot found?) (gethash key elements-hash)
       (when found?
-	(remhash key elements-hash)
-	(when finalizer
-	  (funcall finalizer (lruc-slot-value slot)))
-	(when (eq slot elements-list)
-	  (setf elements-list (dle-next slot)))
-	(dle-remove slot)
-	(decf size)
-	t))))
+        (remhash key elements-hash)
+        (when finalizer
+          (funcall finalizer (lruc-slot-value slot)))
+        (when (eq slot elements-list)
+          (setf elements-list (dle-next slot)))
+        (dle-remove slot)
+        (decf size)
+        t))))
 
 (defmacro cached (cache key value)
   "If KEY is found in CACHE return the associated object.  Otherwise
 store VALUE for later re-use."
   (with-gensyms (object my-cache my-key my-value found?)
     `(let* ((,my-cache ,cache)
-	    (,my-key ,key))
+            (,my-key ,key))
        (multiple-value-bind (,object ,found?) (getcache ,my-key ,my-cache)
-	 (if ,found?
-	     ,object
-	     (let ((,my-value ,value))
-	       (setf (getcache ,my-key ,my-cache) ,my-value)
-	       ,my-value))))))
+         (if ,found?
+             ,object
+             (let ((,my-value ,value))
+               (setf (getcache ,my-key ,my-cache) ,my-value)
+               ,my-value))))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
@@ -1073,17 +1073,17 @@ store VALUE for later re-use."
 (defun find-uid (name)
   "Find the user id of NAME.  Return an integer."
   #+sbcl (awhen (sb-posix:getpwnam name)
-	   (sb-posix:passwd-uid it))
+           (sb-posix:passwd-uid it))
   #+cmu (awhen (unix:unix-getpwnam name)
-	  (unix:user-info-uid it))
+          (unix:user-info-uid it))
   #-(or cmu sbcl)
   (error "Unable to find a UID on this Lisp system."))
 
 #+clisp (ffi:def-call-out %getuid
-	    (:name "getuid")
-	  (:arguments)
-	  (:return-type ffi:int)
-	  (:library "libc.so"))
+            (:name "getuid")
+          (:arguments)
+          (:return-type ffi:int)
+          (:library "libc.so"))
 
 (defun getuid ()
   "Return the Unix user id.  This is an integer."
@@ -1104,7 +1104,7 @@ user id."
     `(be ,ruid (getuid)
        (seteuid ,uid)
        (unwind-protect (progn ,@forms)
-	 (seteuid ,ruid)))))
+         (seteuid ,ruid)))))
 
 (defun get-logname (&optional uid)
   "Return the login id of the user.  This is a string and it is not
@@ -1129,9 +1129,9 @@ file."
     (setf uid (find-uid uid)))
   (when uid
     (car (split-string-at-char #+cmu (unix:user-info-gecos (unix:unix-getpwuid uid))
-			       #+sbcl (sb-posix:passwd-gecos (sb-posix:getpwuid uid))
-			       #-(or cmu sbcl) (error "can't getpwuid() on this Lisp system.")
-			       #\,))))
+                               #+sbcl (sb-posix:passwd-gecos (sb-posix:getpwuid uid))
+                               #-(or cmu sbcl) (error "can't getpwuid() on this Lisp system.")
+                               #\,))))
 
 (defun get-user-home (&optional uid)
   (unless uid
@@ -1158,37 +1158,37 @@ value.  If PAIRS-P is true the alist elements will be pairs."
   (loop
      for (key val) on plist by #'cddr
      collect (if pairs-p
-		 (cons key val)
-		 (list key val))))
+                 (cons key val)
+                 (list key val))))
 
 (defun string->byte-vector (string &key start end)
   "Convert a string of characters into a vector of (unsigned-byte
 8) elements."
   (map '(vector (unsigned-byte 8)) #'char-code
        (if (or start end)
-	   (subseq string (or start 0) end)
-	   string)))
+           (subseq string (or start 0) end)
+           string)))
 
 (defun byte-vector->string (vector &key start end)
   "Convert a vector of (unsigned-byte 8) elements into a string
 of characters."
   (map 'string #'code-char
        (if (or start end)
-	   (subseq vector (or start 0) end)
-	   vector)))
+           (subseq vector (or start 0) end)
+           vector)))
 
 (defun outdated-p (file dependencies)
   "Check if FILE has been modified before any of its
 DEPENDENCIES."
   (be epoch (and (probe-file file)
-		 (file-write-date file))
+                 (file-write-date file))
     ;; if file is missing altogether, we consider it outdated
     (or (not epoch)
-	(loop
-	   for dep in dependencies
-	   thereis (aand (probe-file dep)
-			 (file-write-date dep)
-			 (> it epoch))))))
+        (loop
+           for dep in dependencies
+           thereis (aand (probe-file dep)
+                         (file-write-date dep)
+                         (> it epoch))))))
 
 (defmacro let-places (places-and-values &body body)
   "Execute BODY binding temporarily some places to new values and
@@ -1198,21 +1198,21 @@ instead of new variable names this macro binds values to existing
 places (variables)."
   (be tmp-variables (loop for x in places-and-values collect (gensym))
     `(let ,(mapcar #'(lambda (tmp-var place-and-value)
-		       (list tmp-var (car place-and-value)))
-		   tmp-variables places-and-values)
+                       (list tmp-var (car place-and-value)))
+                   tmp-variables places-and-values)
        (unwind-protect
-	    (progn
-	      ;; as some assignments could signal an error, we assign
-	      ;; within the unwind-protect block so that we can always
-	      ;; guarantee a consistent state on exit
-	      ,@(mapcar #'(lambda (place-and-value)
-			    `(setf ,(car place-and-value) ,(cadr place-and-value)))
-			places-and-values)
-	      ,@body)
-	 ,@(mapcar #'(lambda (tmp-var place-and-value)
-		       `(setf ,(car place-and-value) ,tmp-var))
-		   tmp-variables
-		   places-and-values)))))
+            (progn
+              ;; as some assignments could signal an error, we assign
+              ;; within the unwind-protect block so that we can always
+              ;; guarantee a consistent state on exit
+              ,@(mapcar #'(lambda (place-and-value)
+                            `(setf ,(car place-and-value) ,(cadr place-and-value)))
+                        places-and-values)
+              ,@body)
+         ,@(mapcar #'(lambda (tmp-var place-and-value)
+                       `(setf ,(car place-and-value) ,tmp-var))
+                   tmp-variables
+                   places-and-values)))))
 
 (defmacro let-slots (accessor/new-value-pairs object &body body)
   "Execute BODY with some OBJECT's slots temporary sets to new
@@ -1223,61 +1223,61 @@ their original value.  See LET-PLACES."
   (with-gensyms (obj)
     `(be ,obj ,object
        (let-places ,(mapcar #'(lambda (av)
-				`((,(car av) ,obj) ,(cadr av)))
-			    accessor/new-value-pairs)
-	 ,@body))))
+                                `((,(car av) ,obj) ,(cadr av)))
+                            accessor/new-value-pairs)
+         ,@body))))
 
 (defvar *decimal-point* #\.)
 (defvar *thousands-comma* #\,)
 
 (defun format-amount (number &key (decimals 2) (rounder #'round)
-		      (comma *thousands-comma*) (comma-stance 3)
-		      (decimal-point *decimal-point*))
+                      (comma *thousands-comma*) (comma-stance 3)
+                      (decimal-point *decimal-point*))
   "Return a string formatted as fixed decimal point number of DECIMALS
 adding commas every COMMA-STANCE places before the decimal point."
   (declare (type number number)
-	   (type fixnum decimals comma-stance)
-	   (type function rounder)
-	   (type character comma decimal-point)
-	   (optimize (speed 3) (safety 0) (debug 0)))
+           (type fixnum decimals comma-stance)
+           (type function rounder)
+           (type character comma decimal-point)
+           (optimize (speed 3) (safety 0) (debug 0)))
   (let* ((int (funcall rounder (* number (expt 10 decimals))))
-	 (negative (< int 0)))
+         (negative (< int 0)))
     (declare (integer int))
     (when negative
       (setf int (- int)))
     (let* ((digits (max (1+ decimals)
-			(1+ (if (zerop int)
-				0
-				(truncate (log int 10))))))
-	   (string-length (+ digits
-			     ;; the minus sign
-			     (if negative 1 0)
-			     ;; the decimal point
-			     (if (zerop decimals) 0 1)
-			     ;; the thousands commas
-			     (1- (ceiling (- digits decimals) comma-stance))))
-	   (string (make-string string-length))
-	   (pos (1- string-length)))
+                        (1+ (if (zerop int)
+                                0
+                                (truncate (log int 10))))))
+           (string-length (+ digits
+                             ;; the minus sign
+                             (if negative 1 0)
+                             ;; the decimal point
+                             (if (zerop decimals) 0 1)
+                             ;; the thousands commas
+                             (1- (ceiling (- digits decimals) comma-stance))))
+           (string (make-string string-length))
+           (pos (1- string-length)))
       (declare (type fixnum pos digits))
       (labels ((add-char (char)
-		 (setf (schar string pos) char)
-		 (decf pos))
-	       (add-digit ()
-		 (add-char (digit-char (mod int 10)))
-		 (setf int (truncate int 10))))
-	(unless (zerop decimals)
-	  (loop
-	     for i fixnum from 0 below decimals
-	     do (add-digit))
-	  (add-char decimal-point))
-	(loop
-	   for i fixnum from 1
-	   do (add-digit)
-	   while (>= pos (if negative 1 0))
-	   when (zerop (mod i comma-stance))
-	   do (add-char comma))
-	(when negative
-	  (add-char #\-)))
+                 (setf (schar string pos) char)
+                 (decf pos))
+               (add-digit ()
+                 (add-char (digit-char (mod int 10)))
+                 (setf int (truncate int 10))))
+        (unless (zerop decimals)
+          (loop
+             for i fixnum from 0 below decimals
+             do (add-digit))
+          (add-char decimal-point))
+        (loop
+           for i fixnum from 1
+           do (add-digit)
+           while (>= pos (if negative 1 0))
+           when (zerop (mod i comma-stance))
+           do (add-char comma))
+        (when negative
+          (add-char #\-)))
       string)))
 
 (defun parse-amount (string &key (start 0) end)
@@ -1288,28 +1288,28 @@ trailing spaces must be removed from the string in advance."
      with amount = 0
      with decimals = nil
      with negative = (when (and (not (zerop (length string)))
-				(char= #\- (char string 0)))
-		       (incf start)
-		       t)
+                                (char= #\- (char string 0)))
+                       (incf start)
+                       t)
      for i from start below (or end (length string))
      for c = (char string i)
      do (cond ((char= c *decimal-point*)
-	       (if decimals
-		   (return nil)
-		   (setf decimals 0)))
-	      ((char= c *thousands-comma*))
-	      (t
-	       (be d (digit-char-p c)
-		 (cond ((not d)
-			(return nil))
-		       (decimals
-			(incf decimals)
-			(incf amount (/ d (expt 10 decimals))))
-		       (t
-			(setf amount (+ d (* amount 10))))))))
+               (if decimals
+                   (return nil)
+                   (setf decimals 0)))
+              ((char= c *thousands-comma*))
+              (t
+               (be d (digit-char-p c)
+                 (cond ((not d)
+                        (return nil))
+                       (decimals
+                        (incf decimals)
+                        (incf amount (/ d (expt 10 decimals))))
+                       (t
+                        (setf amount (+ d (* amount 10))))))))
      finally (return (if negative
-			 (- amount)
-			 amount))))
+                         (- amount)
+                         amount))))
 
 (defmacro with-package (name &body body)
   `(let ((*package* (find-package ,name)))
@@ -1320,22 +1320,22 @@ trailing spaces must be removed from the string in advance."
 of a byte that is most apporpriate for the magnitude of N.  A
 kilobyte is 1024 not 1000 bytes, everything follows."
   (let* ((kilo 1024)
-	 (mega (* kilo kilo))
-	 (giga (* kilo mega))
-	 (tera (* mega mega))
-	 (peta (* kilo tera)))
+         (mega (* kilo kilo))
+         (giga (* kilo mega))
+         (tera (* mega mega))
+         (peta (* kilo tera)))
     (apply #'format nil "~,1F~A"
-	   (cond ((> n (* 2 peta))
-		  (list (/ n peta) (if imply-bytes "P" "PB")))
-		 ((> n (* 2 tera))
-		  (list (/ n tera) (if imply-bytes "T" "TB")))
-		 ((> n (* 2 giga))
-		  (list (/ n giga) (if imply-bytes "G" "GB")))
-		 ((> n (* 2 mega))
-		  (list (/ n mega) (if imply-bytes "M" "MB")))
-		 ((> n (* 2 kilo))
-		  (list (/ n kilo) (if imply-bytes "K" "KB")))
-		 (t (list n (if imply-bytes "" " bytes")))))))
+           (cond ((> n (* 2 peta))
+                  (list (/ n peta) (if imply-bytes "P" "PB")))
+                 ((> n (* 2 tera))
+                  (list (/ n tera) (if imply-bytes "T" "TB")))
+                 ((> n (* 2 giga))
+                  (list (/ n giga) (if imply-bytes "G" "GB")))
+                 ((> n (* 2 mega))
+                  (list (/ n mega) (if imply-bytes "M" "MB")))
+                 ((> n (* 2 kilo))
+                  (list (/ n kilo) (if imply-bytes "K" "KB")))
+                 (t (list n (if imply-bytes "" " bytes")))))))
 
 ;; WARNING: This function may or may not work on your Lisp system.  It
 ;; all depends on how the OPEN function has been implemented regarding
@@ -1368,31 +1368,31 @@ prevent the inadvertent immediate removal of any newly created
 lock file by another program."
   (be locked '()
     (flet ((lock (file)
-	     (when (and expiration
-			(> (get-universal-time)
-			   (+ (file-write-date file) expiration)))
-	       (delete-file file)
-	       (when suspend
-		 (sleep suspend)))
-	     (do ((i 0 (1+ i))
-		  (done nil))
-		 (done)
-	       (unless (or (not retries)
-			   (< i retries))
-		 (error "Can't create lock file ~S: tried ~A time~:P." file retries))
-	       (with-open-file (out file :direction :output :if-exists nil)
-		 (cond (out
-			(format out "Lock file created on ~A~%" (time-string (get-universal-time)))
-			(setf done t))
-		       (sleep-time
-			(sleep sleep-time)))))))
+             (when (and expiration
+                        (> (get-universal-time)
+                           (+ (file-write-date file) expiration)))
+               (delete-file file)
+               (when suspend
+                 (sleep suspend)))
+             (do ((i 0 (1+ i))
+                  (done nil))
+                 (done)
+               (unless (or (not retries)
+                           (< i retries))
+                 (error "Can't create lock file ~S: tried ~A time~:P." file retries))
+               (with-open-file (out file :direction :output :if-exists nil)
+                 (cond (out
+                        (format out "Lock file created on ~A~%" (time-string (get-universal-time)))
+                        (setf done t))
+                       (sleep-time
+                        (sleep sleep-time)))))))
       (unwind-protect
-	   (progn
-	     (dolist (file pathnames)
-	       (lock file)
-	       (push file locked))
-	     (setf locked '()))
-	(mapc #'delete-file locked)))))
+           (progn
+             (dolist (file pathnames)
+               (lock file)
+               (push file locked))
+             (setf locked '()))
+        (mapc #'delete-file locked)))))
 
 (defmacro with-lock-files ((lock-files &rest lock-args) &body body)
   "Execute BODY after creating LOCK-FILES.  Remove the lock files
@@ -1401,7 +1401,7 @@ on exit.  LOCK-ARGS are passed to MAKE-LOCK-FILES."
     `(be ,files (list ,@lock-files)
        (make-lock-files ,files ,@lock-args)
        (unwind-protect (progn ,@body)
-	 (mapc #'delete-file ,files)))))
+         (mapc #'delete-file ,files)))))
 
 (defun getpid ()
   #+cmu (unix:unix-getpid)
@@ -1416,11 +1416,11 @@ This does _not_ stop the error from propagating."
   (be done-p (gensym)
     `(be ,done-p nil
        (unwind-protect
-	    (prog1
-		,form
-	      (setf ,done-p t))
-	 (unless ,done-p
-	   ,@error-forms)))))
+            (prog1
+                ,form
+              (setf ,done-p t))
+         (unless ,done-p
+           ,@error-forms)))))
 
 (defun floor-to (x aim)
   "Round X down to the nearest multiple of AIM."
@@ -1446,11 +1446,11 @@ This does _not_ stop the error from propagating."
 
 (defmethod queue-append ((queue queue) (objects list))
   (cond ((null (queue-first queue))
-	 (setf (queue-first queue) objects
-	       (queue-last queue) (last objects)))
-	(t
-	 (setf (cdr (queue-last queue)) objects
-	       (queue-last queue) (last objects))))
+         (setf (queue-first queue) objects
+               (queue-last queue) (last objects)))
+        (t
+         (setf (cdr (queue-last queue)) objects
+               (queue-last queue) (last objects))))
   queue)
 
 (defmethod queue-append ((queue queue) object)
@@ -1479,30 +1479,30 @@ don't get garbage collected.  It may work for your own code, though.
 Locked packages are left alone.  If you need to do those too, unlock
 them first."
   (flet ((forget (symbol)
-	   (dolist (type '(compiler-macro function method-combination setf structure type variable))
-	     (when (ignore-errors (documentation symbol type))
-	       (setf (documentation symbol type) nil)))))
+           (dolist (type '(compiler-macro function method-combination setf structure type variable))
+             (when (ignore-errors (documentation symbol type))
+               (setf (documentation symbol type) nil)))))
     (setf packages (mapcar #'(lambda (pkg)
-			       (if (packagep pkg)
-				   (package-name pkg)
-				   (package-name (find-package pkg))))
-			   packages))
+                               (if (packagep pkg)
+                                   (package-name pkg)
+                                   (package-name (find-package pkg))))
+                           packages))
     (setf packages
-	  ;; don't try to modify locked packages
-	  (remove-if #'package-locked-p
-		     (mapcar #'find-package
-			     (or packages
-				 (list-all-packages)))))
+          ;; don't try to modify locked packages
+          (remove-if #'package-locked-p
+                     (mapcar #'find-package
+                             (or packages
+                                 (list-all-packages)))))
     (dolist (package packages)
       (with-package-iterator (next package :internal :external)
-	(loop
-	   (multiple-value-bind (more? symbol) (next)
-	     (unless more?
-	       (return))
-	     (forget symbol)))))
+        (loop
+           (multiple-value-bind (more? symbol) (next)
+             (unless more?
+               (return))
+             (forget symbol)))))
     #+(OR) (do-all-symbols (symbol)
-	     (when (member (symbol-package symbol) packages)
-	       (forget symbol))))
+             (when (member (symbol-package symbol) packages)
+               (forget symbol))))
   (values))
 
 (defun load-compiled (pathname &optional compiled-pathname)
@@ -1513,13 +1513,13 @@ the compiled version is more recent than its source."
     (setf pathname (merge-pathnames pathname (make-pathname :type "lisp"))))
   (if (probe-file pathname)
       (progn
-	(setf compiled-pathname (or compiled-pathname
-				    (compile-file-pathname pathname)))
-	(when (or (not (probe-file compiled-pathname))
-		  (< (file-write-date compiled-pathname)
-		     (file-write-date pathname)))
-	  (compile-file pathname))
-	(load compiled-pathname))
+        (setf compiled-pathname (or compiled-pathname
+                                    (compile-file-pathname pathname)))
+        (when (or (not (probe-file compiled-pathname))
+                  (< (file-write-date compiled-pathname)
+                     (file-write-date pathname)))
+          (compile-file pathname))
+        (load compiled-pathname))
       (error "Can't load ~A as it doesn't exist." pathname)))
 
 ;; Just a silly mnemonic for those used to lesser languages
@@ -1535,14 +1535,14 @@ also specify forms, not just variables."
   (let ((*print-pretty* nil))
     `(let ((*print-circle* t))
        (format t ,(format nil "~~&~{~A=~~:W~~%~}" things)
-	       ,@things)
+               ,@things)
        (finish-output)
        (values))))
 
 (defmacro memoize-function (name &key test)
   "Make function NAME memoized.  TEST is passed to MAKE-HASH-TABLE."
   `(setf (get ',name 'results-hash-table)
-	 (make-hash-table ,@(when test (list :test test)))))
+         (make-hash-table ,@(when test (list :test test)))))
 
 (defmacro defun-memoized (name args &body forms)
   "Define function NAME and make it memoizable.  Then the MEMOIZED
@@ -1560,13 +1560,13 @@ memoized.  The next time this form is executed with the same argument
 value, the memoized result is returned instead of executing FUNCTION."
   (with-gensyms (table key result not-found)
     `(be* ,key ,arg
-	  ,table (get ',function 'results-hash-table)
-	  ,not-found (list nil)
-	  ,result (gethash ,key ,table ,not-found)
+          ,table (get ',function 'results-hash-table)
+          ,not-found (list nil)
+          ,result (gethash ,key ,table ,not-found)
        (if (eq ,not-found ,result)
-	   (setf (gethash ,key ,table)
-		 (,function ,key))
-	   ,result))))
+           (setf (gethash ,key ,table)
+                 (,function ,key))
+           ,result))))
 
 
 (defmacro save-file-excursion ((stream &optional position) &body forms)
@@ -1587,9 +1587,9 @@ before FORMS.  Optionally POSITION can be set to the starting offset."
 (defun getenv (var)
   "Return the string associate to VAR in the system environment."
   #+cmu (cdr (assoc (if (symbolp var)
-			var
-			(intern var :keyword))
-		    ext:*environment-list*))
+                        var
+                        (intern var :keyword))
+                    ext:*environment-list*))
   #+sbcl (sb-ext:posix-getenv (string var))
   #+lispworks (hcl:getenv var)
   #+clisp (ext:getenv (string var))
@@ -1597,16 +1597,16 @@ before FORMS.  Optionally POSITION can be set to the starting offset."
   (error "GETENV not implemented for your Lisp system."))
 
 #+clisp (ffi:def-call-out %setenv
-	    (:name "setenv")
-	  (:arguments (name ffi:c-string) (value ffi:c-string) (overwrite ffi:int))
-	  (:return-type ffi:int)
-	  (:library "libc.so"))
+            (:name "setenv")
+          (:arguments (name ffi:c-string) (value ffi:c-string) (overwrite ffi:int))
+          (:return-type ffi:int)
+          (:library "libc.so"))
 
 #+clisp (ffi:def-call-out %unsetenv
-	    (:name "unsetenv")
-	  (:arguments (name ffi:c-string))
-	  (:return-type ffi:int)
-	  (:library "libc.so"))
+            (:name "unsetenv")
+          (:arguments (name ffi:c-string))
+          (:return-type ffi:int)
+          (:library "libc.so"))
 
 (defun setenv (name value &optional (overwrite t))
   (typecase value
@@ -1616,30 +1616,30 @@ before FORMS.  Optionally POSITION can be set to the starting offset."
     (t
      (setf value (format nil "~A" value))))
   #+sbcl (unless (zerop (sb-posix:setenv name value (if overwrite 1 0)))
-	   (error "unable to setenv ~A: errno=~A." name
-		  (sb-alien:get-errno)))
+           (error "unable to setenv ~A: errno=~A." name
+                  (sb-alien:get-errno)))
   #+cmu (be key (keywordify name)
-	  (aif (assoc key
-		      ext:*environment-list*)
-	       (when overwrite
-		 (setf (cdr it) value))
-	       (setf ext:*environment-list*
-		     (cons (cons key value)
-			   ext:*environment-list*))))
+          (aif (assoc key
+                      ext:*environment-list*)
+               (when overwrite
+                 (setf (cdr it) value))
+               (setf ext:*environment-list*
+                     (cons (cons key value)
+                           ext:*environment-list*))))
   #-(or cmu sbcl) (unless (zerop (%setenv name value (if overwrite 1 0)))
-		    (error "unable to setenv ~A." name)))
+                    (error "unable to setenv ~A." name)))
 
 (defun unsetenv (name)
   #+sbcl (unless (zerop (sb-posix:unsetenv name))
-	   (error "unable to unsetenv ~A: errno=~A." name
-		  (sb-alien:get-errno)))
+           (error "unable to unsetenv ~A: errno=~A." name
+                  (sb-alien:get-errno)))
   #+cmu (be key (keywordify name)
-	  (setf ext:*environment-list*
-		(delete-if #'(lambda (e)
-			       (eq (car e) key))
-			   ext:*environment-list*)))
+          (setf ext:*environment-list*
+                (delete-if #'(lambda (e)
+                               (eq (car e) key))
+                           ext:*environment-list*)))
   #-(or cmu sbcl) (unless (zerop (%unsetenv name))
-		    (error "unable to unsetenv ~A." name)))
+                    (error "unable to unsetenv ~A." name)))
 
 (defun (setf getenv) (value name)
   (if value
@@ -1650,38 +1650,38 @@ before FORMS.  Optionally POSITION can be set to the starting offset."
 #-cmu
 (defmacro with-system-environment ((&rest var-and-values) &body body)
   (be gensym-alist (mapcar #'(lambda (vv)
-			       (list (gensym) (string (car vv)) (cadr vv)))
-			   var-and-values)
+                               (list (gensym) (string (car vv)) (cadr vv)))
+                           var-and-values)
       `(let ,(mapcar #'(lambda (vv)
-			 (destructuring-bind (varsym var value) vv
-			   (declare (ignore value))
-			   `(,varsym (getenv ,var))))
-		     gensym-alist)
-	 (unwind-protect
-	      (progn
-		,@(mapcar #'(lambda (vv)
-			      (destructuring-bind (varsym var value) vv
-				(declare (ignore varsym))
-				`(setenv ,var ,value)))
-			  gensym-alist)
-		,@body)
-	   ,@(mapcar #'(lambda (vv)
-			 (destructuring-bind (varsym var value) vv
-			   (declare (ignore value))
-			   `(if ,varsym
-				(setenv ,var ,varsym)
-				(unsetenv ,var))))
-		     gensym-alist)))))
+                         (destructuring-bind (varsym var value) vv
+                           (declare (ignore value))
+                           `(,varsym (getenv ,var))))
+                     gensym-alist)
+         (unwind-protect
+              (progn
+                ,@(mapcar #'(lambda (vv)
+                              (destructuring-bind (varsym var value) vv
+                                (declare (ignore varsym))
+                                `(setenv ,var ,value)))
+                          gensym-alist)
+                ,@body)
+           ,@(mapcar #'(lambda (vv)
+                         (destructuring-bind (varsym var value) vv
+                           (declare (ignore value))
+                           `(if ,varsym
+                                (setenv ,var ,varsym)
+                                (unsetenv ,var))))
+                     gensym-alist)))))
 
 #+cmu
 (defmacro with-system-environment ((&rest var-and-values) &body body)
   `(let ((ext:*environment-list*
-	  (append (list ,@(mapcar #'(lambda (vv)
-				      (destructuring-bind (variable value) vv
-					`(cons ,(keywordify variable)
-					       ,value)))
-				  var-and-values))
-		  ext:*environment-list*)))
+          (append (list ,@(mapcar #'(lambda (vv)
+                                      (destructuring-bind (variable value) vv
+                                        `(cons ,(keywordify variable)
+                                               ,value)))
+                                  var-and-values))
+                  ext:*environment-list*)))
      ,@body))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -1693,7 +1693,7 @@ before FORMS.  Optionally POSITION can be set to the starting offset."
      for l2 = (member item l :key key :test test)
      while l2
      do (setf result l2
-	      l (cdr l2))
+              l (cdr l2))
      finally (return result)))
 
 
@@ -1705,13 +1705,13 @@ before FORMS.  Optionally POSITION can be set to the starting offset."
     (loop
        for i from 0 below (length string)
        do (be c (char string i)
-	    (cond ((char= c #\\)
-		   (setf c (char string (incf i))))
-		  ((find c  ".+()|^$")
-		   (write-char #\\ out))
-		  ((char= c #\*)
-		   (write-char #\. out))
-		  ((char= c #\?)
-		   (setf c #\.)))
-	    (write-char c out)))
+            (cond ((char= c #\\)
+                   (setf c (char string (incf i))))
+                  ((find c  ".+()|^$")
+                   (write-char #\\ out))
+                  ((char= c #\*)
+                   (write-char #\. out))
+                  ((char= c #\?)
+                   (setf c #\.)))
+            (write-char c out)))
     (write-char #\$ out)))