Commit 66bdc868 authored by Michael Albinus's avatar Michael Albinus
Browse files

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'.
parent 365f8d85
2010-05-05 Michael Albinus <michael.albinus@gmx.de>
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 <monnier@iro.umontreal.ca>
Minor cleanups.
......
......@@ -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))))
......
......@@ -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)."
......
......@@ -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)))
......
;;; 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 <michael.albinus@gmx.de>
;; 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
......
......@@ -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))
......
......@@ -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)
......
......@@ -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
......
......@@ -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)
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment