[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
master 6aafb92167 1/2: Don't let Tramp block dired (Bug#54542)
From: |
Michael Albinus |
Subject: |
master 6aafb92167 1/2: Don't let Tramp block dired (Bug#54542) |
Date: |
Sat, 26 Mar 2022 05:40:29 -0400 (EDT) |
branch: master
commit 6aafb92167565b13598a71635a1474645de0d5d4
Author: Michael Albinus <michael.albinus@gmx.de>
Commit: Michael Albinus <michael.albinus@gmx.de>
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.
---
lisp/dired.el | 69 +++++++++++++++++++++++++++-------------------------
lisp/net/tramp-sh.el | 1 +
2 files changed, 37 insertions(+), 33 deletions(-)
diff --git a/lisp/dired.el b/lisp/dired.el
index 3c37a887ba..409a312d0d 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 fd18b3f05c..805be8270a 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