[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] emacs/lisp/net tramp.el
|
From: |
Michael Albinus |
|
Subject: |
[Emacs-diffs] emacs/lisp/net tramp.el |
|
Date: |
Thu, 27 Aug 2009 13:47:55 +0000 |
CVSROOT: /sources/emacs
Module name: emacs
Changes by: Michael Albinus <albinus> 09/08/27 13:47:55
Modified files:
lisp/net : tramp.el
Log message:
* net/tramp.el (tramp-methods): New method "rsyncc".
(top): Add completion function for "rsyncc".
(tramp-message-show-message): New defvar.
(tramp-message, tramp-error): Use it.
(tramp-do-copy-or-rename-file-directly): Extend check for direct
remote copying.
(tramp-do-copy-or-rename-file-out-of-band): Handle new
`tramp-methods' entry `copy-env' of "rsyncc".
((tramp-handle-process-file): Do not flush all
caches when `process-file-side-effects' is set.
tramp-vc-registered-read-file-names): New defconst.
(tramp-vc-registered-file-names): New defvar.
(tramp-handle-vc-registered): Implement optimization strategy.
(tramp-run-real-handler): Add `tramp-vc-file-name-handler'.
(tramp-vc-file-name-handler): New defun.
(tramp-get-ls-command, tramp-get-test-command)
(tramp-get-file-exists-command, tramp-get-remote-ln)
(tramp-get-remote-perl, tramp-get-remote-stat)
(tramp-get-remote-id): Remove
superfluous `with-current-buffer'.
CVSWeb URLs:
http://cvs.savannah.gnu.org/viewcvs/emacs/lisp/net/tramp.el?cvsroot=emacs&r1=1.250&r2=1.251
Patches:
Index: tramp.el
===================================================================
RCS file: /sources/emacs/emacs/lisp/net/tramp.el,v
retrieving revision 1.250
retrieving revision 1.251
diff -u -b -r1.250 -r1.251
--- tramp.el 17 Aug 2009 19:11:33 -0000 1.250
+++ tramp.el 27 Aug 2009 13:47:55 -0000 1.251
@@ -375,6 +375,21 @@
(tramp-copy-args (("-e" "ssh") ("-t" "%k")))
(tramp-copy-keep-date t)
(tramp-password-end-of-line nil))
+ ("rsyncc" (tramp-login-program "ssh")
+ (tramp-login-args (("%h") ("-l" "%u") ("-p" "%p")
+ ("-o" "address@hidden:%%p")
+ ("-o" "ControlMaster=yes")
+ ("-e" "none")))
+ (tramp-remote-sh "/bin/sh")
+ (tramp-copy-program "rsync")
+ (tramp-copy-args (("-t" "%k")))
+ (tramp-copy-env (("RSYNC_RSH")
+ (,(concat
+ "ssh"
+ " -o address@hidden:%%p"
+ " -o ControlMaster=auto"))))
+ (tramp-copy-keep-date t)
+ (tramp-password-end-of-line nil))
("remcp" (tramp-login-program "remsh")
(tramp-login-args (("%h") ("-l" "%u")))
(tramp-remote-sh "/bin/sh")
@@ -850,6 +865,8 @@
(tramp-set-completion-function
"rsync" tramp-completion-function-alist-ssh)
(tramp-set-completion-function
+ "rsyncc" tramp-completion-function-alist-ssh)
+ (tramp-set-completion-function
"remcp" tramp-completion-function-alist-rsh)
(tramp-set-completion-function
"rsh" tramp-completion-function-alist-rsh)
@@ -1788,6 +1805,25 @@
Escape sequence %s is replaced with name of Perl binary.
This string is passed to `format', so percent characters need to be doubled.")
+(defconst tramp-vc-registered-read-file-names
+ "echo \"(\"
+for file in \"address@hidden"; do
+ if %s $file; then
+ echo \"(\\\"$file\\\" \\\"file-exists-p\\\" t)\"
+ else
+ echo \"(\\\"$file\\\" \\\"file-exists-p\\\" nil)\"
+ fi
+ if %s $file; then
+ echo \"(\\\"$file\\\" \\\"file-readable-p\\\" t)\"
+ else
+ echo \"(\\\"$file\\\" \\\"file-readable-p\\\" nil)\"
+ fi
+done
+echo \")\""
+ "Script to check existence of VC related files.
+It must be send formatted with two strings; the tests for file
+existence, and file readability.")
+
(defconst tramp-file-mode-type-map
'((0 . "-") ; Normal file (SVID-v2 and XPG2)
(1 . "p") ; fifo
@@ -1938,6 +1974,11 @@
;; The message.
(insert (apply 'format fmt-string args)))))
+(defvar tramp-message-show-message t
+ "Show Tramp message in the minibuffer.
+This variable is used to disable messages from `tramp-error'.
+The messages are visible anyway, because an error is raised.")
+
(defsubst tramp-message (vec-or-proc level fmt-string &rest args)
"Emit a message depending on verbosity level.
VEC-OR-PROC identifies the Tramp buffer to use. It can be either a
@@ -1956,7 +1997,7 @@
;; Match data must be preserved!
(save-match-data
;; Display only when there is a minimum level.
- (when (<= level 3)
+ (when (and tramp-message-show-message (<= level 3))
(apply 'message
(concat
(cond
@@ -1987,11 +2028,14 @@
VEC-OR-PROC identifies the connection to use, SIGNAL is the
signal identifier to be raised, remaining args passed to
`tramp-message'. Finally, signal SIGNAL is raised."
+ (let (tramp-message-show-message)
(tramp-message
vec-or-proc 1 "%s"
(error-message-string
- (list signal (get signal 'error-message) (apply 'format fmt-string args))))
- (signal signal (list (apply 'format fmt-string args))))
+ (list signal
+ (get signal 'error-message)
+ (apply 'format fmt-string args))))
+ (signal signal (list (apply 'format fmt-string args)))))
(defsubst tramp-error-with-buffer
(buffer vec-or-proc signal fmt-string &rest args)
@@ -3298,10 +3342,11 @@
'rename-file (list localname1 localname2 ok-if-already-exists))))
;; We can do it directly with `tramp-send-command'
- ((let (file-name-handler-alist)
- (and (file-readable-p (concat prefix localname1))
+ ((and (file-readable-p (concat prefix localname1))
(file-writable-p
- (file-name-directory (concat prefix localname2)))))
+ (file-name-directory (concat prefix localname2)))
+ (or (file-directory-p (concat prefix localname2))
+ (file-writable-p (concat prefix localname2))))
(tramp-do-copy-or-rename-file-directly
op (concat prefix localname1) (concat prefix localname2)
ok-if-already-exists keep-date t)
@@ -3392,7 +3437,7 @@
The method used must be an out-of-band method."
(let ((t1 (tramp-tramp-file-p filename))
(t2 (tramp-tramp-file-p newname))
- copy-program copy-args copy-keep-date port spec
+ copy-program copy-args copy-env copy-keep-date port spec
source target)
(with-parsed-tramp-file-name (if t1 filename newname) nil
@@ -3445,7 +3490,15 @@
;; " " is indication for keep-date argument.
(delete " " (mapcar '(lambda (y) (format-spec y spec)) x)))
(unless (member "" x) (mapconcat 'identity x " ")))
- (tramp-get-method-parameter method 'tramp-copy-args))))
+ (tramp-get-method-parameter method 'tramp-copy-args)))
+ copy-env
+ (delq
+ nil
+ (mapcar
+ '(lambda (x)
+ (setq x (mapcar '(lambda (y) (format-spec y spec)) x))
+ (unless (member "" x) (mapconcat 'identity x " ")))
+ (tramp-get-method-parameter method 'tramp-copy-env))))
;; Check for program.
(when (and (fboundp 'executable-find)
@@ -3459,12 +3512,16 @@
(with-temp-buffer
;; The default directory must be remote.
(let ((default-directory
- (file-name-directory (if t1 filename newname))))
+ (file-name-directory (if t1 filename newname)))
+ (process-environment (copy-sequence process-environment)))
;; Set the transfer process properties.
(tramp-set-connection-property
v "process-name" (buffer-name (current-buffer)))
(tramp-set-connection-property
v "process-buffer" (current-buffer))
+ (while copy-env
+ (tramp-message v 5 "%s=\"%s\"" (car copy-env) (cadr copy-env))
+ (setenv (pop copy-env) (pop copy-env)))
;; Use an asynchronous process. By this, password can
;; be handled. The default directory must be local, in
@@ -4015,7 +4072,15 @@
;; Cleanup. We remove all file cache values for the connection,
;; because the remote process could have changed them.
(when tmpinput (delete-file tmpinput))
- (tramp-flush-directory-property v "")
+
+ ;; `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'.
+ (unless (and (boundp 'process-file-side-effects)
+ (not (symbol-value 'process-file-side-effects)))
+ (tramp-flush-directory-property v ""))
+
;; Return exit status.
(if (equal ret -1)
(keyboard-quit)
@@ -4664,12 +4729,61 @@
(tramp-message v 0 "Wrote %s" filename))
(run-hooks 'tramp-handle-write-region-hook)))))
+(defvar tramp-vc-registered-file-names nil
+ "List used to collect file names, which are checked during `vc-registered'.")
+
+;; VC backends check for the existence of various different special
+;; files. This is very time consuming, because every single check
+;; requires a remote command (the file cache must be invalidated).
+;; Therefore, we apply a kind of optimization. We install the file
+;; name handler `tramp-vc-file-name-handler', which does nothing but
+;; remembers all file names for which `file-exists-p' or
+;; `file-readable-p' has been applied. A first run of `vc-registered'
+;; is performed. Afterwards, a script is applied for all collected
+;; file names, using just one remote command. The result of this
+;; script is used to fill the file cache with actual values. Now we
+;; can reset the file name handlers, and we make a second run of
+;; `vc-registered', which returns the expected result without sending
+;; any other remote command.
(defun tramp-handle-vc-registered (file)
"Like `vc-registered' for Tramp files."
- ;; There could be new files, created by the vc backend. We disable
- ;; the file cache therefore.
- (let ((tramp-cache-inhibit-cache t))
- (tramp-run-real-handler 'vc-registered (list file))))
+ ;; There could be new files, created by the vc backend. We cannot
+ ;; reuse the old cache entries, therefore.
+ (with-parsed-tramp-file-name file nil
+ (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.
+ (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 requests 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)
@@ -4678,6 +4792,7 @@
pass to the OPERATION."
(let* ((inhibit-file-name-handlers
`(tramp-file-name-handler
+ tramp-vc-file-name-handler
tramp-completion-file-name-handler
cygwin-mount-name-hook-function
cygwin-mount-map-drive-hook-function
@@ -4881,6 +4996,30 @@
(tramp-run-real-handler operation args))))))
(setq tramp-locked tl))))
+(defun tramp-vc-file-name-handler (operation &rest args)
+ "Invoke special file name handler, which collects files to be handled."
+ (save-match-data
+ (let ((filename
+ (tramp-replace-environment-variables
+ (apply 'tramp-file-name-for-operation operation args)))
+ (fn (assoc operation tramp-file-name-handler-alist)))
+ (with-parsed-tramp-file-name filename nil
+ (cond
+ ;; That's what we want: file names, for which checks are
+ ;; applied. We assume, that VC uses only `file-exists-p' and
+ ;; `file-readable-p' checks; otherwise we must extend the
+ ;; list. We do not perform any action, but return nil, in
+ ;; order to keep `vc-registered' running.
+ ((and fn (memq operation '(file-exists-p file-readable-p)))
+ (add-to-list 'tramp-vc-registered-file-names localname 'append)
+ nil)
+ ;; Tramp file name handlers like `expand-file-name'. They
+ ;; must still work.
+ (fn
+ (save-match-data (apply (cdr fn) args)))
+ ;; Default file name handlers, we don't care.
+ (t (tramp-run-real-handler operation args)))))))
+
;;;###autoload
(progn (defun tramp-completion-file-name-handler (operation &rest args)
"Invoke Tramp file name completion handler.
@@ -7369,24 +7508,19 @@
(defun tramp-get-ls-command (vec)
(with-connection-property vec "ls"
- (with-current-buffer (tramp-get-buffer vec)
(tramp-message vec 5 "Finding a suitable `ls' command")
(or
(catch 'ls-found
(dolist (cmd '("ls" "gnuls" "gls"))
(let ((dl (tramp-get-remote-path vec))
result)
- (while
- (and
- dl
- (setq result
- (tramp-find-executable vec cmd dl t t)))
+ (while (and dl (setq result (tramp-find-executable vec cmd dl t t)))
;; Check parameter.
(when (zerop (tramp-send-command-and-check
vec (format "%s -lnd /" result)))
(throw 'ls-found result))
(setq dl (cdr dl))))))
- (tramp-error vec 'file-error "Couldn't find a proper `ls' command")))))
+ (tramp-error vec 'file-error "Couldn't find a proper `ls' command"))))
(defun tramp-get-ls-command-with-dired (vec)
(save-match-data
@@ -7397,11 +7531,10 @@
(defun tramp-get-test-command (vec)
(with-connection-property vec "test"
- (with-current-buffer (tramp-get-buffer vec)
(tramp-message vec 5 "Finding a suitable `test' command")
(if (zerop (tramp-send-command-and-check vec "test 0"))
"test"
- (tramp-find-executable vec "test" (tramp-get-remote-path vec))))))
+ (tramp-find-executable vec "test" (tramp-get-remote-path vec)))))
(defun tramp-get-test-nt-command (vec)
;; Does `test A -nt B' work? Use abominable `find' construct if it
@@ -7426,26 +7559,22 @@
(defun tramp-get-file-exists-command (vec)
(with-connection-property vec "file-exists"
- (with-current-buffer (tramp-get-buffer vec)
(tramp-message vec 5 "Finding command to check if file exists")
- (tramp-find-file-exists-command vec))))
+ (tramp-find-file-exists-command vec)))
(defun tramp-get-remote-ln (vec)
(with-connection-property vec "ln"
- (with-current-buffer (tramp-get-buffer vec)
(tramp-message vec 5 "Finding a suitable `ln' command")
- (tramp-find-executable vec "ln" (tramp-get-remote-path vec)))))
+ (tramp-find-executable vec "ln" (tramp-get-remote-path vec))))
(defun tramp-get-remote-perl (vec)
(with-connection-property vec "perl"
- (with-current-buffer (tramp-get-buffer vec)
(tramp-message vec 5 "Finding a suitable `perl' command")
(or (tramp-find-executable vec "perl5" (tramp-get-remote-path vec))
- (tramp-find-executable vec "perl" (tramp-get-remote-path vec))))))
+ (tramp-find-executable vec "perl" (tramp-get-remote-path vec)))))
(defun tramp-get-remote-stat (vec)
(with-connection-property vec "stat"
- (with-current-buffer (tramp-get-buffer vec)
(tramp-message vec 5 "Finding a suitable `stat' command")
(let ((result (tramp-find-executable
vec "stat" (tramp-get-remote-path vec)))
@@ -7464,27 +7593,22 @@
(string-match "^./.$" (car tmp))
(integerp (cadr tmp)))
(setq result nil)))
- result))))
+ result)))
(defun tramp-get-remote-id (vec)
(with-connection-property vec "id"
- (with-current-buffer (tramp-get-buffer vec)
(tramp-message vec 5 "Finding POSIX `id' command")
(or
(catch 'id-found
(let ((dl (tramp-get-remote-path vec))
result)
- (while
- (and
- dl
- (setq result
- (tramp-find-executable vec "id" dl t t)))
+ (while (and dl (setq result (tramp-find-executable vec "id" dl t t)))
;; Check POSIX parameter.
(when (zerop (tramp-send-command-and-check
vec (format "%s -u" result)))
(throw 'id-found result))
(setq dl (cdr dl)))))
- (tramp-error vec 'file-error "Couldn't find a POSIX `id' command")))))
+ (tramp-error vec 'file-error "Couldn't find a POSIX `id' command"))))
(defun tramp-get-remote-uid (vec id-format)
(with-connection-property vec (format "uid-%s" id-format)
@@ -7939,7 +8063,15 @@
;; tramp-server-local-variable-alist) to define any such variables
;; that they need to, which would then be let bound as appropriate
;; in tramp functions. (Jason Rumney)
-;; * Optimize out-of-band copying, when both methods are scp-like.
+;; * Optimize out-of-band copying, when both methods are scp-like (not
+;; rsync).
+;; * Keep a second connection open for out-of-band methods like scp or
+;; rsync.
+;; * Partial completion completes word constituents. I find it
+;; acceptable if method completion works only after :, so that we
+;; have "/s: TAB" offer completion for the method first, filenames
+;; afterwards. (David Kastrup)
+
;; Functions for file-name-handler-alist:
;; diff-latest-backup-file -- in diff.el
- [Emacs-diffs] emacs/lisp/net tramp.el, Michael Albinus, 2009/08/02
- [Emacs-diffs] emacs/lisp/net tramp.el, Michael Albinus, 2009/08/03
- [Emacs-diffs] emacs/lisp/net tramp.el, Michael Albinus, 2009/08/03
- [Emacs-diffs] emacs/lisp/net tramp.el, Michael Albinus, 2009/08/09
- [Emacs-diffs] emacs/lisp/net tramp.el, Michael Albinus, 2009/08/17
- [Emacs-diffs] emacs/lisp/net tramp.el,
Michael Albinus <=
- [Emacs-diffs] emacs/lisp/net tramp.el, Michael Albinus, 2009/08/28