(compilation-start): Move let-binding of

`process-environment' into `with-current-buffer' body.
Reported by Matt Hodges <MPHodges@member.fsf.org>.

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index c0c5518f765b40e32dac4fdda0f1ebb814587624..9409b485a3a22a557067d7d2297e33f04600a495 100644 (file)
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,9 @@
+2004-10-16  Juri Linkov  <juri@jurta.org>
+
+       * progmodes/compile.el (compilation-start): Move let-binding of
+       `process-environment' into `with-current-buffer' body.
+       Reported by Matt Hodges <MPHodges@member.fsf.org>.
+
 2004-10-16  Richard M. Stallman  <rms@gnu.org>
 
        * pcvs-util.el (cvs-bury-buffer):
@@ -271,7 +277,7 @@
 2004-10-05  Juri Linkov  <juri@jurta.org>
 
        * isearch.el (isearch-done): Set mark after running hook.
-       Suggested by Drew Adams <drew.adams@oracle.com>.
+       Reported by Drew Adams <drew.adams@oracle.com>.
 
        * info.el (Info-history, Info-toc): Fix Info headers.
        (Info-toc): Narrow buffer before Info-fontify-node.

diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el
index a3aa70a8a8d7445806de54231f5568e5401cd16a..d90fe77fe2833c5fc9f911ed805d7debb32fa4a7 100644 (file)
--- a/lisp/progmodes/compile.el
+++ b/lisp/progmodes/compile.el
@@ -866,20 +866,6 @@ Returns the compilation buffer created."
          (if (eq mode t)
              (prog1 "compilation" (require 'comint))
            (replace-regexp-in-string "-mode$" "" (symbol-name mode))))
-        (process-environment
-         (append
-          compilation-environment
-          (if (if (boundp 'system-uses-terminfo) ; `if' for compiler warning
-                  system-uses-terminfo)
-              (list "TERM=dumb" "TERMCAP="
-                    (format "COLUMNS=%d" (window-width)))
-            (list "TERM=emacs"
-                  (format "TERMCAP=emacs:co#%d:tc=unknown:"
-                          (window-width))))
-          ;; Set the EMACS variable, but
-          ;; don't override users' setting of $EMACS.
-          (unless (getenv "EMACS") '("EMACS=t"))
-          (copy-sequence process-environment)))
         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))
@@ -923,69 +909,83 @@ Returns the compilation buffer created."
     ;; Pop up the compilation buffer.
     (setq outwin (display-buffer outbuf nil t))
     (with-current-buffer outbuf
-      (if (not (eq mode t))
-         (funcall mode)
-       (setq buffer-read-only nil)
-       (with-no-warnings (comint-mode))
-       (compilation-shell-minor-mode))
-      (if highlight-regexp
-         (set (make-local-variable 'compilation-highlight-regexp)
-              highlight-regexp))
-      (set (make-local-variable 'compilation-arguments)
-          (list command mode name-function highlight-regexp))
-      (set (make-local-variable 'revert-buffer-function)
-          'compilation-revert-buffer)
-      (set-window-start outwin (point-min))
-      (or (eq outwin (selected-window))
-         (set-window-point outwin (if compilation-scroll-output
-                                      (point)
-                                    (point-min))))
-      ;; The setup function is called before compilation-set-window-height
-      ;; so it can set the compilation-window-height buffer locally.
-      (if compilation-process-setup-function
-         (funcall compilation-process-setup-function))
-      (compilation-set-window-height outwin)
-      ;; Start the compilation.
-      (if (fboundp 'start-process)
-         (let ((proc (if (eq mode t)
-                         (get-buffer-process
-                          (with-no-warnings
-                           (comint-exec outbuf (downcase mode-name)
-                                        shell-file-name nil `("-c" ,command))))
-                       (start-process-shell-command (downcase mode-name)
-                                                    outbuf command))))
-           ;; Make the buffer's mode line show process state.
-           (setq mode-line-process '(":%s"))
-           (set-process-sentinel proc 'compilation-sentinel)
-           (set-process-filter proc 'compilation-filter)
-           (set-marker (process-mark proc) (point) outbuf)
-           (setq compilation-in-progress
-                 (cons proc compilation-in-progress)))
-       ;; No asynchronous processes available.
-       (message "Executing `%s'..." command)
-       ;; Fake modeline display as if `start-process' were run.
-       (setq mode-line-process ":run")
-       (force-mode-line-update)
-       (sit-for 0)                     ; Force redisplay
-       (let ((status (call-process shell-file-name nil outbuf nil "-c"
-                                   command)))
-         (cond ((numberp status)
-                (compilation-handle-exit 'exit status
-                                         (if (zerop status)
-                                             "finished\n"
-                                           (format "\
+      (let ((process-environment
+            (append
+             compilation-environment
+             (if (if (boundp 'system-uses-terminfo) ; `if' for compiler warning
+                     system-uses-terminfo)
+                 (list "TERM=dumb" "TERMCAP="
+                       (format "COLUMNS=%d" (window-width)))
+               (list "TERM=emacs"
+                     (format "TERMCAP=emacs:co#%d:tc=unknown:"
+                             (window-width))))
+             ;; Set the EMACS variable, but
+             ;; don't override users' setting of $EMACS.
+             (unless (getenv "EMACS") '("EMACS=t"))
+             (copy-sequence process-environment))))
+       (if (not (eq mode t))
+           (funcall mode)
+         (setq buffer-read-only nil)
+         (with-no-warnings (comint-mode))
+         (compilation-shell-minor-mode))
+       (if highlight-regexp
+           (set (make-local-variable 'compilation-highlight-regexp)
+                highlight-regexp))
+       (set (make-local-variable 'compilation-arguments)
+            (list command mode name-function highlight-regexp))
+       (set (make-local-variable 'revert-buffer-function)
+            'compilation-revert-buffer)
+       (set-window-start outwin (point-min))
+       (or (eq outwin (selected-window))
+           (set-window-point outwin (if compilation-scroll-output
+                                        (point)
+                                      (point-min))))
+       ;; The setup function is called before compilation-set-window-height
+       ;; so it can set the compilation-window-height buffer locally.
+       (if compilation-process-setup-function
+           (funcall compilation-process-setup-function))
+       (compilation-set-window-height outwin)
+       ;; Start the compilation.
+       (if (fboundp 'start-process)
+           (let ((proc (if (eq mode t)
+                           (get-buffer-process
+                            (with-no-warnings
+                             (comint-exec outbuf (downcase mode-name)
+                                          shell-file-name nil `("-c" ,command))))
+                         (start-process-shell-command (downcase mode-name)
+                                                      outbuf command))))
+             ;; Make the buffer's mode line show process state.
+             (setq mode-line-process '(":%s"))
+             (set-process-sentinel proc 'compilation-sentinel)
+             (set-process-filter proc 'compilation-filter)
+             (set-marker (process-mark proc) (point) outbuf)
+             (setq compilation-in-progress
+                   (cons proc compilation-in-progress)))
+         ;; No asynchronous processes available.
+         (message "Executing `%s'..." command)
+         ;; Fake modeline display as if `start-process' were run.
+         (setq mode-line-process ":run")
+         (force-mode-line-update)
+         (sit-for 0)                   ; Force redisplay
+         (let ((status (call-process shell-file-name nil outbuf nil "-c"
+                                     command)))
+           (cond ((numberp status)
+                  (compilation-handle-exit 'exit status
+                                           (if (zerop status)
+                                               "finished\n"
+                                             (format "\
 exited abnormally with code %d\n"
-                                                   status))))
-               ((stringp status)
-                (compilation-handle-exit 'signal status
-                                         (concat status "\n")))
-               (t
-                (compilation-handle-exit 'bizarre status status))))
-       ;; Without async subprocesses, the buffer is not yet
-       ;; fontified, so fontify it now.
-       (let ((font-lock-verbose nil))  ; shut up font-lock messages
-         (font-lock-fontify-buffer))
-       (message "Executing `%s'...done" command)))
+                                                     status))))
+                 ((stringp status)
+                  (compilation-handle-exit 'signal status
+                                           (concat status "\n")))
+                 (t
+                  (compilation-handle-exit 'bizarre status status))))
+         ;; Without async subprocesses, the buffer is not yet
+         ;; fontified, so fontify it now.
+         (let ((font-lock-verbose nil)) ; shut up font-lock messages
+           (font-lock-fontify-buffer))
+         (message "Executing `%s'...done" command))))
     (if (buffer-local-value 'compilation-scroll-output outbuf)
        (save-selected-window
          (select-window outwin)