X-Git-Url: http://git.kpe.io/?p=vcs-tree.git;a=blobdiff_plain;f=kmrcl-excerpt.lisp;h=d425d7101f683275f4ac5a2fe946ca1e3a4915c3;hp=9a74e8cda31f8417a67cd539a01eff4c28c4622c;hb=07ed07c71c97ed1741d2d7ff4d5244dcb6c70907;hpb=02bd40927e811ece487d24a7bc5a0bd50e0dc9fd

diff --git a/kmrcl-excerpt.lisp b/kmrcl-excerpt.lisp
index 9a74e8c..d425d71 100644
--- a/kmrcl-excerpt.lisp
+++ b/kmrcl-excerpt.lisp
@@ -17,10 +17,10 @@
   (let ((lines '()))
     (with-open-file (in file :direction :input)
       (let ((eof (gensym)))
-	(do ((line (read-line in nil eof)
-		   (read-line in nil eof)))
-	    ((eq line eof))
-	  (push line lines)))
+        (do ((line (read-line in nil eof)
+                   (read-line in nil eof)))
+            ((eq line eof))
+          (push line lines)))
       (nreverse lines))))
 
 
@@ -35,9 +35,9 @@
 
 (defun flatten (lis)
   (cond ((atom lis) lis)
-	((listp (car lis))
-	 (append (flatten (car lis)) (flatten (cdr lis))))
-	(t (append (list (car lis)) (flatten (cdr lis))))))
+        ((listp (car lis))
+         (append (flatten (car lis)) (flatten (cdr lis))))
+        (t (append (list (car lis)) (flatten (cdr lis))))))
 
 (defun mklist (obj)
   "Make into list if atom"
@@ -46,49 +46,49 @@
 (defun directory-tree (filename)
   "Returns a tree of pathnames for sub-directories of a directory"
   (let* ((root (canonicalize-directory-name filename))
-	 (subdirs (loop for path in (directory
-				     (make-pathname :name :wild
-						    :type :wild
-						    :defaults root))
-			when (probe-directory path)
-			collect (canonicalize-directory-name path))))
+         (subdirs (loop for path in (directory
+                                     (make-pathname :name :wild
+                                                    :type :wild
+                                                    :defaults root))
+                        when (probe-directory path)
+                        collect (canonicalize-directory-name path))))
     (when (find nil subdirs)
       (error "~A" subdirs))
     (when (null root)
       (error "~A" root))
     (if subdirs
-	(cons root (mapcar #'directory-tree subdirs))
-	(if (probe-directory root)
-	    (list root)
-	    (error "root not directory ~A" root)))))
+        (cons root (mapcar #'directory-tree subdirs))
+        (if (probe-directory root)
+            (list root)
+            (error "root not directory ~A" root)))))
 
 
 (defun canonicalize-directory-name (filename)
   (flet ((un-unspecific (value)
-	   (if (eq value :unspecific) nil value)))
+           (if (eq value :unspecific) nil value)))
     (let* ((path (pathname filename))
-	   (name (un-unspecific (pathname-name path)))
-	   (type (un-unspecific (pathname-type path)))
-	   (new-dir
-	    (cond ((and name type) (list (concatenate 'string name "." type)))
-		  (name (list name))
-		  (type (list type))
-		  (t nil))))
+           (name (un-unspecific (pathname-name path)))
+           (type (un-unspecific (pathname-type path)))
+           (new-dir
+            (cond ((and name type) (list (concatenate 'string name "." type)))
+                  (name (list name))
+                  (type (list type))
+                  (t nil))))
       (if new-dir
-	  (make-pathname
-	   :directory (append (un-unspecific (pathname-directory path))
-			      new-dir)
-		    :name nil :type nil :version nil :defaults path)
-	  path))))
+          (make-pathname
+           :directory (append (un-unspecific (pathname-directory path))
+                              new-dir)
+                    :name nil :type nil :version nil :defaults path)
+          path))))
 
 
 (defun probe-directory (filename)
   (let ((path (canonicalize-directory-name filename)))
     #+allegro (excl:probe-directory path)
     #+clisp (values
-	     (ignore-errors
-	       (#+lisp=cl ext:probe-directory #-lisp=cl lisp:probe-directory
-			  path)))
+             (ignore-errors
+               (#+lisp=cl ext:probe-directory #-lisp=cl lisp:probe-directory
+                          path)))
     #+(or cmu scl) (eq :directory (unix:unix-file-kind (namestring path)))
     #+lispworks (lw:file-directory-p path)
     #+sbcl (eq :directory (sb-unix:unix-file-kind (namestring path)))
@@ -101,7 +101,7 @@
   (cond
    ((not (null dir))
     (when (and (typep dir 'logical-pathname)
-	       (translate-logical-pathname dir))
+               (translate-logical-pathname dir))
       (setq dir (translate-logical-pathname dir)))
     (when (stringp dir)
       (setq dir (parse-namestring dir)))
@@ -116,16 +116,16 @@
     (setq cl:*default-pathname-defaults* dir))
    (t
     (let ((dir
-	   #+allegro (excl:current-directory)
-	   #+clisp (#+lisp=cl ext:default-directory #-lisp=cl lisp:default-directory)
-	   #+(or cmu scl) (ext:default-directory)
-	   #+sbcl (sb-unix:posix-getcwd/)
-	   #+cormanlisp (ccl:get-current-directory)
-	   #+lispworks (hcl:get-working-directory)
-	   #+mcl (ccl:mac-default-directory)
-	   #-(or allegro clisp cmu scl cormanlisp mcl sbcl lispworks) (truename ".")))
+           #+allegro (excl:current-directory)
+           #+clisp (#+lisp=cl ext:default-directory #-lisp=cl lisp:default-directory)
+           #+(or cmu scl) (ext:default-directory)
+           #+sbcl (sb-unix:posix-getcwd/)
+           #+cormanlisp (ccl:get-current-directory)
+           #+lispworks (hcl:get-working-directory)
+           #+mcl (ccl:mac-default-directory)
+           #-(or allegro clisp cmu scl cormanlisp mcl sbcl lispworks) (truename ".")))
       (when (stringp dir)
-	(setq dir (parse-namestring dir)))
+        (setq dir (parse-namestring dir)))
       dir))))
 
 
@@ -154,16 +154,16 @@
   #+allegro (excl.osi:command-output cmd :directory directory :whole whole)
   #+sbcl
   (let* ((out (make-array '(0) :element-type 'character :fill-pointer 0
-			  :adjustable t))
-	 (err (make-array '(0) :element-type 'character :fill-pointer 0
-			  :adjustable t))
-	(status
-	 (sb-impl::process-exit-code
-	  (with-output-to-string (out-stream out)
-	    (with-output-to-string (err-stream err)
-	      (sb-ext:run-program
-	       "/bin/sh"
-	       (list  "-c" cmd)
-	       :input nil :output out-stream :error err-stream))))))
+                          :adjustable t))
+         (err (make-array '(0) :element-type 'character :fill-pointer 0
+                          :adjustable t))
+        (status
+         (sb-impl::process-exit-code
+          (with-output-to-string (out-stream out)
+            (with-output-to-string (err-stream err)
+              (sb-ext:run-program
+               "/bin/sh"
+               (list  "-c" cmd)
+               :input nil :output out-stream :error err-stream))))))
     (values out err status))
   )