[Emacs-diffs] trunk r113357: Improve error messages. (Bug#14808)

[Michael Albinus]

------------------------------------------------------------
revno: 113357
revision-id: address@hidden
parent: address@hidden
committer: Michael Albinus <address@hidden>
branch nick: trunk
timestamp: Wed 2013-07-10 16:58:26 +0200
message:
  Improve error messages.  (Bug#14808)
  
  * net/tramp.el (tramp-current-connection): New defvar, moved from
  tramp-sh.el.
  (tramp-message-show-progress-reporter-message): Removed, not
  needed anymore.
  (tramp-error-with-buffer): Show message in minibuffer.  Discard
  input before waiting.  Reset connection timestamp.
  (with-tramp-progress-reporter): Improve messages.
  (tramp-process-actions): Use progress reporter.  Delete process in
  case of error.  Improve messages.
  
  * net/tramp-sh.el (tramp-barf-if-no-shell-prompt): Use
  condition-case.  Call `tramp-error-with-buffer' with vector and buffer.
  (tramp-current-connection): Removed.
  (tramp-maybe-open-connection): The car of
  `tramp-current-connection' are the first 3 slots of the vector.
modified:
  lisp/ChangeLog                 changelog-20091113204419-o5vbwnq5f7feedwu-1432
  lisp/net/tramp-sh.el           trampsh.el-20100913133439-a1faifh29eqoi4nh-1
  lisp/net/tramp.el              tramp.el-20091113204419-o5vbwnq5f7feedwu-2427

=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog    2013-07-10 14:34:13 +0000
+++ b/lisp/ChangeLog    2013-07-10 14:58:26 +0000
@@ -1,3 +1,23 @@
+2013-07-10  Michael Albinus  <address@hidden>
+
+       Improve error messages.  (Bug#14808)
+
+       * net/tramp.el (tramp-current-connection): New defvar, moved from
+       tramp-sh.el.
+       (tramp-message-show-progress-reporter-message): Removed, not
+       needed anymore.
+       (tramp-error-with-buffer): Show message in minibuffer.  Discard
+       input before waiting.  Reset connection timestamp.
+       (with-tramp-progress-reporter): Improve messages.
+       (tramp-process-actions): Use progress reporter.  Delete process in
+       case of error.  Improve messages.
+
+       * net/tramp-sh.el (tramp-barf-if-no-shell-prompt): Use
+       condition-case.  Call `tramp-error-with-buffer' with vector and buffer.
+       (tramp-current-connection): Removed.
+       (tramp-maybe-open-connection): The car of
+       `tramp-current-connection' are the first 3 slots of the vector.
+
 2013-07-10  Teodor Zlatanov  <address@hidden>
 
        * progmodes/cfengine.el (cfengine3-indent-line): Do not indent

=== modified file 'lisp/net/tramp-sh.el'
--- a/lisp/net/tramp-sh.el      2013-07-06 16:17:16 +0000
+++ b/lisp/net/tramp-sh.el      2013-07-10 14:58:26 +0000
@@ -3752,12 +3752,16 @@
   "Wait for shell prompt and barf if none appears.
 Looks at process PROC to see if a shell prompt appears in TIMEOUT
 seconds.  If not, it produces an error message with the given ERROR-ARGS."
-  (unless
-      (tramp-wait-for-regexp
-       proc timeout
-       (format
-       "\\(%s\\|%s\\)\\'" shell-prompt-pattern tramp-shell-prompt-pattern))
-    (apply 'tramp-error-with-buffer nil proc 'file-error error-args)))
+  (let ((vec (tramp-get-connection-property proc "vector" nil)))
+    (condition-case err
+       (tramp-wait-for-regexp
+        proc timeout
+        (format
+         "\\(%s\\|%s\\)\\'" shell-prompt-pattern tramp-shell-prompt-pattern))
+      (error
+       (delete-process proc)
+       (apply 'tramp-error-with-buffer
+             (tramp-get-connection-buffer vec) vec 'file-error error-args)))))
 
 (defun tramp-open-connection-setup-interactive-shell (proc vec)
   "Set up an interactive shell.
@@ -4332,9 +4336,6 @@
     ;; Result.
     target-alist))
 
-(defvar tramp-current-connection nil
-  "Last connection timestamp.")
-
 (defun tramp-maybe-open-connection (vec)
   "Maybe open a connection VEC.
 Does not do anything if a connection is already open, but re-opens the
@@ -4348,7 +4349,7 @@
       ;; If Tramp opens the same connection within a short time frame,
       ;; there is a problem.  We shall signal this.
       (unless (or (and p (processp p) (memq (process-status p) '(run open)))
-                 (not (equal (butlast (append vec nil))
+                 (not (equal (butlast (append vec nil) 2)
                              (car tramp-current-connection)))
                  (> (tramp-time-diff
                      (current-time) (cdr tramp-current-connection))
@@ -4433,7 +4434,7 @@
                (set-process-sentinel p 'tramp-process-sentinel)
                (tramp-compat-set-process-query-on-exit-flag p nil)
                (setq tramp-current-connection
-                     (cons (butlast (append vec nil)) (current-time))
+                     (cons (butlast (append vec nil) 2) (current-time))
                      tramp-current-host (system-name))
 
                (tramp-message
@@ -4442,7 +4443,7 @@
                ;; Check whether process is alive.
                (tramp-barf-if-no-shell-prompt
                 p 60
-                "Couldn't find local shell prompt %s" tramp-encoding-shell)
+                "Couldn't find local shell prompt for %s" tramp-encoding-shell)
 
                ;; Now do all the connections as specified.
                (while target-alist

=== modified file 'lisp/net/tramp.el'
--- a/lisp/net/tramp.el 2013-07-06 16:12:04 +0000
+++ b/lisp/net/tramp.el 2013-07-10 14:58:26 +0000
@@ -1071,6 +1071,9 @@
 (defvar tramp-current-host nil
   "Remote host for this *tramp* buffer.")
 
+(defvar tramp-current-connection nil
+  "Last connection timestamp.")
+
 ;;;###autoload
 (defconst tramp-completion-file-name-handler-alist
   '((file-name-all-completions . 
tramp-completion-handle-file-name-all-completions)
@@ -1464,10 +1467,6 @@
 This variable is used to disable messages from `tramp-error'.
 The messages are visible anyway, because an error is raised.")
 
-(defvar tramp-message-show-progress-reporter-message t
-  "Show Tramp progress reporter message in the minibuffer.
-This variable is used to disable recursive progress reporter messages.")
-
 (defsubst tramp-message (vec-or-proc level fmt-string &rest args)
   "Emit a message depending on verbosity level.
 VEC-OR-PROC identifies the Tramp buffer to use.  It can be either a
@@ -1547,12 +1546,13 @@
           (or (and (bufferp buffer) buffer)
               (and (processp vec-or-proc) (process-buffer vec-or-proc))
               (tramp-get-connection-buffer vec-or-proc)))
-         (when (string-equal fmt-string "Process died")
-           (message
-            "%s\n    %s"
-            "Tramp failed to connect.  If this happens repeatedly, try"
-            "`M-x tramp-cleanup-this-connection'"))
-         (sit-for 30))))))
+         ;; `tramp-error' does not show messages.  So we must do it ourselves.
+         (message fmt-string args)
+         (discard-input)
+         (sit-for 30)))
+      ;; Reset timestamp.  It would be wrong after waiting for a while.
+      (when tramp-current-connection
+       (setcdr tramp-current-connection (current-time))))))
 
 (defmacro with-parsed-tramp-file-name (filename var &rest body)
   "Parse a Tramp filename and make components available in the body.
@@ -1604,23 +1604,27 @@
      (tramp-message ,vec ,level "%s..." ,message)
      ;; We start a pulsing progress reporter after 3 seconds.  Feature
      ;; introduced in Emacs 24.1.
-     (when (and tramp-message-show-progress-reporter-message
-               tramp-message-show-message
+     (when (and tramp-message-show-message
                ;; Display only when there is a minimum level.
                (<= ,level (min tramp-verbose 3)))
        (ignore-errors
         (setq pr (tramp-compat-funcall 'make-progress-reporter ,message)
               tm (when pr
                    (run-at-time 3 0.1 'tramp-progress-reporter-update pr)))))
-     (unwind-protect
-        ;; Execute the body.  Suppress concurrent progress reporter
-        ;; messages.
-        (let ((tramp-message-show-progress-reporter-message
-               (and tramp-message-show-progress-reporter-message (not tm))))
-          ,@body)
-       ;; Stop progress reporter.
-       (if tm (tramp-compat-funcall 'cancel-timer tm))
-       (tramp-message ,vec ,level "%s...done" ,message))))
+     (condition-case err
+        (unwind-protect
+            ;; Execute the body.
+            (progn  ,@body)
+          ;; Stop progress reporter.
+          (if tm (tramp-compat-funcall 'cancel-timer tm)))
+
+       ;; Error handling.
+       ((error quit)
+       (tramp-message ,vec ,level "%s...failed" ,message)
+       (signal (car err) (cdr err))))
+
+     ;; Exit.
+     (tramp-message ,vec ,level "%s...done" ,message)))
 
 (tramp-compat-font-lock-add-keywords
  'emacs-lisp-mode '("\\<with-tramp-progress-reporter\\>"))
@@ -3393,39 +3397,47 @@
 PROC and VEC indicate the remote connection to be used.  POS, if
 set, is the starting point of the region to be deleted in the
 connection buffer."
-  ;; Preserve message for `progress-reporter'.
-  (tramp-compat-with-temp-message ""
-    ;; Enable `auth-source' and `password-cache'.  We must use
-    ;; tramp-current-* variables in case we have several hops.
-    (tramp-set-connection-property
-     (tramp-dissect-file-name
-      (tramp-make-tramp-file-name
-       tramp-current-method tramp-current-user tramp-current-host ""))
-     "first-password-request" t)
-    (save-restriction
+  ;; Enable `auth-source' and `password-cache'.  We must use
+  ;; tramp-current-* variables in case we have several hops.
+  (tramp-set-connection-property
+   (tramp-dissect-file-name
+    (tramp-make-tramp-file-name
+     tramp-current-method tramp-current-user tramp-current-host ""))
+   "first-password-request" t)
+  (save-restriction
+    (with-tramp-progress-reporter
+       proc 3 "Waiting for prompts from remote shell"
       (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))
+       (if timeout
+           (with-timeout (timeout (setq exit 'timeout))
+             (while (not exit)
+               (setq exit
+                     (catch 'tramp-action
+                       (tramp-process-one-action proc vec actions)))))
+         (while (not exit)
+           (setq exit
+                 (catch 'tramp-action
                    (tramp-process-one-action proc vec actions)))))
        (with-current-buffer (tramp-get-connection-buffer vec)
          (widen)
          (tramp-message vec 6 "\n%s" (buffer-string)))
        (unless (eq exit 'ok)
          (tramp-clear-passwd vec)
+         (delete-process proc)
          (tramp-error-with-buffer
-          nil vec 'file-error
+          (tramp-get-connection-buffer vec) vec 'file-error
           (cond
            ((eq exit 'permission-denied) "Permission denied")
-           ((eq exit 'process-died) "Process died")
-           (t "Login failed"))))
-       (when (numberp pos)
-         (with-current-buffer (tramp-get-connection-buffer vec)
-           (let (buffer-read-only) (delete-region pos (point)))))))))
+           ((eq exit 'process-died)
+            (concat
+             "Tramp failed to connect.  If this happens repeatedly, try\n"
+             "    `M-x tramp-cleanup-this-connection'"))
+           ((eq exit 'timeout)
+            "Timeout reached.  Check the buffer for the error reason")
+           (t "Login failed")))))
+      (when (numberp pos)
+       (with-current-buffer (tramp-get-connection-buffer vec)
+         (let (buffer-read-only) (delete-region pos (point))))))))
 
 :;; Utility functions: