##Merge of all patches applied from revision 118413 ## patch-r118414: Fix error when trying to copy directory on itself (bug#10489). ## patch-r118415: * lisp/dired-aux.el (dired-copy-file-recursive): Handle also remote file/dir. ## patch-r118416: Handle only remote files with sudo method when copying directories. ## patch-r118417: * lisp/dired-aux.el (dired-copy-file-recursive): Use file-truename. ## diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el --- a/lisp/dired-aux.el +++ b/lisp/dired-aux.el @@ -1264,24 +1264,34 @@ (defun dired-copy-file-recursive (from to ok-flag &optional preserve-time top recursive) - (let ((attrs (file-attributes from))) + (let* ((case-fold-search t) + (fromname (file-name-as-directory (file-truename from))) + (destname (file-name-as-directory (file-truename to))) + (rem-dirname (and (equal "sudo" (file-remote-p fromname 'method)) + (file-remote-p fromname 'localname))) + (rem-newname (and (equal "sudo" (file-remote-p destname 'method)) + (file-remote-p destname 'localname))) + (attrs (file-attributes from))) + (when (equal (or rem-dirname fromname) + (or rem-newname destname)) + (error "Can't copy directory `%s' on itself" from)) (if (and recursive - (eq t (car attrs)) - (or (eq recursive 'always) - (yes-or-no-p (format "Recursive copies of %s? " from)))) - ;; This is a directory. - (copy-directory from to preserve-time) + (eq t (car attrs)) + (or (eq recursive 'always) + (yes-or-no-p (format "Recursive copies of %s? " from)))) + ;; This is a directory. + (copy-directory from to preserve-time) ;; Not a directory. (or top (dired-handle-overwrite to)) (condition-case err - (if (stringp (car attrs)) - ;; It is a symlink - (make-symbolic-link (car attrs) to ok-flag) - (copy-file from to ok-flag preserve-time)) - (file-date-error - (push (dired-make-relative from) - dired-create-files-failures) - (dired-log "Can't set date on %s:\n%s\n" from err)))))) + (if (stringp (car attrs)) + ;; It is a symlink + (make-symbolic-link (car attrs) to ok-flag) + (copy-file from to ok-flag preserve-time)) + (file-date-error + (push (dired-make-relative from) + dired-create-files-failures) + (dired-log "Can't set date on %s:\n%s\n" from err)))))) ;;;###autoload (defun dired-rename-file (file newname ok-if-already-exists) @@ -1402,7 +1412,7 @@ newfile's entry, or t to use the current marker character if the old file was marked." (let (dired-create-files-failures failures - skipped (success-count 0) (total (length fn-list))) + skipped (success-count 0) (total (length fn-list))) (let (to overwrite-query overwrite-backup-query) ; for dired-handle-overwrite (dolist (from fn-list) @@ -1430,10 +1440,40 @@ (cond ((integerp marker-char) marker-char) (marker-char (dired-file-marker from)) ; slow (t nil)))) - (when (and (file-directory-p from) - (file-directory-p to) - (eq file-creator 'dired-copy-file)) - (setq to (file-name-directory to))) + ;; Handle the `dired-copy-file' file-creator specially + ;; When copying a directory to another directory or + ;; possibly to itself. + ;; (e.g "~/foo" => "~/test" or "~/foo" =>"~/foo") + ;; In this case the 'name-constructor' have set the destination + ;; 'to' to "~/test/foo" because the old + ;; emacs23 behavior of `copy-directory' + ;; was no not create the subdir and copy instead the contents only. + ;; With it's new behavior (similar to cp shell command) we don't + ;; need such a construction, so modify the destination 'to' to + ;; "~/test/" instead of "~/test/foo/". + ;; If from and to are the same directory do the same, + ;; the error will be handled by `dired-copy-file-recursive'. + (let* ((case-fold-search t) + (fromname (file-name-as-directory (file-truename from))) + (destname (file-name-as-directory (file-name-directory + (file-truename to)))) + (rem-fromname (and (equal "sudo" (file-remote-p fromname + 'method)) + (file-remote-p fromname 'localname))) + (rem-newname (and (equal "sudo" (file-remote-p destname + 'method)) + (file-remote-p destname 'localname)))) + (when (and (file-directory-p from) + (or (equal (or + ;; Maybe a remote file with sudo method + ;; converted to its localname. + rem-fromname + ;; Otherwise compare with local name. + fromname) + (or rem-newname destname)) + (file-directory-p to)) + (eq file-creator 'dired-copy-file)) + (setq to (file-name-directory to)))) (condition-case err (progn (funcall file-creator from to dired-overwrite-confirmed) @@ -1456,21 +1496,21 @@ (setq failures (nconc failures dired-create-files-failures)) (dired-log-summary (format "%s failed for %d file%s in %d requests" - operation (length failures) - (dired-plural-s (length failures)) - total) + operation (length failures) + (dired-plural-s (length failures)) + total) failures)) (failures (dired-log-summary (format "%s failed for %d of %d file%s" - operation (length failures) - total (dired-plural-s total)) + operation (length failures) + total (dired-plural-s total)) failures)) (skipped (dired-log-summary (format "%s: %d of %d file%s skipped" - operation (length skipped) total - (dired-plural-s total)) + operation (length skipped) total + (dired-plural-s total)) skipped)) (t (message "%s: %s file%s" diff --git a/lisp/files.el b/lisp/files.el --- a/lisp/files.el +++ b/lisp/files.el @@ -4928,10 +4928,20 @@ (format "Copy directory %s to: " dir) default-directory default-directory nil nil) current-prefix-arg t nil))) - ;; 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)))) + (let* ((case-fold-search t) + (fromname (file-name-as-directory (file-truename directory))) + (destname (file-name-as-directory (file-truename newname))) + (rem-dirname (and (equal "sudo" (file-remote-p fromname 'method)) + (file-remote-p fromname 'localname))) + (rem-newname (and (equal "sudo" (file-remote-p destname 'method)) + (file-remote-p destname 'localname))) + ;; If default-directory is a remote directory, make sure we find its + ;; copy-directory handler. + (handler (or (find-file-name-handler directory 'copy-directory) + (find-file-name-handler newname 'copy-directory)))) + (when (equal (or rem-dirname fromname) + (or rem-newname destname)) + (error "Can't copy directory `%s' on itself" directory)) (if handler (funcall handler 'copy-directory directory newname keep-time parents)