diff options
| author | Michael Albinus | 2010-05-25 10:45:35 +0200 |
|---|---|---|
| committer | Michael Albinus | 2010-05-25 10:45:35 +0200 |
| commit | 9e0213891d41fb237d61916e5e316a1ee522d569 (patch) | |
| tree | 8095208d05e795ed7e8fa8f4a55d810590c84d33 | |
| parent | c345fe90206916a13a261bf7ec5827ccd4bd9147 (diff) | |
| download | emacs-9e0213891d41fb237d61916e5e316a1ee522d569.tar.gz emacs-9e0213891d41fb237d61916e5e316a1ee522d569.zip | |
* 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)
| -rw-r--r-- | lisp/ChangeLog | 9 | ||||
| -rw-r--r-- | lisp/net/tramp-gvfs.el | 14 | ||||
| -rw-r--r-- | 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 @@ | |||
| 1 | 2010-05-25 Michael Albinus <michael.albinus@gmx.de> | ||
| 2 | |||
| 3 | * net/tramp.el (tramp-progress-reporter-update): New defun. | ||
| 4 | (with-progress-reporter): Use it. | ||
| 5 | (tramp-process-actions): | ||
| 6 | * net/tramp-gvfs.el (tramp-gvfs-handler-askquestion): Preserve | ||
| 7 | current message, in order to let progress reporter continue | ||
| 8 | afterwards. (Bug#6257) | ||
| 9 | |||
| 1 | 2010-05-25 Glenn Morris <rgm@gnu.org> | 10 | 2010-05-25 Glenn Morris <rgm@gnu.org> |
| 2 | 11 | ||
| 3 | * net/rcirc.el (rcirc-default-user-name, rcirc-default-full-name): | 12 | * 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]\"." | |||
| 874 | ;; there is only the question whether to accept an unknown | 874 | ;; there is only the question whether to accept an unknown |
| 875 | ;; host signature. | 875 | ;; host signature. |
| 876 | (with-temp-buffer | 876 | (with-temp-buffer |
| 877 | (insert message) | 877 | ;; Preserve message for `progress-reporter'. |
| 878 | (pop-to-buffer (current-buffer)) | 878 | (with-temp-message "" |
| 879 | (setq choice (if (yes-or-no-p (concat (car choices) " ")) 0 1)) | 879 | (insert message) |
| 880 | (tramp-message v 6 "%d" choice)) | 880 | (pop-to-buffer (current-buffer)) |
| 881 | (setq choice (if (yes-or-no-p (concat (car choices) " ")) 0 1)) | ||
| 882 | (tramp-message v 6 "%d" choice))) | ||
| 881 | 883 | ||
| 882 | ;; When the choice is "no", we set an empty | 884 | ;; When the choice is "no", we set an empty |
| 883 | ;; fuse-mountpoint in order to leave the timeout. | 885 | ;; 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]\"." | |||
| 889 | nil ;; no abort of D-Bus. | 891 | nil ;; no abort of D-Bus. |
| 890 | choice)) | 892 | choice)) |
| 891 | 893 | ||
| 892 | ;; When QUIT is raised, we shall return this information to D-Bus. | 894 | ;; When QUIT is raised, we shall return this information to D-Bus. |
| 893 | (quit (list nil t 0)))))) | 895 | (quit (list nil t 0)))))) |
| 894 | 896 | ||
| 895 | (defun tramp-gvfs-handler-mounted-unmounted (mount-info) | 897 | (defun tramp-gvfs-handler-mounted-unmounted (mount-info) |
| 896 | "Signal handler for the \"org.gtk.vfs.MountTracker.mounted\" and | 898 | "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." | |||
| 2283 | (put 'with-connection-property 'edebug-form-spec t) | 2283 | (put 'with-connection-property 'edebug-form-spec t) |
| 2284 | (font-lock-add-keywords 'emacs-lisp-mode '("\\<with-connection-property\\>")) | 2284 | (font-lock-add-keywords 'emacs-lisp-mode '("\\<with-connection-property\\>")) |
| 2285 | 2285 | ||
| 2286 | (defun tramp-progress-reporter-update (reporter &optional value) | ||
| 2287 | (let* ((parameters (cdr reporter)) | ||
| 2288 | (message (aref parameters 3))) | ||
| 2289 | (when (string-match message (or (current-message) "")) | ||
| 2290 | (funcall 'progress-reporter-update reporter value)))) | ||
| 2291 | |||
| 2286 | (defmacro with-progress-reporter (vec level message &rest body) | 2292 | (defmacro with-progress-reporter (vec level message &rest body) |
| 2287 | "Executes BODY, spinning a progress reporter with MESSAGE." | 2293 | "Executes BODY, spinning a progress reporter with MESSAGE." |
| 2288 | `(let (pr tm) | 2294 | `(let (pr tm) |
| @@ -2294,7 +2300,8 @@ FILE must be a local file name on a connection identified via VEC." | |||
| 2294 | (<= ,level (min tramp-verbose 3))) | 2300 | (<= ,level (min tramp-verbose 3))) |
| 2295 | (condition-case nil | 2301 | (condition-case nil |
| 2296 | (setq pr (tramp-compat-funcall 'make-progress-reporter ,message) | 2302 | (setq pr (tramp-compat-funcall 'make-progress-reporter ,message) |
| 2297 | tm (if pr (run-at-time 3 0.1 'progress-reporter-update pr))) | 2303 | tm (when pr |
| 2304 | (run-at-time 3 0.1 'tramp-progress-reporter-update pr))) | ||
| 2298 | (error nil))) | 2305 | (error nil))) |
| 2299 | (unwind-protect | 2306 | (unwind-protect |
| 2300 | ;; Execute the body. | 2307 | ;; Execute the body. |
| @@ -6734,27 +6741,29 @@ The terminal type can be configured with `tramp-terminal-type'." | |||
| 6734 | 6741 | ||
| 6735 | (defun tramp-process-actions (proc vec actions &optional timeout) | 6742 | (defun tramp-process-actions (proc vec actions &optional timeout) |
| 6736 | "Perform actions until success or TIMEOUT." | 6743 | "Perform actions until success or TIMEOUT." |
| 6737 | ;; Enable auth-source and password-cache. | 6744 | ;; Preserve message for `progress-reporter'. |
| 6738 | (tramp-set-connection-property vec "first-password-request" t) | 6745 | (with-temp-message "" |
| 6739 | (let (exit) | 6746 | ;; Enable auth-source and password-cache. |
| 6740 | (while (not exit) | 6747 | (tramp-set-connection-property vec "first-password-request" t) |
| 6741 | (tramp-message proc 3 "Waiting for prompts from remote shell") | 6748 | (let (exit) |
| 6742 | (setq exit | 6749 | (while (not exit) |
| 6743 | (catch 'tramp-action | 6750 | (tramp-message proc 3 "Waiting for prompts from remote shell") |
| 6744 | (if timeout | 6751 | (setq exit |
| 6745 | (with-timeout (timeout) | 6752 | (catch 'tramp-action |
| 6746 | (tramp-process-one-action proc vec actions)) | 6753 | (if timeout |
| 6747 | (tramp-process-one-action proc vec actions))))) | 6754 | (with-timeout (timeout) |
| 6748 | (with-current-buffer (tramp-get-connection-buffer vec) | 6755 | (tramp-process-one-action proc vec actions)) |
| 6749 | (tramp-message vec 6 "\n%s" (buffer-string))) | 6756 | (tramp-process-one-action proc vec actions))))) |
| 6750 | (unless (eq exit 'ok) | 6757 | (with-current-buffer (tramp-get-connection-buffer vec) |
| 6751 | (tramp-clear-passwd vec) | 6758 | (tramp-message vec 6 "\n%s" (buffer-string))) |
| 6752 | (tramp-error-with-buffer | 6759 | (unless (eq exit 'ok) |
| 6753 | nil vec 'file-error | 6760 | (tramp-clear-passwd vec) |
| 6754 | (cond | 6761 | (tramp-error-with-buffer |
| 6755 | ((eq exit 'permission-denied) "Permission denied") | 6762 | nil vec 'file-error |
| 6756 | ((eq exit 'process-died) "Process died") | 6763 | (cond |
| 6757 | (t "Login failed")))))) | 6764 | ((eq exit 'permission-denied) "Permission denied") |
| 6765 | ((eq exit 'process-died) "Process died") | ||
| 6766 | (t "Login failed"))))))) | ||
| 6758 | 6767 | ||
| 6759 | ;; Utility functions. | 6768 | ;; Utility functions. |
| 6760 | 6769 | ||