comparison lisp/net/tramp.el @ 108244:2ee48fcc701c

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'.

108243:be3f6d650654

			   (format
			    "File %s already exists; make it a link anyway? "
			    l-localname)))))
	    (tramp-error
	     l 'file-already-exists "File %s already exists" l-localname)
	  (delete-file linkname)))

      ;; If FILENAME is a Tramp name, use just the localname component.
      (when (tramp-tramp-file-p filename)
	(setq filename
	      (tramp-file-name-localname

      (unless nomessage (tramp-message v 0 "Loading %s..." file))
      (let ((local-copy (file-local-copy file)))
	;; 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)))
      (unless nomessage (tramp-message v 0 "Loading %s...done" file))
      t)))

;; Localname manipulation functions that grok Tramp localnames...
(defun tramp-handle-file-name-as-directory (file)

  ;; KEEP-DATE handling.
  (when keep-date (set-file-times newname (nth 5 (file-attributes 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)))

(defun tramp-do-copy-or-rename-file-directly
 (op filename newname ok-if-already-exists keep-date preserve-uid-gid)
  "Invokes `cp' or `mv' on the remote system.
OP must be one of `copy' or `rename', indicating `cp' or `mv',

		       'rename-file
		       (list tmpfile localname2 ok-if-already-exists)))))

		;; Save exit.
		(condition-case nil
		    (delete-file tmpfile)
		  (error)))))))))

      ;; Set the time and mode. Mask possible errors.
      (condition-case nil
	  (when keep-date

	      ;; Save exit.
	      (condition-case nil
		  (if dir-flag
		      (tramp-compat-delete-directory
		       (expand-file-name ".." tmpfile) 'recursive)
		    (delete-file tmpfile))
		(error))))

	;; Expand hops.  Might be necessary for gateway methods.
	(setq v (car (tramp-compute-multi-hops v)))
	(aset v 3 localname)

	    (set-file-modes newname (tramp-default-file-modes filename)))))

      ;; If the operation was `rename', delete the original file.
      (unless (eq op 'copy)
	(if (file-regular-p filename)
	    (delete-file filename)
	  (tramp-compat-delete-directory filename 'recursive))))))

(defun tramp-handle-make-directory (dir &optional parents)
  "Like `make-directory' for Tramp files."
  (setq dir (expand-file-name dir))

		     "%s %s"
		     (if recursive "rm -rf" "rmdir")
		     (tramp-shell-quote-argument localname))))
      (tramp-error v 'file-error "Couldn't delete %s" directory))))

(defun tramp-handle-delete-file (filename)
  "Like `delete-file' for Tramp files."
  (setq filename (expand-file-name filename))
  (with-parsed-tramp-file-name filename nil
    (tramp-flush-file-property v (file-name-directory localname))
    (tramp-flush-file-property v localname)

      ;; Provide error file.
      (when tmpstderr (rename-file tmpstderr (cadr destination) t))

      ;; Cleanup.  We remove all file cache values for the connection,
      ;; because the remote process could have changed them.
      (when tmpinput (delete-file tmpinput))

      ;; `process-file-side-effects' has been introduced with GNU
      ;; Emacs 23.2.  If set to `nil', no remote file will be changed
      ;; by `program'.  If it doesn't exist, we assume its default
      ;; value 't'.

  (let ((tmpfile (tramp-compat-make-temp-file "")))
    (write-region start end tmpfile)
    (when delete (delete-region start end))
    (unwind-protect
	(apply 'call-process program tmpfile buffer display args)
      (delete-file tmpfile))))

(defun tramp-handle-shell-command
  (command &optional output-buffer error-buffer)
  "Like `shell-command' for Tramp files."
  (let* ((asynchronous (string-match "[ \t]*&[ \t]*\\'" command))

	  (apply 'process-file (car args) nil buffer nil (cdr args))
	;; Insert error messages if they were separated.
	(when (listp buffer)
	  (with-current-buffer error-buffer
	    (insert-file-contents (cadr buffer)))
	  (delete-file (cadr buffer)))
	(if current-buffer-p
	    ;; This is like exchange-point-and-mark, but doesn't
	    ;; activate the mark.  It is cleaner to avoid activation,
	    ;; even though the command loop would deactivate the mark
	    ;; because we inserted text.

		  (tramp-message
		   v 5 "Decoding remote file %s with command %s..."
		   filename loc-dec)
		  (unwind-protect
		      (tramp-call-local-coding-command loc-dec tmpfile2 tmpfile)
		    (delete-file tmpfile2))))

	      (tramp-message v 5 "Decoding remote file %s...done" filename)
	      ;; Set proper permissions.
	      (set-file-modes tmpfile (tramp-default-file-modes filename))
	      ;; Set local user ownership.

	   (t (tramp-error
	       v 'file-error "Wrong method specification for `%s'" method)))

	;; Error handling.
	((error quit)
	 (delete-file tmpfile)
	 (signal (car err) (cdr err))))

      (run-hooks 'tramp-handle-file-local-copy-hook)
      tmpfile)))

	    (setq buffer-read-only (not (file-writable-p filename)))
	    (set-visited-file-modtime)
	    (set-buffer-modified-p nil))
	  (when (and (stringp local-copy)
		     (or remote-copy (null tramp-temp-buffer-file-name)))
	    (delete-file local-copy))
	  (when (stringp remote-copy)
	    (delete-file
	     (tramp-make-tramp-file-name method user host remote-copy))))))

    ;; Result.
    (list (expand-file-name filename)
	  (cadr result))))

		(tramp-run-real-handler
		 'write-region
		 (list start end tmpfile append 'no-message lockname confirm))
	      ((error quit)
	       (setq tramp-temp-buffer-file-name nil)
	       (delete-file tmpfile)
	       (signal (car err) (cdr err))))

	    ;; Now, `last-coding-system-used' has the right value.  Remember it.
	    (when (boundp 'last-coding-system-used)
	      (setq coding-system-used

			;; We keep the local file for performance
			;; reasons, useful for "rsync".
			(copy-file tmpfile filename t)
		      ((error quit)
		       (setq tramp-temp-buffer-file-name nil)
		       (delete-file tmpfile)
		       (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))))

	     ;; Use inline file transfer.
	     (rem-dec
	      ;; Encode tmpfile.
	      (tramp-message v 5 "Encoding region...")

			filename rem-dec)))
		    (tramp-message
		     v 5 "Decoding region into remote file %s...done" filename))

		;; Save exit.
		(delete-file tmpfile)))

	     ;; That's not expected.
	     (t
	      (tramp-error
	       v 'file-error

(defun tramp-delete-temp-file-function ()
  "Remove temporary files related to current buffer."
  (when (stringp tramp-temp-buffer-file-name)
    (condition-case nil
	(delete-file tramp-temp-buffer-file-name)
      (error nil))))

(add-hook 'kill-buffer-hook 'tramp-delete-temp-file-function)
(add-hook 'tramp-cache-unload-hook
	  (lambda ()

108244:2ee48fcc701c

			   (format
			    "File %s already exists; make it a link anyway? "
			    l-localname)))))
	    (tramp-error
	     l 'file-already-exists "File %s already exists" l-localname)
	  (tramp-compat-delete-file linkname 'force)))

      ;; If FILENAME is a Tramp name, use just the localname component.
      (when (tramp-tramp-file-p filename)
	(setq filename
	      (tramp-file-name-localname

      (unless nomessage (tramp-message v 0 "Loading %s..." file))
      (let ((local-copy (file-local-copy file)))
	;; MUST-SUFFIX doesn't exist on XEmacs, so let it default to nil.
	(unwind-protect
	    (load local-copy noerror t t)
	  (tramp-compat-delete-file local-copy 'force)))
      (unless nomessage (tramp-message v 0 "Loading %s...done" file))
      t)))

;; Localname manipulation functions that grok Tramp localnames...
(defun tramp-handle-file-name-as-directory (file)

  ;; KEEP-DATE handling.
  (when keep-date (set-file-times newname (nth 5 (file-attributes 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) (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)
  "Invokes `cp' or `mv' on the remote system.
OP must be one of `copy' or `rename', indicating `cp' or `mv',

		       'rename-file
		       (list tmpfile localname2 ok-if-already-exists)))))

		;; Save exit.
		(condition-case nil
		    (tramp-compat-delete-file tmpfile 'force)
		  (error)))))))))

      ;; Set the time and mode. Mask possible errors.
      (condition-case nil
	  (when keep-date

	      ;; Save exit.
	      (condition-case nil
		  (if dir-flag
		      (tramp-compat-delete-directory
		       (expand-file-name ".." tmpfile) 'recursive)
		    (tramp-compat-delete-file tmpfile 'force))
		(error))))

	;; Expand hops.  Might be necessary for gateway methods.
	(setq v (car (tramp-compute-multi-hops v)))
	(aset v 3 localname)

	    (set-file-modes newname (tramp-default-file-modes filename)))))

      ;; If the operation was `rename', delete the original file.
      (unless (eq op 'copy)
	(if (file-regular-p filename)
	    (tramp-compat-delete-file filename 'force)
	  (tramp-compat-delete-directory filename 'recursive))))))

(defun tramp-handle-make-directory (dir &optional parents)
  "Like `make-directory' for Tramp files."
  (setq dir (expand-file-name dir))

		     "%s %s"
		     (if recursive "rm -rf" "rmdir")
		     (tramp-shell-quote-argument localname))))
      (tramp-error v 'file-error "Couldn't delete %s" directory))))

(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
    (tramp-flush-file-property v (file-name-directory localname))
    (tramp-flush-file-property v localname)

      ;; Provide error file.
      (when tmpstderr (rename-file tmpstderr (cadr destination) t))

      ;; Cleanup.  We remove all file cache values for the connection,
      ;; because the remote process could have changed them.
      (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
      ;; by `program'.  If it doesn't exist, we assume its default
      ;; value 't'.

  (let ((tmpfile (tramp-compat-make-temp-file "")))
    (write-region start end tmpfile)
    (when delete (delete-region start end))
    (unwind-protect
	(apply 'call-process program tmpfile buffer display args)
      (tramp-compat-delete-file tmpfile 'force))))

(defun tramp-handle-shell-command
  (command &optional output-buffer error-buffer)
  "Like `shell-command' for Tramp files."
  (let* ((asynchronous (string-match "[ \t]*&[ \t]*\\'" command))

	  (apply 'process-file (car args) nil buffer nil (cdr args))
	;; Insert error messages if they were separated.
	(when (listp buffer)
	  (with-current-buffer error-buffer
	    (insert-file-contents (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,
	    ;; even though the command loop would deactivate the mark
	    ;; because we inserted text.

		  (tramp-message
		   v 5 "Decoding remote file %s with command %s..."
		   filename loc-dec)
		  (unwind-protect
		      (tramp-call-local-coding-command loc-dec tmpfile2 tmpfile)
		    (tramp-compat-delete-file tmpfile2 'force))))

	      (tramp-message v 5 "Decoding remote file %s...done" filename)
	      ;; Set proper permissions.
	      (set-file-modes tmpfile (tramp-default-file-modes filename))
	      ;; Set local user ownership.

	   (t (tramp-error
	       v 'file-error "Wrong method specification for `%s'" method)))

	;; Error handling.
	((error quit)
	 (tramp-compat-delete-file tmpfile 'force)
	 (signal (car err) (cdr err))))

      (run-hooks 'tramp-handle-file-local-copy-hook)
      tmpfile)))

	    (setq buffer-read-only (not (file-writable-p filename)))
	    (set-visited-file-modtime)
	    (set-buffer-modified-p nil))
	  (when (and (stringp local-copy)
		     (or remote-copy (null tramp-temp-buffer-file-name)))
	    (tramp-compat-delete-file local-copy 'force))
	  (when (stringp remote-copy)
	    (tramp-compat-delete-file
	     (tramp-make-tramp-file-name method user host remote-copy)
	     'force)))))

    ;; Result.
    (list (expand-file-name filename)
	  (cadr result))))

		(tramp-run-real-handler
		 'write-region
		 (list start end tmpfile append 'no-message lockname confirm))
	      ((error quit)
	       (setq tramp-temp-buffer-file-name nil)
	       (tramp-compat-delete-file tmpfile 'force)
	       (signal (car err) (cdr err))))

	    ;; Now, `last-coding-system-used' has the right value.  Remember it.
	    (when (boundp 'last-coding-system-used)
	      (setq coding-system-used

			;; We keep the local file for performance
			;; reasons, useful for "rsync".
			(copy-file tmpfile filename t)
		      ((error quit)
		       (setq tramp-temp-buffer-file-name nil)
		       (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)
		  (tramp-compat-delete-file tmpfile 'force))))

	     ;; Use inline file transfer.
	     (rem-dec
	      ;; Encode tmpfile.
	      (tramp-message v 5 "Encoding region...")

			filename rem-dec)))
		    (tramp-message
		     v 5 "Decoding region into remote file %s...done" filename))

		;; Save exit.
		(tramp-compat-delete-file tmpfile 'force)))

	     ;; That's not expected.
	     (t
	      (tramp-error
	       v 'file-error

(defun tramp-delete-temp-file-function ()
  "Remove temporary files related to current buffer."
  (when (stringp tramp-temp-buffer-file-name)
    (condition-case nil
	(tramp-compat-delete-file tramp-temp-buffer-file-name 'force)
      (error nil))))

(add-hook 'kill-buffer-hook 'tramp-delete-temp-file-function)
(add-hook 'tramp-cache-unload-hook
	  (lambda ()