changeset 108066:47a124b50bbf

Synchronize with Tramp repository. * net/tramp.el (with-connection-property, tramp-completion-mode-p) (tramp-action-process-alive, tramp-action-out-of-band) (tramp-check-for-regexp, tramp-file-name-p, tramp-equal-remote) (tramp-exists-file-name-handler): Fix docstring. (with-progress-reporter): New defmacro. (tramp-do-copy-or-rename-file, tramp-handle-dired-compress-file) (tramp-maybe-open-connection): Use it.
author Michael Albinus <michael.albinus@gmx.de>
date Thu, 22 Apr 2010 14:07:37 +0200
parents 186cf99d4122
children b0957e256d91 6ebf8ca9708b
files lisp/ChangeLog lisp/net/tramp.el
diffstat 2 files changed, 140 insertions(+), 121 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/ChangeLog	Thu Apr 22 13:21:39 2010 +0200
+++ b/lisp/ChangeLog	Thu Apr 22 14:07:37 2010 +0200
@@ -1,3 +1,15 @@
+2010-04-22  Michael Albinus  <michael.albinus@gmx.de>
+
+	Synchronize with Tramp repository.
+
+	* net/tramp.el (with-connection-property, tramp-completion-mode-p)
+	(tramp-action-process-alive, tramp-action-out-of-band)
+	(tramp-check-for-regexp, tramp-file-name-p, tramp-equal-remote)
+	(tramp-exists-file-name-handler): Fix docstring.
+	(with-progress-reporter): New defmacro.
+	(tramp-do-copy-or-rename-file, tramp-handle-dired-compress-file)
+	(tramp-maybe-open-connection): Use it.
+
 2010-04-22  Noah Lavine  <noah549@gmail.com>  (tiny change)
 
 	Detect ssh 'ControlMaster' argument automatically in some cases.
