diff lisp/net/tramp.el @ 108775:481bba2e11df

* net/tramp.el (tramp-progress-reporter-update): New defun. (with-progress-reporter): Use it. (tramp-process-actions): * net/tramp-gvfs.el (tramp-gvfs-handler-askquestion): Preserve current message, in order to let progress reporter continue afterwards. (Bug#6257)
author Michael Albinus <michael.albinus@gmx.de>
date Tue, 25 May 2010 10:45:35 +0200
parents ae0f7dfcf9c9
children 04bc013ba171
line wrap: on
line diff
--- a/lisp/net/tramp.el	Mon May 24 21:25:15 2010 -0700
+++ b/lisp/net/tramp.el	Tue May 25 10:45:35 2010 +0200
@@ -2283,6 +2283,12 @@
 (put 'with-connection-property 'edebug-form-spec t)
 (font-lock-add-keywords 'emacs-lisp-mode '("\\<with-connection-property\\>"))
 
+(defun tramp-progress-reporter-update (reporter &optional value)
+  (let* ((parameters (cdr reporter))
+	 (message (aref parameters 3)))
+    (when (string-match message (or (current-message) ""))
+      (funcall 'progress-reporter-update reporter value))))
+
 (defmacro with-progress-reporter (vec level message &rest body)
   "Executes BODY, spinning a progress reporter with MESSAGE."
   `(let (pr tm)
@@ -2294,7 +2300,8 @@
 		(<= ,level (min tramp-verbose 3)))
        (condition-case nil
 	   (setq pr (tramp-compat-funcall 'make-progress-reporter ,message)
-		 tm (if pr (run-at-time 3 0.1 'progress-reporter-update pr)))
+		 tm (when pr
+		      (run-at-time 3 0.1 'tramp-progress-reporter-update pr)))
 	 (error nil)))
      (unwind-protect
 	 ;; Execute the body.
@@ -6734,27 +6741,29 @@
 
 (defun tramp-process-actions (proc vec actions &optional timeout)
   "Perform actions until success or TIMEOUT."
-  ;; Enable auth-source and password-cache.
-  (tramp-set-connection-property vec "first-password-request" t)
-  (let (exit)
-    (while (not exit)
-      (tramp-message proc 3 "Waiting for prompts from remote shell")
-      (setq exit
-	    (catch 'tramp-action
-	      (if timeout
-		  (with-timeout (timeout)
-		    (tramp-process-one-action proc vec actions))
-		(tramp-process-one-action proc vec actions)))))
-    (with-current-buffer (tramp-get-connection-buffer vec)
-      (tramp-message vec 6 "\n%s" (buffer-string)))
-    (unless (eq exit 'ok)
-      (tramp-clear-passwd vec)
-      (tramp-error-with-buffer
-       nil vec 'file-error
-       (cond
-	((eq exit 'permission-denied) "Permission denied")
-	((eq exit 'process-died) "Process died")
-	(t "Login failed"))))))
+  ;; Preserve message for `progress-reporter'.
+  (with-temp-message ""
+    ;; Enable auth-source and password-cache.
+    (tramp-set-connection-property vec "first-password-request" t)
+    (let (exit)
+      (while (not exit)
+	(tramp-message proc 3 "Waiting for prompts from remote shell")
+	(setq exit
+	      (catch 'tramp-action
+		(if timeout
+		    (with-timeout (timeout)
+		      (tramp-process-one-action proc vec actions))
+		  (tramp-process-one-action proc vec actions)))))
+      (with-current-buffer (tramp-get-connection-buffer vec)
+	(tramp-message vec 6 "\n%s" (buffer-string)))
+      (unless (eq exit 'ok)
+	(tramp-clear-passwd vec)
+	(tramp-error-with-buffer
+	 nil vec 'file-error
+	 (cond
+	  ((eq exit 'permission-denied) "Permission denied")
+	  ((eq exit 'process-died) "Process died")
+	  (t "Login failed")))))))
 
 ;; Utility functions.