X-Git-Url: http://git.kpe.io/?p=kmrcl.git;a=blobdiff_plain;f=strings.lisp;h=1178b5d5426e24c727f804de200625d6d3e4ed02;hp=bc5f4bde8c178e0ae257d025dc12509bdfa9da1f;hb=03712fbb06acbb103602bae10f41aeae7fa05127;hpb=739b14ee8844dc777b174105646df3abcb865282

diff --git a/strings.lisp b/strings.lisp
index bc5f4bd..1178b5d 100644
--- a/strings.lisp
+++ b/strings.lisp
@@ -30,24 +30,24 @@
 
 (defun count-string-words (str)
   (declare (simple-string str)
-	   (optimize (speed 3) (safety 0) (space 0)))
+           (optimize (speed 3) (safety 0) (space 0)))
   (let ((n-words 0)
-	(in-word nil))
+        (in-word nil))
     (declare (fixnum n-words))
     (do* ((len (length str))
-	  (i 0 (1+ i)))
-	((= i len) n-words)
+          (i 0 (1+ i)))
+        ((= i len) n-words)
       (declare (fixnum i))
       (if (alphanumericp (schar str i))
-	  (unless in-word
-	    (incf n-words)
-	    (setq in-word t))
-	(setq in-word nil)))))
+          (unless in-word
+            (incf n-words)
+            (setq in-word t))
+        (setq in-word nil)))))
 
 ;; From Larry Hunter with modifications
 (defun position-char (char string start max)
   (declare (optimize (speed 3) (safety 0) (space 0))
-	   (fixnum start max) (simple-string string))
+           (fixnum start max) (simple-string string))
   (do* ((i start (1+ i)))
        ((= i max) nil)
     (declare (fixnum i))
@@ -55,31 +55,31 @@
 
 (defun position-not-char (char string start max)
   (declare (optimize (speed 3) (safety 0) (space 0))
-	   (fixnum start max) (simple-string string))
+           (fixnum start max) (simple-string string))
   (do* ((i start (1+ i)))
        ((= i max) nil)
     (declare (fixnum i))
     (when (char/= char (schar string i)) (return i))))
 
 (defun delimited-string-to-list (string &optional (separator #\space)
-						  skip-terminal)
+                                                  skip-terminal)
   "split a string with delimiter"
   (declare (optimize (speed 3) (safety 0) (space 0) (compilation-speed 0))
-	   (type string string)
-	   (type character separator))
+           (type string string)
+           (type character separator))
   (do* ((len (length string))
-	(output '())
-	(pos 0)
-	(end (position-char separator string pos len)
-	     (position-char separator string pos len)))
+        (output '())
+        (pos 0)
+        (end (position-char separator string pos len)
+             (position-char separator string pos len)))
        ((null end)
-	(if (< pos len)
-	    (push (subseq string pos) output)
-	    (when (or (not skip-terminal) (zerop len))
-	      (push "" output)))
-	(nreverse output))
+        (if (< pos len)
+            (push (subseq string pos) output)
+            (when (or (not skip-terminal) (zerop len))
+              (push "" output)))
+        (nreverse output))
     (declare (type fixnum pos len)
-	     (type (or null fixnum) end))
+             (type (or null fixnum) end))
     (push (subseq string pos end) output)
     (setq pos (1+ end))))
 
