Author: mhenoch Date: Fri Oct 6 13:07:36 2006 New Revision: 43 Modified: cl-darcs/trunk/util.lisp Log: Add copy-directory. Modified: cl-darcs/trunk/util.lisp ============================================================================== --- cl-darcs/trunk/util.lisp (original) +++ cl-darcs/trunk/util.lisp Fri Oct 6 13:07:36 2006 @@ -215,3 +215,31 @@ #+sbcl (sb-posix:rmdir pathname) #-(or clisp sbcl) (error "DELETE-DIR not implemented for ~A." (lisp-implementation-type))) + +(defun copy-directory (source target &key excluding) + "Copy all files and directories in SOURCE to TARGET. +SOURCE and TARGET are pathnames designating directories, both of +which must exist. EXCLUDING is a list of files and directories +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)) + + (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) + ;; File excluded - do nothing. + ) + ((fad:directory-pathname-p source-file) + (make-dir target-file) + (copy-directory source-file target-file)) + (t + (fad:copy-file source-file target-file)))))))