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

[Noah Friedman <friedman@splode.com>]

[-- Attachment #1: message body text --]
[-- Type: text/plain, Size: 746 bytes --]

I have a fix for this, but I'd like for someone else to look over it and
perhaps sanity check it before I commit it.  Volunteers?

This is a very old limitation.

Let's say I have three directories in my shell buffer directory stack:

	/s/software/wwwroot/Java Development Kit
	/s/software/wwwroot/Perl Compatible Regular Expressions
	~/src/build/depot/main/tools/build

If I run M-x shell-resync-dirs, I simply get the error:

	Couldn’t cd: (error No such directory found via CDPATH environment variable)

because the directory "/s/software/wwwroot/Java" doesn't exist.  The parser
considers whitespace to be a separator between directory tokens.

This version handles that case.

Diff and full function attached below.


[-- Attachment #2: ChangeLog --]
[-- Type: text/plain, Size: 137 bytes --]

2016-04-21  Noah Friedman  <friedman@splode.com>

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

[-- Attachment #3: shell.el.diff --]
[-- Type: text/plain, Size: 3860 bytes --]

--- 2016-04-20--18-08-56--0c9f35a/lisp/shell.el.~1~	2016-01-01 01:34:24.000000000 -0800
+++ 2016-04-20--18-08-56--0c9f35a/lisp/shell.el	2016-04-20 19:24:25.534756498 -0700
@@ -985,45 +985,62 @@
       ;; 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"))
+	(insert shell-dirstack-query "\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\\)")))
+	    (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)
+	(insert "\n")
+        (backward-char 1)
 	;; Wait for one line.
 	(while (not (looking-at regexp))
-	  (accept-process-output proc)
+	  (accept-process-output proc 1)
 	  (goto-char pt)))
-      (goto-char pmark) (delete-char 1) ; remove the extra newline
+      (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 tem 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:

[-- Attachment #4: shell-resync-dirs.el --]
[-- Type: text/plain, Size: 3225 bytes --]

(defun shell-resync-dirs ()
  "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."
  (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 "\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 1)
	  (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 '())
             (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 tem 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)))))