bug#54776: 28.1; shell-resync-dirs hangs

[Lars Ingebrigtsen]

Glenn Morris <rgm@gnu.org> writes:

> Are you sure this issue isn't due to the changes from
> https://debbugs.gnu.org/23324, which were applied in Emacs 28.1 (which
> would make it a regression from Emacs 27, no)?

Good catch.

Kevin, could you try reverting 90e65c826fa (or applying (in reverse) the
attached patch) and see whether that fixes the problem?  If so, we could
revert the patch for Emacs 28.2.

-- 
(domestic pets only, the antidote for overdose, milk.)
   bloggy blog: http://lars.ingebrigtsen.no

commit 90e65c826fab2092ad2099d7763538194c93e021
Author:     Noah Friedman <friedman@splode.com>
AuthorDate: Wed Aug 19 15:59:59 2020 +0200
Commit:     Lars Ingebrigtsen <larsi@gnus.org>
CommitDate: Wed Aug 19 15:59:59 2020 +0200

    Make shell-resync-dirs handle whitespace in directory names
    
    * lisp/shell.el (shell-resync-dirs): Correctly handle
    whitespace in directory names (bug#23324).

diff --git a/lisp/shell.el b/lisp/shell.el
index 301a8cb083..9667dab2af 100644
--- a/lisp/shell.el
+++ b/lisp/shell.el
@@ -1035,25 +1035,41 @@ shell-resync-dirs
          (accept-process-output proc)
          (goto-char pt)))
       (goto-char pmark) (delete-char 1) ; remove the extra newline
-      ;; That's the dirlist. grab it & parse it.
-      (let* ((dl (buffer-substring (match-beginning 2) (1- (match-end 2))))
-            (dl-len (length dl))
-            (ds '())                   ; new dir stack
-            (i 0))
-       (while (< i dl-len)
-         ;; regexp = optional whitespace, (non-whitespace), optional whitespace
-         (string-match "\\s *\\(\\S +\\)\\s *" dl i) ; pick off next dir
-         (setq ds (cons (concat comint-file-name-prefix
-                                (substring dl (match-beginning 1)
-                                           (match-end 1)))
-                        ds))
-         (setq i (match-end 0)))
-       (let ((ds (nreverse ds)))
-         (with-demoted-errors "Couldn't cd: %s"
-           (shell-cd (car ds))
-           (setq shell-dirstack (cdr ds)
-                 shell-last-dir (car shell-dirstack))
-           (shell-dirstack-message)))))
+      ;; That's the dirlist.  Grab it & parse it.
+      (let* ((dls (buffer-substring-no-properties
+                   (match-beginning 0) (1- (match-end 0))))
+             (dlsl nil)
+             (pos 0)
+             (ds nil))
+        ;; Split the dirlist into whitespace and non-whitespace chunks.
+        ;; dlsl will be a reversed list of tokens.
+        (while (string-match "\\(\\S-+\\|\\s-+\\)" dls pos)
+          (push (match-string 1 dls) dlsl)
+          (setq pos (match-end 1)))
+
+        ;; Prepend trailing entries until they form an existing directory,
+        ;; whitespace and all.  Discard the next whitespace and repeat.
+        (while dlsl
+          (let ((newelt "")
+                tem1 tem2)
+            (while newelt
+              ;; We need tem1 because we don't want to prepend
+              ;; `comint-file-name-prefix' repeatedly into newelt via tem2.
+              (setq tem1 (pop dlsl)
+                    tem2 (concat comint-file-name-prefix tem1 newelt))
+              (cond ((file-directory-p tem2)
+                     (push tem2 ds)
+                     (when (string= " " (car dlsl))
+                       (pop dlsl))
+                     (setq newelt nil))
+                    (t
+                     (setq newelt (concat tem1 newelt)))))))
+
+        (with-demoted-errors "Couldn't cd: %s"
+          (shell-cd (car ds))
+          (setq shell-dirstack (cdr ds)
+                shell-last-dir (car shell-dirstack))
+          (shell-dirstack-message))))
     (if started-at-pmark (goto-char (marker-position pmark)))))
 
 ;; For your typing convenience: