[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] /srv/bzr/emacs/trunk r100406: * net/tramp.el (tramp-do-cop
|
From: |
Michael Albinus |
|
Subject: |
[Emacs-diffs] /srv/bzr/emacs/trunk r100406: * net/tramp.el (tramp-do-copy-or-rename-file) |
|
Date: |
Fri, 21 May 2010 16:16:42 +0200 |
|
User-agent: |
Bazaar (2.0.3) |
------------------------------------------------------------
revno: 100406
committer: Michael Albinus <address@hidden>
branch nick: trunk
timestamp: Fri 2010-05-21 16:16:42 +0200
message:
* 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'.
modified:
lisp/ChangeLog
lisp/net/tramp-fish.el
lisp/net/tramp-gvfs.el
lisp/net/tramp-imap.el
lisp/net/tramp.el
=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog 2010-05-21 01:46:38 +0000
+++ b/lisp/ChangeLog 2010-05-21 14:16:42 +0000
@@ -1,3 +1,17 @@
+2010-05-21 Michael Albinus <address@hidden>
+
+ * 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 <address@hidden>
* add-log.el (change-log-font-lock-keywords):
=== modified file 'lisp/net/tramp-fish.el'
--- a/lisp/net/tramp-fish.el 2010-05-05 10:20:23 +0000
+++ b/lisp/net/tramp-fish.el 2010-05-21 14:16:42 +0000
@@ -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 @@
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 @@
(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 @@
(delete-process p))
(setenv "TERM" tramp-terminal-type)
(setenv "PS1" tramp-initial-end-of-output)
- (tramp-message
- vec 3 "Opening connection for address@hidden 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 address@hidden 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."
=== modified file 'lisp/net/tramp-gvfs.el'
--- a/lisp/net/tramp-gvfs.el 2010-05-09 19:57:55 +0000
+++ b/lisp/net/tramp-gvfs.el 2010-05-21 14:16:42 +0000
@@ -1067,65 +1067,58 @@
(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 address@hidden 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 address@hidden 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 address@hidden 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 address@hidden using %s...done" user host
method)))))
+ "Timeout reached mounting address@hidden 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.
=== modified file 'lisp/net/tramp-imap.el'
--- a/lisp/net/tramp-imap.el 2010-05-09 19:57:55 +0000
+++ b/lisp/net/tramp-imap.el 2010-05-21 14:16:42 +0000
@@ -241,32 +241,31 @@
(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
+ (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)))
-
- (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))
+ 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 @@
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 @@
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)
=== modified file 'lisp/net/tramp.el'
--- a/lisp/net/tramp.el 2010-05-19 18:56:18 +0000
+++ b/lisp/net/tramp.el 2010-05-21 14:16:42 +0000
@@ -3659,85 +3659,86 @@
(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)
-
- (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)))))))
+ 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)))))))
(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 @@
(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 @@
;; 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)))))))
;;;###autoload
(progn (defun tramp-run-real-handler (operation args)
@@ -7432,131 +7437,135 @@
;; We call `tramp-get-buffer' in order to get a debug buffer for
;; messages from the beginning.
(tramp-get-buffer vec)
- (if (zerop (length (tramp-file-name-user vec)))
+ (with-progress-reporter
+ vec 3
+ (if (zerop (length (tramp-file-name-user vec)))
+ (format "Opening connection for %s using %s"
+ (tramp-file-name-host vec)
+ (tramp-file-name-method vec))
+ (format "Opening connection for address@hidden using %s"
+ (tramp-file-name-user vec)
+ (tramp-file-name-host vec)
+ (tramp-file-name-method vec)))
+
+ ;; Start new process.
+ (when (and p (processp p))
+ (delete-process p))
+ (setenv "TERM" tramp-terminal-type)
+ (setenv "LC_ALL" "C")
+ (setenv "PROMPT_COMMAND")
+ (setenv "PS1" tramp-initial-end-of-output)
+ (let* ((target-alist (tramp-compute-multi-hops vec))
+ (process-connection-type tramp-process-connection-type)
+ (process-adaptive-read-buffering nil)
+ (coding-system-for-read nil)
+ ;; This must be done in order to avoid our file name handler.
+ (p (let ((default-directory
+ (tramp-compat-temporary-file-directory)))
+ (start-process
+ (or process-name (tramp-buffer-name vec))
+ (tramp-get-connection-buffer vec)
+ tramp-encoding-shell))))
+
(tramp-message
- vec 3 "Opening connection for %s using %s"
- (tramp-file-name-host vec)
- (tramp-file-name-method vec))
- (tramp-message
- vec 3 "Opening connection for address@hidden using %s"
- (tramp-file-name-user vec)
- (tramp-file-name-host vec)
- (tramp-file-name-method vec)))
-
- ;; Start new process.
- (when (and p (processp p))
- (delete-process p))
- (setenv "TERM" tramp-terminal-type)
- (setenv "LC_ALL" "C")
- (setenv "PROMPT_COMMAND")
- (setenv "PS1" tramp-initial-end-of-output)
- (let* ((target-alist (tramp-compute-multi-hops vec))
- (process-connection-type tramp-process-connection-type)
- (process-adaptive-read-buffering nil)
- (coding-system-for-read nil)
- ;; This must be done in order to avoid our file name handler.
- (p (let ((default-directory
- (tramp-compat-temporary-file-directory)))
- (start-process
- (or process-name (tramp-buffer-name vec))
- (tramp-get-connection-buffer vec)
- tramp-encoding-shell))))
-
- (tramp-message
- vec 6 "%s" (mapconcat 'identity (process-command p) " "))
-
- ;; Check whether process is alive.
- (tramp-set-process-query-on-exit-flag p nil)
- (with-progress-reporter vec 3 "Waiting 60s for local shell to come up"
+ vec 6 "%s" (mapconcat 'identity (process-command p) " "))
+
+ ;; Check whether process is alive.
+ (tramp-set-process-query-on-exit-flag p nil)
(tramp-barf-if-no-shell-prompt
- p 60 "Couldn't find local shell prompt %s" tramp-encoding-shell))
-
- ;; Now do all the connections as specified.
- (while target-alist
- (let* ((hop (car target-alist))
- (l-method (tramp-file-name-method hop))
- (l-user (tramp-file-name-user hop))
- (l-host (tramp-file-name-host hop))
- (l-port nil)
- (login-program
- (tramp-get-method-parameter l-method 'tramp-login-program))
- (login-args
- (tramp-get-method-parameter l-method 'tramp-login-args))
- (async-args
- (tramp-get-method-parameter l-method 'tramp-async-args))
- (gw-args
- (tramp-get-method-parameter l-method 'tramp-gw-args))
- (gw (tramp-get-file-property hop "" "gateway" nil))
- (g-method (and gw (tramp-file-name-method gw)))
- (g-user (and gw (tramp-file-name-user gw)))
- (g-host (and gw (tramp-file-name-host gw)))
- (command login-program)
- ;; We don't create the temporary file. In fact, it
- ;; is just a prefix for the ControlPath option of
- ;; ssh; the real temporary file has another name, and
- ;; it is created and protected by ssh. It is also
- ;; removed by ssh, when the connection is closed.
- (tmpfile
- (tramp-set-connection-property
- p "temp-file"
- (make-temp-name
- (expand-file-name
- tramp-temp-name-prefix
- (tramp-compat-temporary-file-directory)))))
- spec)
-
- ;; Add arguments for asynchrononous processes.
- (when (and process-name async-args)
- (setq login-args (append login-args async-args)))
-
- ;; Add gateway arguments if necessary.
- (when (and gw gw-args)
- (setq login-args (append login-args gw-args)))
-
- ;; Check for port number. Until now, there's no need
- ;; for handling like method, user, host.
- (when (string-match tramp-host-with-port-regexp l-host)
+ p 60 "Couldn't find local shell prompt %s" tramp-encoding-shell)
+
+ ;; Now do all the connections as specified.
+ (while target-alist
+ (let* ((hop (car target-alist))
+ (l-method (tramp-file-name-method hop))
+ (l-user (tramp-file-name-user hop))
+ (l-host (tramp-file-name-host hop))
+ (l-port nil)
+ (login-program
+ (tramp-get-method-parameter
+ l-method 'tramp-login-program))
+ (login-args
+ (tramp-get-method-parameter l-method 'tramp-login-args))
+ (async-args
+ (tramp-get-method-parameter l-method 'tramp-async-args))
+ (gw-args
+ (tramp-get-method-parameter l-method 'tramp-gw-args))
+ (gw (tramp-get-file-property hop "" "gateway" nil))
+ (g-method (and gw (tramp-file-name-method gw)))
+ (g-user (and gw (tramp-file-name-user gw)))
+ (g-host (and gw (tramp-file-name-host gw)))
+ (command login-program)
+ ;; We don't create the temporary file. In fact,
+ ;; it is just a prefix for the ControlPath option
+ ;; of ssh; the real temporary file has another
+ ;; name, and it is created and protected by ssh.
+ ;; It is also removed by ssh, when the connection
+ ;; is closed.
+ (tmpfile
+ (tramp-set-connection-property
+ p "temp-file"
+ (make-temp-name
+ (expand-file-name
+ tramp-temp-name-prefix
+ (tramp-compat-temporary-file-directory)))))
+ spec)
+
+ ;; Add arguments for asynchrononous processes.
+ (when (and process-name async-args)
+ (setq login-args (append login-args async-args)))
+
+ ;; Add gateway arguments if necessary.
+ (when (and gw gw-args)
+ (setq login-args (append login-args gw-args)))
+
+ ;; Check for port number. Until now, there's no need
+ ;; for handling like method, user, host.
+ (when (string-match tramp-host-with-port-regexp l-host)
(setq l-port (match-string 2 l-host)
l-host (match-string 1 l-host)))
- ;; Set variables for computing the prompt for reading
- ;; password. They can also be derived from a gateway.
- (setq tramp-current-method (or g-method l-method)
- tramp-current-user (or g-user l-user)
- tramp-current-host (or g-host l-host))
-
- ;; Replace login-args place holders.
- (setq
- l-host (or l-host "")
- l-user (or l-user "")
- l-port (or l-port "")
- spec (format-spec-make ?h l-host ?u l-user ?p l-port ?t tmpfile)
- command
- (concat
- ;; We do not want to see the trailing local prompt in
- ;; `start-file-process'.
- (unless (memq system-type '(windows-nt)) "exec ")
- command " "
- (mapconcat
- (lambda (x)
- (setq x (mapcar (lambda (y) (format-spec y spec)) x))
- (unless (member "" x) (mapconcat 'identity x " ")))
- login-args " ")
- ;; Local shell could be a Windows COMSPEC. It doesn't
- ;; know the ";" syntax, but we must exit always for
- ;; `start-file-process'. "exec" does not work either.
- (if (memq system-type '(windows-nt)) " && exit || exit")))
-
- ;; Send the command.
- (tramp-message vec 3 "Sending command `%s'" command)
- (tramp-send-command vec command t t)
- (tramp-process-actions p vec tramp-actions-before-shell 60)
- (tramp-message vec 3 "Found remote shell prompt on `%s'" l-host))
- ;; Next hop.
- (setq target-alist (cdr target-alist)))
-
- ;; Make initial shell settings.
- (tramp-open-connection-setup-interactive-shell p vec))))))
+ ;; Set variables for computing the prompt for reading
+ ;; password. They can also be derived from a gateway.
+ (setq tramp-current-method (or g-method l-method)
+ tramp-current-user (or g-user l-user)
+ tramp-current-host (or g-host l-host))
+
+ ;; Replace login-args place holders.
+ (setq
+ l-host (or l-host "")
+ l-user (or l-user "")
+ l-port (or l-port "")
+ spec (format-spec-make
+ ?h l-host ?u l-user ?p l-port ?t tmpfile)
+ command
+ (concat
+ ;; We do not want to see the trailing local prompt in
+ ;; `start-file-process'.
+ (unless (memq system-type '(windows-nt)) "exec ")
+ command " "
+ (mapconcat
+ (lambda (x)
+ (setq x (mapcar (lambda (y) (format-spec y spec)) x))
+ (unless (member "" x) (mapconcat 'identity x " ")))
+ login-args " ")
+ ;; Local shell could be a Windows COMSPEC. It
+ ;; doesn't know the ";" syntax, but we must exit
+ ;; always for `start-file-process'. "exec" does not
+ ;; work either.
+ (if (memq system-type '(windows-nt)) " && exit || exit")))
+
+ ;; Send the command.
+ (tramp-message vec 3 "Sending command `%s'" command)
+ (tramp-send-command vec command t t)
+ (tramp-process-actions p vec tramp-actions-before-shell 60)
+ (tramp-message
+ vec 3 "Found remote shell prompt on `%s'" l-host))
+ ;; Next hop.
+ (setq target-alist (cdr target-alist)))
+
+ ;; Make initial shell settings.
+ (tramp-open-connection-setup-interactive-shell p vec)))))))
(defun tramp-send-command (vec command &optional neveropen nooutput)
"Send the COMMAND to connection VEC.
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Emacs-diffs] /srv/bzr/emacs/trunk r100406: * net/tramp.el (tramp-do-copy-or-rename-file),
Michael Albinus <=