From 9e0213891d41fb237d61916e5e316a1ee522d569 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Tue, 25 May 2010 10:45:35 +0200 Subject: [PATCH] * 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) --- lisp/ChangeLog | 9 +++++++++ lisp/net/tramp-gvfs.el | 14 +++++++------ lisp/net/tramp.el | 53 +++++++++++++++++++++++++++++--------------------- 3 files changed, 48 insertions(+), 28 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 884e3c51e8c..ed0de283cd7 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,12 @@ +2010-05-25 Michael Albinus + + * 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 * net/rcirc.el (rcirc-default-user-name, rcirc-default-full-name): diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index 6607dae32f5..2cad20e4cfb 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el @@ -874,10 +874,12 @@ ADDRESS can have the form \"xx:xx:xx:xx:xx:xx\" or \"[xx:xx:xx:xx:xx:xx]\"." ;; 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 @@ ADDRESS can have the form \"xx:xx:xx:xx:xx:xx\" or \"[xx:xx:xx:xx:xx:xx]\"." 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 diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index d643e85ec24..075e931878e 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -2283,6 +2283,12 @@ FILE must be a local file name on a connection identified via VEC." (put 'with-connection-property 'edebug-form-spec t) (font-lock-add-keywords 'emacs-lisp-mode '("\\")) +(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 @@ FILE must be a local file name on a connection identified via VEC." (<= ,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 @@ The terminal type can be configured with `tramp-terminal-type'." (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. -- 2.11.4.GIT