--- a/lisp/net/tramp.el	Thu Apr 22 13:21:39 2010 +0200
+++ b/lisp/net/tramp.el	Thu Apr 22 14:07:37 2010 +0200
@@ -2240,7 +2240,7 @@
 (font-lock-add-keywords 'emacs-lisp-mode '("\\<with-file-property\\>"))
 
 (defmacro with-connection-property (key property &rest body)
-  "Checks in Tramp for property PROPERTY, otherwise executes BODY and set."
+  "Check in Tramp for property PROPERTY, otherwise executes BODY and set."
   `(let ((value (tramp-get-connection-property ,key ,property 'undef)))
     (when (eq value 'undef)
       ;; We cannot pass ,@body as parameter to
@@ -2254,7 +2254,29 @@
 (put 'with-connection-property 'edebug-form-spec t)
 (font-lock-add-keywords 'emacs-lisp-mode '("\\<with-connection-property\\>"))
 
-(eval-and-compile			; silence compiler
+(defmacro with-progress-reporter (vec level message &rest body)
+  "Executes BODY, spinning a progress reporter with MESSAGE."
+  `(let (pr tm)
+     (tramp-message ,vec ,level "%s..." ,message)
+     ;; We start a pulsing progress reporter after 3 seconds.  Feature
+     ;; introduced in Emacs 24.1.
+     (when (<= ,level tramp-verbose)
+       (condition-case nil
+	   (setq pr (funcall 'make-progress-reporter ,message)
+		 tm (run-at-time 3 0.1 'progress-reporter-update pr))
+	 (error nil)))
+     (unwind-protect
+	 ;; Execute the body.
+	 (progn ,@body)
+       ;; Stop progress reporter.
+       (if tm (cancel-timer tm))
+       (tramp-message ,vec ,level "%s...done" ,message))))
+
+(put 'with-progress-reporter 'lisp-indent-function 3)
+(put 'with-progress-reporter 'edebug-form-spec t)
+(font-lock-add-keywords 'emacs-lisp-mode '("\\<with-progress-reporter\\>"))
+
+(eval-and-compile			;; Silence compiler.
   (if (memq system-type '(cygwin windows-nt))
       (defun tramp-drop-volume-letter (name)
 	"Cut off unnecessary drive letter from file NAME.
@@ -3547,91 +3569,76 @@
 	 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 start a pulsing progress reporter.  Introduced in Emacs 24.1.
-    (when (> (nth 7 (file-attributes filename)) tramp-copy-size-limit)
-      (condition-case nil
-	  (setq pr (funcall
-		    'make-progress-reporter
-		    (format "Transferring %s to %s..." filename newname))
-		tm (run-at-time 0 0.1 'progress-reporter-update pr))
-	(error nil)))
-
-    (unwind-protect
-	(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)
-	  (with-parsed-tramp-file-name (if t1 filename newname) nil
-	    (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")))
-
-      ;; 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 nil
-	  (tramp-flush-file-property v (file-name-directory localname))
-	  (tramp-flush-file-property v localname)))
-
-      ;; When newname did exist, we have wrong cached values.
-      (when t2
-	(with-parsed-tramp-file-name newname nil
-	  (tramp-flush-file-property v (file-name-directory localname))
-	  (tramp-flush-file-property v localname)))
-
-      ;; Stop progress reporter.
-      (if tm (cancel-timer tm))
-      (with-parsed-tramp-file-name (if t1 filename newname) nil
-	(tramp-message v 0 "Transferring %s to %s...done" filename newname)))))
+      (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")))
+
+       ;; 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.
@@ -4069,30 +4076,30 @@
 	       nil)
 	      ((and suffix (nth 2 suffix))
 	       ;; We found an uncompression rule.
-	       (tramp-message v 0 "Uncompressing %s..." file)
-	       (when (zerop (tramp-send-command-and-check
-			     v (concat (nth 2 suffix) " "
-				       (tramp-shell-quote-argument localname))))
-		 (tramp-message v 0 "Uncompressing %s...done" file)
-		 ;; `dired-remove-file' is not defined in XEmacs
-		 (funcall (symbol-function 'dired-remove-file) file)
-		 (string-match (car suffix) file)
-		 (concat (substring file 0 (match-beginning 0)))))
+	       (with-progress-reporter v 0 (format "Uncompressing %s..." file)
+		 (when (zerop
+			(tramp-send-command-and-check
+			 v (concat (nth 2 suffix) " "
+				   (tramp-shell-quote-argument localname))))
+		   ;; `dired-remove-file' is not defined in XEmacs
+		   (funcall (symbol-function 'dired-remove-file) file)
+		   (string-match (car suffix) file)
+		   (concat (substring file 0 (match-beginning 0))))))
 	      (t
 	       ;; We don't recognize the file as compressed, so compress it.
 	       ;; Try gzip.
-	       (tramp-message v 0 "Compressing %s..." file)
-	       (when (zerop (tramp-send-command-and-check
-			     v (concat "gzip -f "
-				       (tramp-shell-quote-argument localname))))
-		 (tramp-message v 0 "Compressing %s...done" file)
-		 ;; `dired-remove-file' is not defined in XEmacs
-		 (funcall (symbol-function 'dired-remove-file) file)
-		 (cond ((file-exists-p (concat file ".gz"))
-			(concat file ".gz"))
-		       ((file-exists-p (concat file ".z"))
-			(concat file ".z"))
-		       (t nil)))))))))
+	       (with-progress-reporter v 0 (format "Compressing %s..." file)
+		 (when (zerop
+			(tramp-send-command-and-check
+			 v (concat "gzip -f "
+				   (tramp-shell-quote-argument localname))))
+		   ;; `dired-remove-file' is not defined in XEmacs
+		   (funcall (symbol-function 'dired-remove-file) file)
+		   (cond ((file-exists-p (concat file ".gz"))
+			  (concat file ".gz"))
+			 ((file-exists-p (concat file ".z"))
+			  (concat file ".z"))
+			 (t nil))))))))))
 
 (defun tramp-handle-dired-uncache (dir &optional dir-p)
   "Like `dired-uncache' for Tramp files."
@@ -5552,9 +5559,9 @@
          ;; disable this part of the completion, unless the user implicitly
          ;; indicated his interest in using a fancier completion system.
          (or (eq tramp-syntax 'sep)
-             (featurep 'tramp) ;; If it's loaded, we may as well use
-	     ;; it.  `partial-completion-mode' does not exist in
-	     ;; XEmacs.  It is obsoleted with Emacs 24.1.
+             (featurep 'tramp) ;; If it's loaded, we may as well use it.
+	     ;; `partial-completion-mode' does not exist in XEmacs.
+	     ;; It is obsoleted with Emacs 24.1.
              (and (boundp 'partial-completion-mode) partial-completion-mode)
              ;; FIXME: These may have been loaded even if the user never
              ;; intended to use them.
@@ -5628,7 +5635,7 @@
 ;; overwriting this check in such cases. Or we change Tramp file name
 ;; syntax in order to avoid ambiguities, like in XEmacs ...
 (defun tramp-completion-mode-p ()
-  "Checks whether method / user name / host name completion is active."
+  "Check, whether method / user name / host name completion is active."
   (or
    ;; Signal from outside.  `non-essential' has been introduced in Emacs 24.
    (and (boundp 'non-essential) (symbol-value 'non-essential))
@@ -6587,12 +6594,12 @@
   (tramp-send-string vec tramp-terminal-type))
 
 (defun tramp-action-process-alive (proc vec)
-  "Check whether a process has finished."
+  "Check, whether a process has finished."
   (unless (memq (process-status proc) '(run open))
     (throw 'tramp-action 'process-died)))
 
 (defun tramp-action-out-of-band (proc vec)
-  "Check whether an out-of-band copy has finished."
+  "Check, whether an out-of-band copy has finished."
   (cond ((and (memq (process-status proc) '(stop exit))
 	      (zerop (process-exit-status proc)))
 	 (tramp-message	vec 3 "Process has finished.")
@@ -6674,7 +6681,7 @@
     (tramp-message proc 10 "\n%s" (buffer-string))))
 
 (defun tramp-check-for-regexp (proc regexp)
-  "Check whether REGEXP is contained in process buffer of PROC.
+  "Check, whether REGEXP is contained in process buffer of PROC.
 Erase echoed commands if exists."
   (with-current-buffer (process-buffer proc)
     (goto-char (point-min))
@@ -7315,9 +7322,9 @@
 
 	  ;; Check whether process is alive.
 	  (tramp-set-process-query-on-exit-flag p nil)
-	  (tramp-message vec 3 "Waiting 60s for local shell to come up...")
-	  (tramp-barf-if-no-shell-prompt
-	   p 60 "Couldn't find local shell prompt %s" tramp-encoding-shell)
+	  (with-progress-reporter vec 3 "Waiting 60s for local shell to come up"
+	    (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
@@ -7810,7 +7817,7 @@
 ;; data structure.
 
 (defun tramp-file-name-p (vec)
-  "Check whether VEC is a Tramp object."
+  "Check, whether VEC is a Tramp object."
   (and (vectorp vec) (= 4 (length vec))))
 
 (defun tramp-file-name-method (vec)
@@ -7941,7 +7948,7 @@
 	   localname))))))
 
 (defun tramp-equal-remote (file1 file2)
-  "Checks, whether the remote parts of FILE1 and FILE2 are identical.
+  "Check, whether the remote parts of FILE1 and FILE2 are identical.
 The check depends on method, user and host name of the files.  If
 one of the components is missing, the default values are used.
 The local file name parts of FILE1 and FILE2 are not taken into
@@ -8319,7 +8326,7 @@
 ;; Auto saving to a special directory.
 
 (defun tramp-exists-file-name-handler (operation &rest args)
-  "Checks whether OPERATION runs a file name handler."
+  "Check, whether OPERATION runs a file name handler."
   ;; The file name handler is determined on base of either an
   ;; argument, `buffer-file-name', or `default-directory'.
   (condition-case nil