Make shell-resync-dirs work with zsh

* lisp/shell.el (shell-resync-dirs): Use shell-eval-command to
avoid getting confused by zsh (bug#54384).
(shell-eval-command): New function.

1 files changed, 68 insertions, 70 deletions

diff --git a/lisp/shell.el b/lisp/shell.el
index 6198214abee..7d5cb475eb2 100644
--- a/lisp/shell.el
+++ b/lisp/shell.el
@@ -1026,77 +1026,45 @@ this feature; see the function `dirtrack-mode'."
   "Resync the buffer's idea of the current directory stack.
 This command queries the shell with the command bound to
 `shell-dirstack-query' (default \"dirs\"), reads the next
-line output and parses it to form the new directory stack.
-DON'T issue this command unless the buffer is at a shell prompt.
-Also, note that if some other subprocess decides to do output
-immediately after the query, its output will be taken as the
-new directory stack -- you lose.  If this happens, just do the
-command again."
+line output and parses it to form the new directory stack."
   (interactive)
-  (let* ((proc (get-buffer-process (current-buffer)))
-	 (pmark (process-mark proc))
-	 (started-at-pmark (= (point) (marker-position pmark))))
-    (save-excursion
-      (goto-char pmark)
-      ;; If the process echoes commands, don't insert a fake command in
-      ;; the buffer or it will appear twice.
-      (unless comint-process-echoes
-	(insert shell-dirstack-query) (insert "\n"))
-      (sit-for 0)			; force redisplay
-      (comint-send-string proc shell-dirstack-query)
-      (comint-send-string proc "\n")
-      (set-marker pmark (point))
-      (let ((pt (point))
-	    (regexp
-	     (concat
-	      (if comint-process-echoes
-		  ;; Skip command echo if the process echoes
-		  (concat "\\(" (regexp-quote shell-dirstack-query) "\n\\)")
-		"\\(\\)")
-	      "\\(.+\n\\)")))
-	;; This extra newline prevents the user's pending input from spoofing us.
-	(insert "\n") (backward-char 1)
-	;; Wait for one line.
-	(while (not (looking-at regexp))
-	  (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* ((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)))))
+  (let* ((dls (car
+               (last
+                (string-lines
+                 (string-chop-newline
+                  (shell-eval-command (concat shell-dirstack-query "\n")))))))
+         (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))))
 
 ;; For your typing convenience:
 (defalias 'dirs 'shell-resync-dirs)
@@ -1431,6 +1399,36 @@ Returns t if successful."
            (point-max)
          (shell--prompt-begin-position))))))
 
+(defun shell-eval-command (command)
+  "Eval COMMAND in the current shell process and return the result."
+  (let* ((proc (get-buffer-process (current-buffer)))
+         (old-filter (process-filter proc))
+         (result "")
+         prev)
+    (unwind-protect
+        (progn
+          (set-process-filter
+           proc
+           (lambda (_proc string)
+             (setq result (concat result string))))
+          (process-send-string proc command)
+          ;; Wait until we get a prompt (which will be a line without
+          ;; a newline).  This is far from fool-proof -- if something
+          ;; outputs incomplete data and then sleeps, we'll think
+          ;; we've received the prompt.
+          (while (not (let* ((lines (string-lines result))
+                             (last (car (last lines))))
+                        (and (length> lines 0)
+                             (not (equal last ""))
+                             (or (not prev)
+                                 (not (equal last prev)))
+                             (setq prev last))))
+            (accept-process-output proc 0 100)))
+      ;; Restore old filter.
+      (set-process-filter proc old-filter))
+    ;; Remove the prompt.
+    (replace-regexp-in-string "\n.*\\'" "\n" result)))
+
 (provide 'shell)
 
 ;;; shell.el ends here