[Emacs-diffs] Changes to emacs/lisp/progmodes/compile.el [emacs-unicode-2]

[Miles Bader]

Index: emacs/lisp/progmodes/compile.el
diff -c emacs/lisp/progmodes/compile.el:1.276.2.6 
emacs/lisp/progmodes/compile.el:1.276.2.7
*** emacs/lisp/progmodes/compile.el:1.276.2.6   Wed Sep 15 08:59:57 2004
--- emacs/lisp/progmodes/compile.el     Fri Oct 22 10:13:52 2004
***************
*** 866,889 ****
          (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))
!                   default-directory))
         outwin outbuf)
      (with-current-buffer
        (setq outbuf
--- 866,872 ----
          (if (eq mode t)
              (prog1 "compilation" (require 'comint))
            (replace-regexp-in-string "-mode$" "" (symbol-name mode))))
!        (thisdir default-directory)
         outwin outbuf)
      (with-current-buffer
        (setq outbuf
***************
*** 903,920 ****
                  (error nil))
              (error "Cannot have two processes in `%s' at once"
                     (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)
        (buffer-disable-undo (current-buffer))
!       (erase-buffer)
!       (buffer-enable-undo (current-buffer))
!       (cd thisdir)
!       ;; output a mode setter, for saving and later reloading this buffer
!       (insert "-*- mode: " name-of-mode
!             "; default-directory: " (prin1-to-string default-directory)
!             " -*-\n" command "\n")
        (set-buffer-modified-p nil))
      ;; If we're already in the compilation buffer, go to the end
      ;; of the buffer, so point will track the compilation output.
--- 886,911 ----
                  (error nil))
              (error "Cannot have two processes in `%s' at once"
                     (buffer-name)))))
        (buffer-disable-undo (current-buffer))
!       ;; first transfer directory from where M-x compile was called
!       (setq default-directory thisdir)
!       ;; Make compilation buffer read-only.  The filter can still write it.
!       ;; Clear out the compilation buffer.
!       (let ((inhibit-read-only t)
!           (default-directory thisdir))
!       ;; Then evaluate a cd command if any, but don't perform it yet, else 
start-command
!       ;; would do it again through the shell: (cd "..") AND sh -c "cd ..; 
make"
!       (cd (if (string-match "^\\s *cd\\(?:\\s +\\(\\S +?\\)\\)?\\s *[;&\n]" 
command)
!               (if (match-end 1)
!                   (match-string 1 command)
!                 "~")
!             default-directory))
!       (erase-buffer)
!       ;; output a mode setter, for saving and later reloading this buffer
!       (insert "-*- mode: " name-of-mode
!               "; default-directory: " (prin1-to-string default-directory)
!               " -*-\n" command "\n")
!       (setq thisdir default-directory))
        (set-buffer-modified-p nil))
      ;; If we're already in the compilation buffer, go to the end
      ;; of the buffer, so point will track the compilation output.
***************
*** 923,992 ****
      ;; Pop up the compilation buffer.
      (setq outwin (display-buffer outbuf nil t))
      (with-current-buffer outbuf
!       (if (not (eq mode t))
!         (funcall mode)
!       (with-no-warnings (comint-mode))
!       (compilation-shell-minor-mode))
!       ;; In what way is it non-ergonomic ?  -stef
!       ;; (toggle-read-only 1) ;;; Non-ergonomic.
!       (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)))
      (if (buffer-local-value 'compilation-scroll-output outbuf)
        (save-selected-window
          (select-window outwin)
--- 914,998 ----
      ;; Pop up the compilation buffer.
      (setq outwin (display-buffer outbuf nil t))
      (with-current-buffer outbuf
!       (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)))
!       ;; Now finally cd to where the shell started make/grep/...
!       (setq default-directory thisdir))
      (if (buffer-local-value 'compilation-scroll-output outbuf)
        (save-selected-window
          (select-window outwin)
***************
*** 1108,1114 ****
    :version "21.4")
  
  ;;;###autoload
! (defun compilation-mode ()
    "Major mode for compilation log buffers.
  \\<compilation-mode-map>To visit the source for a line-numbered error,
  move point to the error message line and type \\[compile-goto-error].
--- 1114,1120 ----
    :version "21.4")
  
  ;;;###autoload
! (defun compilation-mode (&optional name-of-mode)
    "Major mode for compilation log buffers.
  \\<compilation-mode-map>To visit the source for a line-numbered error,
  move point to the error message line and type \\[compile-goto-error].
***************
*** 1121,1127 ****
    (kill-all-local-variables)
    (use-local-map compilation-mode-map)
    (setq major-mode 'compilation-mode
!       mode-name "Compilation")
    (set (make-local-variable 'page-delimiter)
         compilation-page-delimiter)
    (compilation-setup)
--- 1127,1133 ----
    (kill-all-local-variables)
    (use-local-map compilation-mode-map)
    (setq major-mode 'compilation-mode
!       mode-name (or name-of-mode "Compilation"))
    (set (make-local-variable 'page-delimiter)
         compilation-page-delimiter)
    (compilation-setup)
***************
*** 1187,1192 ****
--- 1193,1200 ----
    "Prepare the buffer for the compilation parsing commands to work.
  Optional argument MINOR indicates this is called from
  `compilation-minor-mode'."
+   (unless minor
+     (setq buffer-read-only t))
    (make-local-variable 'compilation-current-error)
    (make-local-variable 'compilation-messages-start)
    (make-local-variable 'compilation-error-screen-columns)
***************
*** 1248,1254 ****
  
  (defun compilation-handle-exit (process-status exit-status msg)
    "Write MSG in the current buffer and hack its mode-line-process."
!   (let ((buffer-read-only nil)
        (status (if compilation-exit-message-function
                    (funcall compilation-exit-message-function
                             process-status exit-status msg)
--- 1256,1262 ----
  
  (defun compilation-handle-exit (process-status exit-status msg)
    "Write MSG in the current buffer and hack its mode-line-process."
!   (let ((inhibit-read-only t)
        (status (if compilation-exit-message-function
                    (funcall compilation-exit-message-function
                             process-status exit-status msg)