@@ -94,10 +94,10 @@
   (let ((up nil) (down nil))
     (block skip
       (loop for char of-type character across str do
-	    (cond ((upper-case-p char)
-		   (if down (return-from skip str) (setf up t)))
-		  ((lower-case-p char)
-		   (if up   (return-from skip str) (setf down t)))))
+            (cond ((upper-case-p char)
+                   (if down (return-from skip str) (setf up t)))
+                  ((lower-case-p char)
+                   (if up   (return-from skip str) (setf down t)))))
       (if up (string-downcase str) (string-upcase str)))))
 
 (defun add-sql-quotes (s)
@@ -113,38 +113,38 @@
 (defun string-substitute (string substring replacement-string)
   "String substitute by Larry Hunter. Obtained from Google"
   (let ((substring-length (length substring))
-	(last-end 0)
-	(new-string ""))
+        (last-end 0)
+        (new-string ""))
     (do ((next-start
-	  (search substring string)
-	  (search substring string :start2 last-end)))
-	((null next-start)
-	 (concatenate 'string new-string (subseq string last-end)))
+          (search substring string)
+          (search substring string :start2 last-end)))
+        ((null next-start)
+         (concatenate 'string new-string (subseq string last-end)))
       (setq new-string
-	(concatenate 'string
-	  new-string
-	  (subseq string last-end next-start)
-	  replacement-string))
+        (concatenate 'string
+          new-string
+          (subseq string last-end next-start)
+          replacement-string))
       (setq last-end (+ next-start substring-length)))))
 
 (defun string-trim-last-character (s)
   "Return the string less the last character"
   (let ((len (length s)))
     (if (plusp len)
-	(subseq s 0 (1- len))
-	s)))
+        (subseq s 0 (1- len))
+        s)))
 
 (defun nstring-trim-last-character (s)
   "Return the string less the last character"
   (let ((len (length s)))
     (if (plusp len)
-	(nsubseq s 0 (1- len))
-	s)))
+        (nsubseq s 0 (1- len))
+        s)))
 
 (defun string-hash (str &optional (bitmask 65535))
   (let ((hash 0))
     (declare (fixnum hash)
-	     (simple-string str))
+             (simple-string str))
     (dotimes (i (length str))
       (declare (fixnum i))
       (setq hash (+ hash (char-code (char str i)))))
@@ -154,8 +154,8 @@
   (zerop (length str)))
 
 (defvar *whitespace-chars* '(#\space #\tab #\return #\linefeed
-			     #+allegro #\%space
-			     #+lispworks #\No-Break-Space))
+                             #+allegro #\%space
+                             #+lispworks #\No-Break-Space))
 
 (defun is-char-whitespace (c)
   (declare (character c) (optimize (speed 3) (safety 0)))
@@ -179,46 +179,46 @@
 
 (defun replaced-string-length (str repl-alist)
   (declare (simple-string str)
-	   (optimize (speed 3) (safety 0) (space 0)))
+           (optimize (speed 3) (safety 0) (space 0)))
     (do* ((i 0 (1+ i))
-	  (orig-len (length str))
-	  (new-len orig-len))
-	 ((= i orig-len) new-len)
+          (orig-len (length str))
+          (new-len orig-len))
+         ((= i orig-len) new-len)
       (declare (fixnum i orig-len new-len))
       (let* ((c (char str i))
-	     (match (assoc c repl-alist :test #'char=)))
-	(declare (character c))
-	(when match
-	  (incf new-len (1- (length
-			     (the simple-string (cdr match)))))))))
+             (match (assoc c repl-alist :test #'char=)))
+        (declare (character c))
+        (when match
+          (incf new-len (1- (length
+                             (the simple-string (cdr match)))))))))
 
 (defun substitute-chars-strings (str repl-alist)
   "Replace all instances of a chars with a string. repl-alist is an assoc
 list of characters and replacement strings."
   (declare (simple-string str)
-	   (optimize (speed 3) (safety 0) (space 0)))
+           (optimize (speed 3) (safety 0) (space 0)))
   (do* ((orig-len (length str))
-	(new-string (make-string (replaced-string-length str repl-alist)))
-	(spos 0 (1+ spos))
-	(dpos 0))
+        (new-string (make-string (replaced-string-length str repl-alist)))
+        (spos 0 (1+ spos))
+        (dpos 0))
       ((>= spos orig-len)
        new-string)
     (declare (fixnum spos dpos) (simple-string new-string))
     (let* ((c (char str spos))
-	   (match (assoc c repl-alist :test #'char=)))
+           (match (assoc c repl-alist :test #'char=)))
       (declare (character c))
       (if match
-	  (let* ((subst (cdr match))
-		 (len (length subst)))
-	    (declare (fixnum len)
-		     (simple-string subst))
-	    (dotimes (j len)
-	      (declare (fixnum j))
-	      (setf (char new-string dpos) (char subst j))
-	      (incf dpos)))
-	(progn
-	  (setf (char new-string dpos) c)
-	  (incf dpos))))))
+          (let* ((subst (cdr match))
+                 (len (length subst)))
+            (declare (fixnum len)
+                     (simple-string subst))
+            (dotimes (j len)
+              (declare (fixnum j))
+              (setf (char new-string dpos) (char subst j))
+              (incf dpos)))
+        (progn
+          (setf (char new-string dpos) c)
+          (incf dpos))))))
 
 (defun escape-xml-string (string)
   "Escape invalid XML characters"
@@ -229,53 +229,53 @@ list of characters and replacement strings."
 
 (defun usb8-array-to-string (vec &key (start 0) end)
   (declare (type (simple-array (unsigned-byte 8) (*)) vec)
-	   (fixnum start))
+           (fixnum start))
   (unless end
     (setq end (length vec)))
   (let* ((len (- end start))
-	 (str (make-string len)))
+         (str (make-string len)))
     (declare (fixnum len)
-	     (simple-string str)
-	     (optimize (speed 3) (safety 0)))
+             (simple-string str)
+             (optimize (speed 3) (safety 0)))
     (do ((i 0 (1+ i)))
-	((= i len) str)
+        ((= i len) str)
       (declare (fixnum i))
       (setf (schar str i) (code-char (aref vec (the fixnum (+ i start))))))))
 
 (defun string-to-usb8-array (str)
   (declare (simple-string str))
   (let* ((len (length str))
-	 (vec (make-usb8-array len)))
+         (vec (make-usb8-array len)))
     (declare (fixnum len)
-	     (type (simple-array (unsigned-byte 8) (*)) vec)
-	     (optimize (speed 3)))
+             (type (simple-array (unsigned-byte 8) (*)) vec)
+             (optimize (speed 3)))
     (do ((i 0 (1+ i)))
-	((= i len) vec)
+        ((= i len) vec)
       (declare (fixnum i))
       (setf (aref vec i) (char-code (schar str i))))))
 
 (defun concat-separated-strings (separator &rest lists)
   (format nil (concatenate 'string "~{~A~^" (string separator) "~}")
-	  (append-sublists lists)))
+          (append-sublists lists)))
 
 (defun only-null-list-elements-p (lst)
   (or (null lst) (every #'null lst)))
 
 (defun print-separated-strings (strm separator &rest lists)
   (declare (optimize (speed 3) (safety 0) (space 0) (debug 0)
-		     (compilation-speed 0)))
+                     (compilation-speed 0)))
   (do* ((rest-lists lists (cdr rest-lists))
-	(list (car rest-lists) (car rest-lists))
-	(last-list (only-null-list-elements-p (cdr rest-lists))
-		   (only-null-list-elements-p (cdr rest-lists))))
+        (list (car rest-lists) (car rest-lists))
+        (last-list (only-null-list-elements-p (cdr rest-lists))
+                   (only-null-list-elements-p (cdr rest-lists))))
        ((null rest-lists) strm)
     (do* ((lst list (cdr lst))
-	  (elem (car lst) (car lst))
-	  (last-elem (null (cdr lst)) (null (cdr lst))))
-	 ((null lst))
+          (elem (car lst) (car lst))
+          (last-elem (null (cdr lst)) (null (cdr lst))))
+         ((null lst))
       (write-string elem strm)
       (unless (and last-elem last-list)
-	(write-string separator strm)))))
+        (write-string separator strm)))))
 
 (eval-when (:compile-toplevel :load-toplevel :execute)
   (defmacro def-prefixed-number-string (fn-name type &optional doc)
@@ -298,7 +298,7 @@ list of characters and replacement strings."
             (setf (schar result 0) pchar))
           (when minus? (setf (schar result (if pchar 1 0)) #\-))
           result)
-       (declare (,type val) 
+       (declare (,type val)
                 (fixnum mod zero-code pos)
                 (boolean minus?)
                 (simple-string result))
@@ -316,15 +316,15 @@ Leading zeros are present. LEN must be an integer.")
   "Outputs a string of LEN digit with an optional initial character PCHAR.
 Leading zeros are present."
   (declare (optimize (speed 3) (safety 0) (space 0))
-	   (type fixnum len)
-	   (type integer num))
+           (type fixnum len)
+           (type integer num))
   (do* ((zero-code (char-code #\0))
-	(result (make-string len :initial-element #\0))
-	(minus? (minusp num))
-	(val (if minus? (- 0 num) num)
-	     (nth-value 0 (floor val 10)))
-	(pos (1- len) (1- pos))
-	(mod (mod val 10) (mod val 10)))
+        (result (make-string len :initial-element #\0))
+        (minus? (minusp num))
+        (val (if minus? (- 0 num) num)
+             (nth-value 0 (floor val 10)))
+        (pos (1- len) (1- pos))
+        (mod (mod val 10) (mod val 10)))
       ((or (zerop val) (minusp pos))
        (when minus? (setf (schar result 0) #\-))
        result)
@@ -334,55 +334,55 @@ Leading zeros are present."
 (defun fast-string-search (substr str substr-length startpos endpos)
   "Optimized search for a substring in a simple-string"
   (declare (simple-string substr str)
-	   (fixnum substr-length startpos endpos)
-	   (optimize (speed 3) (space 0) (safety 0)))
+           (fixnum substr-length startpos endpos)
+           (optimize (speed 3) (space 0) (safety 0)))
   (do* ((pos startpos (1+ pos))
-	(lastpos (- endpos substr-length)))
+        (lastpos (- endpos substr-length)))
        ((> pos lastpos) nil)
     (declare (fixnum pos lastpos))
     (do ((i 0 (1+ i)))
-	((= i substr-length)
-	 (return-from fast-string-search pos))
+        ((= i substr-length)
+         (return-from fast-string-search pos))
       (declare (fixnum i))
       (unless (char= (schar str (+ i pos)) (schar substr i))
-	(return nil)))))
+        (return nil)))))
 
 (defun string-delimited-string-to-list (str substr)
   "splits a string delimited by substr into a list of strings"
   (declare (simple-string str substr)
-	   (optimize (speed 3) (safety 0) (space 0) (compilation-speed 0)
-		     (debug 0)))
+           (optimize (speed 3) (safety 0) (space 0) (compilation-speed 0)
+                     (debug 0)))
   (do* ((substr-len (length substr))
-	(strlen (length str))
-	(output '())
-	(pos 0)
-	(end (fast-string-search substr str substr-len pos strlen)
-	     (fast-string-search substr str substr-len pos strlen)))
+        (strlen (length str))
+        (output '())
+        (pos 0)
+        (end (fast-string-search substr str substr-len pos strlen)
+             (fast-string-search substr str substr-len pos strlen)))
        ((null end)
-	(when (< pos strlen)
-	  (push (subseq str pos) output))
-	(nreverse output))
+        (when (< pos strlen)
+          (push (subseq str pos) output))
+        (nreverse output))
     (declare (fixnum strlen substr-len pos)
-	     (type (or fixnum null) end))
+             (type (or fixnum null) end))
     (push (subseq str pos end) output)
     (setq pos (+ end substr-len))))
 
 (defun string-to-list-skip-delimiter (str &optional (delim #\space))
   "Return a list of strings, delimited by spaces, skipping spaces."
   (declare (simple-string str)
-	   (optimize (speed 0) (space 0) (safety 0)))
+           (optimize (speed 0) (space 0) (safety 0)))
   (do* ((results '())
-	(end (length str))
-	(i (position-not-char delim str 0 end)
-	   (position-not-char delim str j end))
-	(j (when i (position-char delim str i end))
-	   (when i (position-char delim str i end))))
+        (end (length str))
+        (i (position-not-char delim str 0 end)
+           (position-not-char delim str j end))
+        (j (when i (position-char delim str i end))
+           (when i (position-char delim str i end))))
        ((or (null i) (null j))
-	(when (and i (< i end))
-	  (push (subseq str i end) results))
-	(nreverse results))
+        (when (and i (< i end))
+          (push (subseq str i end) results))
+        (nreverse results))
     (declare (fixnum end)
-	     (type (or fixnum null) i j))
+             (type (or fixnum null) i j))
     (push (subseq str i j) results)))
 
 (defun string-starts-with (start str)
@@ -392,8 +392,8 @@ Leading zeros are present."
 (defun count-string-char (s c)
   "Return a count of the number of times a character appears in a string"
   (declare (simple-string s)
-	   (character c)
-	   (optimize (speed 3) (safety 0)))
+           (character c)
+           (optimize (speed 3) (safety 0)))
   (do ((len (length s))
        (i 0 (1+ i))
        (count 0))
@@ -406,8 +406,8 @@ Leading zeros are present."
   "Return a count of the number of times a predicate is true
 for characters in a string"
   (declare (simple-string s)
-	   (type (or function symbol) pred)
-	   (optimize (speed 3) (safety 0) (space 0)))
+           (type (or function symbol) pred)
+           (optimize (speed 3) (safety 0) (space 0)))
   (do ((len (length s))
        (i 0 (1+ i))
        (count 0))
@@ -433,15 +433,15 @@ for characters in a string"
 (defconstant* +char-code-upper-a+ (char-code #\A))
 (defconstant* +char-code-0+ (char-code #\0))
 (declaim (type fixnum +char-code-0+ +char-code-upper-a+
-	       +char-code-0))
+               +char-code-0))
 
 (defun charhex (ch)
   "convert hex character to decimal"
   (let ((code (char-code (char-upcase ch))))
     (declare (fixnum ch))
     (if (>= code +char-code-upper-a+)
-	(+ 10 (- code +char-code-upper-a+))
-	(- code +char-code-0+))))
+        (+ 10 (- code +char-code-upper-a+))
+        (- code +char-code-0+))))
 
 (defun binary-sequence-to-hex-string (seq)
   (let ((list (etypecase seq
@@ -452,48 +452,48 @@ for characters in a string"
 (defun encode-uri-string (query)
   "Escape non-alphanumeric characters for URI fields"
   (declare (simple-string query)
-	   (optimize (speed 3) (safety 0) (space 0)))
+           (optimize (speed 3) (safety 0) (space 0)))
   (do* ((count (count-string-char-if #'non-alphanumericp query))
-	(len (length query))
-	(new-len (+ len (* 2 count)))
-	(str (make-string new-len))
-	(spos 0 (1+ spos))
-	(dpos 0 (1+ dpos)))
+        (len (length query))
+        (new-len (+ len (* 2 count)))
+        (str (make-string new-len))
+        (spos 0 (1+ spos))
+        (dpos 0 (1+ dpos)))
       ((= spos len) str)
     (declare (fixnum count len new-len spos dpos)
-	     (simple-string str))
+             (simple-string str))
     (let ((ch (schar query spos)))
       (if (non-alphanumericp ch)
-	  (let ((c (char-code ch)))
-	    (setf (schar str dpos) #\%)
-	    (incf dpos)
-	    (setf (schar str dpos) (hexchar (logand (ash c -4) 15)))
-	    (incf dpos)
-	    (setf (schar str dpos) (hexchar (logand c 15))))
-	(setf (schar str dpos) ch)))))
+          (let ((c (char-code ch)))
+            (setf (schar str dpos) #\%)
+            (incf dpos)
+            (setf (schar str dpos) (hexchar (logand (ash c -4) 15)))
+            (incf dpos)
+            (setf (schar str dpos) (hexchar (logand c 15))))
+        (setf (schar str dpos) ch)))))
 
 (defun decode-uri-string (query)
   "Unescape non-alphanumeric characters for URI fields"
   (declare (simple-string query)
-	   (optimize (speed 3) (safety 0) (space 0)))
+           (optimize (speed 3) (safety 0) (space 0)))
   (do* ((count (count-string-char query #\%))
-	(len (length query))
-	(new-len (- len (* 2 count)))
-	(str (make-string new-len))
-	(spos 0 (1+ spos))
-	(dpos 0 (1+ dpos)))
+        (len (length query))
+        (new-len (- len (* 2 count)))
+        (str (make-string new-len))
+        (spos 0 (1+ spos))
+        (dpos 0 (1+ dpos)))
       ((= spos len) str)
     (declare (fixnum count len new-len spos dpos)
-	     (simple-string str))
+             (simple-string str))
     (let ((ch (schar query spos)))
       (if (char= #\% ch)
-	  (let ((c1 (charhex (schar query (1+ spos))))
-		(c2 (charhex (schar query (+ spos 2)))))
-	    (declare (fixnum c1 c2))
-	    (setf (schar str dpos)
-		  (code-char (logior c2 (ash c1 4))))
-	    (incf spos 2))
-	(setf (schar str dpos) ch)))))
+          (let ((c1 (charhex (schar query (1+ spos))))
+                (c2 (charhex (schar query (+ spos 2)))))
+            (declare (fixnum c1 c2))
+            (setf (schar str dpos)
+                  (code-char (logior c2 (ash c1 4))))
+            (incf spos 2))
+        (setf (schar str dpos) ch)))))
 
 
 (defun uri-query-to-alist (query)
@@ -516,8 +516,8 @@ for characters in a string"
     (:lower-alphanumeric
      (let ((n (random 36)))
        (if (>= n 26)
-	   (code-char (+ +char-code-0+ (- n 26)))
-	 (code-char (+ +char-code-lower-a+ n)))))
+           (code-char (+ +char-code-0+ (- n 26)))
+         (code-char (+ +char-code-lower-a+ n)))))
     (:upper-alpha
      (code-char (+ +char-code-upper-a+ (random 26))))
     (:unambiguous
@@ -525,8 +525,8 @@ for characters in a string"
     (:upper-lower-alpha
      (let ((n (random 52)))
        (if (>= n 26)
-	   (code-char (+ +char-code-upper-a+ (- n 26)))
-	 (code-char (+ +char-code-lower-a+ n)))))))
+           (code-char (+ +char-code-upper-a+ (- n 26)))
+         (code-char (+ +char-code-lower-a+ n)))))))
 
 
 (defun random-string (&key (length 10) (set :lower-alpha))
@@ -560,10 +560,10 @@ for characters in a string"
 (defun string-right-trim-one-char (char str)
   (declare (simple-string str))
   (let* ((len (length str))
-	 (last (1- len)))
+         (last (1- len)))
     (declare (fixnum len last))
     (if (char= char (schar str last))
-	(subseq str 0 last)
+        (subseq str 0 last)
       str)))
 
 
