# HG changeset patch # User Juri Linkov # Date 1097951874 0 # Node ID 2aec2ccb618bdb4e9a302de214bdfb426da54ba4 # Parent 6ef9b12e5d13083f0e81d5509b86685ae1d45bc1 (compilation-start): Move let-binding of `process-environment' into `with-current-buffer' body. Reported by Matt Hodges . diff -r 6ef9b12e5d13 -r 2aec2ccb618b lisp/progmodes/compile.el --- a/lisp/progmodes/compile.el Sat Oct 16 15:35:53 2004 +0000 +++ b/lisp/progmodes/compile.el Sat Oct 16 18:37:54 2004 +0000 @@ -866,20 +866,6 @@ (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 @@ ;; 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)