[Cl-darcs-cvs] r44 - cl-darcs/trunk

[mhenoch at common-lisp.net]

Author: mhenoch
Date: Fri Oct  6 14:51:38 2006
New Revision: 44

Modified:
   cl-darcs/trunk/util.lisp
Log:
Fix the exclusion feature of copy-directory.


Modified: cl-darcs/trunk/util.lisp
==============================================================================
--- cl-darcs/trunk/util.lisp	(original)
+++ cl-darcs/trunk/util.lisp	Fri Oct  6 14:51:38 2006
@@ -223,23 +223,25 @@
 to exclude.
 
 Symlinks will confuse the function."
-  (setq excluding (mapcar #'truename excluding))
   (let* ((wild (make-pathname :directory '(:relative :wild-inferiors)
 			      :name :wild
 			      :type :wild
 			      :version :wild))
 	 (source-wild (merge-pathnames wild source))
 	 (target-wild (merge-pathnames wild target))
+	 (excluding-wild (mapcar
+			  (lambda (excluded) (merge-pathnames wild excluded))
+			  excluding))
 
 	 (files (fad:list-directory (truename source))))
     (dolist (source-file files)
       (let ((target-file (translate-pathname source-file source-wild target-wild)))
 	(cond
-	  ((member source-file excluding :test #'equal)
+	  ((some (lambda (excluded) (pathname-match-p source-file excluded)) excluding-wild)
 	   ;; File excluded - do nothing.
 	   )
 	  ((fad:directory-pathname-p source-file)
 	   (make-dir target-file)
-	   (copy-directory source-file target-file))
+	   (copy-directory source-file target-file :excluding excluding))
 	  (t
 	   (fad:copy-file source-file target-file)))))))