@@ -573,11 +573,11 @@ for characters in a string"
   (let ((len (length str)))
     (dolist (ending endings str)
       (when (and (>= len (length ending))
-		 (string-equal ending
-			       (subseq str (- len
-					      (length ending)))))
-	(return-from string-strip-ending
-	  (subseq str 0 (- len (length ending))))))))
+                 (string-equal ending
+                               (subseq str (- len
+                                              (length ending)))))
+        (return-from string-strip-ending
+          (subseq str 0 (- len (length ending))))))))
 
 
 (defun string-maybe-shorten (str maxlen)
@@ -594,9 +594,9 @@ for characters in a string"
       "...")
      ((eq position :middle)
       (multiple-value-bind (mid remain) (truncate maxlen 2)
-	(let ((end1 (- mid 1))
-	      (start2 (- len (- mid 2) remain)))
-	  (concatenate 'string (subseq str 0 end1) "..." (subseq str start2)))))
+        (let ((end1 (- mid 1))
+              (start2 (- len (- mid 2) remain)))
+          (concatenate 'string (subseq str 0 end1) "..." (subseq str start2)))))
      ((or (eq position :end) t)
       (concatenate 'string (subseq str 0 (- maxlen 3)) "...")))))
 
@@ -634,11 +634,11 @@ for characters in a string"
 (defun split-alphanumeric-string (string)
   "Separates a string at any non-alphanumeric chararacter"
   (declare (simple-string string)
-	   (optimize (speed 3) (safety 0)))
+           (optimize (speed 3) (safety 0)))
   (flet ((is-sep (char)
-	   (declare (character char))
-	   (and (non-alphanumericp char)
-		(not (char= #\_ char)))))
+           (declare (character char))
+           (and (non-alphanumericp char)
+                (not (char= #\_ char)))))
     (let ((tokens nil))
       (do* ((token-start
              (position-if-not #'is-sep string)
@@ -656,47 +656,47 @@ for characters in a string"
 (defun trim-non-alphanumeric (word)
   "Strip non-alphanumeric characters from beginning and end of a word."
   (declare (simple-string word)
-	   (optimize (speed 3) (safety 0) (space 0)))
+           (optimize (speed 3) (safety 0) (space 0)))
   (let* ((start 0)
-	 (len (length word))
-	 (end len))
+         (len (length word))
+         (end len))
     (declare (fixnum start end len))
     (do ((done nil))
-	((or done (= start end)))
+        ((or done (= start end)))
       (if (alphanumericp (schar word start))
-	  (setq done t)
-	(incf start)))
+          (setq done t)
+        (incf start)))
     (when (> end start)
       (do ((done nil))
-	  ((or done (= start end)))
-	(if (alphanumericp (schar word (1- end)))
-	    (setq done t)
-	  (decf end))))
+          ((or done (= start end)))
+        (if (alphanumericp (schar word (1- end)))
+            (setq done t)
+          (decf end))))
     (if (or (plusp start) (/= len end))
-	(subseq word start end)
+        (subseq word start end)
       word)))
 
 
 (defun collapse-whitespace (s)
   "Convert multiple whitespace characters to a single space character."
   (declare (simple-string s)
-	   (optimize (speed 3) (safety 0)))
+           (optimize (speed 3) (safety 0)))
   (with-output-to-string (stream)
     (do ((pos 0 (1+ pos))
-	 (in-white nil)
-	 (len (length s)))
-	((= pos len))
+         (in-white nil)
+         (len (length s)))
+        ((= pos len))
       (declare (fixnum pos len))
       (let ((c (schar s pos)))
-	(declare (character c))
-	(cond
-	 ((kl:is-char-whitespace c)
-	  (unless in-white
-	    (write-char #\space stream))
-	  (setq in-white t))
-	 (t
-	  (setq in-white nil)
-	  (write-char c stream)))))))
+        (declare (character c))
+        (cond
+         ((kl:is-char-whitespace c)
+          (unless in-white
+            (write-char #\space stream))
+          (setq in-white t))
+         (t
+          (setq in-white nil)
+          (write-char c stream)))))))
 
 (defun string->list (string)
   (let ((eof (list nil)))