bug#23324: shell-resync-dirs does not handle dirs with whitespace

[Lars Ingebrigtsen]

Noam Postavsky <npostavs@gmail.com> writes:

> I think this loop is going in the wrong direction (i.e., it should
> rather be appending leading entries).  Because of this, it can be fooled
> by subdirectories with a name matching a substring of a dirs entry:
>
>     ~$ mkdir -p 'foo bar/bar/'
>     ~$ cd 'foo bar/'
>     ~/foo bar$ command dirs # M-x dirs
>     # infloops...
>
>> +          (let ((newelt "")
>> +                tem1 tem2)
>
> I'm also not a fan of the somewhat inscrutable tem1 & tem2 names.

I've respun the patch so that it actually works (tem1 was mis-spelled in
one place, and there was a bunch of unrelated white space fix-ups that
I've remove), but haven't done anything else to it.

Noam, I tried your test case, but I couldn't get it to infloop.  Is
there some additional steps needed to make it infloop?

diff --git a/lisp/shell.el b/lisp/shell.el
index f5e18bbc72..ed4b1efde0 100644
--- a/lisp/shell.el
+++ b/lisp/shell.el
@@ -1039,24 +1039,40 @@ shell-resync-dirs
          (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)))))
+      (let* ((dls (buffer-substring-no-properties
+                   (match-beginning 0) (1- (match-end 0))))
+             (dlsl '())
+             (pos 0)
+             (ds '()))
+        ;; 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:

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