r11421: avoid compiler warnings

[kmrcl.git] / impl.lisp

diff --git a/impl.lisp b/impl.lisp
index 0b37c8badc9b655f1f7c45777dc6f7b433cb1000..7862ca5cec71b0e205babbf368202d304a4f7316 100644 (file)
--- 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))))