r10067: add keyword

diff --git a/impl.lisp b/impl.lisp
index c17449c088fb6a7b11d8755650d95a45d4519ac9..a814cc4d1b0a08d42eb75d94abde0aef1f0b4f7a 100644 (file)
--- a/impl.lisp
+++ b/impl.lisp
@@ -37,22 +37,29 @@
          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) (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-not-exists 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"
 
 (defun cwd (&optional dir)
   "Change directory and set default pathname"