Mercurial > emacs

comparison lisp/progmodes/compile.el @ 57530:2aec2ccb618b

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
(compilation-start): Move let-binding of `process-environment' into `with-current-buffer' body. Reported by Matt Hodges <MPHodges@member.fsf.org>.
author Juri Linkov <juri@jurta.org>
date Sat, 16 Oct 2004 18:37:54 +0000
parents 7a899182458c
children 8b57f4d6c462
comparison
equal deleted inserted replaced
57529:6ef9b12e5d13 57530:2aec2ccb618b
864 (or mode (setq mode 'compilation-mode)) 864 (or mode (setq mode 'compilation-mode))
865 (let* ((name-of-mode 865 (let* ((name-of-mode
866 (if (eq mode t) 866 (if (eq mode t)
867 (prog1 "compilation" (require 'comint)) 867 (prog1 "compilation" (require 'comint))
868 (replace-regexp-in-string "-mode$" "" (symbol-name mode)))) 868 (replace-regexp-in-string "-mode$" "" (symbol-name mode))))
869 (process-environment
870 (append
871 compilation-environment
872 (if (if (boundp 'system-uses-terminfo) ; `if' for compiler warning
873 system-uses-terminfo)
874 (list "TERM=dumb" "TERMCAP="
875 (format "COLUMNS=%d" (window-width)))
876 (list "TERM=emacs"
877 (format "TERMCAP=emacs:co#%d:tc=unknown:"
878 (window-width))))
879 ;; Set the EMACS variable, but
880 ;; don't override users' setting of $EMACS.
881 (unless (getenv "EMACS") '("EMACS=t"))
882 (copy-sequence process-environment)))
883 cd-path ; in case process-environment contains CDPATH 869 cd-path ; in case process-environment contains CDPATH
884 (thisdir (if (string-match "^\\s *cd\\s +\\(.+?\\)\\s *[;&\n]" command) 870 (thisdir (if (string-match "^\\s *cd\\s +\\(.+?\\)\\s *[;&\n]" command)
885 (substitute-in-file-name (match-string 1 command)) 871 (substitute-in-file-name (match-string 1 command))
886 default-directory)) 872 default-directory))
887 outwin outbuf) 873 outwin outbuf)
921 (if (eq outbuf (current-buffer)) 907 (if (eq outbuf (current-buffer))
922 (goto-char (point-max))) 908 (goto-char (point-max)))
923 ;; Pop up the compilation buffer. 909 ;; Pop up the compilation buffer.
924 (setq outwin (display-buffer outbuf nil t)) 910 (setq outwin (display-buffer outbuf nil t))
925 (with-current-buffer outbuf 911 (with-current-buffer outbuf
926 (if (not (eq mode t)) 912 (let ((process-environment
927 (funcall mode) 913 (append
928 (setq buffer-read-only nil) 914 compilation-environment
929 (with-no-warnings (comint-mode)) 915 (if (if (boundp 'system-uses-terminfo) ; `if' for compiler warning
930 (compilation-shell-minor-mode)) 916 system-uses-terminfo)
931 (if highlight-regexp 917 (list "TERM=dumb" "TERMCAP="
932 (set (make-local-variable 'compilation-highlight-regexp) 918 (format "COLUMNS=%d" (window-width)))
933 highlight-regexp)) 919 (list "TERM=emacs"
934 (set (make-local-variable 'compilation-arguments) 920 (format "TERMCAP=emacs:co#%d:tc=unknown:"
935 (list command mode name-function highlight-regexp)) 921 (window-width))))
936 (set (make-local-variable 'revert-buffer-function) 922 ;; Set the EMACS variable, but
937 'compilation-revert-buffer) 923 ;; don't override users' setting of $EMACS.
938 (set-window-start outwin (point-min)) 924 (unless (getenv "EMACS") '("EMACS=t"))
939 (or (eq outwin (selected-window)) 925 (copy-sequence process-environment))))
940 (set-window-point outwin (if compilation-scroll-output 926 (if (not (eq mode t))
941 (point) 927 (funcall mode)
942 (point-min)))) 928 (setq buffer-read-only nil)
943 ;; The setup function is called before compilation-set-window-height 929 (with-no-warnings (comint-mode))
944 ;; so it can set the compilation-window-height buffer locally. 930 (compilation-shell-minor-mode))
945 (if compilation-process-setup-function 931 (if highlight-regexp
946 (funcall compilation-process-setup-function)) 932 (set (make-local-variable 'compilation-highlight-regexp)
947 (compilation-set-window-height outwin) 933 highlight-regexp))
948 ;; Start the compilation. 934 (set (make-local-variable 'compilation-arguments)
949 (if (fboundp 'start-process) 935 (list command mode name-function highlight-regexp))
950 (let ((proc (if (eq mode t) 936 (set (make-local-variable 'revert-buffer-function)
951 (get-buffer-process 937 'compilation-revert-buffer)
952 (with-no-warnings 938 (set-window-start outwin (point-min))
953 (comint-exec outbuf (downcase mode-name) 939 (or (eq outwin (selected-window))
954 shell-file-name nil `("-c" ,command)))) 940 (set-window-point outwin (if compilation-scroll-output
955 (start-process-shell-command (downcase mode-name) 941 (point)
956 outbuf command)))) 942 (point-min))))
957 ;; Make the buffer's mode line show process state. 943 ;; The setup function is called before compilation-set-window-height
958 (setq mode-line-process '(":%s")) 944 ;; so it can set the compilation-window-height buffer locally.
959 (set-process-sentinel proc 'compilation-sentinel) 945 (if compilation-process-setup-function
960 (set-process-filter proc 'compilation-filter) 946 (funcall compilation-process-setup-function))
961 (set-marker (process-mark proc) (point) outbuf) 947 (compilation-set-window-height outwin)
962 (setq compilation-in-progress 948 ;; Start the compilation.
963 (cons proc compilation-in-progress))) 949 (if (fboundp 'start-process)
964 ;; No asynchronous processes available. 950 (let ((proc (if (eq mode t)
965 (message "Executing `%s'..." command) 951 (get-buffer-process
966 ;; Fake modeline display as if `start-process' were run. 952 (with-no-warnings
967 (setq mode-line-process ":run") 953 (comint-exec outbuf (downcase mode-name)
968 (force-mode-line-update) 954 shell-file-name nil `("-c" ,command))))
969 (sit-for 0) ; Force redisplay 955 (start-process-shell-command (downcase mode-name)
970 (let ((status (call-process shell-file-name nil outbuf nil "-c" 956 outbuf command))))
971 command))) 957 ;; Make the buffer's mode line show process state.
972 (cond ((numberp status) 958 (setq mode-line-process '(":%s"))
973 (compilation-handle-exit 'exit status 959 (set-process-sentinel proc 'compilation-sentinel)
974 (if (zerop status) 960 (set-process-filter proc 'compilation-filter)
975 "finished\n" 961 (set-marker (process-mark proc) (point) outbuf)
976 (format "\ 962 (setq compilation-in-progress
963 (cons proc compilation-in-progress)))
964 ;; No asynchronous processes available.
965 (message "Executing `%s'..." command)
966 ;; Fake modeline display as if `start-process' were run.
967 (setq mode-line-process ":run")
968 (force-mode-line-update)
969 (sit-for 0) ; Force redisplay
970 (let ((status (call-process shell-file-name nil outbuf nil "-c"
971 command)))
972 (cond ((numberp status)
973 (compilation-handle-exit 'exit status
974 (if (zerop status)
975 "finished\n"
976 (format "\
977 exited abnormally with code %d\n" 977 exited abnormally with code %d\n"
978 status)))) 978 status))))
979 ((stringp status) 979 ((stringp status)
980 (compilation-handle-exit 'signal status 980 (compilation-handle-exit 'signal status
981 (concat status "\n"))) 981 (concat status "\n")))
982 (t 982 (t
983 (compilation-handle-exit 'bizarre status status)))) 983 (compilation-handle-exit 'bizarre status status))))
984 ;; Without async subprocesses, the buffer is not yet 984 ;; Without async subprocesses, the buffer is not yet
985 ;; fontified, so fontify it now. 985 ;; fontified, so fontify it now.
986 (let ((font-lock-verbose nil)) ; shut up font-lock messages 986 (let ((font-lock-verbose nil)) ; shut up font-lock messages
987 (font-lock-fontify-buffer)) 987 (font-lock-fontify-buffer))
988 (message "Executing `%s'...done" command))) 988 (message "Executing `%s'...done" command))))
989 (if (buffer-local-value 'compilation-scroll-output outbuf) 989 (if (buffer-local-value 'compilation-scroll-output outbuf)
990 (save-selected-window 990 (save-selected-window
991 (select-window outwin) 991 (select-window outwin)
992 (goto-char (point-max)))) 992 (goto-char (point-max))))
993 ;; Make it so the next C-x ` will use this buffer. 993 ;; Make it so the next C-x ` will use this buffer.