From: Michael Albinus Date: Wed, 5 May 2010 10:20:23 +0000 (+0200) Subject: Add FORCE argument to `delete-file'. X-Git-Tag: emacs-pretest-24.0.90~104^2~275^2~438^2~276 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=66bdc86806b8995b0c321d21260056a1b64270b8;p=emacs.git Add FORCE argument to `delete-file'. * net/ange-ftp.el (ange-ftp-del-tmp-name): Make it a defun, forcing to delete the temporary file. (ange-ftp-delete-file): Add FORCE arg. (ange-ftp-rename-remote-to-remote) (ange-ftp-rename-local-to-remote, ange-ftp-rename-remote-to-local) (ange-ftp-load, ange-ftp-compress, ange-ftp-uncompress): Force file deletion. * net/tramp-compat.el (tramp-compat-delete-file): New defun. * net/tramp.el (tramp-handle-delete-file): Add FORCE arg. (tramp-handle-make-symbolic-link, tramp-handle-load) (tramp-do-copy-or-rename-file-via-buffer) (tramp-do-copy-or-rename-file-directly) (tramp-do-copy-or-rename-file-out-of-band) (tramp-handle-process-file, tramp-handle-call-process-region) (tramp-handle-shell-command, tramp-handle-file-local-copy) (tramp-handle-insert-file-contents, tramp-handle-write-region) (tramp-delete-temp-file-function): Use `tramp-compat-delete-file'. * net/tramp-fish.el (tramp-fish-handle-delete-file): Add FORCE arg. (tramp-fish-handle-make-symbolic-link) (tramp-fish-handle-process-file): Use `tramp-compat-delete-file'. * net/tramp-ftp.el (tramp-ftp-file-name-handler): Use `tramp-compat-delete-file'. * net/tramp-gvfs.el (tramp-gvfs-handle-delete-file): Add FORCE arg. (tramp-gvfs-handle-write-region): Use `tramp-compat-delete-file'. * net/tramp-imap.el (tramp-imap-handle-delete-file): Add FORCE arg. (tramp-imap-do-copy-or-rename-file): Use `tramp-compat-delete-file'. * net/tramp-smb.el (tramp-smb-handle-delete-file): Add FORCE arg. (tramp-smb-handle-copy-file, tramp-smb-handle-file-local-copy) (tramp-smb-handle-rename-file, tramp-smb-handle-write-region): Use `tramp-compat-delete-file'. --- diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 4c33ae6a193..23e81510cb1 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,45 @@ +2010-05-05 Michael Albinus + + Add FORCE argument to `delete-file'. + + * net/ange-ftp.el (ange-ftp-del-tmp-name): Make it a defun, + forcing to delete the temporary file. + (ange-ftp-delete-file): Add FORCE arg. + (ange-ftp-rename-remote-to-remote) + (ange-ftp-rename-local-to-remote, ange-ftp-rename-remote-to-local) + (ange-ftp-load, ange-ftp-compress, ange-ftp-uncompress): Force + file deletion. + + * net/tramp-compat.el (tramp-compat-delete-file): New defun. + + * net/tramp.el (tramp-handle-delete-file): Add FORCE arg. + (tramp-handle-make-symbolic-link, tramp-handle-load) + (tramp-do-copy-or-rename-file-via-buffer) + (tramp-do-copy-or-rename-file-directly) + (tramp-do-copy-or-rename-file-out-of-band) + (tramp-handle-process-file, tramp-handle-call-process-region) + (tramp-handle-shell-command, tramp-handle-file-local-copy) + (tramp-handle-insert-file-contents, tramp-handle-write-region) + (tramp-delete-temp-file-function): Use `tramp-compat-delete-file'. + + * net/tramp-fish.el (tramp-fish-handle-delete-file): Add FORCE arg. + (tramp-fish-handle-make-symbolic-link) + (tramp-fish-handle-process-file): Use `tramp-compat-delete-file'. + + * net/tramp-ftp.el (tramp-ftp-file-name-handler): Use + `tramp-compat-delete-file'. + + * net/tramp-gvfs.el (tramp-gvfs-handle-delete-file): Add FORCE arg. + (tramp-gvfs-handle-write-region): Use `tramp-compat-delete-file'. + + * net/tramp-imap.el (tramp-imap-handle-delete-file): Add FORCE arg. + (tramp-imap-do-copy-or-rename-file): Use `tramp-compat-delete-file'. + + * net/tramp-smb.el (tramp-smb-handle-delete-file): Add FORCE arg. + (tramp-smb-handle-copy-file, tramp-smb-handle-file-local-copy) + (tramp-smb-handle-rename-file, tramp-smb-handle-write-region): Use + `tramp-compat-delete-file'. + 2010-05-05 Stefan Monnier Minor cleanups. diff --git a/lisp/net/ange-ftp.el b/lisp/net/ange-ftp.el index 9f7b9cc98b5..73cb2e57bb2 100644 --- a/lisp/net/ange-ftp.el +++ b/lisp/net/ange-ftp.el @@ -1734,7 +1734,10 @@ good, skip, fatal, or unknown." ange-ftp-gateway-tmp-name-template ange-ftp-tmp-name-template))) -(defalias 'ange-ftp-del-tmp-name 'delete-file) +(defun ange-ftp-del-tmp-name (filename) + "Force to delete temporary file." + (delete-file filename 'force)) + ;;;; ------------------------------------------------------------ ;;;; Interactive gateway program support. @@ -3504,7 +3507,7 @@ system TYPE.") (file-exists-p file) (ange-ftp-real-file-executable-p file)))) -(defun ange-ftp-delete-file (file) +(defun ange-ftp-delete-file (file &optional force) (interactive "fDelete file: ") (setq file (expand-file-name file)) (let ((parsed (ange-ftp-ftp-name file))) @@ -3523,7 +3526,7 @@ system TYPE.") (format "FTP Error: \"%s\"" (cdr result)) file))) (ange-ftp-delete-file-entry file)) - (ange-ftp-real-delete-file file)))) + (ange-ftp-real-delete-file file force)))) (defun ange-ftp-file-modtime (file) "Return the modification time of remote file FILE. @@ -3894,7 +3897,7 @@ E.g., (ange-ftp-add-file-entry newname) (ange-ftp-delete-file-entry filename)) (ange-ftp-copy-file-internal filename newname t nil) - (delete-file filename)))) + (delete-file filename 'force)))) (defun ange-ftp-rename-local-to-remote (filename newname) "Rename local file FILENAME to remote file NEWNAME." @@ -3903,7 +3906,7 @@ E.g., (msg (format "Renaming %s to %s" fabbr nabbr))) (ange-ftp-copy-file-internal filename newname t nil msg) (let (ange-ftp-process-verbose) - (delete-file filename)))) + (delete-file filename 'force)))) (defun ange-ftp-rename-remote-to-local (filename newname) "Rename remote file FILENAME to local file NEWNAME." @@ -3912,7 +3915,7 @@ E.g., (msg (format "Renaming %s to %s" fabbr nabbr))) (ange-ftp-copy-file-internal filename newname t nil msg) (let (ange-ftp-process-verbose) - (delete-file filename)))) + (delete-file filename 'force)))) (defun ange-ftp-rename-file (filename newname &optional ok-if-already-exists) (interactive "fRename file: \nFRename %s to file: \np") @@ -4193,7 +4196,7 @@ directory, so that Emacs will know its current contents." (if copy (unwind-protect (funcall 'load copy noerror nomessage nosuffix) - (delete-file copy)) + (delete-file copy 'force)) (or noerror (signal 'file-error (list "Cannot open load file" file))) nil)) @@ -4264,7 +4267,7 @@ NEWNAME should be the name to give the new compressed or uncompressed file.") (if (zerop (buffer-size)) (progn (let (ange-ftp-process-verbose) - (delete-file file)) + (delete-file file 'force)) (ange-ftp-copy-file-internal tmp2 nfile t nil msg2)))) (ange-ftp-del-tmp-name tmp1) (ange-ftp-del-tmp-name tmp2)))) @@ -4300,7 +4303,7 @@ NEWNAME should be the name to give the new compressed or uncompressed file.") (if (zerop (buffer-size)) (progn (let (ange-ftp-process-verbose) - (delete-file file)) + (delete-file file 'force)) (ange-ftp-copy-file-internal tmp2 nfile t nil msg2)))) (ange-ftp-del-tmp-name tmp1) (ange-ftp-del-tmp-name tmp2)))) diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el index 2d8f7535db0..fe4b3d4146a 100644 --- a/lisp/net/tramp-compat.el +++ b/lisp/net/tramp-compat.el @@ -317,6 +317,17 @@ Add the extension of FILENAME, if existing." (if keep-time (set-file-times newname (nth 5 (file-attributes directory)))))))) +;; FORCE has been introduced with Emacs 24.1. +(defun tramp-compat-delete-file (filename &optional force) + "Like `delete-file' for Tramp files (compat function)." + (condition-case nil + (funcall (symbol-function 'delete-file) filename force) + ;; This Emacs version does not support the FORCE flag. Setting + ;; `delete-by-moving-to-trash' shall give us the same effect. + (error + (let ((delete-by-moving-to-trash (null force))) + (delete-file filename))))) + ;; RECURSIVE has been introduced with Emacs 23.2. (defun tramp-compat-delete-directory (directory &optional recursive) "Like `delete-directory' for Tramp files (compat function)." diff --git a/lisp/net/tramp-fish.el b/lisp/net/tramp-fish.el index 11debaed47b..dd1947d5f1e 100644 --- a/lisp/net/tramp-fish.el +++ b/lisp/net/tramp-fish.el @@ -332,7 +332,7 @@ pass to the OPERATION." (tramp-flush-directory-property v localname) (tramp-fish-send-command-and-check v (format "#RMD %s" localname))))) -(defun tramp-fish-handle-delete-file (filename) +(defun tramp-fish-handle-delete-file (filename &optional force) "Like `delete-file' for Tramp files." (when (file-exists-p filename) (with-parsed-tramp-file-name (expand-file-name filename) nil @@ -658,7 +658,7 @@ target of the symlink differ." localname))))) (tramp-error v 'file-already-exists "File %s already exists" localname) - (delete-file linkname))) + (tramp-compat-delete-file linkname 'force))) ;; If FILENAME is a Tramp name, use just the localname component. (when (tramp-tramp-file-p filename) @@ -837,8 +837,8 @@ target of the symlink differ." ;; Provide error file. (when tmpstderr (rename-file tmpstderr (cadr destination) t)) ;; Cleanup. - (when tmpinput (delete-file tmpinput)) - (when tmpoutput (delete-file tmpoutput)) + (when tmpinput (tramp-compat-delete-file tmpinput 'force)) + (when tmpoutput (tramp-compat-delete-file tmpoutput 'force)) ;; Return exit status. ret))) diff --git a/lisp/net/tramp-ftp.el b/lisp/net/tramp-ftp.el index 6428fe594f4..17cd6216c78 100644 --- a/lisp/net/tramp-ftp.el +++ b/lisp/net/tramp-ftp.el @@ -1,7 +1,7 @@ ;;; tramp-ftp.el --- Tramp convenience functions for Ange-FTP -;; Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, -;; 2008, 2009, 2010 Free Software Foundation, Inc. +;; Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, +;; 2009, 2010 Free Software Foundation, Inc. ;; Author: Michael Albinus ;; Keywords: comm, processes @@ -182,7 +182,7 @@ pass to the OPERATION." (unwind-protect (rename-file tmpfile newname (car args)) ;; Cleanup. - (ignore-errors (delete-file tmpfile))))) + (ignore-errors (tramp-compat-delete-file tmpfile 'force))))) ;; Normally, the handlers must be discarded. ;; `inhibit-file-name-handlers' isn't sufficient, because the diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index ba79a96dd58..569fca3fe31 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el @@ -533,9 +533,9 @@ is no information where to trace the message.") (tramp-compat-delete-directory (tramp-gvfs-fuse-file-name directory) recursive)) -(defun tramp-gvfs-handle-delete-file (filename) +(defun tramp-gvfs-handle-delete-file (filename &optional force) "Like `delete-file' for Tramp files." - (delete-file (tramp-gvfs-fuse-file-name filename))) + (tramp-compat-delete-file (tramp-gvfs-fuse-file-name filename) force)) (defun tramp-gvfs-handle-directory-files (directory &optional full match nosort) @@ -741,7 +741,7 @@ is no information where to trace the message.") "gvfs-save" tmpfile (tramp-get-buffer v) nil (tramp-gvfs-url-file-name filename))) (signal (car err) (cdr err))) - (delete-file tmpfile))))) + (tramp-compat-delete-file tmpfile 'force))))) ;; Set file modification time. (when (or (eq visit t) (stringp visit)) diff --git a/lisp/net/tramp-imap.el b/lisp/net/tramp-imap.el index 66ca35e4eac..e9048bcb7a1 100644 --- a/lisp/net/tramp-imap.el +++ b/lisp/net/tramp-imap.el @@ -268,7 +268,7 @@ of `copy' and `rename'." (tramp-message v 0 "Transferring %s to %s...done" filename newname)) (when (eq op 'rename) - (delete-file filename)))) + (tramp-compat-delete-file filename 'force)))) ;; TODO: revise this much (defun tramp-imap-handle-expand-file-name (name &optional dir) @@ -553,7 +553,7 @@ SIZE MODE WEIRD INODE DEVICE)." ;; (file-exists-p (file-name-directory filename))) (file-directory-p (file-name-directory filename))) -(defun tramp-imap-handle-delete-file (filename) +(defun tramp-imap-handle-delete-file (filename &optional force) "Like `delete-file' for Tramp files." (cond ((not (file-exists-p filename)) nil) diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el index 32272e08148..434c2bad20d 100644 --- a/lisp/net/tramp-smb.el +++ b/lisp/net/tramp-smb.el @@ -342,7 +342,7 @@ PRESERVE-UID-GID is completely ignored." (condition-case err (rename-file tmpfile newname ok-if-already-exists) ((error quit) - (delete-file tmpfile) + (tramp-compat-delete-file tmpfile 'force) (signal (car err) (cdr err)))) ;; Remote newname. @@ -404,7 +404,7 @@ PRESERVE-UID-GID is completely ignored." (tramp-error v 'file-error "%s `%s'" (match-string 0) directory)))))) -(defun tramp-smb-handle-delete-file (filename) +(defun tramp-smb-handle-delete-file (filename &optional force) "Like `delete-file' for Tramp files." (setq filename (expand-file-name filename)) (when (file-exists-p filename) @@ -611,7 +611,7 @@ PRESERVE-UID-GID is completely ignored." (tramp-message v 4 "Fetching %s to tmp file %s...done" filename tmpfile) ;; Oops, an error. We shall cleanup. - (delete-file tmpfile) + (tramp-compat-delete-file tmpfile 'force) (tramp-error v 'file-error "Cannot make local copy of file `%s'" filename)) tmpfile))) @@ -858,7 +858,7 @@ target of the symlink differ." (condition-case err (rename-file tmpfile newname ok-if-already-exists) ((error quit) - (delete-file tmpfile) + (tramp-compat-delete-file tmpfile 'force) (signal (car err) (cdr err)))) ;; Remote newname. @@ -881,7 +881,7 @@ target of the symlink differ." v 0 "Copying file %s to file %s...done" filename newname) (tramp-error v 'file-error "Cannot rename `%s'" filename))))) - (delete-file filename)) + (tramp-compat-delete-file filename 'force)) (defun tramp-smb-handle-set-file-modes (filename mode) "Like `set-file-modes' for Tramp files." @@ -945,7 +945,7 @@ errors for shares like \"C$/\", which are common in Microsoft Windows." (tramp-message v 5 "Writing tmp file %s to file %s...done" tmpfile filename) (tramp-error v 'file-error "Cannot write `%s'" filename)) - (delete-file tmpfile)) + (tramp-compat-delete-file tmpfile 'force)) (unless (equal curbuf (current-buffer)) (tramp-error diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 9852b62ff00..26ef72c6ffc 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -2511,7 +2511,7 @@ target of the symlink differ." l-localname))))) (tramp-error l 'file-already-exists "File %s already exists" l-localname) - (delete-file linkname))) + (tramp-compat-delete-file linkname 'force))) ;; If FILENAME is a Tramp name, use just the localname component. (when (tramp-tramp-file-p filename) @@ -2559,7 +2559,7 @@ target of the symlink differ." ;; MUST-SUFFIX doesn't exist on XEmacs, so let it default to nil. (unwind-protect (load local-copy noerror t t) - (delete-file local-copy))) + (tramp-compat-delete-file local-copy 'force))) (unless nomessage (tramp-message v 0 "Loading %s...done" file)) t))) @@ -3737,7 +3737,7 @@ KEEP-DATE is non-nil if NEWNAME should have the same timestamp as FILENAME." ;; Set the mode. (set-file-modes newname (tramp-default-file-modes filename)) ;; If the operation was `rename', delete the original file. - (unless (eq op 'copy) (delete-file filename))) + (unless (eq op 'copy) (tramp-compat-delete-file filename 'force))) (defun tramp-do-copy-or-rename-file-directly (op filename newname ok-if-already-exists keep-date preserve-uid-gid) @@ -3892,7 +3892,7 @@ the uid and gid from FILENAME." ;; Save exit. (condition-case nil - (delete-file tmpfile) + (tramp-compat-delete-file tmpfile 'force) (error))))))))) ;; Set the time and mode. Mask possible errors. @@ -3932,7 +3932,7 @@ The method used must be an out-of-band method." (if dir-flag (tramp-compat-delete-directory (expand-file-name ".." tmpfile) 'recursive) - (delete-file tmpfile)) + (tramp-compat-delete-file tmpfile 'force)) (error)))) ;; Expand hops. Might be necessary for gateway methods. @@ -4050,7 +4050,7 @@ The method used must be an out-of-band method." ;; If the operation was `rename', delete the original file. (unless (eq op 'copy) (if (file-regular-p filename) - (delete-file filename) + (tramp-compat-delete-file filename 'force) (tramp-compat-delete-directory filename 'recursive)))))) (defun tramp-handle-make-directory (dir &optional parents) @@ -4080,7 +4080,7 @@ The method used must be an out-of-band method." (tramp-shell-quote-argument localname)))) (tramp-error v 'file-error "Couldn't delete %s" directory)))) -(defun tramp-handle-delete-file (filename) +(defun tramp-handle-delete-file (filename &optional force) "Like `delete-file' for Tramp files." (setq filename (expand-file-name filename)) (with-parsed-tramp-file-name filename nil @@ -4599,7 +4599,7 @@ beginning of local filename are not substituted." ;; Cleanup. We remove all file cache values for the connection, ;; because the remote process could have changed them. - (when tmpinput (delete-file tmpinput)) + (when tmpinput (tramp-compat-delete-file tmpinput 'force)) ;; `process-file-side-effects' has been introduced with GNU ;; Emacs 23.2. If set to `nil', no remote file will be changed @@ -4636,7 +4636,7 @@ Lisp error raised when PROGRAM is nil is trapped also, returning 1." (when delete (delete-region start end)) (unwind-protect (apply 'call-process program tmpfile buffer display args) - (delete-file tmpfile)))) + (tramp-compat-delete-file tmpfile 'force)))) (defun tramp-handle-shell-command (command &optional output-buffer error-buffer) @@ -4701,7 +4701,7 @@ Lisp error raised when PROGRAM is nil is trapped also, returning 1." (when (listp buffer) (with-current-buffer error-buffer (insert-file-contents (cadr buffer))) - (delete-file (cadr buffer))) + (tramp-compat-delete-file (cadr buffer) 'force)) (if current-buffer-p ;; This is like exchange-point-and-mark, but doesn't ;; activate the mark. It is cleaner to avoid activation, @@ -4783,7 +4783,7 @@ Lisp error raised when PROGRAM is nil is trapped also, returning 1." filename loc-dec) (unwind-protect (tramp-call-local-coding-command loc-dec tmpfile2 tmpfile) - (delete-file tmpfile2)))) + (tramp-compat-delete-file tmpfile2 'force)))) (tramp-message v 5 "Decoding remote file %s...done" filename) ;; Set proper permissions. @@ -4797,7 +4797,7 @@ Lisp error raised when PROGRAM is nil is trapped also, returning 1." ;; Error handling. ((error quit) - (delete-file tmpfile) + (tramp-compat-delete-file tmpfile 'force) (signal (car err) (cdr err)))) (run-hooks 'tramp-handle-file-local-copy-hook) @@ -4943,10 +4943,11 @@ coding system might not be determined. This function repairs it." (set-buffer-modified-p nil)) (when (and (stringp local-copy) (or remote-copy (null tramp-temp-buffer-file-name))) - (delete-file local-copy)) + (tramp-compat-delete-file local-copy 'force)) (when (stringp remote-copy) - (delete-file - (tramp-make-tramp-file-name method user host remote-copy)))))) + (tramp-compat-delete-file + (tramp-make-tramp-file-name method user host remote-copy) + 'force))))) ;; Result. (list (expand-file-name filename) @@ -5136,7 +5137,7 @@ Returns a file name in `tramp-auto-save-directory' for autosaving this file." (list start end tmpfile append 'no-message lockname confirm)) ((error quit) (setq tramp-temp-buffer-file-name nil) - (delete-file tmpfile) + (tramp-compat-delete-file tmpfile 'force) (signal (car err) (cdr err)))) ;; Now, `last-coding-system-used' has the right value. Remember it. @@ -5180,13 +5181,13 @@ Returns a file name in `tramp-auto-save-directory' for autosaving this file." (copy-file tmpfile filename t) ((error quit) (setq tramp-temp-buffer-file-name nil) - (delete-file tmpfile) + (tramp-compat-delete-file tmpfile 'force) (signal (car err) (cdr err))))) (setq tramp-temp-buffer-file-name nil) ;; Don't rename, in order to keep context in SELinux. (unwind-protect (copy-file tmpfile filename t) - (delete-file tmpfile)))) + (tramp-compat-delete-file tmpfile 'force)))) ;; Use inline file transfer. (rem-dec @@ -5270,7 +5271,7 @@ Returns a file name in `tramp-auto-save-directory' for autosaving this file." v 5 "Decoding region into remote file %s...done" filename)) ;; Save exit. - (delete-file tmpfile))) + (tramp-compat-delete-file tmpfile 'force))) ;; That's not expected. (t @@ -6350,7 +6351,7 @@ hosts, or files, disagree." "Remove temporary files related to current buffer." (when (stringp tramp-temp-buffer-file-name) (condition-case nil - (delete-file tramp-temp-buffer-file-name) + (tramp-compat-delete-file tramp-temp-buffer-file-name 'force) (error nil)))) (add-hook 'kill-buffer-hook 'tramp-delete-temp-file-function)