(compilation-start): Rely on `cd' to get dir right and also allow argumentless cd.

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index e0133ddf331a2fbf69a27df2c4355cd0f538bc6f..e0e6e2dbccb2f93f90014d2cef449ad65d8357eb 100644 (file)
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,8 @@
+2004-10-21  Daniel Pfeiffer  <occitan@esperanto.org>
+
+       * progmodes/compile.el (compilation-start): Rely on `cd' to get
+       dir right and also allow argumentless cd.
+
 2004-10-19  Richard M. Stallman  <rms@gnu.org>
 
        * textmodes/flyspell.el (flyspell-mode): Doc fix.

diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el
index 5179e2e9b2cfb4d543a53b68cdc87183bf86ce3f..0dc73e966644a444b2209a887a1328fc1ba32fd8 100644 (file)
--- a/lisp/progmodes/compile.el
+++ b/lisp/progmodes/compile.el
@@ -866,10 +866,7 @@ Returns the compilation buffer created."
          (if (eq mode t)
              (prog1 "compilation" (require 'comint))
            (replace-regexp-in-string "-mode$" "" (symbol-name mode))))
-        cd-path                 ; in case process-environment contains CDPATH
-        (thisdir (if (string-match "^\\s *cd\\s +\\(.+?\\)\\s *[;&\n]" command)
-                     (substitute-in-file-name (match-string 1 command))
-                   default-directory))
+        (thisdir default-directory)
         outwin outbuf)
     (with-current-buffer
        (setq outbuf
@@ -890,17 +887,25 @@ Returns the compilation buffer created."
              (error "Cannot have two processes in `%s' at once"
                     (buffer-name)))))
       (buffer-disable-undo (current-buffer))
+      ;; first transfer directory from where M-x compile was called
+      (setq default-directory thisdir)
       ;; Make compilation buffer read-only.  The filter can still write it.
       ;; Clear out the compilation buffer.
-      (let ((inhibit-read-only t))
+      (let ((inhibit-read-only t)
+           (default-directory thisdir))
+       ;; Then evaluate a cd command if any, but don't perform it yet, else start-command
+       ;; would do it again through the shell: (cd "..") AND sh -c "cd ..; make"
+       (cd (if (string-match "^\\s *cd\\(?:\\s +\\(\\S +?\\)\\)?\\s *[;&\n]" command)
+               (if (match-end 1)
+                   (match-string 1 command)
+                 "~")
+             default-directory))
        (erase-buffer)
-       ;; Change its default-directory to the directory where the compilation
-       ;; will happen, and insert a `cd' command to indicate this.
-       (setq default-directory thisdir)
        ;; output a mode setter, for saving and later reloading this buffer
        (insert "-*- mode: " name-of-mode
                "; default-directory: " (prin1-to-string default-directory)
-               " -*-\n" command "\n"))
+               " -*-\n" command "\n")
+       (setq thisdir default-directory))
       (set-buffer-modified-p nil))
     ;; If we're already in the compilation buffer, go to the end
     ;; of the buffer, so point will track the compilation output.
@@ -985,7 +990,9 @@ exited abnormally with code %d\n"
          ;; fontified, so fontify it now.
          (let ((font-lock-verbose nil)) ; shut up font-lock messages
            (font-lock-fontify-buffer))
-         (message "Executing `%s'...done" command))))
+         (message "Executing `%s'...done" command)))
+      ;; Now finally cd to where the shell started make/grep/...
+      (setq default-directory thisdir))
     (if (buffer-local-value 'compilation-scroll-output outbuf)
        (save-selected-window
          (select-window outwin)