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)))))))