X-Git-Url: http://git.kpe.io/?p=kmrcl.git;a=blobdiff_plain;f=impl.lisp;h=7862ca5cec71b0e205babbf368202d304a4f7316;hp=0b37c8badc9b655f1f7c45777dc6f7b433cb1000;hb=d557c191f92e4e5a3cd4ca3fdd14a78444002c64;hpb=1b7f506ec98bd5b885203a3250c52603b943cee9

diff --git a/impl.lisp b/impl.lisp
index 0b37c8b..7862ca5 100644
--- a/impl.lisp
+++ b/impl.lisp
@@ -35,21 +35,31 @@
 			      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)))
-    #+(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)))
-    #-(or allegro clisp cmu lispworks sbcl scl)
-    (probe-file 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)))
+    (if probe
+	probe
+	(when error-if-does-not-exist
+	  (error "Directory ~A does not exist." filename)))))
 
 (defun cwd (&optional dir)
   "Change directory and set default pathname"
@@ -108,11 +118,12 @@
 (defun copy-file (from to &key link overwrite preserve-symbolic-links
 		  (preserve-time t) remove-destination force verbose)
   #+allegro (sys:copy-file from to :link link :overwrite overwrite
-			   :preserve-symbolic-links preserve-symbolic-links 
+			   :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
     ((and (typep from 'stream) (typep to 'stream))
      (copy-binary-stream from to))
@@ -130,7 +141,7 @@
     (t
      (when (and (or force remove-destination) (probe-file to))
        (delete-file to))
-     (let* ((options (if preserve-time 
+     (let* ((options (if preserve-time
 			 "-p"
 			 ""))
 	    (cmd (format nil "cp ~A ~A ~A" options (namestring from) (namestring to))))