Merge from trunk

5 files changed, 114 insertions, 76 deletions

diff --git a/lisp/net/shr.el b/lisp/net/shr.el
index bdc30bc9292..4506ede8722 100644
--- a/lisp/net/shr.el
+++ b/lisp/net/shr.el
@@ -145,6 +145,7 @@ cid: URL as the argument.")
     (define-key map [follow-link] 'mouse-face)
     (define-key map "I" 'shr-insert-image)
     (define-key map "w" 'shr-copy-url)
+    (define-key map "u" 'shr-copy-url)
     (define-key map "v" 'shr-browse-url)
     (define-key map "o" 'shr-save-contents)
     (define-key map "\r" 'shr-browse-url)
diff --git a/lisp/net/tramp-cache.el b/lisp/net/tramp-cache.el
index 4c6141fe42b..f7f570590c8 100644
--- a/lisp/net/tramp-cache.el
+++ b/lisp/net/tramp-cache.el
@@ -38,9 +38,11 @@
 ;;
 ;; - localname is a string.  This are temporary properties, which are
 ;;   related to the file localname is referring to.  Examples:
-;;   "file-exists-p" is t or nile, depending on the file existence, or
+;;   "file-exists-p" is t or nil, depending on the file existence, or
 ;;   "file-attributes" caches the result of the function
-;;  `file-attributes'.
+;;   `file-attributes'.  These entries have a timestamp, and they
+;;   expire after `remote-file-name-inhibit-cache' seconds if this
+;;   variable is set.
 ;;
 ;; - The key is a process.  This are temporary properties related to
 ;;   an open connection.  Examples: "scripts" keeps shell script
diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el
index 6ba055b8bb8..c2fdc0491b6 100644
--- a/lisp/net/tramp-gvfs.el
+++ b/lisp/net/tramp-gvfs.el
@@ -1539,7 +1539,8 @@ connection if a previous connection has died for some reason."
 	;; indicated by the "mounted" signal, i.e. the "fuse-mountpoint"
 	;; file property.
 	(with-timeout
-	    (60
+	    ((or (tramp-get-method-parameter method 'tramp-connection-timeout)
+		 tramp-connection-timeout)
 	     (if (zerop (length (tramp-file-name-user vec)))
 		 (tramp-error
 		  vec 'file-error
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el
index d7316b8d2ea..281f497692d 100644
--- a/lisp/net/tramp-sh.el
+++ b/lisp/net/tramp-sh.el
@@ -222,21 +222,24 @@ detected as prompt when being sent on echoing hosts, therefore.")
     (tramp-login-program        "su")
     (tramp-login-args           (("-") ("%u")))
     (tramp-remote-shell         "/bin/sh")
-    (tramp-remote-shell-args    ("-c"))))
+    (tramp-remote-shell-args    ("-c"))
+    (tramp-connection-timeout   10)))
 ;;;###tramp-autoload
 (add-to-list 'tramp-methods
   '("sudo"
     (tramp-login-program        "sudo")
     (tramp-login-args           (("-u" "%u") ("-s") ("-H") ("-p" "Password:")))
     (tramp-remote-shell         "/bin/sh")
-    (tramp-remote-shell-args    ("-c"))))
+    (tramp-remote-shell-args    ("-c"))
+    (tramp-connection-timeout   10)))
 ;;;###tramp-autoload
 (add-to-list 'tramp-methods
   '("ksu"
     (tramp-login-program        "ksu")
     (tramp-login-args           (("%u") ("-q")))
     (tramp-remote-shell         "/bin/sh")
-    (tramp-remote-shell-args    ("-c"))))
+    (tramp-remote-shell-args    ("-c"))
+    (tramp-connection-timeout   10)))
 ;;;###tramp-autoload
 (add-to-list 'tramp-methods
   '("krlogin"
@@ -3752,12 +3755,16 @@ file exists and nonzero exit status otherwise."
   "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 +4339,6 @@ Gateway hops are already opened."
     ;; 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 +4352,7 @@ connection if a previous connection has died for some reason."
       ;; 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 +4437,7 @@ connection if a previous connection has died for some reason."
 		(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
@@ -4441,8 +4445,8 @@ connection if a previous connection has died for some reason."
 
 		;; Check whether process is alive.
 		(tramp-barf-if-no-shell-prompt
-		 p 60
-		 "Couldn't find local shell prompt %s" tramp-encoding-shell)
+		 p 10
+		 "Couldn't find local shell prompt for %s" tramp-encoding-shell)
 
 		;; Now do all the connections as specified.
 		(while target-alist
@@ -4460,6 +4464,9 @@ connection if a previous connection has died for some reason."
 			 (async-args
 			  (tramp-get-method-parameter
 			   l-method 'tramp-async-args))
+			 (connection-timeout
+			  (tramp-get-method-parameter
+			   l-method 'tramp-connection-timeout))
 			 (gw-args
 			  (tramp-get-method-parameter l-method 'tramp-gw-args))
 			 (gw (tramp-get-file-property hop "" "gateway" nil))
@@ -4542,7 +4549,8 @@ connection if a previous connection has died for some reason."
 		    (tramp-message vec 3 "Sending command `%s'" command)
 		    (tramp-send-command vec command t t)
 		    (tramp-process-actions
-		     p vec pos tramp-actions-before-shell 60)
+		     p vec pos tramp-actions-before-shell
+		     (or connection-timeout tramp-connection-timeout))
 		    (tramp-message
 		     vec 3 "Found remote shell prompt on `%s'" l-host))
 		  ;; Next hop.
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index f114c681fb7..3513701d20e 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -252,6 +252,11 @@ pair of the form (KEY VALUE).  The following KEYs are defined:
   * `tramp-tmpdir'
     A directory on the remote host for temporary files.  If not
     specified, \"/tmp\" is taken as default.
+  * `tramp-connection-timeout'
+    This is the maximum time to be spent for establishing a connection.
+    In general, the global default value shall be used, but for
+    some methods, like \"su\" or \"sudo\", a shorter timeout
+    might be desirable.
 
 What does all this mean?  Well, you should specify `tramp-login-program'
 for all methods; this program is used to log in to the remote site.  Then,
@@ -1034,6 +1039,13 @@ opening a connection to a remote host."
   :group 'tramp
   :type '(choice (const nil) (const t) (const pty)))
 
+(defcustom tramp-connection-timeout 60
+  "Defines the max time to wait for establishing a connection (in seconds).
+This can be overwritten for different connection types in `tramp-methods'."
+  :group 'tramp
+  :version "24.4"
+  :type 'integer)
+
 (defcustom tramp-connection-min-time-diff 5
   "Defines seconds between two consecutive connection attempts.
 This is necessary as self defense mechanism, in order to avoid
@@ -1071,6 +1083,9 @@ means to use always cached values for the directory contents."
 (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 +1479,6 @@ ARGS to actually emit the message (if applicable)."
 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
@@ -1536,23 +1547,32 @@ signal identifier to be raised, remaining args passed to
 If BUFFER is nil, show the connection buffer.  Wait for 30\", or until
 an input event arrives.  The other arguments are passed to `tramp-error'."
   (save-window-excursion
-    (unwind-protect
-	(apply 'tramp-error vec-or-proc signal fmt-string args)
-      (when (and vec-or-proc
-		 tramp-message-show-message
-		 (not (zerop tramp-verbose))
-		 (not (tramp-completion-mode-p)))
-	(let ((enable-recursive-minibuffers t))
-	  (pop-to-buffer
-	   (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))))))
+    (let* ((buf (or (and (bufferp buffer) buffer)
+		    (and (processp vec-or-proc) (process-buffer vec-or-proc))
+		    (and (vectorp vec-or-proc)
+			 (tramp-get-connection-buffer vec-or-proc))))
+	   (vec (or (and (vectorp vec-or-proc) vec-or-proc)
+		    (and buf (with-current-buffer buf
+			       (tramp-dissect-file-name default-directory))))))
+      (unwind-protect
+	  (apply 'tramp-error vec-or-proc signal fmt-string args)
+	;; Save exit.
+	(when (and buf
+		   tramp-message-show-message
+		   (not (zerop tramp-verbose))
+		   (not (tramp-completion-mode-p)))
+	  (let ((enable-recursive-minibuffers t))
+	    ;; `tramp-error' does not show messages.  So we must do it
+	    ;; ourselves.
+	    (message fmt-string args)
+	    ;; Show buffer.
+	    (pop-to-buffer buf)
+	    (discard-input)
+	    (sit-for 30)))
+	;; Reset timestamp.  It would be wrong after waiting for a while.
+	(when (equal (butlast (append vec nil) 2)
+		     (car 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.
@@ -1596,16 +1616,15 @@ If VAR is nil, then we bind `v' to the structure and `method', `user',
 
 (defmacro with-tramp-progress-reporter (vec level message &rest body)
   "Executes BODY, spinning a progress reporter with MESSAGE.
-If LEVEL does not fit for visible messages, or if this is a
-nested call of the macro, there are only traces without a visible
-progress reporter."
+If LEVEL does not fit for visible messages, there are only traces
+without a visible progress reporter."
   (declare (indent 3) (debug t))
-  `(let (pr tm)
+  `(let ((result "failed")
+	 pr tm)
      (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
@@ -1613,14 +1632,11 @@ progress reporter."
 	       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)
+	 ;; Execute the body.
+	 (prog1 (progn ,@body) (setq result "done"))
        ;; Stop progress reporter.
        (if tm (tramp-compat-funcall 'cancel-timer tm))
-       (tramp-message ,vec ,level "%s...done" ,message))))
+       (tramp-message ,vec ,level "%s...%s" ,message result))))
 
 (tramp-compat-font-lock-add-keywords
  'emacs-lisp-mode '("\\<with-tramp-progress-reporter\\>"))
@@ -3393,39 +3409,49 @@ The terminal type can be configured with `tramp-terminal-type'."
 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)
+	     (format
+	      "Timeout reached, see buffer `%s' for details"
+	      (tramp-get-connection-buffer vec)))
+	    (t "Login failed")))))
+      (when (numberp pos)
+	(with-current-buffer (tramp-get-connection-buffer vec)
+	  (let (buffer-read-only) (delete-region pos (point))))))))
 
 :;; Utility functions: