]> code.delx.au - gnu-emacs/blobdiff - lisp/progmodes/compile.el
merge and fixes
[gnu-emacs] / lisp / progmodes / compile.el
index cd3197c3039b787a9357d6b5604ecb817990c68a..7000b4bbc8a94438b701c9b6bc932a596661b67e 100644 (file)
@@ -1,7 +1,7 @@
 ;;; compile.el --- run compiler as inferior of Emacs, parse error messages
 
 ;; Copyright (C) 1985, 1986, 1987, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
-;;   2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008
+;;   2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010
 ;;   Free Software Foundation, Inc.
 
 ;; Authors: Roland McGrath <roland@gnu.org>,
 
 ;; This file is part of GNU Emacs.
 
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; GNU Emacs is free software: you can redistribute it and/or modify
 ;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 3, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
 
 ;; GNU Emacs is distributed in the hope that it will be useful,
 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
@@ -22,9 +22,7 @@
 ;; GNU General Public License for more details.
 
 ;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
 
 ;;; Commentary:
 
@@ -74,6 +72,7 @@
 
 (eval-when-compile (require 'cl))
 (require 'tool-bar)
+(require 'comint)
 
 (defvar font-lock-extra-managed-props)
 (defvar font-lock-keywords)
   :type 'hook
   :group 'compilation)
 
+;;;###autoload
+(defcustom compilation-start-hook nil
+  "List of hook functions run by `compilation-start' on the compilation process.
+\(See `run-hook-with-args').
+If you use \"omake -P\" and do not want \\[save-buffers-kill-terminal] to ask whether you want
+the compilation to be killed, you can use this hook:
+  (add-hook 'compilation-start-hook
+    (lambda (process) (set-process-query-on-exit-flag process nil)) nil t)"
+  :type 'hook
+  :group 'compilation)
+
 ;;;###autoload
 (defcustom compilation-window-height nil
   "Number of lines in a compilation window.  If nil, use Emacs default."
@@ -169,10 +179,6 @@ of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?:" 3 2 nil (1))
      "^[ \t]*\\[[^] \n]+\\][ \t]*\\([^: \n]+\\):\\([0-9]+\\):\\(?:\\([0-9]+\\):[0-9]+:[0-9]+:\\)?\
 \\( warning\\)?" 1 2 3 (4))
 
-    (maven
-     ;; Maven is a popular build tool for Java.  Maven is Free Software.
-     "\\(.*?\\):\\[\\([0-9]+\\),\\([0-9]+\\)\\]" 1 2 3)
-
     (bash
      "^\\([^: \n\t]+\\): line \\([0-9]+\\):" 1 2)
 
@@ -228,11 +234,19 @@ of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?:" 3 2 nil (1))
      (2 (compilation-face '(3))))
 
     (gnu
-     ;; I have no idea what this first line is supposed to match, but it
-     ;; makes things ambiguous with output such as "foo:344:50:blabla" since
-     ;; the "foo" part can match this first line (in which case the file
-     ;; name as "344").  To avoid this, the second line disallows filenames
-     ;; exclusively composed of digits.  --Stef
+     ;; The first line matches the program name for
+
+     ;;     PROGRAM:SOURCE-FILE-NAME:LINENO: MESSAGE
+
+     ;; format, which is used for non-interactive programs other than
+     ;; compilers (e.g. the "jade:" entry in compilation.txt).
+
+     ;; This first line makes things ambiguous with output such as
+     ;; "foo:344:50:blabla" since the "foo" part can match this first
+     ;; line (in which case the file name as "344").  To avoid this,
+     ;; the second line disallows filenames exclusively composed of
+     ;; digits.
+
      ;; Similarly, we get lots of false positives with messages including
      ;; times of the form "HH:MM:SS" where MM is taken as a line number, so
      ;; the last line tries to rule out message where the info after the
@@ -245,7 +259,7 @@ of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?:" 3 2 nil (1))
      "^\\(?:[[:alpha:]][-[:alnum:].]+: ?\\)?\
 \\([0-9]*[^0-9\n]\\(?:[^\n ]\\| [^-/\n]\\)*?\\): ?\
 \\([0-9]+\\)\\(?:\\([.:]\\)\\([0-9]+\\)\\)?\
-\\(?:-\\([0-9]+\\)?\\(?:\\3\\([0-9]+\\)\\)?\\)?:\
+\\(?:-\\([0-9]+\\)?\\(?:\\.\\([0-9]+\\)\\)?\\)?:\
 \\(?: *\\(\\(?:Future\\|Runtime\\)?[Ww]arning\\|W:\\)\\|\
  *\\([Ii]nfo\\(?:\\>\\|rmationa?l?\\)\\|I:\\|instantiated from\\|[Nn]ote\\)\\|\
 \[0-9]?\\(?:[^0-9\n]\\|$\\)\\|[0-9][0-9][0-9]\\)"
@@ -271,6 +285,11 @@ of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?:" 3 2 nil (1))
       (1 (compilation-error-properties 2 3 nil nil nil 0 nil)
         append)))
 
+    ;; This regexp is pathologically slow on long lines (Bug#3441).
+    ;; (maven
+    ;;  ;; Maven is a popular build tool for Java.  Maven is Free Software.
+    ;;  "\\(.*?\\):\\[\\([0-9]+\\),\\([0-9]+\\)\\]" 1 2 3)
+
     ;; Should be lint-1, lint-2 (SysV lint)
     (mips-1
      " (\\([0-9]+\\)) in \\([^ \n]+\\)" 2 1)
@@ -278,9 +297,16 @@ of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?:" 3 2 nil (1))
      " in \\([^()\n ]+\\)(\\([0-9]+\\))$" 1 2)
 
     (msft
-     ;; AFAWK, The message may be a "warning", "error", or "fatal error".
-     "^\\([0-9]+>\\)?\\(\\(?:[a-zA-Z]:\\)?[^:(\t\n]+\\)(\\([0-9]+\\)) \
-: \\(?:warnin\\(g\\)\\|[a-z ]+\\) C[0-9]+:" 2 3 nil (4))
+     ;; The message may be a "warning", "error", or "fatal error" with
+     ;; an error code, or "see declaration of" without an error code.
+     "^ *\\([0-9]+>\\)?\\(\\(?:[a-zA-Z]:\\)?[^:(\t\n]+\\)(\\([0-9]+\\)) \
+: \\(?:see declaration\\|\\(?:warnin\\(g\\)\\|[a-z ]+\\) C[0-9]+:\\)"
+     2 3 nil (4))
+
+    (omake
+     ;; "omake -P" reports "file foo changed"
+     ;; (useful if you do "cvs up" and want to see what has changed)
+     "omake: file \\(.*\\) changed" 1)
 
     (oracle
      "^\\(?:Semantic error\\|Error\\|PCC-[0-9]+:\\).* line \\([0-9]+\\)\
@@ -324,7 +350,7 @@ File = \\(.+\\), Line = \\([0-9]+\\)\\(?:, Column = \\([0-9]+\\)\\)?"
      "^\\([^, \n\t]+\\), line \\([0-9]+\\), char \\([0-9]+\\)[:., \(-]" 1 2 3)
 
     (watcom
-     "\\(\\(?:[a-zA-Z]:\\)?[^:(\t\n]+\\)(\\([0-9]+\\)): ?\
+     "^[ \t]*\\(\\(?:[a-zA-Z]:\\)?[^:(\t\n]+\\)(\\([0-9]+\\)): ?\
 \\(?:\\(Error! E[0-9]+\\)\\|\\(Warning! W[0-9]+\\)\\):"
      1 2 nil (4))
 
@@ -541,7 +567,12 @@ especially the TAB character."
 
 (defcustom compilation-read-command t
   "Non-nil means \\[compile] reads the compilation command to use.
-Otherwise, \\[compile] just uses the value of `compile-command'."
+Otherwise, \\[compile] just uses the value of `compile-command'.
+
+Note that changing this to nil may be a security risk, because a
+file might define a malicious `compile-command' as a file local
+variable, and you might not notice.  Therefore, `compile-command'
+is considered unsafe if this variable is nil."
   :type 'boolean
   :group 'compilation)
 
@@ -552,6 +583,21 @@ Otherwise, it saves all modified buffers without asking."
   :type 'boolean
   :group 'compilation)
 
+(defcustom compilation-save-buffers-predicate nil
+  "The second argument (PRED) passed to `save-some-buffers' before compiling.
+E.g., one can set this to
+  (lambda ()
+    (string-prefix-p my-compilation-root (file-truename (buffer-file-name))))
+to limit saving to files located under `my-compilation-root'.
+Note, that, in general, `compilation-directory' cannot be used instead
+of `my-compilation-root' here."
+  :type '(choice
+          (const :tag "Default (save all file-visiting buffers)" nil)
+          (const :tag "Save all buffers" t)
+          function)
+  :group 'compilation
+  :version "24.1")
+
 ;;;###autoload
 (defcustom compilation-search-path '(nil)
   "List of directories to search for source files named in error messages.
@@ -562,7 +608,7 @@ The value nil as an element means to try the default directory."
   :group 'compilation)
 
 ;;;###autoload
-(defcustom compile-command "make -k "
+(defcustom compile-command (purecopy "make -k ")
   "Last shell command used to do a compilation; default for next compilation.
 
 Sometimes it is useful for files to supply local values for this variable.
@@ -577,7 +623,7 @@ You might also use mode hooks to specify it in certain modes, like this:
                        (file-name-sans-extension buffer-file-name))))))"
   :type 'string
   :group 'compilation)
-;;;###autoload(put 'compile-command 'safe-local-variable 'stringp)
+;;;###autoload(put 'compile-command 'safe-local-variable (lambda (a) (and (stringp a) (or (not (boundp 'compilation-read-command)) compilation-read-command))))
 
 ;;;###autoload
 (defcustom compilation-disable-input nil
@@ -693,7 +739,7 @@ Faces `compilation-error-face', `compilation-warning-face',
 (defvar compilation-old-error-list nil)
 
 (defcustom compilation-auto-jump-to-first-error nil
-  "If non-nil, automatically jump to the first error after `compile'."
+  "If non-nil, automatically jump to the first error during compilation."
   :type 'boolean
   :group 'compilation
   :version "23.1")
@@ -702,6 +748,9 @@ Faces `compilation-error-face', `compilation-warning-face',
   "If non-nil, automatically jump to the next error encountered.")
 (make-variable-buffer-local 'compilation-auto-jump-to-next)
 
+(defvar compilation-buffer-modtime nil
+  "The buffer modification time, for buffers not associated with files.")
+(make-variable-buffer-local 'compilation-buffer-modtime)
 
 (defvar compilation-skip-to-next-location t
   "*If non-nil, skip multiple error messages for the same source location.")
@@ -854,7 +903,7 @@ from a different message."
 If SCREEN is non-nil, columns are screen columns, otherwise, they are
 just char-counts."
   (if screen
-      (move-to-column col)
+      (move-to-column (max col 0))
     (goto-char (min (+ (line-beginning-position) col) (line-end-position)))))
 
 (defun compilation-internal-error-properties (file line end-line col end-col type fmts)
@@ -959,7 +1008,16 @@ FMTS is a list of format specs for transforming the file name.
              (line (nth 2 item))
              (col (nth 3 item))
              (type (nth 4 item))
+              (pat (car item))
              end-line end-col fmt)
+          ;; omake reports some error indented, so skip the indentation.
+          ;; another solution is to modify (some?) regexps in
+          ;; `compilation-error-regexp-alist'.
+          ;; note that omake usage is not limited to ocaml and C (for stubs).
+          (when (and (= ?^ (aref pat 0)) ; anchored: starts with "^"
+                     ;; but does not allow an arbitrary number of leading spaces
+                     (not (and (= ?  (aref pat 1)) (= ?* (aref pat 2)))))
+            (setq pat (concat "^ *" (substring pat 1))))
          (if (consp file)      (setq fmt (cdr file)      file (car file)))
          (if (consp line)      (setq end-line (cdr line) line (car line)))
          (if (consp col)       (setq end-col (cdr col)   col (car col)))
@@ -968,7 +1026,7 @@ FMTS is a list of format specs for transforming the file name.
              ;; The old compile.el had here an undocumented hook that
              ;; allowed `line' to be a function that computed the actual
              ;; error location.  Let's do our best.
-             `(,(car item)
+             `(,pat
                (0 (save-match-data
                     (compilation-compat-error-properties
                      (funcall ',line (cons (match-string ,file)
@@ -980,7 +1038,7 @@ FMTS is a list of format specs for transforming the file name.
            (unless (or (null (nth 5 item)) (integerp (nth 5 item)))
              (error "HYPERLINK should be an integer: %s" (nth 5 item)))
 
-           `(,(nth 0 item)
+           `(,pat
 
              ,@(when (integerp file)
                  `((,file ,(if (consp type)
@@ -1010,6 +1068,12 @@ FMTS is a list of format specs for transforming the file name.
 
      compilation-mode-font-lock-keywords)))
 
+(defun compilation-read-command (command)
+  (read-shell-command "Compile command: " command
+                      (if (equal (car compile-history) command)
+                          '(compile-history . 1)
+                        'compile-history)))
+
 \f
 ;;;###autoload
 (defun compile (command &optional comint)
@@ -1043,26 +1107,29 @@ to a function that generates a unique name."
    (list
     (let ((command (eval compile-command)))
       (if (or compilation-read-command current-prefix-arg)
-         (read-shell-command "Compile command: " command
-                              (if (equal (car compile-history) command)
-                                  '(compile-history . 1)
-                                'compile-history))
+         (compilation-read-command command)
        command))
     (consp current-prefix-arg)))
   (unless (equal command (eval compile-command))
     (setq compile-command command))
-  (save-some-buffers (not compilation-ask-about-save) nil)
+  (save-some-buffers (not compilation-ask-about-save)
+                     compilation-save-buffers-predicate)
   (setq-default compilation-directory default-directory)
   (compilation-start command comint))
 
 ;; run compile with the default command line
-(defun recompile ()
+(defun recompile (&optional edit-command)
   "Re-compile the program including the current buffer.
 If this is run in a Compilation mode buffer, re-use the arguments from the
-original use.  Otherwise, recompile using `compile-command'."
-  (interactive)
-  (save-some-buffers (not compilation-ask-about-save) nil)
+original use.  Otherwise, recompile using `compile-command'.
+If the optional argument `edit-command' is non-nil, the command can be edited."
+  (interactive "P")
+  (save-some-buffers (not compilation-ask-about-save)
+                     compilation-save-buffers-predicate)
   (let ((default-directory (or compilation-directory default-directory)))
+    (when edit-command
+      (setcar compilation-arguments
+              (compilation-read-command (car compilation-arguments))))
     (apply 'compilation-start (or compilation-arguments
                                  `(,(eval compile-command))))))
 
@@ -1139,7 +1206,7 @@ Returns the compilation buffer created."
   (or mode (setq mode 'compilation-mode))
   (let* ((name-of-mode
          (if (eq mode t)
-             (prog1 "compilation" (require 'comint))
+             "compilation"
            (replace-regexp-in-string "-mode$" "" (symbol-name mode))))
         (thisdir default-directory)
         outwin outbuf)
@@ -1161,7 +1228,6 @@ Returns the compilation buffer created."
                  (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.
@@ -1171,7 +1237,8 @@ Returns the compilation buffer created."
        ;; 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)
+       (cd (if (string-match "\\`\\s *cd\\(?:\\s +\\(\\S +?\\)\\)?\\s *[;&\n]"
+                             command)
                (if (match-end 1)
                    (substitute-env-vars (match-string 1 command))
                  "~")
@@ -1179,7 +1246,9 @@ Returns the compilation buffer created."
        (erase-buffer)
        ;; Select the desired mode.
        (if (not (eq mode t))
-           (funcall mode)
+            (progn
+              (buffer-disable-undo)
+              (funcall mode))
          (setq buffer-read-only nil)
          (with-no-warnings (comint-mode))
          (compilation-shell-minor-mode))
@@ -1196,7 +1265,8 @@ Returns the compilation buffer created."
             (set (make-local-variable 'compilation-auto-jump-to-next) t))
        ;; Output a mode setter, for saving and later reloading this buffer.
        (insert "-*- mode: " name-of-mode
-               "; default-directory: " (prin1-to-string default-directory)
+               "; default-directory: "
+                (prin1-to-string (abbreviate-file-name default-directory))
                " -*-\n"
                (format "%s started at %s\n\n"
                        mode-name
@@ -1247,41 +1317,81 @@ Returns the compilation buffer created."
            (funcall compilation-process-setup-function))
        (compilation-set-window-height outwin)
        ;; Start the compilation.
-       (let ((proc
-              (if (eq mode t)
-                  ;; comint uses `start-file-process'.
-                  (get-buffer-process
-                   (with-no-warnings
-                     (comint-exec
-                      outbuf (downcase mode-name)
-                      (if (file-remote-p default-directory)
-                          "/bin/sh"
-                        shell-file-name)
-                      nil `("-c" ,command))))
-                (start-file-process-shell-command (downcase mode-name)
-                                                  outbuf command))))
-         ;; Make the buffer's mode line show process state.
+       (if (fboundp 'start-process)
+           (let ((proc
+                  (if (eq mode t)
+                      ;; comint uses `start-file-process'.
+                      (get-buffer-process
+                       (with-no-warnings
+                         (comint-exec
+                          outbuf (downcase mode-name)
+                          (if (file-remote-p default-directory)
+                              "/bin/sh"
+                            shell-file-name)
+                          nil `("-c" ,command))))
+                    (start-file-process-shell-command (downcase mode-name)
+                                                      outbuf command))))
+             ;; Make the buffer's mode line show process state.
+             (setq mode-line-process
+                   (list (propertize ":%s" 'face 'compilation-warning)))
+             (set-process-sentinel proc 'compilation-sentinel)
+             (unless (eq mode t)
+               ;; Keep the comint filter, since it's needed for proper handling
+               ;; of the prompts.
+               (set-process-filter proc 'compilation-filter))
+             ;; Use (point-max) here so that output comes in
+             ;; after the initial text,
+             ;; regardless of where the user sees point.
+             (set-marker (process-mark proc) (point-max) outbuf)
+             (when compilation-disable-input
+               (condition-case nil
+                   (process-send-eof proc)
+                 ;; The process may have exited already.
+                 (error nil)))
+             (run-hook-with-args 'compilation-start-hook proc)
+              (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
-               (list (propertize ":%s" 'face 'compilation-warning)))
-         (set-process-sentinel proc 'compilation-sentinel)
-         (set-process-filter proc 'compilation-filter)
-         ;; Use (point-max) here so that output comes in
-         ;; after the initial text,
-         ;; regardless of where the user sees point.
-         (set-marker (process-mark proc) (point-max) outbuf)
-         (when compilation-disable-input
-           (condition-case nil
-               (process-send-eof proc)
-             ;; The process may have exited already.
-             (error nil)))
-         (setq compilation-in-progress
-               (cons proc compilation-in-progress))))
+               (list (propertize ":run" 'face 'compilation-warning)))
+         (force-mode-line-update)
+         (sit-for 0)                   ; Force redisplay
+         (save-excursion
+           ;; Insert the output at the end, after the initial text,
+           ;; regardless of where the user sees point.
+           (goto-char (point-max))
+           (let* ((buffer-read-only nil) ; call-process needs to modify outbuf
+                  (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))
+         (set-buffer-modified-p nil)
+         (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)
-         (goto-char (point-max))))
+      (setq default-directory thisdir)
+      ;; The following form selected outwin ever since revision 1.183,
+      ;; so possibly messing up point in some other window (bug#1073).
+      ;; Moved into the scope of with-current-buffer, though still with
+      ;; complete disregard for the case when compilation-scroll-output
+      ;; equals 'first-error (martin 2008-10-04).
+      (when compilation-scroll-output
+       (goto-char (point-max))))
+
     ;; Make it so the next C-x ` will use this buffer.
     (setq next-error-last-buffer outbuf)))
 
@@ -1359,6 +1469,8 @@ Returns the compilation buffer created."
     (define-key map "\M-p" 'compilation-previous-error)
     (define-key map "\M-{" 'compilation-previous-file)
     (define-key map "\M-}" 'compilation-next-file)
+    (define-key map "g" 'recompile) ; revert
+    (define-key map "q" 'quit-window)
     ;; Set up the menu-bar
     (define-key map [menu-bar compilation]
       (cons "Errors" compilation-menu-map))
@@ -1403,6 +1515,8 @@ Returns the compilation buffer created."
     (define-key map "\M-}" 'compilation-next-file)
     (define-key map "\t" 'compilation-next-error)
     (define-key map [backtab] 'compilation-previous-error)
+    (define-key map "g" 'recompile) ; revert
+    (define-key map "q" 'quit-window)
 
     (define-key map " " 'scroll-up)
     (define-key map "\^?" 'scroll-down)
@@ -1429,26 +1543,28 @@ Returns the compilation buffer created."
 `compilation-minor-mode-map' is a parent of this.")
 
 (defvar compilation-mode-tool-bar-map
-  (if (display-graphic-p)
-      (let ((map (butlast (copy-keymap tool-bar-map)))
-           (help (last tool-bar-map))) ;; Keep Help last in tool bar
-       (tool-bar-local-item
-        "left-arrow" 'previous-error-no-select 'previous-error-no-select map
-        :rtl "right-arrow"
-        :help "Goto previous error")
-       (tool-bar-local-item
-        "right-arrow" 'next-error-no-select 'next-error-no-select map
-        :rtl "left-arrow"
-        :help "Goto next error")
-       (tool-bar-local-item
-        "cancel" 'kill-compilation 'kill-compilation map
-        :enable '(let ((buffer (compilation-find-buffer)))
-                   (get-buffer-process buffer))
-        :help "Stop compilation")
-       (tool-bar-local-item
-        "refresh" 'recompile 'recompile map
-        :help "Restart compilation")
-       (append map help))))
+  ;; When bootstrapping, tool-bar-map is not properly initialized yet,
+  ;; so don't do anything.
+  (when (keymapp (butlast tool-bar-map))
+    (let ((map (butlast (copy-keymap tool-bar-map)))
+         (help (last tool-bar-map))) ;; Keep Help last in tool bar
+      (tool-bar-local-item
+       "left-arrow" 'previous-error-no-select 'previous-error-no-select map
+       :rtl "right-arrow"
+       :help "Goto previous error")
+      (tool-bar-local-item
+       "right-arrow" 'next-error-no-select 'next-error-no-select map
+       :rtl "left-arrow"
+       :help "Goto next error")
+      (tool-bar-local-item
+       "cancel" 'kill-compilation 'kill-compilation map
+       :enable '(let ((buffer (compilation-find-buffer)))
+                 (get-buffer-process buffer))
+       :help "Stop compilation")
+      (tool-bar-local-item
+       "refresh" 'recompile 'recompile map
+       :help "Restart compilation")
+      (append map help))))
 
 (put 'compilation-mode 'mode-class 'special)
 
@@ -1465,11 +1581,14 @@ Runs `compilation-mode-hook' with `run-mode-hooks' (which see).
   (interactive)
   (kill-all-local-variables)
   (use-local-map compilation-mode-map)
+  ;; Let windows scroll along with the output.
+  (set (make-local-variable 'window-point-insertion-type) t)
   (set (make-local-variable 'tool-bar-map) compilation-mode-tool-bar-map)
   (setq major-mode 'compilation-mode
        mode-name (or name-of-mode "Compilation"))
   (set (make-local-variable 'page-delimiter)
        compilation-page-delimiter)
+  (set (make-local-variable 'compilation-buffer-modtime) nil)
   (compilation-setup)
   (setq buffer-read-only t)
   (run-mode-hooks 'compilation-mode-hook))
@@ -1661,14 +1780,36 @@ Turning the mode on runs the normal hook `compilation-minor-mode-hook'."
 
 (defun compilation-filter (proc string)
   "Process filter for compilation buffers.
-Just inserts the text, but uses `insert-before-markers'."
-  (if (buffer-name (process-buffer proc))
-      (with-current-buffer (process-buffer proc)
-       (let ((inhibit-read-only t))
-         (save-excursion
-           (goto-char (process-mark proc))
-           (insert-before-markers string)
-           (run-hooks 'compilation-filter-hook))))))
+Just inserts the text,
+handles carriage motion (see `comint-inhibit-carriage-motion'),
+and runs `compilation-filter-hook'."
+  (when (buffer-live-p (process-buffer proc))
+    (with-current-buffer (process-buffer proc)
+      (let ((inhibit-read-only t)
+            ;; `save-excursion' doesn't use the right insertion-type for us.
+            (pos (copy-marker (point) t))
+           (min (point-min-marker))
+           (max (point-max-marker)))
+        (unwind-protect
+            (progn
+             ;; If we are inserting at the end of the accessible part
+             ;; of the buffer, keep the inserted text visible.
+             (set-marker-insertion-type max t)
+             (widen)
+              (goto-char (process-mark proc))
+              ;; We used to use `insert-before-markers', so that windows with
+              ;; point at `process-mark' scroll along with the output, but we
+              ;; now use window-point-insertion-type instead.
+              (insert string)
+              (unless comint-inhibit-carriage-motion
+                (comint-carriage-motion (process-mark proc) (point)))
+              (set-marker (process-mark proc) (point))
+              (set (make-local-variable 'compilation-buffer-modtime) (current-time))
+              (run-hooks 'compilation-filter-hook))
+         (goto-char pos)
+          (narrow-to-region min max)
+         (set-marker min nil)
+         (set-marker max nil))))))
 
 ;;; test if a buffer is a compilation buffer, assuming we're in the buffer
 (defsubst compilation-buffer-internal-p ()
@@ -1833,16 +1974,11 @@ This is the value of `next-error-function' in Compilation buffers."
     ;; (`omake -P' polls filesystem for changes and recompiles when needed
     ;;  in the same process and buffer).
     ;; So, recalculate all markers for that file.
-    (unless (and (nth 3 loc) (marker-buffer (nth 3 loc))
-                 ;; There may be no timestamp info if the loc is a `fake-loc'.
-                 ;; So we skip the time-check here, although we should maybe
-                 ;; change `compilation-fake-loc' to add timestamp info.
-                 (or (null (nth 4 loc))
-                     (equal (nth 4 loc)
-                            (setq timestamp
-                                  (with-current-buffer
-                                      (marker-buffer (nth 3 loc))
-                                    (visited-file-modtime))))))
+    (unless (and (nth 3 loc) (marker-buffer (nth 3 loc)) (nthcdr 4 loc)
+                 ;; There may be no timestamp info if the loc is a `fake-loc',
+                 ;; but we just checked that the file has been visited before!
+                 (equal (nth 4 loc)
+                        (setq timestamp compilation-buffer-modtime)))
       (with-current-buffer (compilation-find-file marker (caar (nth 2 loc))
                                                  (cadr (car (nth 2 loc))))
        (save-restriction
@@ -1967,10 +2103,12 @@ and overlay is highlighted between MK and END-MK."
       (if (window-dedicated-p (selected-window))
           (pop-to-buffer (marker-buffer mk))
         (switch-to-buffer (marker-buffer mk))))
-    ;; If narrowing gets in the way of going to the right place, widen.
     (unless (eq (goto-char mk) (point))
+      ;; If narrowing gets in the way of going to the right place, widen.
       (widen)
-      (goto-char mk))
+      (if next-error-move-function
+         (funcall next-error-move-function msg mk)
+       (goto-char mk)))
     (if end-mk
         (push-mark end-mk t)
       (if mark-active (setq mark-active)))
@@ -2230,7 +2368,7 @@ The file-structure looks like this:
   (goto-char limit)
   nil)
 
-;; Beware: this is not only compatiblity code.  New code stil uses it.  --Stef
+;; Beware: this is not only compatibility code.  New code stil uses it.  --Stef
 (defun compilation-forget-errors ()
   ;; In case we hit the same file/line specs, we want to recompute a new
   ;; marker for them, so flush our cache.
@@ -2266,7 +2404,7 @@ The file-structure looks like this:
           (eq compilation-scroll-output 'first-error))))
 
 ;;;###autoload
-(add-to-list 'auto-mode-alist '("\\.gcov\\'" . compilation-mode))
+(add-to-list 'auto-mode-alist (cons (purecopy "\\.gcov\\'") 'compilation-mode))
 
 (provide 'compile)