/[emacs]/emacs/lisp/progmodes/compile.el
ViewVC logotype

Diff of /emacs/lisp/progmodes/compile.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.331 by rms, Sat Oct 16 15:12:25 2004 UTC revision 1.332 by jurta, Sat Oct 16 18:37:54 2004 UTC
# Line 866  Returns the compilation buffer created." Line 866  Returns the compilation buffer created."
866            (if (eq mode t)            (if (eq mode t)
867                (prog1 "compilation" (require 'comint))                (prog1 "compilation" (require 'comint))
868              (replace-regexp-in-string "-mode$" "" (symbol-name mode))))              (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)))  
869           cd-path                 ; in case process-environment contains CDPATH           cd-path                 ; in case process-environment contains CDPATH
870           (thisdir (if (string-match "^\\s *cd\\s +\\(.+?\\)\\s *[;&\n]" command)           (thisdir (if (string-match "^\\s *cd\\s +\\(.+?\\)\\s *[;&\n]" command)
871                        (substitute-in-file-name (match-string 1 command))                        (substitute-in-file-name (match-string 1 command))
# Line 923  Returns the compilation buffer created." Line 909  Returns the compilation buffer created."
909      ;; Pop up the compilation buffer.      ;; Pop up the compilation buffer.
910      (setq outwin (display-buffer outbuf nil t))      (setq outwin (display-buffer outbuf nil t))
911      (with-current-buffer outbuf      (with-current-buffer outbuf
912        (if (not (eq mode t))        (let ((process-environment
913            (funcall mode)               (append
914          (setq buffer-read-only nil)                compilation-environment
915          (with-no-warnings (comint-mode))                (if (if (boundp 'system-uses-terminfo) ; `if' for compiler warning
916          (compilation-shell-minor-mode))                        system-uses-terminfo)
917        (if highlight-regexp                    (list "TERM=dumb" "TERMCAP="
918            (set (make-local-variable 'compilation-highlight-regexp)                          (format "COLUMNS=%d" (window-width)))
919                 highlight-regexp))                  (list "TERM=emacs"
920        (set (make-local-variable 'compilation-arguments)                        (format "TERMCAP=emacs:co#%d:tc=unknown:"
921             (list command mode name-function highlight-regexp))                                (window-width))))
922        (set (make-local-variable 'revert-buffer-function)                ;; Set the EMACS variable, but
923             'compilation-revert-buffer)                ;; don't override users' setting of $EMACS.
924        (set-window-start outwin (point-min))                (unless (getenv "EMACS") '("EMACS=t"))
925        (or (eq outwin (selected-window))                (copy-sequence process-environment))))
926            (set-window-point outwin (if compilation-scroll-output          (if (not (eq mode t))
927                                         (point)              (funcall mode)
928                                       (point-min))))            (setq buffer-read-only nil)
929        ;; The setup function is called before compilation-set-window-height            (with-no-warnings (comint-mode))
930        ;; so it can set the compilation-window-height buffer locally.            (compilation-shell-minor-mode))
931        (if compilation-process-setup-function          (if highlight-regexp
932            (funcall compilation-process-setup-function))              (set (make-local-variable 'compilation-highlight-regexp)
933        (compilation-set-window-height outwin)                   highlight-regexp))
934        ;; Start the compilation.          (set (make-local-variable 'compilation-arguments)
935        (if (fboundp 'start-process)               (list command mode name-function highlight-regexp))
936            (let ((proc (if (eq mode t)          (set (make-local-variable 'revert-buffer-function)
937                            (get-buffer-process               'compilation-revert-buffer)
938                             (with-no-warnings          (set-window-start outwin (point-min))
939                              (comint-exec outbuf (downcase mode-name)          (or (eq outwin (selected-window))
940                                           shell-file-name nil `("-c" ,command))))              (set-window-point outwin (if compilation-scroll-output
941                          (start-process-shell-command (downcase mode-name)                                           (point)
942                                                       outbuf command))))                                         (point-min))))
943              ;; Make the buffer's mode line show process state.          ;; The setup function is called before compilation-set-window-height
944              (setq mode-line-process '(":%s"))          ;; so it can set the compilation-window-height buffer locally.
945              (set-process-sentinel proc 'compilation-sentinel)          (if compilation-process-setup-function
946              (set-process-filter proc 'compilation-filter)              (funcall compilation-process-setup-function))
947              (set-marker (process-mark proc) (point) outbuf)          (compilation-set-window-height outwin)
948              (setq compilation-in-progress          ;; Start the compilation.
949                    (cons proc compilation-in-progress)))          (if (fboundp 'start-process)
950          ;; No asynchronous processes available.              (let ((proc (if (eq mode t)
951          (message "Executing `%s'..." command)                              (get-buffer-process
952          ;; Fake modeline display as if `start-process' were run.                               (with-no-warnings
953          (setq mode-line-process ":run")                                (comint-exec outbuf (downcase mode-name)
954          (force-mode-line-update)                                             shell-file-name nil `("-c" ,command))))
955          (sit-for 0)                     ; Force redisplay                            (start-process-shell-command (downcase mode-name)
956          (let ((status (call-process shell-file-name nil outbuf nil "-c"                                                         outbuf command))))
957                                      command)))                ;; Make the buffer's mode line show process state.
958            (cond ((numberp status)                (setq mode-line-process '(":%s"))
959                   (compilation-handle-exit 'exit status                (set-process-sentinel proc 'compilation-sentinel)
960                                            (if (zerop status)                (set-process-filter proc 'compilation-filter)
961                                                "finished\n"                (set-marker (process-mark proc) (point) outbuf)
962                                              (format "\                (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"  exited abnormally with code %d\n"
978                                                      status))))                                                        status))))
979                  ((stringp status)                    ((stringp status)
980                   (compilation-handle-exit 'signal status                     (compilation-handle-exit 'signal status
981                                            (concat status "\n")))                                              (concat status "\n")))
982                  (t                    (t
983                   (compilation-handle-exit 'bizarre status status))))                     (compilation-handle-exit 'bizarre status status))))
984          ;; Without async subprocesses, the buffer is not yet            ;; Without async subprocesses, the buffer is not yet
985          ;; fontified, so fontify it now.            ;; fontified, so fontify it now.
986          (let ((font-lock-verbose nil))  ; shut up font-lock messages            (let ((font-lock-verbose nil)) ; shut up font-lock messages
987            (font-lock-fontify-buffer))              (font-lock-fontify-buffer))
988          (message "Executing `%s'...done" command)))            (message "Executing `%s'...done" command))))
989      (if (buffer-local-value 'compilation-scroll-output outbuf)      (if (buffer-local-value 'compilation-scroll-output outbuf)
990          (save-selected-window          (save-selected-window
991            (select-window outwin)            (select-window outwin)

Legend:
Removed from v.1.331  
changed lines
  Added in v.1.332

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26