[Emacs-diffs] /srv/bzr/emacs/trunk r100435: * net/tramp.el (tramp-progress-reporter-update): New defun.

[Michael Albinus]

------------------------------------------------------------
revno: 100435
committer: Michael Albinus <address@hidden>
branch nick: trunk
timestamp: Tue 2010-05-25 10:45:35 +0200
message:
  * 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)
modified:
  lisp/ChangeLog
  lisp/net/tramp-gvfs.el
  lisp/net/tramp.el

=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog    2010-05-25 03:38:41 +0000
+++ b/lisp/ChangeLog    2010-05-25 08:45:35 +0000
@@ -1,3 +1,12 @@
+2010-05-25  Michael Albinus  <address@hidden>
+
+       * 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)
+
 2010-05-25  Glenn Morris  <address@hidden>
 
        * net/rcirc.el (rcirc-default-user-name, rcirc-default-full-name):

=== modified file 'lisp/net/tramp-gvfs.el'
--- a/lisp/net/tramp-gvfs.el    2010-05-21 14:16:42 +0000
+++ b/lisp/net/tramp-gvfs.el    2010-05-25 08:45:35 +0000
@@ -874,10 +874,12 @@
            ;; there is only the question whether to accept an unknown
            ;; host signature.
            (with-temp-buffer
-             (insert message)
-             (pop-to-buffer (current-buffer))
-             (setq choice (if (yes-or-no-p (concat (car choices) " ")) 0 1))
-             (tramp-message v 6 "%d" choice))
+             ;; Preserve message for `progress-reporter'.
+             (with-temp-message ""
+               (insert message)
+               (pop-to-buffer (current-buffer))
+               (setq choice (if (yes-or-no-p (concat (car choices) " ")) 0 1))
+               (tramp-message v 6 "%d" choice)))
 
            ;; When the choice is "no", we set an empty
            ;; fuse-mountpoint in order to leave the timeout.
@@ -889,8 +891,8 @@
             nil ;; no abort of D-Bus.
             choice))
 
-         ;; When QUIT is raised, we shall return this information to D-Bus.
-         (quit (list nil t 0))))))
+       ;; When QUIT is raised, we shall return this information to D-Bus.
+       (quit (list nil t 0))))))
 
 (defun tramp-gvfs-handler-mounted-unmounted (mount-info)
   "Signal handler for the \"org.gtk.vfs.MountTracker.mounted\" and

=== modified file 'lisp/net/tramp.el'
--- a/lisp/net/tramp.el 2010-05-21 14:16:42 +0000
+++ b/lisp/net/tramp.el 2010-05-25 08:45:35 +0000
@@ -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.