summaryrefslogtreecommitdiff
path: root/lisp/dired.el
diff options
context:
space:
mode:
authorChong Yidong <cyd@stupidchicken.com>2008-04-06 21:01:54 +0000
committerChong Yidong <cyd@stupidchicken.com>2008-04-06 21:01:54 +0000
commit3b1b11e968c38c794e550a7689b3ca917b542d25 (patch)
tree46b0d7291071f2ba43908a297e9f2df148bc0cf1 /lisp/dired.el
parent5e1a21c7428e3d1d6a1e3d3a2d1fef0839e3c6d2 (diff)
downloademacs-3b1b11e968c38c794e550a7689b3ca917b542d25.tar.gz
(dired-dnd-handle-local-file): Obey dired-backup-overwrite for copy,
move, and link operations.
Diffstat (limited to 'lisp/dired.el')
-rw-r--r--lisp/dired.el73
1 files changed, 41 insertions, 32 deletions
diff --git a/lisp/dired.el b/lisp/dired.el
index e184b3bc0ea..0daaf2d3987 100644
--- a/lisp/dired.el
+++ b/lisp/dired.el
@@ -3236,7 +3236,7 @@ Anything else means ask for each directory."
(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 @@ URI is the file to handle, ACTION is one of copy, move, link or ask.
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.