From: Michael Albinus <michael.albinus@gmx.de>
Date: Sat, 26 Mar 2022 09:39:39 +0000 (+0100)
Subject: Don't let Tramp block dired  (Bug#54542)
X-Git-Tag: emacs-29.0.90~1931^2~904
X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=6aafb92167565b13598a71635a1474645de0d5d4;p=emacs.git

Don't let Tramp block dired  (Bug#54542)

* lisp/dired.el (dired-find-buffer-nocreate): Avoid avoid hangs in
remote buffers with a blocked connection.  (Bug#54542)

* lisp/net/tramp-sh.el (tramp-maybe-open-connection):
Extend suppression rules.
---

diff --git a/lisp/dired.el b/lisp/dired.el
index 3c37a887baf..409a312d0dd 100644
--- a/lisp/dired.el
+++ b/lisp/dired.el
@@ -1282,39 +1282,42 @@ The return value is the target column for the file names."
   ;; This differs from dired-buffers-for-dir in that it does not consider
   ;; subdirs of default-directory and searches for the first match only.
   ;; Also, the major mode must be MODE.
-  (if (and (featurep 'dired-x)
-           dired-find-subdir
-           ;; Don't try to find a wildcard as a subdirectory.
-	   (string-equal dirname (file-name-directory dirname)))
-      (let* ((cur-buf (current-buffer))
-	     (buffers (nreverse (dired-buffers-for-dir dirname)))
-	     (cur-buf-matches (and (memq cur-buf buffers)
-				   ;; Wildcards must match, too:
-				   (equal dired-directory dirname))))
-	;; We don't want to switch to the same buffer---
-	(setq buffers (delq cur-buf buffers))
-	(or (car (sort buffers #'dired-buffer-more-recently-used-p))
-	    ;; ---unless it's the only possibility:
-	    (and cur-buf-matches cur-buf)))
-    ;; No dired-x, or dired-find-subdir nil.
-    (setq dirname (expand-file-name dirname))
-    (let (found (blist dired-buffers))    ; was (buffer-list)
-      (or mode (setq mode 'dired-mode))
-      (while blist
-        (if (null (buffer-name (cdr (car blist))))
-            (setq blist (cdr blist))
-          (with-current-buffer (cdr (car blist))
-            (if (and (eq major-mode mode)
-                     dired-directory  ;; nil during find-alternate-file
-                     (equal dirname
-                            (expand-file-name
-                             (if (consp dired-directory)
-                                 (car dired-directory)
-                               dired-directory))))
-                (setq found (cdr (car blist))
-                      blist nil)
-              (setq blist (cdr blist))))))
-      found)))
+  ;; We bind `non-essential' in order to avoid hangs in remote buffers
+  ;; with a blocked connection.  (Bug#54542)
+  (let ((non-essential t))
+    (if (and (featurep 'dired-x)
+             dired-find-subdir
+             ;; Don't try to find a wildcard as a subdirectory.
+	     (string-equal dirname (file-name-directory dirname)))
+        (let* ((cur-buf (current-buffer))
+	       (buffers (nreverse (dired-buffers-for-dir dirname)))
+	       (cur-buf-matches (and (memq cur-buf buffers)
+				     ;; Wildcards must match, too:
+				     (equal dired-directory dirname))))
+	  ;; We don't want to switch to the same buffer---
+	  (setq buffers (delq cur-buf buffers))
+	  (or (car (sort buffers #'dired-buffer-more-recently-used-p))
+	      ;; ---unless it's the only possibility:
+	      (and cur-buf-matches cur-buf)))
+      ;; No dired-x, or dired-find-subdir nil.
+      (setq dirname (expand-file-name dirname))
+      (let (found (blist dired-buffers))    ; was (buffer-list)
+        (or mode (setq mode 'dired-mode))
+        (while blist
+          (if (null (buffer-name (cdr (car blist))))
+              (setq blist (cdr blist))
+            (with-current-buffer (cdr (car blist))
+              (if (and (eq major-mode mode)
+                       dired-directory  ;; nil during find-alternate-file
+                       (equal dirname
+                              (expand-file-name
+                               (if (consp dired-directory)
+                                   (car dired-directory)
+                                 dired-directory))))
+                  (setq found (cdr (car blist))
+                        blist nil)
+                (setq blist (cdr blist))))))
+        found))))
 
 
 ;;; Read in a new dired buffer
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el
index fd18b3f05c6..805be8270a4 100644
--- a/lisp/net/tramp-sh.el
+++ b/lisp/net/tramp-sh.el
@@ -4957,6 +4957,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 (process-live-p p)
+                (and (processp p) (not non-essential))
 		(not (tramp-file-name-equal-p
 		      vec (car tramp-current-connection)))
 		(time-less-p