X-Git-Url: http://git.kpe.io/?p=kmrcl.git;a=blobdiff_plain;f=impl.lisp;h=52193ab12880360d0e638fa16c7b266c2327b7f6;hp=7862ca5cec71b0e205babbf368202d304a4f7316;hb=03712fbb06acbb103602bae10f41aeae7fa05127;hpb=739b14ee8844dc777b174105646df3abcb865282

diff --git a/impl.lisp b/impl.lisp
index 7862ca5..52193ab 100644
--- a/impl.lisp
+++ b/impl.lisp
@@ -20,53 +20,53 @@
 
 (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 &key (error-if-does-not-exist nil))
   (let* ((path (canonicalize-directory-name filename))
-	 (probe
-	  #+allegro (excl:probe-directory path)
-	  #+clisp (values
-		   (ignore-errors
-		     (#+lisp=cl ext:probe-directory
-				#-lisp=cl lisp:probe-directory
-				path)))
-	  #+(or cmu scl) (when (eq :directory
-				   (unix:unix-file-kind (namestring path)))
-			   path)
-	  #+lispworks (when (lw:file-directory-p path)
-			path)
-	  #+sbcl (when (eq :directory
-			   (sb-unix:unix-file-kind (namestring path)))
-		   path)
-	  #-(or allegro clisp cmu lispworks sbcl scl)
-	  (probe-file path)))
+         (probe
+          #+allegro (excl:probe-directory path)
+          #+clisp (values
+                   (ignore-errors
+                     (#+lisp=cl ext:probe-directory
+                                #-lisp=cl lisp:probe-directory
+                                path)))
+          #+(or cmu scl) (when (eq :directory
+                                   (unix:unix-file-kind (namestring path)))
+                           path)
+          #+lispworks (when (lw:file-directory-p path)
+                        path)
+          #+sbcl (when (eq :directory
+                           (sb-unix:unix-file-kind (namestring path)))
+                   path)
+          #-(or allegro clisp cmu lispworks sbcl scl)
+          (probe-file path)))
     (if probe
-	probe
-	(when error-if-does-not-exist
-	  (error "Directory ~A does not exist." filename)))))
+        probe
+        (when error-if-does-not-exist
+          (error "Directory ~A does not exist." filename)))))
 
 (defun cwd (&optional dir)
   "Change directory and set default pathname"
   (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)))
@@ -81,16 +81,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))))
 
 
@@ -116,12 +116,12 @@
   )
 
 (defun copy-file (from to &key link overwrite preserve-symbolic-links
-		  (preserve-time t) remove-destination force verbose)
+                  (preserve-time t) remove-destination force verbose)
   #+allegro (sys:copy-file from to :link link :overwrite overwrite
-			   :preserve-symbolic-links preserve-symbolic-links
-			   :preserve-time preserve-time
-			   :remove-destination remove-destination
-			   :force force :verbose verbose)
+                           :preserve-symbolic-links preserve-symbolic-links
+                           :preserve-time preserve-time
+                           :remove-destination remove-destination
+                           :force force :verbose verbose)
   #-allegro
   (declare (ignore verbose preserve-symbolic-links overwrite))
   (cond
@@ -133,16 +133,16 @@
      (run-shell-command "ln -f ~A ~A" (namestring from) (namestring to)))
     (link
      (multiple-value-bind (stdout stderr status)
-	 (command-output "ln -f ~A ~A" (namestring from) (namestring to))
+         (command-output "ln -f ~A ~A" (namestring from) (namestring to))
        (declare (ignore stdout stderr))
        ;; try symbolic if command failed
        (unless (zerop status)
-	 (run-shell-command "ln -sf ~A ~A" (namestring from) (namestring to)))))
+         (run-shell-command "ln -sf ~A ~A" (namestring from) (namestring to)))))
     (t
      (when (and (or force remove-destination) (probe-file to))
        (delete-file to))
      (let* ((options (if preserve-time
-			 "-p"
-			 ""))
-	    (cmd (format nil "cp ~A ~A ~A" options (namestring from) (namestring to))))
+                         "-p"
+                         ""))
+            (cmd (format nil "cp ~A ~A ~A" options (namestring from) (namestring to))))
        (run-shell-command cmd)))))