From 6aafb92167565b13598a71635a1474645de0d5d4 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Sat, 26 Mar 2022 10:39:39 +0100 Subject: [PATCH] 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 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 -- 2.39.2