##Merge of all patches applied from revision 118951 ## patch-r118952: Return Error when trying to copy a directory on itself. ## patch-r118953: * lisp/files.el (copy-directory): Improve error message. ## diff --git a/lisp/files.el b/lisp/files.el --- a/lisp/files.el +++ b/lisp/files.el @@ -4935,6 +4935,7 @@ (equal (file-attributes (file-truename root)) (file-attributes f2)))))) +(defvar copy-directory-newdir-inode nil) (defun copy-directory (directory newname &optional keep-time parents copy-contents) "Copy DIRECTORY to NEWNAME. Both args must be strings. This function always sets the file modes of the output files to match @@ -4961,54 +4962,63 @@ (format "Copy directory %s to: " dir) default-directory default-directory nil nil) current-prefix-arg t nil))) - (when (file-subdir-of-p newname directory) - (error "Can't copy directory `%s' on itself" directory)) + ;; (when (file-subdir-of-p newname directory) + ;; (error "Can't copy directory `%s' on itself" directory)) ;; If default-directory is a remote directory, make sure we find its ;; copy-directory handler. - (let ((handler (or (find-file-name-handler directory 'copy-directory) - (find-file-name-handler newname 'copy-directory)))) - (if handler - (funcall handler 'copy-directory directory newname keep-time parents) - - ;; Compute target name. - (setq directory (directory-file-name (expand-file-name directory)) - newname (directory-file-name (expand-file-name newname))) - - (cond ((not (file-directory-p newname)) - ;; If NEWNAME is not an existing directory, create it; - ;; that is where we will copy the files of DIRECTORY. - (make-directory newname parents)) - ;; If NEWNAME is an existing directory and COPY-CONTENTS - ;; is nil, copy into NEWNAME/[DIRECTORY-BASENAME]. - ((not copy-contents) - (setq newname (expand-file-name - (file-name-nondirectory - (directory-file-name directory)) - newname)) - (and (file-exists-p newname) - (not (file-directory-p newname)) - (error "Cannot overwrite non-directory %s with a directory" - newname)) - (make-directory newname t))) - - ;; Copy recursively. - (dolist (file - ;; We do not want to copy "." and "..". - (directory-files directory 'full - directory-files-no-dot-files-regexp)) - (if (file-directory-p file) - (copy-directory file newname keep-time parents) - (let ((target (expand-file-name (file-name-nondirectory file) newname)) - (attrs (file-attributes file))) - (if (stringp (car attrs)) ; Symbolic link - (make-symbolic-link (car attrs) target t) - (copy-file file target t keep-time))))) - - ;; Set directory attributes. - (let ((modes (file-modes directory)) - (times (and keep-time (nth 5 (file-attributes directory))))) - (if modes (set-file-modes newname modes)) - (if times (set-file-times newname times)))))) + (unwind-protect + (let ((handler (or (find-file-name-handler directory 'copy-directory) + (find-file-name-handler newname 'copy-directory)))) + (if handler + (funcall handler 'copy-directory directory newname keep-time parents) + + ;; Compute target name. + (setq directory (file-truename (directory-file-name (expand-file-name directory))) + newname (file-truename (directory-file-name (expand-file-name newname)))) + (cond ((not (file-directory-p newname)) + ;; If NEWNAME is not an existing directory, create it; + ;; that is where we will copy the files of DIRECTORY. + (make-directory newname parents)) + ;; If NEWNAME is an existing directory and COPY-CONTENTS + ;; is nil, copy into NEWNAME/[DIRECTORY-BASENAME]. + ((not copy-contents) + (setq newname (expand-file-name + (file-name-nondirectory + (directory-file-name directory)) + newname)) + + (and (file-exists-p newname) + (not (file-directory-p newname)) + (error "Cannot overwrite non-directory %s with a directory" + newname)) + (make-directory newname t) + (unless copy-directory-newdir-inode + (setq copy-directory-newdir-inode (nth 10 (file-attributes newname)))))) + + ;; Copy recursively. + (dolist (file + ;; We do not want to copy "." and "..". + (directory-files directory 'full + directory-files-no-dot-files-regexp)) + (assert (not (equal (nth 10 (file-attributes file)) + copy-directory-newdir-inode)) + nil "Unable to create directory `%s' in itself `%s'" + (file-name-nondirectory (directory-file-name file)) + (file-name-directory (directory-file-name newname))) + (if (file-directory-p file) + (copy-directory file newname keep-time parents) + (let ((target (expand-file-name (file-name-nondirectory file) newname)) + (attrs (file-attributes file))) + (if (stringp (car attrs)) ; Symbolic link + (make-symbolic-link (car attrs) target t) + (copy-file file target t keep-time))))) + + ;; Set directory attributes. + (let ((modes (file-modes directory)) + (times (and keep-time (nth 5 (file-attributes directory))))) + (if modes (set-file-modes newname modes)) + (if times (set-file-times newname times))))) + (setq copy-directory-newdir-inode nil))) (put 'revert-buffer-function 'permanent-local t) (defvar revert-buffer-function nil