X-Git-Url: http://git.kpe.io/?p=kmrcl.git;a=blobdiff_plain;f=impl.lisp;h=7efec3d79b1cfd33eef5163ba24bdf38e4f12ca3;hp=c17449c088fb6a7b11d8755650d95a45d4519ac9;hb=10959ae8c2c6839e1a2134c17f267429c938f44a;hpb=d4bfdf559cbd44dee337d2d2fbb457bfe1cec56e

diff --git a/impl.lisp b/impl.lisp
index c17449c..7efec3d 100644
--- a/impl.lisp
+++ b/impl.lisp
@@ -37,22 +37,29 @@
 	  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) (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)))
-
+(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-not-exists
+	  (error "Directory ~A does not exist." filename)))))
 
 (defun cwd (&optional dir)
   "Change directory and set default pathname"