/[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.276.2.6 by miles, Wed Sep 15 08:59:57 2004 UTC revision 1.276.2.7 by miles, Fri Oct 22 10:13:52 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))))
869           (process-environment           (thisdir default-directory)
           (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))  
                     default-directory))  
870           outwin outbuf)           outwin outbuf)
871      (with-current-buffer      (with-current-buffer
872          (setq outbuf          (setq outbuf
# Line 903  Returns the compilation buffer created." Line 886  Returns the compilation buffer created."
886                    (error nil))                    (error nil))
887                (error "Cannot have two processes in `%s' at once"                (error "Cannot have two processes in `%s' at once"
888                       (buffer-name)))))                       (buffer-name)))))
       ;; Clear out the compilation buffer and make it writable.  
       ;; Change its default-directory to the directory where the compilation  
       ;; will happen, and insert a `default-directory' to indicate this.  
       (setq buffer-read-only nil)  
889        (buffer-disable-undo (current-buffer))        (buffer-disable-undo (current-buffer))
890        (erase-buffer)        ;; first transfer directory from where M-x compile was called
891        (buffer-enable-undo (current-buffer))        (setq default-directory thisdir)
892        (cd thisdir)        ;; Make compilation buffer read-only.  The filter can still write it.
893        ;; output a mode setter, for saving and later reloading this buffer        ;; Clear out the compilation buffer.
894        (insert "-*- mode: " name-of-mode        (let ((inhibit-read-only t)
895                "; default-directory: " (prin1-to-string default-directory)              (default-directory thisdir))
896                " -*-\n" command "\n")          ;; Then evaluate a cd command if any, but don't perform it yet, else start-command
897            ;; would do it again through the shell: (cd "..") AND sh -c "cd ..; make"
898            (cd (if (string-match "^\\s *cd\\(?:\\s +\\(\\S +?\\)\\)?\\s *[;&\n]" command)
899                    (if (match-end 1)
900                        (match-string 1 command)
901                      "~")
902                  default-directory))
903            (erase-buffer)
904            ;; output a mode setter, for saving and later reloading this buffer
905            (insert "-*- mode: " name-of-mode
906                    "; default-directory: " (prin1-to-string default-directory)
907                    " -*-\n" command "\n")
908            (setq thisdir default-directory))
909        (set-buffer-modified-p nil))        (set-buffer-modified-p nil))
910      ;; If we're already in the compilation buffer, go to the end      ;; If we're already in the compilation buffer, go to the end
911      ;; of the buffer, so point will track the compilation output.      ;; of the buffer, so point will track the compilation output.
# Line 923  Returns the compilation buffer created." Line 914  Returns the compilation buffer created."
914      ;; Pop up the compilation buffer.      ;; Pop up the compilation buffer.
915      (setq outwin (display-buffer outbuf nil t))      (setq outwin (display-buffer outbuf nil t))
916      (with-current-buffer outbuf      (with-current-buffer outbuf
917        (if (not (eq mode t))        (let ((process-environment
918            (funcall mode)               (append
919          (with-no-warnings (comint-mode))                compilation-environment
920          (compilation-shell-minor-mode))                (if (if (boundp 'system-uses-terminfo) ; `if' for compiler warning
921        ;; In what way is it non-ergonomic ?  -stef                        system-uses-terminfo)
922        ;; (toggle-read-only 1) ;;; Non-ergonomic.                    (list "TERM=dumb" "TERMCAP="
923        (if highlight-regexp                          (format "COLUMNS=%d" (window-width)))
924            (set (make-local-variable 'compilation-highlight-regexp)                  (list "TERM=emacs"
925                 highlight-regexp))                        (format "TERMCAP=emacs:co#%d:tc=unknown:"
926        (set (make-local-variable 'compilation-arguments)                                (window-width))))
927             (list command mode name-function highlight-regexp))                ;; Set the EMACS variable, but
928        (set (make-local-variable 'revert-buffer-function)                ;; don't override users' setting of $EMACS.
929             'compilation-revert-buffer)                (unless (getenv "EMACS") '("EMACS=t"))
930        (set-window-start outwin (point-min))                (copy-sequence process-environment))))
931        (or (eq outwin (selected-window))          (if (not (eq mode t))
932            (set-window-point outwin (if compilation-scroll-output              (funcall mode)
933                                         (point)            (setq buffer-read-only nil)
934                                       (point-min))))            (with-no-warnings (comint-mode))
935        ;; The setup function is called before compilation-set-window-height            (compilation-shell-minor-mode))
936        ;; so it can set the compilation-window-height buffer locally.          (if highlight-regexp
937        (if compilation-process-setup-function              (set (make-local-variable 'compilation-highlight-regexp)
938            (funcall compilation-process-setup-function))                   highlight-regexp))
939        (compilation-set-window-height outwin)          (set (make-local-variable 'compilation-arguments)
940        ;; Start the compilation.               (list command mode name-function highlight-regexp))
941        (if (fboundp 'start-process)          (set (make-local-variable 'revert-buffer-function)
942            (let ((proc (if (eq mode t)               'compilation-revert-buffer)
943                            (get-buffer-process          (set-window-start outwin (point-min))
944                             (with-no-warnings          (or (eq outwin (selected-window))
945                              (comint-exec outbuf (downcase mode-name)              (set-window-point outwin (if compilation-scroll-output
946                                           shell-file-name nil `("-c" ,command))))                                           (point)
947                          (start-process-shell-command (downcase mode-name)                                         (point-min))))
948                                                       outbuf command))))          ;; The setup function is called before compilation-set-window-height
949              ;; Make the buffer's mode line show process state.          ;; so it can set the compilation-window-height buffer locally.
950              (setq mode-line-process '(":%s"))          (if compilation-process-setup-function
951              (set-process-sentinel proc 'compilation-sentinel)              (funcall compilation-process-setup-function))
952              (set-process-filter proc 'compilation-filter)          (compilation-set-window-height outwin)
953              (set-marker (process-mark proc) (point) outbuf)          ;; Start the compilation.
954              (setq compilation-in-progress          (if (fboundp 'start-process)
955                    (cons proc compilation-in-progress)))              (let ((proc (if (eq mode t)
956          ;; No asynchronous processes available.                              (get-buffer-process
957          (message "Executing `%s'..." command)                               (with-no-warnings
958          ;; Fake modeline display as if `start-process' were run.                                (comint-exec outbuf (downcase mode-name)
959          (setq mode-line-process ":run")                                             shell-file-name nil `("-c" ,command))))
960          (force-mode-line-update)                            (start-process-shell-command (downcase mode-name)
961          (sit-for 0)                     ; Force redisplay                                                         outbuf command))))
962          (let ((status (call-process shell-file-name nil outbuf nil "-c"                ;; Make the buffer's mode line show process state.
963                                      command)))                (setq mode-line-process '(":%s"))
964            (cond ((numberp status)                (set-process-sentinel proc 'compilation-sentinel)
965                   (compilation-handle-exit 'exit status                (set-process-filter proc 'compilation-filter)
966                                            (if (zerop status)                (set-marker (process-mark proc) (point) outbuf)
967                                                "finished\n"                (setq compilation-in-progress
968                                              (format "\                      (cons proc compilation-in-progress)))
969              ;; No asynchronous processes available.
970              (message "Executing `%s'..." command)
971              ;; Fake modeline display as if `start-process' were run.
972              (setq mode-line-process ":run")
973              (force-mode-line-update)
974              (sit-for 0)                   ; Force redisplay
975              (let ((status (call-process shell-file-name nil outbuf nil "-c"
976                                          command)))
977                (cond ((numberp status)
978                       (compilation-handle-exit 'exit status
979                                                (if (zerop status)
980                                                    "finished\n"
981                                                  (format "\
982  exited abnormally with code %d\n"  exited abnormally with code %d\n"
983                                                      status))))                                                        status))))
984                  ((stringp status)                    ((stringp status)
985                   (compilation-handle-exit 'signal status                     (compilation-handle-exit 'signal status
986                                            (concat status "\n")))                                              (concat status "\n")))
987                  (t                    (t
988                   (compilation-handle-exit 'bizarre status status))))                     (compilation-handle-exit 'bizarre status status))))
989          ;; Without async subprocesses, the buffer is not yet            ;; Without async subprocesses, the buffer is not yet
990          ;; fontified, so fontify it now.            ;; fontified, so fontify it now.
991          (let ((font-lock-verbose nil))  ; shut up font-lock messages            (let ((font-lock-verbose nil)) ; shut up font-lock messages
992            (font-lock-fontify-buffer))              (font-lock-fontify-buffer))
993          (message "Executing `%s'...done" command)))            (message "Executing `%s'...done" command)))
994          ;; Now finally cd to where the shell started make/grep/...
995          (setq default-directory thisdir))
996      (if (buffer-local-value 'compilation-scroll-output outbuf)      (if (buffer-local-value 'compilation-scroll-output outbuf)
997          (save-selected-window          (save-selected-window
998            (select-window outwin)            (select-window outwin)
# Line 1108  from a different message." Line 1114  from a different message."
1114    :version "21.4")    :version "21.4")
1115    
1116  ;;;###autoload  ;;;###autoload
1117  (defun compilation-mode ()  (defun compilation-mode (&optional name-of-mode)
1118    "Major mode for compilation log buffers.    "Major mode for compilation log buffers.
1119  \\<compilation-mode-map>To visit the source for a line-numbered error,  \\<compilation-mode-map>To visit the source for a line-numbered error,
1120  move point to the error message line and type \\[compile-goto-error].  move point to the error message line and type \\[compile-goto-error].
# Line 1121  Runs `compilation-mode-hook' with `run-h Line 1127  Runs `compilation-mode-hook' with `run-h
1127    (kill-all-local-variables)    (kill-all-local-variables)
1128    (use-local-map compilation-mode-map)    (use-local-map compilation-mode-map)
1129    (setq major-mode 'compilation-mode    (setq major-mode 'compilation-mode
1130          mode-name "Compilation")          mode-name (or name-of-mode "Compilation"))
1131    (set (make-local-variable 'page-delimiter)    (set (make-local-variable 'page-delimiter)
1132         compilation-page-delimiter)         compilation-page-delimiter)
1133    (compilation-setup)    (compilation-setup)
# Line 1187  If nil, use the beginning of buffer.") Line 1193  If nil, use the beginning of buffer.")
1193    "Prepare the buffer for the compilation parsing commands to work.    "Prepare the buffer for the compilation parsing commands to work.
1194  Optional argument MINOR indicates this is called from  Optional argument MINOR indicates this is called from
1195  `compilation-minor-mode'."  `compilation-minor-mode'."
1196      (unless minor
1197        (setq buffer-read-only t))
1198    (make-local-variable 'compilation-current-error)    (make-local-variable 'compilation-current-error)
1199    (make-local-variable 'compilation-messages-start)    (make-local-variable 'compilation-messages-start)
1200    (make-local-variable 'compilation-error-screen-columns)    (make-local-variable 'compilation-error-screen-columns)
# Line 1248  Turning the mode on runs the normal hook Line 1256  Turning the mode on runs the normal hook
1256    
1257  (defun compilation-handle-exit (process-status exit-status msg)  (defun compilation-handle-exit (process-status exit-status msg)
1258    "Write MSG in the current buffer and hack its mode-line-process."    "Write MSG in the current buffer and hack its mode-line-process."
1259    (let ((buffer-read-only nil)    (let ((inhibit-read-only t)
1260          (status (if compilation-exit-message-function          (status (if compilation-exit-message-function
1261                      (funcall compilation-exit-message-function                      (funcall compilation-exit-message-function
1262                               process-status exit-status msg)                               process-status exit-status msg)

Legend:
Removed from v.1.276.2.6  
changed lines
  Added in v.1.276.2.7

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