# HG changeset patch # User Chong Yidong # Date 1207515714 0 # Node ID 837d54fb9fc9d0deef55c60fd52b442d766fbfa9 # Parent 42cedd27ec5a22a1f637b149e312fc91a27f754c (dired-dnd-handle-local-file): Obey dired-backup-overwrite for copy, move, and link operations. diff -r 42cedd27ec5a -r 837d54fb9fc9 lisp/dired.el --- a/lisp/dired.el Sun Apr 06 21:01:07 2008 +0000 +++ b/lisp/dired.el Sun Apr 06 21:01:54 2008 +0000 @@ -3236,7 +3236,7 @@ (defun dired-dnd-popup-notice () (message-box - "Recursive copies not enabled.\nSee variable dired-recursive-copies.")) + "Dired recursive copies are currently disabled.\nSee the variable `dired-recursive-copies'.")) (defun dired-dnd-do-ask-action (uri) @@ -3261,37 +3261,46 @@ Ask means pop up a menu for the user to select one of copy, move or link." (require 'dired-aux) (let* ((from (dnd-get-local-file-name uri t)) - (to (if from (concat (dired-current-directory) - (file-name-nondirectory from)) - nil))) - (if from - (cond ((or (eq action 'copy) - (eq action 'private)) ; Treat private as copy. - - ;; If copying a directory and dired-recursive-copies is nil, - ;; dired-copy-file silently fails. Pop up a notice. - (if (and (file-directory-p from) - (not dired-recursive-copies)) - (dired-dnd-popup-notice) - (progn - (dired-copy-file from to 1) - (dired-relist-entry to) - action))) - - ((eq action 'move) - (dired-rename-file from to 1) - (dired-relist-entry to) - action) - - ((eq action 'link) - (make-symbolic-link from to 1) - (dired-relist-entry to) - action) - - ((eq action 'ask) - (dired-dnd-do-ask-action uri)) - - (t nil))))) + (to (when from + (concat (dired-current-directory) + (file-name-nondirectory from))))) + (when from + (cond ((eq action 'ask) + (dired-dnd-do-ask-action uri)) + ;; If copying a directory and dired-recursive-copies is + ;; nil, dired-copy-file fails. Pop up a notice. + ((and (memq action '(copy private)) + (file-directory-p from) + (not dired-recursive-copies)) + (dired-dnd-popup-notice)) + ((memq action '(copy private move link)) + (let ((overwrite (and (file-exists-p to) + (y-or-n-p + (format "Overwrite existing file `%s'? " to)))) + ;; Binding dired-overwrite-confirmed to nil makes + ;; dired-handle-overwrite a no-op. We instead use + ;; y-or-n-p, which pops a graphical menu. + dired-overwrite-confirmed backup-file) + (when (and overwrite + ;; d-b-o is defined in dired-aux. + (boundp 'dired-backup-overwrite) + dired-backup-overwrite + (setq backup-file + (car (find-backup-file-name to))) + (or (eq dired-backup-overwrite 'always) + (y-or-n-p + (format + "Make backup for existing file `%s'? " to)))) + (rename-file to backup-file 0) + (dired-relist-entry backup-file)) + (cond ((memq action '(copy private)) + (dired-copy-file from to overwrite)) + ((eq action 'move) + (dired-rename-file from to overwrite)) + ((eq action 'link) + (make-symbolic-link from to overwrite))) + (dired-relist-entry to) + action)))))) (defun dired-dnd-handle-file (uri action) "Copy, move or link a file to the dired directory if it is a local file.