Commit 655bded0 authored by Michael Albinus's avatar Michael Albinus
Browse files

* net/tramp.el (tramp-do-copy-or-rename-file)

(tramp-handle-file-local-copy, tramp-maybe-open-connection): Tune
`with-progress-reporter' messages.
(tramp-handle-vc-registered):
* net/tramp-fish.el (tramp-fish-handle-file-local-copy)
(tramp-fish-handle-insert-file-contents)
(tramp-fish-maybe-open-connection):
* net/tramp-gvfs.el (tramp-gvfs-maybe-open-connection):
* net/tramp-imap.el (tramp-imap-do-copy-or-rename-file)
(tramp-imap-handle-insert-file-contents)
(tramp-imap-handle-file-local-copy): Use `with-progress-reporter'.
parent bf1e8d4a
2010-05-21 Michael Albinus <michael.albinus@gmx.de>
* net/tramp.el (tramp-do-copy-or-rename-file)
(tramp-handle-file-local-copy, tramp-maybe-open-connection): Tune
`with-progress-reporter' messages.
(tramp-handle-vc-registered):
* net/tramp-fish.el (tramp-fish-handle-file-local-copy)
(tramp-fish-handle-insert-file-contents)
(tramp-fish-maybe-open-connection):
* net/tramp-gvfs.el (tramp-gvfs-maybe-open-connection):
* net/tramp-imap.el (tramp-imap-do-copy-or-rename-file)
(tramp-imap-handle-insert-file-contents)
(tramp-imap-handle-file-local-copy): Use `with-progress-reporter'.
2010-05-21 Juanma Barranquero <lekktu@gmail.com>
* add-log.el (change-log-font-lock-keywords):
......
......@@ -149,9 +149,12 @@
;; parameter of `write-region'. Transfer of binary data fails due to
;; Emacs' process input/output handling.
;;; Code:
(eval-when-compile
;; Pacify byte-compiler.
(require 'cl))
(require 'tramp)
(require 'tramp-cache)
(require 'tramp-compat)
......@@ -487,13 +490,13 @@ pass to the OPERATION."
v 'file-error
"Cannot make local copy of non-existing file `%s'" filename))
(let ((tmpfile (tramp-compat-make-temp-file filename)))
(tramp-message v 4 "Fetching %s to tmp file %s..." filename tmpfile)
(when (tramp-fish-retrieve-data v)
;; Save file
(with-current-buffer (tramp-get-buffer v)
(write-region (point-min) (point-max) tmpfile))
(tramp-message v 4 "Fetching %s to tmp file %s...done" filename tmpfile)
tmpfile))))
(with-progress-reporter
v 3 (format "Fetching %s to tmp file %s" filename tmpfile)
(when (tramp-fish-retrieve-data v)
;; Save file
(with-current-buffer (tramp-get-buffer v)
(write-region (point-min) (point-max) tmpfile))
tmpfile)))))
;; This function should return "foo/" for directories and "bar" for
;; files.
......@@ -591,17 +594,16 @@ WILDCARD and FULL-DIRECTORY-P are not handled."
(let ((point (point))
size)
(tramp-message v 4 "Fetching file %s..." filename)
(when (tramp-fish-retrieve-data v)
;; Insert file
(insert
(with-current-buffer (tramp-get-buffer v)
(let ((beg (or beg (point-min)))
(end (min (or end (point-max)) (point-max))))
(setq size (- end beg))
(buffer-substring beg end))))
(goto-char point))
(tramp-message v 4 "Fetching file %s...done" filename)
(with-progress-reporter v 3 (format "Fetching file %s" filename)
(when (tramp-fish-retrieve-data v)
;; Insert file
(insert
(with-current-buffer (tramp-get-buffer v)
(let ((beg (or beg (point-min)))
(end (min (or end (point-max)) (point-max))))
(setq size (- end beg))
(buffer-substring beg end))))
(goto-char point)))
(list (expand-file-name filename) size)))))
......@@ -1115,34 +1117,36 @@ connection if a previous connection has died for some reason."
(delete-process p))
(setenv "TERM" tramp-terminal-type)
(setenv "PS1" tramp-initial-end-of-output)
(tramp-message
vec 3 "Opening connection for %s@%s using %s..."
tramp-current-user tramp-current-host tramp-current-method)
(let* ((process-connection-type tramp-process-connection-type)
(inhibit-eol-conversion nil)
(coding-system-for-read 'binary)
(coding-system-for-write 'binary)
;; This must be done in order to avoid our file name handler.
(p (let ((default-directory
(tramp-compat-temporary-file-directory)))
(start-process
(or (tramp-get-connection-property vec "process-name" nil)
(tramp-buffer-name vec))
(tramp-get-connection-buffer vec)
"ssh" "-l"
(tramp-file-name-user vec)
(tramp-file-name-host vec)))))
(tramp-message vec 6 "%s" (mapconcat 'identity (process-command p) " "))
;; Check whether process is alive.
(tramp-set-process-query-on-exit-flag p nil)
(tramp-process-actions p vec tramp-actions-before-shell 60)
(tramp-fish-send-command vec tramp-fish-start-fish-server-command)
(tramp-message
vec 3
"Found remote shell prompt on `%s'" (tramp-file-name-host vec))))))
(with-progress-reporter
vec 3
(format "Opening connection for %s@%s using %s"
tramp-current-user tramp-current-host tramp-current-method)
(let* ((process-connection-type tramp-process-connection-type)
(inhibit-eol-conversion nil)
(coding-system-for-read 'binary)
(coding-system-for-write 'binary)
;; This must be done in order to avoid our file name handler.
(p (let ((default-directory
(tramp-compat-temporary-file-directory)))
(start-process
(or (tramp-get-connection-property vec "process-name" nil)
(tramp-buffer-name vec))
(tramp-get-connection-buffer vec)
"ssh" "-l"
(tramp-file-name-user vec)
(tramp-file-name-host vec)))))
(tramp-message
vec 6 "%s" (mapconcat 'identity (process-command p) " "))
;; Check whether process is alive.
(tramp-set-process-query-on-exit-flag p nil)
(tramp-process-actions p vec tramp-actions-before-shell 60)
(tramp-fish-send-command vec tramp-fish-start-fish-server-command)
(tramp-message
vec 3
"Found remote shell prompt on `%s'" (tramp-file-name-host vec)))))))
(defun tramp-fish-send-command (vec command)
"Send the COMMAND to connection VEC."
......
......@@ -1067,65 +1067,58 @@ connection if a previous connection has died for some reason."
(tramp-gvfs-object-path
(tramp-make-tramp-file-name method user host ""))))
(if (zerop (length (tramp-file-name-user vec)))
(tramp-message
vec 3 "Opening connection for %s using %s..." host method)
(tramp-message
vec 3 "Opening connection for %s@%s using %s..." user host method))
;; Enable auth-sorce and password-cache.
(tramp-set-connection-property vec "first-password-request" t)
;; There will be a callback of "askPassword", when a password is
;; needed.
(dbus-register-method
:session dbus-service-emacs object-path
tramp-gvfs-interface-mountoperation "askPassword"
'tramp-gvfs-handler-askpassword)
;; There could be a callback of "askQuestion", when adding fingerprint.
(dbus-register-method
:session dbus-service-emacs object-path
tramp-gvfs-interface-mountoperation "askQuestion"
'tramp-gvfs-handler-askquestion)
;; The call must be asynchronously, because of the "askPassword"
;; or "askQuestion"callbacks.
(with-tramp-dbus-call-method vec nil
:session tramp-gvfs-service-daemon tramp-gvfs-path-mounttracker
tramp-gvfs-interface-mounttracker "mountLocation"
`(:struct
,(dbus-string-to-byte-array "/")
,(tramp-gvfs-mount-spec vec))
(dbus-get-unique-name :session)
:object-path object-path)
;; We must wait, until the mount is applied. This will be
;; indicated by the "mounted" signal, i.e. the "fuse-mountpoint"
;; file property.
(with-timeout
(60
(if (zerop (length (tramp-file-name-user vec)))
(with-progress-reporter
vec 3
(if (zerop (length user))
(format "Opening connection for %s using %s" host method)
(format "Opening connection for %s@%s using %s" user host method))
;; Enable auth-sorce and password-cache.
(tramp-set-connection-property vec "first-password-request" t)
;; There will be a callback of "askPassword", when a password is
;; needed.
(dbus-register-method
:session dbus-service-emacs object-path
tramp-gvfs-interface-mountoperation "askPassword"
'tramp-gvfs-handler-askpassword)
;; There could be a callback of "askQuestion", when adding fingerprint.
(dbus-register-method
:session dbus-service-emacs object-path
tramp-gvfs-interface-mountoperation "askQuestion"
'tramp-gvfs-handler-askquestion)
;; The call must be asynchronously, because of the "askPassword"
;; or "askQuestion"callbacks.
(with-tramp-dbus-call-method vec nil
:session tramp-gvfs-service-daemon tramp-gvfs-path-mounttracker
tramp-gvfs-interface-mounttracker "mountLocation"
`(:struct
,(dbus-string-to-byte-array "/")
,(tramp-gvfs-mount-spec vec))
(dbus-get-unique-name :session)
:object-path object-path)
;; We must wait, until the mount is applied. This will be
;; indicated by the "mounted" signal, i.e. the "fuse-mountpoint"
;; file property.
(with-timeout
(60
(if (zerop (length (tramp-file-name-user vec)))
(tramp-error
vec 'file-error
"Timeout reached mounting %s using %s" host method)
(tramp-error
vec 'file-error
"Timeout reached mounting %s using %s" host method)
(tramp-error
vec 'file-error
"Timeout reached mounting %s@%s using %s" user host method)))
(while (not (tramp-get-file-property vec "/" "fuse-mountpoint" nil))
(read-event nil nil 0.1)))
;; We set the connection property "started" in order to put the
;; remote location into the cache, which is helpful for further
;; completion.
(tramp-set-connection-property vec "started" t)
(if (zerop (length (tramp-file-name-user vec)))
(tramp-message
vec 3 "Opening connection for %s using %s...done" host method)
(tramp-message
vec 3
"Opening connection for %s@%s using %s...done" user host method)))))
"Timeout reached mounting %s@%s using %s" user host method)))
(while (not (tramp-get-file-property vec "/" "fuse-mountpoint" nil))
(read-event nil nil 0.1)))
;; We set the connection property "started" in order to put the
;; remote location into the cache, which is helpful for further
;; completion.
(tramp-set-connection-property vec "started" t)))))
;; D-Bus BLUEZ functions.
......
......@@ -241,32 +241,31 @@ of `copy' and `rename'."
(t2 (and (tramp-tramp-file-p newname)
(tramp-imap-file-name-p newname))))
(when (and (not ok-if-already-exists) (file-exists-p newname))
(with-parsed-tramp-file-name (if t1 filename newname) nil
(tramp-error
v 'file-already-exists "File %s already exists" newname)))
(with-parsed-tramp-file-name (if t1 filename newname) nil
(tramp-message v 0 "Transferring %s to %s..." filename newname))
;; We just make a local copy of FILENAME, and write it then to
;; NEWNAME. This must be optimized, when both files are located
;; on the same IMAP server.
(with-temp-buffer
(if (and t1 t2)
;; We don't encrypt.
(with-parsed-tramp-file-name newname nil
(insert (tramp-imap-get-file filename nil))
(tramp-imap-put-file
v (current-buffer)
(tramp-imap-file-name-name v)
nil nil (nth 7 (file-attributes filename))))
;; One of them is not located on a IMAP mailbox.
(insert-file-contents filename)
(write-region (point-min) (point-max) newname)))
(with-parsed-tramp-file-name (if t1 filename newname) nil
(tramp-message v 0 "Transferring %s to %s...done" filename newname))
(when (and (not ok-if-already-exists) (file-exists-p newname))
(tramp-error
v 'file-already-exists "File %s already exists" newname))
(with-progress-reporter
v 0 (format "%s %s to %s"
(if (eq op 'copy) "Copying" "Renaming")
filename newname)
;; We just make a local copy of FILENAME, and write it then to
;; NEWNAME. This must be optimized, when both files are
;; located on the same IMAP server.
(with-temp-buffer
(if (and t1 t2)
;; We don't encrypt.
(with-parsed-tramp-file-name newname v1
(insert (tramp-imap-get-file filename nil))
(tramp-imap-put-file
v1 (current-buffer)
(tramp-imap-file-name-name v1)
nil nil (nth 7 (file-attributes filename))))
;; One of them is not located on a IMAP mailbox.
(insert-file-contents filename)
(write-region (point-min) (point-max) newname)))))
(when (eq op 'rename)
(tramp-compat-delete-file filename 'force))))
......@@ -505,17 +504,16 @@ SIZE MODE WEIRD INODE DEVICE)."
v 'file-error "File `%s' not found on remote host" filename)
(let ((point (point))
size data)
(tramp-message v 4 "Fetching file %s..." filename)
(insert (tramp-imap-get-file filename t))
(setq size (- (point) point))
(with-progress-reporter v 3 (format "Fetching file %s" filename)
(insert (tramp-imap-get-file filename t))
(setq size (- (point) point))
;;; TODO: handle ranges.
;;; (let ((beg (or beg (point-min)))
;;; (end (min (or end (point-max)) (point-max))))
;;; (setq size (- end beg))
;;; (buffer-substring beg end))
(goto-char point)
(tramp-message v 4 "Fetching file %s...done" filename)
(list (expand-file-name filename) size)))))
(goto-char point)
(list (expand-file-name filename) size))))))
(defun tramp-imap-handle-file-exists-p (filename)
"Like `file-exists-p' for Tramp files."
......@@ -588,12 +586,12 @@ SIZE MODE WEIRD INODE DEVICE)."
v 'file-error
"Cannot make local copy of non-existing file `%s'" filename))
(let ((tmpfile (tramp-compat-make-temp-file filename)))
(tramp-message v 4 "Fetching %s to tmp file %s..." filename tmpfile)
(with-temp-buffer
(insert-file-contents filename)
(write-region (point-min) (point-max) tmpfile)
(tramp-message v 4 "Fetching %s to tmp file %s...done" filename tmpfile)
tmpfile))))
(with-progress-reporter
v 3 (format "Fetching %s to tmp file %s" filename tmpfile)
(with-temp-buffer
(insert-file-contents filename)
(write-region (point-min) (point-max) tmpfile)
tmpfile)))))
(defun tramp-imap-put-file
(vec filename-or-buffer &optional subject inode encode size)
......
......@@ -3659,85 +3659,86 @@ and `rename'. FILENAME and NEWNAME must be absolute file names."
(apply 'file-selinux-context (list filename))))
pr tm)
(when (and (not ok-if-already-exists) (file-exists-p newname))
(with-parsed-tramp-file-name (if t1 filename newname) nil
(with-parsed-tramp-file-name (if t1 filename newname) nil
(when (and (not ok-if-already-exists) (file-exists-p newname))
(tramp-error
v 'file-already-exists "File %s already exists" newname)))
v 'file-already-exists "File %s already exists" newname))
(with-parsed-tramp-file-name (if t1 filename newname) nil
(with-progress-reporter
v 0 (format "Transferring %s to %s" filename newname)
v 0 (format "%s %s to %s"
(if (eq op 'copy) "Copying" "Renaming")
filename newname)
(cond
;; Both are Tramp files.
((and t1 t2)
(with-parsed-tramp-file-name filename v1
(with-parsed-tramp-file-name newname v2
(cond
;; Shortcut: if method, host, user are the same for both
;; files, we invoke `cp' or `mv' on the remote host
;; directly.
((tramp-equal-remote filename newname)
(tramp-do-copy-or-rename-file-directly
op filename newname
ok-if-already-exists keep-date preserve-uid-gid))
;; Try out-of-band operation.
((tramp-method-out-of-band-p
v1 (nth 7 (file-attributes filename)))
(tramp-do-copy-or-rename-file-out-of-band
op filename newname keep-date))
;; No shortcut was possible. So we copy the
;; file first. If the operation was `rename', we go
;; back and delete the original file (if the copy was
;; successful). The approach is simple-minded: we
;; create a new buffer, insert the contents of the
;; source file into it, then write out the buffer to
;; the target file. The advantage is that it doesn't
;; matter which filename handlers are used for the
;; source and target file.
(t
(tramp-do-copy-or-rename-file-via-buffer
op filename newname keep-date))))))
;; One file is a Tramp file, the other one is local.
((or t1 t2)
(cond
;; Fast track on local machine.
((tramp-local-host-p v)
(tramp-do-copy-or-rename-file-directly
op filename newname
ok-if-already-exists keep-date preserve-uid-gid))
;; If the Tramp file has an out-of-band method, the corresponding
;; copy-program can be invoked.
((tramp-method-out-of-band-p v (nth 7 (file-attributes filename)))
(tramp-do-copy-or-rename-file-out-of-band
op filename newname keep-date))
;; Use the inline method via a Tramp buffer.
(t (tramp-do-copy-or-rename-file-via-buffer
op filename newname keep-date))))
(t
;; One of them must be a Tramp file.
(error "Tramp implementation says this cannot happen")))
;; Handle `preserve-selinux-context'.
(when context (apply 'set-file-selinux-context (list newname context)))
;; In case of `rename', we must flush the cache of the source file.
(when (and t1 (eq op 'rename))
(with-parsed-tramp-file-name filename v1
(tramp-flush-file-property v1 (file-name-directory localname))
(tramp-flush-file-property v1 localname)))
;; When newname did exist, we have wrong cached values.
(when t2
(with-parsed-tramp-file-name newname v2
(tramp-flush-file-property v2 (file-name-directory localname))
(tramp-flush-file-property v2 localname)))))))
(cond
;; Both are Tramp files.
((and t1 t2)
(with-parsed-tramp-file-name filename v1
(with-parsed-tramp-file-name newname v2
(cond
;; Shortcut: if method, host, user are the same for
;; both files, we invoke `cp' or `mv' on the remote
;; host directly.
((tramp-equal-remote filename newname)
(tramp-do-copy-or-rename-file-directly
op filename newname
ok-if-already-exists keep-date preserve-uid-gid))
;; Try out-of-band operation.
((tramp-method-out-of-band-p
v1 (nth 7 (file-attributes filename)))
(tramp-do-copy-or-rename-file-out-of-band
op filename newname keep-date))
;; No shortcut was possible. So we copy the file
;; first. If the operation was `rename', we go back
;; and delete the original file (if the copy was
;; successful). The approach is simple-minded: we
;; create a new buffer, insert the contents of the
;; source file into it, then write out the buffer to
;; the target file. The advantage is that it doesn't
;; matter which filename handlers are used for the
;; source and target file.
(t
(tramp-do-copy-or-rename-file-via-buffer
op filename newname keep-date))))))
;; One file is a Tramp file, the other one is local.
((or t1 t2)
(cond
;; Fast track on local machine.
((tramp-local-host-p v)
(tramp-do-copy-or-rename-file-directly
op filename newname
ok-if-already-exists keep-date preserve-uid-gid))
;; If the Tramp file has an out-of-band method, the
;; corresponding copy-program can be invoked.
((tramp-method-out-of-band-p v (nth 7 (file-attributes filename)))
(tramp-do-copy-or-rename-file-out-of-band
op filename newname keep-date))
;; Use the inline method via a Tramp buffer.
(t (tramp-do-copy-or-rename-file-via-buffer
op filename newname keep-date))))
(t
;; One of them must be a Tramp file.
(error "Tramp implementation says this cannot happen")))
;; Handle `preserve-selinux-context'.
(when context (apply 'set-file-selinux-context (list newname context)))
;; In case of `rename', we must flush the cache of the source file.
(when (and t1 (eq op 'rename))
(with-parsed-tramp-file-name filename v1
(tramp-flush-file-property v1 (file-name-directory localname))
(tramp-flush-file-property v1 localname)))
;; When newname did exist, we have wrong cached values.
(when t2
(with-parsed-tramp-file-name newname v2
(tramp-flush-file-property v2 (file-name-directory localname))
(tramp-flush-file-property v2 localname)))))))
(defun tramp-do-copy-or-rename-file-via-buffer (op filename newname keep-date)
"Use an Emacs buffer to copy or rename a file.
......@@ -4770,7 +4771,7 @@ Lisp error raised when PROGRAM is nil is trapped also, returning 1."
(rem-enc
(save-excursion
(with-progress-reporter
v 5 (format "Encoding remote file %s" filename)
v 3 (format "Encoding remote file %s" filename)
(tramp-barf-unless-okay
v (format rem-enc (tramp-shell-quote-argument localname))
"Encoding remote file failed"))
......@@ -5341,46 +5342,50 @@ Returns a file name in `tramp-auto-save-directory' for autosaving this file."
;; any other remote command.
(defun tramp-handle-vc-registered (file)
"Like `vc-registered' for Tramp files."
(with-parsed-tramp-file-name file nil
;; There could be new files, created by the vc backend. We cannot
;; reuse the old cache entries, therefore.
(let (tramp-vc-registered-file-names
(tramp-cache-inhibit-cache (current-time))
(file-name-handler-alist
`((,tramp-file-name-regexp . tramp-vc-file-name-handler))))
;; Here we collect only file names, which need an operation.
(tramp-run-real-handler 'vc-registered (list file))
(tramp-message v 10 "\n%s" tramp-vc-registered-file-names)
;; Send just one command, in order to fill the cache.
(when tramp-vc-registered-file-names
(tramp-maybe-send-script
v
(format tramp-vc-registered-read-file-names
(tramp-get-file-exists-command v)
(format "%s -r" (tramp-get-test-command v)))
"tramp_vc_registered_read_file_names")
(dolist
(elt
(tramp-send-command-and-read
v
(format
"tramp_vc_registered_read_file_names %s"
(mapconcat 'tramp-shell-quote-argument
tramp-vc-registered-file-names
" "))))
(tramp-set-file-property v (car elt) (cadr elt) (cadr (cdr elt))))))
;; Second run. Now all `file-exists-p' or `file-readable-p' calls
;; shall be answered from the file cache.
;; We unset `process-file-side-effects' in order to keep the cache
;; when `process-file' calls appear.
(let (process-file-side-effects)
(tramp-run-real-handler 'vc-registered (list file)))))
(with-temp-message ""
(with-parsed-tramp-file-name file nil
(with-progress-reporter
v 3 (format "Checking `vc-registered' for %s" file)
;; There could be new files, created by the vc backend. We
;; cannot reuse the old cache entries, therefore.
(let (tramp-vc-registered-file-names
(tramp-cache-inhibit-cache (current-time))
(file-name-handler-alist
`((,tramp-file-name-regexp . tramp-vc-file-name-handler))))
;; Here we collect only file names, which need an operation.
(tramp-run-real-handler 'vc-registered (list file))
(tramp-message v 10 "\n%s" tramp-vc-registered-file-names)
;; Send just one command, in order to fill the cache.
(when tramp-vc-registered-file-names
(tramp-maybe-send-script
v
(format tramp-vc-registered-read-file-names
(tramp-get-file-exists-command v)
(format "%s -r" (tramp-get-test-command v)))
"tramp_vc_registered_read_file_names")
(dolist
(elt
(tramp-send-command-and-read
v
(format
"tramp_vc_registered_read_file_names %s"
(mapconcat 'tramp-shell-quote-argument
tramp-vc-registered-file-names
" "))))
(tramp-set-file-property
v (car elt) (cadr elt) (cadr (cdr elt))))))
;; Second run. Now all `file-exists-p' or `file-readable-p'
;; calls shall be answered from the file cache. We unset
;; `process-file-side-effects' in order to keep the cache when
;; `process-file' calls appear.
(let (process-file-side-effects)
(tramp-run-real-handler 'vc-registered (list file)))))))