(decode_any_window): New function.
[bpt/emacs.git] / lisp / progmodes / compile.el
index db6be78..6d76fe3 100644 (file)
@@ -1,6 +1,7 @@
-;;; compile.el --- run compiler as inferior of Emacs, parse error messages.
+;;; compile.el --- run compiler as inferior of Emacs, parse error messages
 
-;; Copyright (C) 1985, 86, 87, 93, 94, 95, 96, 97, 98, 1999 Free Software Foundation, Inc.
+;; Copyright (C) 1985, 86, 87, 93, 94, 95, 96, 97, 98, 1999, 2001, 2003
+;;  Free Software Foundation, Inc.
 
 ;; Author: Roland McGrath <roland@gnu.org>
 ;; Maintainer: FSF
@@ -94,12 +95,19 @@ It should read in the source files which have errors and set
 `compilation-error-list' to a list with an element for each error message
 found.  See that variable for more info.")
 
+(defvar compilation-parse-errors-filename-function nil
+  "Function to call to post-process filenames while parsing error messages.
+It takes one arg FILENAME which is the name of a file as found
+in the compilation output, and should return a transformed file name.")
+
 ;;;###autoload
 (defvar compilation-process-setup-function nil
   "*Function to call to customize the compilation process.
 This functions is called immediately before the compilation process is
 started.  It can be used to set any variables or functions that are used
-while processing the output of the compilation process.")
+while processing the output of the compilation process.  The function
+is called with variables `compilation-buffer' and `compilation-window'
+bound to the compilation buffer and window, respectively.") 
 
 ;;;###autoload
 (defvar compilation-buffer-name-function nil
@@ -168,6 +176,33 @@ or when it is used with \\[next-error] or \\[compile-goto-error].")
 \\([a-zA-Z]?:?[^:( \t\n]*[^:( \t\n0-9][^:( \t\n]*\\)[:(][ \t]*\\([0-9]+\\)\
 \\([) \t]\\|:\\(\\([0-9]+:\\)\\|[0-9]*[^:0-9]\\)\\)" 2 3 6)
 
+    ;; GNU utilities with precise locations (line and columns),
+    ;; possibly ranges:
+    ;;  foo.c:8.23-9.1: error message
+    ("\\([a-zA-Z][-a-zA-Z._0-9]+\\): ?\
+\\([0-9]+\\)\\.\\([0-9]+\\)\
+-\\([0-9]+\\)\\.\\([0-9]+\\)\
+:" 1 2 3) ;; When ending points are supported, add line = 4 and col = 5.
+    ;;  foo.c:8.23-45: error message
+    ("\\([a-zA-Z][-a-zA-Z._0-9]+\\): ?\
+\\([0-9]+\\)\\.\\([0-9]+\\)\
+-\\([0-9]+\\)\
+:" 1 2 3) ;; When ending points are supported, add line = 2 and col = 4.
+    ;;  foo.c:8-45.3: error message
+    ("\\([a-zA-Z][-a-zA-Z._0-9]+\\): ?\
+\\([0-9]+\\)\
+-\\([0-9]+\\)\\.\\([0-9]+\\)\
+:" 1 2 nil) ;; When ending points are supported, add line = 2 and col = 4.
+    ;;  foo.c:8.23: error message
+    ("\\([a-zA-Z][-a-zA-Z._0-9]+\\): ?\
+\\([0-9]+\\)\\.\\([0-9]+\\)\
+:" 1 2 3)
+    ;;  foo.c:8-23: error message
+    ("\\([a-zA-Z][-a-zA-Z._0-9]+\\): ?\
+\\([0-9]+\\)\
+-\\([0-9]+\\)\
+:" 1 2 nil);; When ending points are supported, add line = 3.
+
     ;; Microsoft C/C++:
     ;;  keyboard.c(537) : warning C4005: 'min' : macro redefinition
     ;;  d:\tmp\test.c(23) : error C2143: syntax error : missing ';' before 'if'
@@ -189,6 +224,12 @@ or when it is used with \\[next-error] or \\[compile-goto-error].")
 \\([a-zA-Z]?:?[^:( \t\n]+\\)\
  \\([0-9]+\\)\\([) \t]\\|:[^0-9\n]\\)" 4 5)
 
+    ;; Valgrind (memory debugger for x86 GNU/Linux):
+    ;;  ==1332==    at 0x8008621: main (vtest.c:180)
+    ;; Currently this regexp only matches the first error.
+    ;; Thanks to Hans Petter Jansson <hpj@ximian.com> for his regexp wisdom.
+    ("^==[0-9]+==[^(]+\(([^:]+):([0-9]+)" 1 2)
+
     ;; 4.3BSD lint pass 2
     ;;         strcmp: variable # of args. llib-lc(359)  ::  /usr/src/foo/foo.c(8)
     (".*[ \t:]\\([a-zA-Z]?:?[^:( \t\n]+\\)[:(](+[ \t]*\\([0-9]+\\))[:) \t]*$"
@@ -234,6 +275,10 @@ of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?:" 3 2)
     (".*\"\\([^,\" \n\t]+\\)\", lines? \
 \\([0-9]+\\)\\([\(.]\\([0-9]+\\)\)?\\)?[:., (-]" 1 2 4)
 
+    ;; Python:
+    ;;  File "foobar.py", line 5, blah blah
+   ("^File \"\\([^,\" \n\t]+\\)\", line \\([0-9]+\\)," 1 2)
+
     ;; Caml compiler:
     ;;  File "foobar.ml", lines 5-8, characters 20-155: blah blah
    ("^File \"\\([^,\" \n\t]+\\)\", lines? \\([0-9]+\\)[-0-9]*, characters? \\([0-9]+\\)" 1 2 3)
@@ -264,10 +309,10 @@ of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?:" 3 2)
     ;; E, file.cc(35,52) Illegal operation on pointers
     ("[EW], \\([^(\n]*\\)(\\([0-9]+\\),[ \t]*\\([0-9]+\\)" 1 2 3)
 
-;;; This seems to be superfluous because the first pattern matches it.
-;;;    ;; GNU messages with program name and optional column number.
-;;;    ("[a-zA-Z]?:?[^0-9 \n\t:]+[^ \n\t:]*:[ \t]*\\([^ \n\t:]+\\):\
-;;;\\([0-9]+\\):\\(\\([0-9]+\\)[: \t]\\)?" 1 2 4)
+    ;; This seems to be superfluous because the first pattern matches it.
+    ;; ;; GNU messages with program name and optional column number.
+    ;; ("[a-zA-Z]?:?[^0-9 \n\t:]+[^ \n\t:]*:[ \t]*\\([^ \n\t:]+\\):\
+    ;;\\([0-9]+\\):\\(\\([0-9]+\\)[: \t]\\)?" 1 2 4)
 
     ;; Cray C compiler error messages
     ("\\(cc\\| cft\\)-[0-9]+ c\\(c\\|f77\\): ERROR \\([^,\n]+, \\)* File = \
@@ -312,6 +357,24 @@ of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?:" 3 2)
     ;; cf90-113 f90comp: ERROR NSE, File = Hoved.f90, Line = 16, Column = 3
     (".* ERROR [a-zA-Z0-9 ]+, File = \\(.+\\), Line = \\([0-9]+\\), Column = \\([0-9]+\\)"
      1 2 3)
+
+    ;; RXP - GPL XML validator at http://www.cogsci.ed.ac.uk/~richard/rxp.html:
+    ;; Error: Mismatched end tag: expected </geroup>, got </group>
+    ;; in unnamed entity at line 71 char 8 of file:///home/reto/test/group.xml
+    ("Error:.*\n.* line \\([0-9]+\\) char \\([0-9]+\\) of file://\\(.+\\)"
+     3 1 2)
+    ;; Warning: Start tag for undeclared element geroup
+    ;; in unnamed entity at line 4 char 8 of file:///home/reto/test/group.xml
+    ("Warning:.*\n.* line \\([0-9]+\\) char \\([0-9]+\\) of file://\\(.+\\)"
+     3 1 2)
+
+    ;; See http://ant.apache.org/faq.html
+    ;; Ant Java: works for jikes
+    ("^\\s-*\\[[^]]*\\]\\s-*\\(.+\\):\\([0-9]+\\):\\([0-9]+\\):[0-9]+:[0-9]+:" 1 2 3)
+
+    ;; Ant Java: works for javac
+    ("^\\s-*\\[[^]]*\\]\\s-*\\(.+\\):\\([0-9]+\\):" 1 2)
+
     )
 
   "Alist that specifies how to match errors in compiler output.
@@ -327,6 +390,8 @@ subexpression.")
   '(
     ;; Matches lines printed by the `-w' option of GNU Make.
     (".*: Entering directory `\\(.*\\)'$" 1)
+    ;; Matches lines made by Emacs byte compiler.
+    ("^Entering directory `\\(.*\\)'$" 1)
     )
   "Alist specifying how to match lines that indicate a new current directory.
 Note that the match is done at the beginning of lines.
@@ -339,6 +404,8 @@ The default value matches lines printed by the `-w' option of GNU Make.")
   '(
     ;; Matches lines printed by the `-w' option of GNU Make.
     (".*: Leaving directory `\\(.*\\)'$" 1)
+    ;; Matches lines made by Emacs byte compiler.
+    ("^Leaving directory `\\(.*\\)'$" 1)
     )
 "Alist specifying how to match lines that indicate restoring current directory.
 Note that the match is done at the beginning of lines.
@@ -373,6 +440,13 @@ Note that the match is done at the beginning of lines.
 Each elt has the form (REGEXP).  This alist is by default empty, but if
 you have some good regexps here, the parsing of messages will be faster.")
 
+(defvar compilation-highlight-regexp t
+  "Regexp matching part of visited source lines to highlight temporarily.
+Highlight entire line if t; don't highlight source lines if nil.")
+
+(defvar compilation-highlight-overlay nil
+  "Overlay used to temporarily highlight compilation matches.")
+
 (defcustom compilation-error-screen-columns t
   "*If non-nil, column numbers in error messages are screen columns.
 Otherwise they are interpreted as character positions, with
@@ -397,44 +471,6 @@ Otherwise, it saves all modified buffers without asking."
   :type 'boolean
   :group 'compilation)
 
-(defvar grep-regexp-alist
-  '(("\\([a-zA-Z]?:?[^:( \t\n]+\\)[:( \t]+\\([0-9]+\\)[:) \t]" 1 2))
-  "Regexp used to match grep hits.  See `compilation-error-regexp-alist'.")
-
-(defvar grep-program
-  ;; Currently zgrep has trouble.  It runs egrep instead of grep,
-  ;; and it doesn't pass along long options right.
-  "grep"
-;;;  (if (equal (condition-case nil    ; in case "zgrep" isn't in exec-path
-;;;             (call-process "zgrep" nil nil nil
-;;;                           "foo" null-device)
-;;;           (error nil))
-;;;         1)
-;;;      "zgrep"
-;;;    "grep")
-  "The default grep program for `grep-command' and `grep-find-command'.
-This variable's value takes effect when `grep-compute-defaults' is called.")
-
-;; Use -e if grep supports it,
-;; because that avoids lossage if the pattern starts with `-'.
-(defvar grep-command nil
-  "The default grep command for \\[grep].
-The real default value of this variable is set up by `grep-compute-defaults';
-call that function before using this variable.")
-
-(defvar grep-find-use-xargs nil
-  "Whether \\[grep-find] uses the `xargs' utility by default.
-
-If nil, it uses `grep -exec'; if `gnu', it uses `find -print0' and `xargs -0';
-if not nil and not `gnu', it uses `find -print' and `xargs'.
-
-This variable's value takes effect when `grep-compute-defaults' is called.")
-
-(defvar grep-find-command nil
-  "The default find command for \\[grep-find].
-The default value of this variable is set up by `grep-compute-defaults';
-call that function before using this variable.")
-
 ;;;###autoload
 (defcustom compilation-search-path '(nil)
   "*List of directories to search for source files named in error messages.
@@ -451,14 +487,12 @@ Sometimes it is useful for files to supply local values for this variable.
 You might also use mode hooks to specify it in certain modes, like this:
 
     (add-hook 'c-mode-hook
-      (function
        (lambda ()
         (unless (or (file-exists-p \"makefile\")
                     (file-exists-p \"Makefile\"))
-          (make-local-variable 'compile-command)
-          (setq compile-command
-                (concat \"make -k \"
-                        (file-name-sans-extension buffer-file-name)))))))"
+          (set (make-local-variable 'compile-command)
+               (concat \"make -k \"
+                       (file-name-sans-extension buffer-file-name))))))"
   :type 'string
   :group 'compilation)
 
@@ -472,11 +506,14 @@ This should be a function of three arguments: process status, exit status,
 and exit message; it returns a cons (MESSAGE . MODELINE) of the strings to
 write into the compilation buffer, and to put in its mode line.")
 
+(defvar compilation-environment nil
+  "*List of environment variables for compilation to inherit.
+Each element should be a string of the form ENVVARNAME=VALUE.
+This list is temporarily prepended to `process-environment' prior to
+starting the compilation process.")
+
 ;; History of compile commands.
 (defvar compile-history nil)
-;; History of grep commands.
-(defvar grep-history nil)
-(defvar grep-find-history nil)
 
 (defun compilation-mode-font-lock-keywords ()
   "Return expressions to highlight in Compilation mode."
@@ -523,9 +560,11 @@ and move to the source code that caused it.
 Interactively, prompts for the command if `compilation-read-command' is
 non-nil; otherwise uses `compile-command'.  With prefix arg, always prompts.
 
-To run more than one compilation at once, start one and rename the
-\`*compilation*' buffer to some other name with \\[rename-buffer].
-Then start the next one.
+To run more than one compilation at once, start one and rename
+the \`*compilation*' buffer to some other name with
+\\[rename-buffer].  Then start the next one.  On most systems,
+termination of the main compilation process kills its
+subprocesses.
 
 The name used for the buffer is actually whatever is returned by
 the function in `compilation-buffer-name-function', so you can set that
@@ -533,143 +572,23 @@ to a function that generates a unique name."
   (interactive
    (if (or compilation-read-command current-prefix-arg)
        (list (read-from-minibuffer "Compile command: "
-                                 compile-command nil nil
+                                 (eval compile-command) nil nil
                                  '(compile-history . 1)))
-     (list compile-command)))
-  (setq compile-command command)
+     (list (eval compile-command))))
+  (unless (equal command (eval compile-command))
+    (setq compile-command command))
   (save-some-buffers (not compilation-ask-about-save) nil)
-  (compile-internal compile-command "No more errors"))
+  (compile-internal command "No more errors"))
 
-;;; run compile with the default command line
+;; run compile with the default command line
 (defun recompile ()
-  "Re-compile the program including the current buffer."
+  "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, it recompiles using `compile-command'."
   (interactive)
   (save-some-buffers (not compilation-ask-about-save) nil)
-  (compile-internal compile-command "No more errors"))
-
-(defun grep-process-setup ()
-  "Set up `compilation-exit-message-function' for `grep'."
-  (set (make-local-variable 'compilation-exit-message-function)
-       (lambda (status code msg)
-        (if (eq status 'exit)
-            (cond ((zerop code)
-                   '("finished (matches found)\n" . "matched"))
-                  ((= code 1)
-                   '("finished with no matches found\n" . "no match"))
-                  (t
-                   (cons msg code)))
-          (cons msg code)))))
-
-(defun grep-compute-defaults ()
-  (setq grep-command
-       (if (equal (condition-case nil  ; in case "grep" isn't in exec-path
-                      (call-process grep-program nil nil nil
-                                    "-e" "foo" null-device)
-                    (error nil))
-                  1)
-           (format "%s -n -e " grep-program)
-         (format "%s -n " grep-program)))
-  (unless grep-find-use-xargs
-    (setq grep-find-use-xargs
-         (if (and
-               (equal (call-process "find" nil nil nil
-                                    null-device "-print0")
-                      0)
-               (equal (call-process "xargs" nil nil nil
-                                    "-0" "-e" "echo")
-                    0))
-             'gnu)))
-  (setq grep-find-command
-       (cond ((eq grep-find-use-xargs 'gnu)
-              (format "find . -type f -print0 | xargs -0 -e %s"
-                      grep-command))
-             (grep-find-use-xargs
-              (format "find . -type f -print | xargs %s" grep-command))
-             (t (cons (format "find . -type f -exec %s {} /dev/null \\;"
-                              grep-command)
-                      (+ 22 (length grep-command)))))))
-
-;;;###autoload
-(defun grep (command-args)
-  "Run grep, with user-specified args, and collect output in a buffer.
-While grep runs asynchronously, you can use \\[next-error] (M-x next-error),
-or \\<compilation-minor-mode-map>\\[compile-goto-error] in the grep \
-output buffer, to go to the lines
-where grep found matches.
-
-This command uses a special history list for its arguments, so you can
-easily repeat a grep command.
-
-A prefix argument says to default the argument based upon the current
-tag the cursor is over, substituting it into the last grep command
-in the grep command history (or into `grep-command'
-if that history list is empty)."
-  (interactive
-   (let (grep-default (arg current-prefix-arg))
-     (unless grep-command
-       (grep-compute-defaults))
-     (when arg
-       (let* ((tag-default
-              (funcall (or find-tag-default-function
-                           (get major-mode 'find-tag-default-function)
-                           ;; We use grep-tag-default instead of
-                           ;; find-tag-default, to avoid loading etags.
-                           'grep-tag-default))))
-        (setq grep-default (or (car grep-history) grep-command))
-        ;; Replace the thing matching for with that around cursor
-        (if (string-match "[^ ]+\\s +\\(-[^ ]+\\s +\\)*\\(\"[^\"]+\"\\|[^ ]+\\)" grep-default)
-            (setq grep-default (replace-match tag-default t t
-                                              grep-default 2)))))
-     (list (read-from-minibuffer "Run grep (like this): "
-                                (or grep-default grep-command)
-                                nil nil 'grep-history))))
-
-  ;; Setting process-setup-function makes exit-message-function work
-  ;; even when async processes aren't supported.
-  (let* ((compilation-process-setup-function 'grep-process-setup)
-        (buf (compile-internal (if null-device
-                                   (concat command-args " " null-device)
-                                 command-args)
-                               "No more grep hits" "grep"
-                               ;; Give it a simpler regexp to match.
-                               nil grep-regexp-alist)))))
-
-;; This is a copy of find-tag-default from etags.el.
-(defun grep-tag-default ()
-  (save-excursion
-    (while (looking-at "\\sw\\|\\s_")
-      (forward-char 1))
-    (when (or (re-search-backward "\\sw\\|\\s_"
-                                 (save-excursion (beginning-of-line) (point))
-                                 t)
-             (re-search-forward "\\(\\sw\\|\\s_\\)+"
-                                (save-excursion (end-of-line) (point))
-                                t))
-      (goto-char (match-end 0))
-      (buffer-substring (point)
-                       (progn (forward-sexp -1)
-                              (while (looking-at "\\s'")
-                                (forward-char 1))
-                              (point))))))
-
-;;;###autoload
-(defun grep-find (command-args)
-  "Run grep via find, with user-specified args COMMAND-ARGS.
-Collect output in a buffer.
-While find runs asynchronously, you can use the \\[next-error] command
-to find the text that grep hits refer to.
-
-This command uses a special history list for its arguments, so you can
-easily repeat a find command."
-  (interactive
-   (progn
-     (unless grep-find-command
-       (grep-compute-defaults))
-     (list (read-from-minibuffer "Run find (like this): "
-                                grep-find-command nil nil
-                                'grep-find-history))))
-  (let ((null-device nil))             ; see grep
-    (grep command-args)))
+  (apply 'compile-internal (or compilation-arguments
+                             `(,(eval compile-command) "No more errors"))))
 
 (defcustom compilation-scroll-output nil
   "*Non-nil to scroll the *compilation* buffer window as output appears.
@@ -681,19 +600,45 @@ visible rather than the begining."
   :version "20.3"
   :group 'compilation)
 
+
+(defun compilation-buffer-name (mode-name name-function)
+  "Return the name of a compilation buffer to use.
+If NAME-FUNCTION is non-nil, call it with one argument MODE-NAME
+to determine the buffer name.
+Likewise if `compilation-buffer-name-function' is non-nil.
+If current buffer is in Compilation mode for the same mode name
+return the name of the current buffer, so that it gets reused.
+Otherwise, construct a buffer name from MODE-NAME."
+  (cond (name-function
+        (funcall name-function mode-name))
+       (compilation-buffer-name-function
+        (funcall compilation-buffer-name-function mode-name))
+       ((and (eq major-mode 'compilation-mode)
+             (equal mode-name (nth 2 compilation-arguments)))
+        (buffer-name))
+       (t
+        (concat "*" (downcase mode-name) "*"))))
+
+
 (defun compile-internal (command error-message
                                 &optional name-of-mode parser
                                 error-regexp-alist name-function
                                 enter-regexp-alist leave-regexp-alist
-                                file-regexp-alist nomessage-regexp-alist)
+                                file-regexp-alist nomessage-regexp-alist
+                                no-async highlight-regexp local-map)
   "Run compilation command COMMAND (low level interface).
 ERROR-MESSAGE is a string to print if the user asks to see another error
-and there are no more errors.  The rest of the arguments, 3-10 are optional.
-For them nil means use the default.
+and there are no more errors.  
+
+The rest of the arguments are optional; for them, nil means use the default.
+
 NAME-OF-MODE is the name to display as the major mode in the compilation
-buffer.  PARSER is the error parser function.  ERROR-REGEXP-ALIST is the error
-message regexp alist to use.  NAME-FUNCTION is a function called to name the
-buffer.  ENTER-REGEXP-ALIST is the enter directory message regexp alist to use.
+buffer.
+
+PARSER is the error parser function.
+ERROR-REGEXP-ALIST is the error message regexp alist to use.
+NAME-FUNCTION is a function called to name the buffer.
+ENTER-REGEXP-ALIST is the enter directory message regexp alist to use.
 LEAVE-REGEXP-ALIST is the leave directory message regexp alist to use.
 FILE-REGEXP-ALIST is the change current file message regexp alist to use.
 NOMESSAGE-REGEXP-ALIST is the nomessage regexp alist to use.
@@ -702,19 +647,26 @@ NOMESSAGE-REGEXP-ALIST is the nomessage regexp alist to use.
 \`compilation-buffer-name-function', `compilation-enter-directory-regexp-alist',
 \`compilation-leave-directory-regexp-alist', `compilation-file-regexp-alist',
 \ and `compilation-nomessage-regexp-alist', respectively.
-For arg 7-10 a value `t' means an empty alist.
+For arg 7-10 a value t means an empty alist.
+
+If NO-ASYNC is non-nil, start the compilation process synchronously.
+
+If HIGHLIGHT-REGEXP is non-nil, `next-error' will temporarily highlight
+matching section of the visited source line; the default is to use the
+global value of `compilation-highlight-regexp'.
+
+If LOCAL-MAP is non-nil, use the given keymap instead of `compilation-mode-map'.
 
 Returns the compilation buffer created."
+  (unless no-async
+    (setq no-async (not (fboundp 'start-process))))
   (let (outbuf)
     (save-excursion
       (or name-of-mode
          (setq name-of-mode "Compilation"))
       (setq outbuf
-           (get-buffer-create
-            (funcall (or name-function compilation-buffer-name-function
-                         (function (lambda (mode)
-                                     (concat "*" (downcase mode) "*"))))
-                     name-of-mode)))
+           (get-buffer-create (compilation-buffer-name name-of-mode
+                                                       name-function)))
       (set-buffer outbuf)
       (let ((comp-proc (get-buffer-process (current-buffer))))
        (if comp-proc
@@ -744,6 +696,8 @@ Returns the compilation buffer created."
        (setq file-regexp-alist compilation-file-regexp-alist))
     (or nomessage-regexp-alist
        (setq nomessage-regexp-alist compilation-nomessage-regexp-alist))
+    (or highlight-regexp
+       (setq highlight-regexp compilation-highlight-regexp))
     (or parser (setq parser compilation-parse-errors-function))
     (let ((thisdir default-directory)
          outwin)
@@ -765,10 +719,12 @@ Returns the compilation buffer created."
          (goto-char (point-max)))
       ;; Pop up the compilation buffer.
       (setq outwin (display-buffer outbuf nil t))
-      (save-excursion
-       (set-buffer outbuf)
+      (with-current-buffer outbuf
        (compilation-mode name-of-mode)
-       ;; (setq buffer-read-only t)  ;;; Non-ergonomic.
+       (if local-map
+           (use-local-map local-map))
+       ;; In what way is it non-ergonomic ?  -stef
+       ;; (toggle-read-only 1) ;;; Non-ergonomic.
        (set (make-local-variable 'compilation-parse-errors-function) parser)
        (set (make-local-variable 'compilation-error-message) error-message)
        (set (make-local-variable 'compilation-error-regexp-alist)
@@ -781,27 +737,46 @@ Returns the compilation buffer created."
             file-regexp-alist)
        (set (make-local-variable 'compilation-nomessage-regexp-alist)
             nomessage-regexp-alist)
+       (set (make-local-variable 'compilation-highlight-regexp)
+            highlight-regexp)
        (set (make-local-variable 'compilation-arguments)
             (list command error-message
                   name-of-mode parser
                   error-regexp-alist name-function
                   enter-regexp-alist leave-regexp-alist
-                  file-regexp-alist nomessage-regexp-alist))
-        (make-local-variable 'lazy-lock-defer-on-scrolling)
+                  file-regexp-alist nomessage-regexp-alist
+                  nil  ; or no-async ??
+                  highlight-regexp local-map))
         ;; This proves a good idea if the buffer's going to scroll
         ;; with lazy-lock on.
-        (setq lazy-lock-defer-on-scrolling t)
+        (set (make-local-variable 'lazy-lock-defer-on-scrolling) t)
        (setq default-directory thisdir
              compilation-directory-stack (list default-directory))
        (set-window-start outwin (point-min))
        (or (eq outwin (selected-window))
            (set-window-point outwin (point-min)))
-       (compilation-set-window-height outwin)
+       ;; 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* ((process-environment (cons "EMACS=t" process-environment))
+       (if (not no-async)
+           (let* ((process-environment
+                   (append
+                    compilation-environment
+                    (if (and (boundp 'system-uses-terminfo)
+                             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.
+                    (if (getenv "EMACS")
+                        process-environment
+                      (cons "EMACS=t" process-environment))))
                   (proc (start-process-shell-command (downcase mode-name)
                                                      outbuf
                                                      command)))
@@ -831,30 +806,41 @@ exited abnormally with code %d\n"
                  (t
                   (compilation-handle-exit 'bizarre status status))))
          (message "Executing `%s'...done" command)))
-      (if compilation-scroll-output
+      (if (buffer-local-value 'compilation-scroll-output outbuf)
          (save-selected-window
-            (select-window outwin)
-            (goto-char (point-max)))))
+           (select-window outwin)
+           (goto-char (point-max)))))
     ;; Make it so the next C-x ` will use this buffer.
     (setq compilation-last-buffer outbuf)))
 
 (defun compilation-set-window-height (window)
   "Set the height of WINDOW according to `compilation-window-height'."
-  (and compilation-window-height
-       (= (window-width window) (frame-width (window-frame window)))
-       ;; If window is alone in its frame, aside from a minibuffer,
-       ;; don't change its height.
-       (not (eq window (frame-root-window (window-frame window))))
-       ;; This save-excursion prevents us from changing the current buffer,
-       ;; which might not be the same as the selected window's buffer.
-       (save-excursion
-        (let ((w (selected-window)))
-          (unwind-protect
-              (progn
-                (select-window window)
-                (enlarge-window (- compilation-window-height
-                                   (window-height))))
-            (select-window w))))))
+  (let ((height (buffer-local-value 'compilation-window-height (window-buffer window))))
+    (and height
+        (= (window-width window) (frame-width (window-frame window)))
+        ;; If window is alone in its frame, aside from a minibuffer,
+        ;; don't change its height.
+        (not (eq window (frame-root-window (window-frame window))))
+        ;; This save-current-buffer prevents us from changing the current
+        ;; buffer, which might not be the same as the selected window's buffer.
+        (save-current-buffer
+          (save-selected-window
+            (select-window window)
+            (enlarge-window (- height (window-height))))))))
+
+(defvar compilation-menu-map
+  (let ((map (make-sparse-keymap "Errors")))
+    (define-key map [stop-subjob]
+      '("Stop Compilation" . kill-compilation))
+    (define-key map [compilation-mode-separator2]
+      '("----" . nil))
+    (define-key map [compilation-first-error]
+      '("First Error" . first-error))
+    (define-key map [compilation-previous-error]
+      '("Previous Error" . previous-error))
+    (define-key map [compilation-next-error]
+      '("Next Error" . next-error))
+    map))
 
 (defvar compilation-minor-mode-map
   (let ((map (make-sparse-keymap)))
@@ -866,6 +852,9 @@ exited abnormally with code %d\n"
     (define-key map "\M-p" 'compilation-previous-error)
     (define-key map "\M-{" 'compilation-previous-file)
     (define-key map "\M-}" 'compilation-next-file)
+    ;; Set up the menu-bar
+    (define-key map [menu-bar compilation]
+      (cons "Errors" compilation-menu-map))
     map)
   "Keymap for `compilation-minor-mode'.")
 
@@ -878,50 +867,31 @@ exited abnormally with code %d\n"
     (define-key map "\M-{" 'compilation-previous-file)
     (define-key map "\M-}" 'compilation-next-file)
     ;; Set up the menu-bar
-    (define-key map [menu-bar errors-menu]
-      (cons "Errors" (make-sparse-keymap "Errors")))
-    (define-key map [menu-bar errors-menu stop-subjob]
-      '("Stop" . comint-interrupt-subjob))
-    (define-key map [menu-bar errors-menu compilation-mode-separator2]
-      '("----" . nil))
-    (define-key map [menu-bar errors-menu compilation-mode-first-error]
-      '("First Error" . first-error))
-    (define-key map [menu-bar errors-menu compilation-mode-previous-error]
-      '("Previous Error" . previous-error))
-    (define-key map [menu-bar errors-menu compilation-mode-next-error]
-      '("Next Error" . next-error))
+    (define-key map [menu-bar compilation]
+      (cons "Errors" compilation-menu-map))
     map)
   "Keymap for `compilation-shell-minor-mode'.")
 
 (defvar compilation-mode-map
-  (let ((map (cons 'keymap compilation-minor-mode-map)))
+  (let ((map (make-sparse-keymap)))
+    (set-keymap-parent map compilation-minor-mode-map)
     (define-key map " " 'scroll-up)
     (define-key map "\^?" 'scroll-down)
+
     ;; Set up the menu-bar
-    (define-key map [menu-bar compilation-menu]
+    (define-key map [menu-bar compilation]
       (cons "Compile" (make-sparse-keymap "Compile")))
-
-    (define-key map [menu-bar compilation-menu compilation-mode-kill-compilation]
-      '("Stop Compilation" . kill-compilation))
-    (define-key map [menu-bar compilation-menu compilation-mode-separator2]
-      '("----" . nil))
-    (define-key map [menu-bar compilation-menu compilation-mode-first-error]
-      '("First Error" . first-error))
-    (define-key map [menu-bar compilation-menu compilation-mode-previous-error]
-      '("Previous Error" . previous-error))
-    (define-key map [menu-bar compilation-menu compilation-mode-next-error]
-      '("Next Error" . next-error))
-    (define-key map [menu-bar compilation-menu compilation-separator2]
+    (define-key map [menu-bar compilation compilation-separator2]
       '("----" . nil))
-    (define-key map [menu-bar compilation-menu compilation-mode-grep]
+    (define-key map [menu-bar compilation compilation-grep]
       '("Search Files (grep)" . grep))
-    (define-key map [menu-bar compilation-menu compilation-mode-recompile]
+    (define-key map [menu-bar compilation compilation-recompile]
       '("Recompile" . recompile))
-    (define-key map [menu-bar compilation-menu compilation-mode-compile]
+    (define-key map [menu-bar compilation compilation-compile]
       '("Compile..." . compile))
     map)
   "Keymap for compilation log buffers.
-`compilation-minor-mode-map' is a cdr of this.")
+`compilation-minor-mode-map' is a parent of this.")
 
 (put 'compilation-mode 'mode-class 'special)
 
@@ -946,8 +916,11 @@ Runs `compilation-mode-hook' with `run-hooks' (which see)."
   (run-hooks 'compilation-mode-hook))
 
 (defun compilation-revert-buffer (ignore-auto noconfirm)
-  (if (or noconfirm (yes-or-no-p (format "Restart compilation? ")))
-      (apply 'compile-internal compilation-arguments)))
+  (if buffer-file-name
+      (let (revert-buffer-function)
+       (revert-buffer ignore-auto noconfirm))
+    (if (or noconfirm (yes-or-no-p (format "Restart compilation? ")))
+       (apply 'compile-internal compilation-arguments))))
 
 (defun compilation-setup ()
   "Prepare the buffer for the compilation parsing commands to work."
@@ -958,65 +931,33 @@ Runs `compilation-mode-hook' with `run-hooks' (which see)."
   (set (make-local-variable 'compilation-parsing-end) (copy-marker 1))
   (set (make-local-variable 'compilation-directory-stack)
        (list default-directory))
+  (make-local-variable 'compilation-error-screen-columns)
   (setq compilation-last-buffer (current-buffer)))
 
-(defvar compilation-shell-minor-mode nil
-  "Non-nil when in `compilation-shell-minor-mode'.
-In this minor mode, all the error-parsing commands of the
-Compilation major mode are available but bound to keys that don't
-collide with Shell mode.")
-(make-variable-buffer-local 'compilation-shell-minor-mode)
-
-(or (assq 'compilation-shell-minor-mode minor-mode-alist)
-    (setq minor-mode-alist
-         (cons '(compilation-shell-minor-mode " Shell-Compile")
-               minor-mode-alist)))
-(or (assq 'compilation-shell-minor-mode minor-mode-map-alist)
-    (setq minor-mode-map-alist (cons (cons 'compilation-shell-minor-mode
-                                          compilation-shell-minor-mode-map)
-                                    minor-mode-map-alist)))
-
-(defvar compilation-minor-mode nil
-  "Non-nil when in `compilation-minor-mode'.
-In this minor mode, all the error-parsing commands of the
-Compilation major mode are available.")
-(make-variable-buffer-local 'compilation-minor-mode)
-
-(or (assq 'compilation-minor-mode minor-mode-alist)
-    (setq minor-mode-alist (cons '(compilation-minor-mode " Compilation")
-                                minor-mode-alist)))
-(or (assq 'compilation-minor-mode minor-mode-map-alist)
-    (setq minor-mode-map-alist (cons (cons 'compilation-minor-mode
-                                          compilation-minor-mode-map)
-                                    minor-mode-map-alist)))
-
 ;;;###autoload
-(defun compilation-shell-minor-mode (&optional arg)
+(define-minor-mode compilation-shell-minor-mode
   "Toggle compilation shell minor mode.
 With arg, turn compilation mode on if and only if arg is positive.
-See `compilation-mode'.
+In this minor mode, all the error-parsing commands of the
+Compilation major mode are available but bound to keys that don't
+collide with Shell mode.  See `compilation-mode'.
 Turning the mode on runs the normal hook `compilation-shell-minor-mode-hook'."
-  (interactive "P")
-  (if (setq compilation-shell-minor-mode (if (null arg)
-                                      (null compilation-shell-minor-mode)
-                                    (> (prefix-numeric-value arg) 0)))
-      (let ((mode-line-process))
-       (compilation-setup)
-       (run-hooks 'compilation-shell-minor-mode-hook))))
+  nil " Shell-Compile" nil
+  :group 'compilation
+  (let (mode-line-process)
+    (compilation-setup)))
 
 ;;;###autoload
-(defun compilation-minor-mode (&optional arg)
+(define-minor-mode compilation-minor-mode
   "Toggle compilation minor mode.
 With arg, turn compilation mode on if and only if arg is positive.
-See `compilation-mode'.
+In this minor mode, all the error-parsing commands of the
+Compilation major mode are available.  See `compilation-mode'.
 Turning the mode on runs the normal hook `compilation-minor-mode-hook'."
-  (interactive "P")
-  (if (setq compilation-minor-mode (if (null arg)
-                                      (null compilation-minor-mode)
-                                    (> (prefix-numeric-value arg) 0)))
-      (let ((mode-line-process))
-       (compilation-setup)
-       (run-hooks 'compilation-minor-mode-hook))))
+  nil " Compilation" nil
+  :group 'compilation
+  (let ((mode-line-process))
+    (compilation-setup)))
 
 (defun compilation-handle-exit (process-status exit-status msg)
   "Write msg in the current buffer and hack its mode-line-process."
@@ -1031,10 +972,16 @@ Turning the mode on runs the normal hook `compilation-minor-mode-hook'."
     ;; later on.
     (goto-char omax)
     (insert ?\n mode-name " " (car status))
+    (if (and (numberp compilation-window-height)
+             (zerop compilation-window-height))
+        (message "%s" (cdr status)))
     (if (bolp)
        (forward-char -1))
     (insert " at " (substring (current-time-string) 0 19))
     (goto-char (point-max))
+    ;; Prevent that message from being recognized as a compilation error.
+    (add-text-properties omax (point)
+                        (append '(compilation-handle-exit t) nil))
     (setq mode-line-process (format ":%s [%s]" process-status (cdr status)))
     ;; Force mode line redisplay soon.
     (force-mode-line-update)
@@ -1138,7 +1085,18 @@ Does NOT find the source line like \\[next-error]."
                          (if (> (- n) i)
                              (error "Moved back past first error")
                            (nth (+ i n) compilation-old-error-list)))
-                     (let ((compilation-error-list (cdr errors)))
+                     (save-excursion
+                       (while (and (> n 0) errors)
+                         ;; Discard the current error and any previous.
+                         (while (and errors (>= (point) (car (car errors))))
+                           (setq errors (cdr errors)))
+                         ;; Now (car errors) is the next error.
+                         ;; If we want to move down more errors,
+                         ;; put point at this one and start again.
+                         (setq n (1- n))
+                         (if (and errors (> n 0))
+                             (goto-char (car (car errors))))))
+                     (let ((compilation-error-list errors))
                        (compile-reinitialize-errors nil nil n)
                        (if compilation-error-list
                            (nth (1- n) compilation-error-list)
@@ -1152,6 +1110,23 @@ Does NOT find the source line like \\[next-error]."
   (interactive "p")
   (compilation-next-error (- n)))
 
+(defun next-error-no-select (n)
+  "Move point to the next error in the compilation buffer and highlight match.
+Prefix arg N says how many error messages to move forwards.
+Finds and highlights the source line like \\[next-error], but does not
+select the source buffer."
+  (interactive "p")
+  (next-error n)
+  (pop-to-buffer compilation-last-buffer))
+
+(defun previous-error-no-select (n)
+  "Move point to the previous error in the compilation buffer and highlight match.
+Prefix arg N says how many error messages to move forwards.
+Finds and highlights the source line like \\[next-error], but does not
+select the source buffer."
+  (interactive "p")
+  (next-error (- n))
+  (pop-to-buffer compilation-last-buffer))
 
 ;; Given an elt of `compilation-error-list', return an object representing
 ;; the referenced file which is equal to (but not necessarily eq to) what
@@ -1231,15 +1206,15 @@ Does NOT find the source line like \\[next-error]."
   (interactive "p")
   (compilation-next-file (- n)))
 
-
 (defun kill-compilation ()
-  "Kill the process made by the \\[compile] command."
+  "Kill the process made by the \\[compile] or \\[grep] commands."
   (interactive)
   (let ((buffer (compilation-find-buffer)))
     (if (get-buffer-process buffer)
        (interrupt-process (get-buffer-process buffer))
       (error "The compilation process is not running"))))
 
+(defalias 'kill-grep 'kill-compilation)
 
 ;; Parse any new errors in the compilation buffer,
 ;; or reparse from the beginning if the user has asked for that.
@@ -1291,13 +1266,16 @@ Does NOT find the source line like \\[next-error]."
            (let ((inhibit-read-only t)
                  (buffer-undo-list t)
                  deactivate-mark
+                  (buffer-was-modified (buffer-modified-p))
                  (error-list compilation-error-list))
              (while error-list
                (save-excursion
-                 (put-text-property (goto-char (car (car error-list)))
-                                    (progn (end-of-line) (point))
-                                    'mouse-face 'highlight))
-               (setq error-list (cdr error-list))))
+                 (add-text-properties (goto-char (car (car error-list)))
+                                      (progn (end-of-line) (point))
+                                      '(mouse-face highlight help-echo "\
+mouse-2: visit this file and line")))
+               (setq error-list (cdr error-list)))
+              (set-buffer-modified-p buffer-was-modified))
            )))))
 
 (defun compile-mouse-goto-error (event)
@@ -1330,7 +1308,16 @@ at the end of the line."
                ;; failed to find the relevant file.  See
                ;; compilation-next-error-locus.
                (or (null (marker-buffer (caar compilation-error-list)))
-                   (> (point) (caar compilation-error-list))))
+                   (and (> (point) (caar compilation-error-list))
+                        (>= (point)
+                            ;; Don't skip too far: the text between
+                            ;; two errors belongs to the first.  This
+                            ;; in-between text might be other errors
+                            ;; on the same line (see
+                            ;; compilation-skip-to-next-location).
+                            (if (null (cdr compilation-error-list))
+                                compilation-parsing-end
+                              (caar (cdr compilation-error-list)))))))
       (setq compilation-error-list (cdr compilation-error-list)))
     (or compilation-error-list
        (error "No error to go to")))
@@ -1361,7 +1348,16 @@ other kinds of prefix arguments are ignored."
              ;; failed to find the relevant file.  See
              ;; compilation-next-error-locus.
              (or (null (marker-buffer (caar compilation-error-list)))
-                 (> (point) (caar compilation-error-list))))
+                 (and (> (point) (caar compilation-error-list))
+                      (>= (point)
+                          ;; Don't skip too far: the text between
+                          ;; two errors belongs to the first.  This
+                          ;; in-between text might be other errors
+                          ;; on the same line (see
+                          ;; compilation-skip-to-next-location).
+                          (if (null (cdr compilation-error-list))
+                              compilation-parsing-end
+                            (caar (cdr compilation-error-list)))))))
     (setq compilation-error-list (cdr compilation-error-list)))
 
   (push-mark)
@@ -1405,9 +1401,9 @@ other kinds of prefix arguments are ignored."
 If all the error messages parsed so far have been processed already,
 the message buffer is checked for new ones.
 
-A prefix arg specifies how many error messages to move;
+A prefix ARGP specifies how many error messages to move;
 negative means move back to previous error messages.
-Just C-u as a prefix means reparse the error message buffer
+Just \\[universal-argument] as a prefix means reparse the error message buffer
 and start at the first error.
 
 \\[next-error] normally uses the most recently started compilation or
@@ -1433,11 +1429,15 @@ See variables `compilation-parse-errors-function' and
                           (consp argp))))
 ;;;###autoload (define-key ctl-x-map "`" 'next-error)
 
-(defun previous-error ()
+(defun previous-error (argp)
   "Visit previous compilation error message and corresponding source code.
-This operates on the output from the \\[compile] command."
-  (interactive)
-  (next-error -1))
+
+A prefix ARGP specifies how many error messages to move;
+negative means move forward to next error messages.
+
+This operates on the output from the \\[compile] and \\[grep] commands."
+  (interactive "P")
+  (next-error (- (prefix-numeric-value argp))))
 
 (defun first-error ()
   "Reparse the error message buffer and start at the first error.
@@ -1616,9 +1616,8 @@ Selects a window with point at SOURCE, with another window displaying ERROR."
       ;; display the source in another window.
       (let ((pop-up-windows t))
        (pop-to-buffer (marker-buffer (cdr next-error))))
-    (if (and (window-dedicated-p (selected-window))
-            (eq (selected-window) (frame-root-window)))
-       (switch-to-buffer-other-frame (marker-buffer (cdr next-error)))
+    (if (window-dedicated-p (selected-window))
+       (pop-to-buffer (marker-buffer (cdr next-error)))
       (switch-to-buffer (marker-buffer (cdr next-error)))))
   (goto-char (cdr next-error))
   ;; If narrowing got in the way of
@@ -1640,15 +1639,36 @@ Selects a window with point at SOURCE, with another window displaying ERROR."
         ;; Use an existing window if it is in a visible frame.
         (w (or (get-buffer-window (marker-buffer (car next-error)) 'visible)
                ;; Pop up a window.
-               (display-buffer (marker-buffer (car next-error))))))
+               (display-buffer (marker-buffer (car next-error)))))
+        (highlight-regexp (with-current-buffer (marker-buffer (car next-error))
+                            compilation-highlight-regexp)))
     (set-window-point w (car next-error))
     (set-window-start w (car next-error))
-    (compilation-set-window-height w)))
+    (compilation-set-window-height w)
+
+    (when highlight-regexp
+      (unless compilation-highlight-overlay
+       (setq compilation-highlight-overlay (make-overlay 1 1))
+       (overlay-put compilation-highlight-overlay 'face 'region))
+      (with-current-buffer (marker-buffer (cdr next-error))
+       (save-excursion
+         (end-of-line)
+         (let ((end (point)) olay)
+           (beginning-of-line)
+           (if (and (stringp highlight-regexp)
+                    (re-search-forward  highlight-regexp end t))
+               (progn
+                 (goto-char (match-beginning 0))
+                 (move-overlay compilation-highlight-overlay (match-beginning 0) (match-end 0)))
+             (move-overlay compilation-highlight-overlay (point) end))
+           (sit-for 0 500)
+           (delete-overlay compilation-highlight-overlay)))))))
+
 \f
 (defun compilation-find-file (marker filename dir &rest formats)
   "Find a buffer for file FILENAME.
-Search the directories in compilation-search-path.
-A nil in compilation-search-path means to try the
+Search the directories in `compilation-search-path'.
+A nil in `compilation-search-path' means to try the
 current directory, which is passed in DIR.
 If FILENAME is not found at all, ask the user where to find it.
 Pop up the buffer containing MARKER and scroll to MARKER if we ask the user."
@@ -1657,11 +1677,11 @@ Pop up the buffer containing MARKER and scroll to MARKER if we ask the user."
     (let ((dirs compilation-search-path)
          buffer thisdir fmts name)
       (if (file-name-absolute-p filename)
-       ;; The file name is absolute.  Use its explicit directory as
-       ;; the first in the search path, and strip it from FILENAME.
-       (setq filename (abbreviate-file-name (expand-file-name filename))
-             dirs (cons (file-name-directory filename) dirs)
-             filename (file-name-nondirectory filename)))
+         ;; The file name is absolute.  Use its explicit directory as
+         ;; the first in the search path, and strip it from FILENAME.
+         (setq filename (abbreviate-file-name (expand-file-name filename))
+               dirs (cons (file-name-directory filename) dirs)
+               filename (file-name-nondirectory filename)))
       ;; Now search the path.
       (while (and dirs (null buffer))
        (setq thisdir (or (car dirs) dir)
@@ -1670,7 +1690,7 @@ Pop up the buffer containing MARKER and scroll to MARKER if we ask the user."
        (while (and fmts (null buffer))
          (setq name (expand-file-name (format (car fmts) filename) thisdir)
                buffer (and (file-exists-p name)
-                           (find-file name))
+                           (find-file-noselect name))
                fmts (cdr fmts)))
        (setq dirs (cdr dirs)))
       (or buffer
@@ -1698,12 +1718,40 @@ Pop up the buffer containing MARKER and scroll to MARKER if we ask the user."
              (overlays-in (point-min) (point-max)))
       buffer)))
 
+(defun compilation-normalize-filename (filename)
+  "Convert a filename string found in an error message to make it usable."
+
+  ;; Check for a comint-file-name-prefix and prepend it if
+  ;; appropriate.  (This is very useful for
+  ;; compilation-minor-mode in an rlogin-mode buffer.)
+  (and (boundp 'comint-file-name-prefix)
+       ;; If file name is relative, default-directory will
+       ;; already contain the comint-file-name-prefix (done
+       ;; by compile-abbreviate-directory).
+       (file-name-absolute-p filename)
+       (setq filename
+            (concat comint-file-name-prefix filename)))
+
+  ;; If compilation-parse-errors-filename-function is
+  ;; defined, use it to process the filename.
+  (when compilation-parse-errors-filename-function
+    (setq filename
+         (funcall compilation-parse-errors-filename-function
+                  filename)))
+
+  ;; Some compilers (e.g. Sun's java compiler, reportedly)
+  ;; produce bogus file names like "./bar//foo.c" for file
+  ;; "bar/foo.c"; expand-file-name will collapse these into
+  ;; "/foo.c" and fail to find the appropriate file.  So we
+  ;; look for doubled slashes in the file name and fix them
+  ;; up in the buffer.
+  (setq filename (command-line-normalize-file-name filename)))
 
 ;; Set compilation-error-list to nil, and unchain the markers that point to the
 ;; error messages and their text, so that they no longer slow down gap motion.
 ;; This would happen anyway at the next garbage collection, but it is better to
 ;; do it right away.
-  (defun compilation-forget-errors ()
+(defun compilation-forget-errors ()
   (while compilation-old-error-list
     (let ((next-error (car compilation-old-error-list)))
       (set-marker (car next-error) nil)
@@ -1712,13 +1760,14 @@ Pop up the buffer containing MARKER and scroll to MARKER if we ask the user."
     (setq compilation-old-error-list (cdr compilation-old-error-list)))
   (setq compilation-error-list nil
        compilation-directory-stack (list default-directory))
-  (set-marker compilation-parsing-end 1)
+  (if compilation-parsing-end
+      (set-marker compilation-parsing-end 1))
   ;; Remove the highlighting added by compile-reinitialize-errors:
   (let ((inhibit-read-only t)
        (buffer-undo-list t)
        deactivate-mark)
-    (remove-text-properties (point-min) (point-max) '(mouse-face highlight)))
-  )
+    (remove-text-properties (point-min) (point-max)
+                           '(mouse-face highlight help-echo nil))))
 
 
 ;; This function is not needed any more by compilation mode.
@@ -1782,8 +1831,8 @@ See variable `compilation-parse-errors-function' for the interface it uses."
     (compile-collect-regexps 'leave compilation-leave-directory-regexp-alist)
     (compile-collect-regexps 'enter compilation-enter-directory-regexp-alist)
     (compile-collect-regexps 'file compilation-file-regexp-alist)
-    (compile-collect-regexps 'nomessage compilation-nomessage-regexp-alist)
     (compile-collect-regexps 'error compilation-error-regexp-alist)
+    (compile-collect-regexps 'nomessage compilation-nomessage-regexp-alist)
 
     ;; Don't reparse messages already seen at last parse.
     (goto-char compilation-parsing-end)
@@ -1795,7 +1844,10 @@ See variable `compilation-parse-errors-function' for the interface it uses."
       (forward-line 2))
 
     ;; Parse messages.
-    (while (not (or found-desired (eobp)))
+    (while (not (or found-desired (eobp)
+                   ;; Don't parse the "compilation finished" message
+                   ;; as a compilation error.
+                   (get-text-property (point) 'compilation-handle-exit)))
       (let ((this compilation-regexps) (prev nil) (alist nil) type)
        ;; Go through the regular expressions. If a match is found,
        ;; variable alist is set to the corresponding alist and the
@@ -1838,24 +1890,8 @@ See variable `compilation-parse-errors-function' for the interface it uses."
                        (error "\
 An error message with no file name and no file name has been seen earlier"))
 
-                   ;; Check for a comint-file-name-prefix and prepend it if
-                   ;; appropriate.  (This is very useful for
-                   ;; compilation-minor-mode in an rlogin-mode buffer.)
-                   (and (boundp 'comint-file-name-prefix)
-                        ;; If file name is relative, default-directory will
-                        ;; already contain the comint-file-name-prefix (done
-                        ;; by compile-abbreviate-directory).
-                        (file-name-absolute-p filename)
-                        (setq filename
-                              (concat comint-file-name-prefix filename)))
-
-                   ;; Some compilers (e.g. Sun's java compiler, reportedly)
-                   ;; produce bogus file names like "./bar//foo.c" for file
-                   ;; "bar/foo.c"; expand-file-name will collapse these into
-                   ;; "/foo.c" and fail to find the appropriate file.  So we
-                   ;; look for doubled slashes in the file name and fix them
-                   ;; up in the buffer.
-                   (setq filename (command-line-normalize-file-name filename))
+                   ;; Clean up the file name string in several ways.
+                   (setq filename (compilation-normalize-filename filename))
 
                    (setq filename
                          (cons filename (cons default-directory (cdr alist))))
@@ -1892,9 +1928,17 @@ An error message with no file name and no file name has been seen earlier"))
                                          find-at-least))
                                 (and limit-search
                                      (>= end-of-match limit-search)))
-                            (not (equal ; Same filename?
-                                  (car (cdr (car compilation-error-list)))
-                                  (car (cdr this-error)))))
+                            ;; `this-error' could contain a pair of
+                            ;; markers already.
+                            (let ((thispos (cdr this-error))
+                                  (lastpos (cdar compilation-error-list)))
+                              (not (equal
+                                    (if (markerp thispos)
+                                        (marker-buffer thispos)
+                                      (car thispos))
+                                    (if (markerp lastpos)
+                                        (marker-buffer lastpos)
+                                      (car lastpos))))))
                        ;; We are past the limits and the last error
                        ;; parsed, didn't belong to the same source file
                        ;; as the earlier ones i.e. we have seen all the
@@ -1918,27 +1962,37 @@ An error message with no file name and no file name has been seen earlier"))
 
                ;; Not an error message.
                (if (eq type `file)     ; Change current file.
-                   (and filename (setq compilation-current-file filename))
+                   (when filename
+                     (setq compilation-current-file
+                           ;; Clean up the file name string in several ways.
+                           (compilation-normalize-filename filename)))
                  ;; Enter or leave directory.
                  (setq stack compilation-directory-stack)
-                 (and filename
-                      (file-directory-p
-                       (setq filename
-                             ;; The directory name in the message
-                             ;; is a truename.  Try to convert it to a form
-                             ;; like what the user typed in.
-                             (compile-abbreviate-directory
-                              (file-name-as-directory
-                               (expand-file-name filename))
-                              orig orig-expanded parent-expanded)))
-                      (if (eq type 'leave)
-                          (while (and stack
-                                      (not (string-equal (car stack)
-                                                         filename)))
-                            (setq stack (cdr stack)))
-                        (setq compilation-directory-stack
-                              (cons filename compilation-directory-stack)
-                              default-directory filename)))
+                 ;; Don't check if it is really a directory.
+                 ;; Let the code to search and clean up file names
+                 ;; try to use it in any case.
+                 (when filename
+                   ;; Clean up the directory name string in several ways.
+                   (setq filename (compilation-normalize-filename filename))
+                   (setq filename
+                         ;; The directory name in the message
+                         ;; is a truename.  Try to convert it to a form
+                         ;; like what the user typed in.
+                         (compile-abbreviate-directory
+                          (file-name-as-directory
+                           (expand-file-name filename))
+                          orig orig-expanded parent-expanded))
+                   (if (eq type 'leave)
+                       ;; If we are leaving a specific directory,
+                       ;; as preparation, pop out of all other directories
+                       ;; that we entered nested within it.
+                       (while (and stack
+                                   (not (string-equal (car stack)
+                                                      filename)))
+                         (setq stack (cdr stack)))
+                     (setq compilation-directory-stack
+                           (cons filename compilation-directory-stack)
+                           default-directory filename)))
                  (and (eq type 'leave)
                       stack
                       (setq compilation-directory-stack (cdr stack))
@@ -1969,26 +2023,23 @@ An error message with no file name and no file name has been seen earlier"))
               ;; Use floating-point because (* 100 (point)) frequently
               ;; exceeds the range of Emacs Lisp integers.
               (/ (* 100.0 (point)) (point-max)))
-             ))
+             )))
 
-       (forward-line 1)))              ; End of while loop. Look at next line.
+      (forward-line 1))                ; End of while loop. Look at next line.
 
     (set-marker compilation-parsing-end (point))
     (setq compilation-error-list (nreverse compilation-error-list))
-;;; (message "Parsing error messages...done. %d found. %.0f%% of buffer seen."
-;;;         compilation-num-errors-found
-;;;         (/ (* 100.0 (point)) (point-max)))
+    ;; (message "Parsing error messages...done. %d found. %.0f%% of buffer seen."
+    ;;      compilation-num-errors-found
+    ;;      (/ (* 100.0 (point)) (point-max)))
     (message "Parsing error messages...done.")))
 
 (defun compile-collect-regexps (type this)
   ;; Add elements to variable compilation-regexps that is bound in
   ;; compilation-parse-errors.
   (and (not (eq this t))
-       (while this
-        (setq compilation-regexps
-              (cons (cons (car (car this)) (cons type (cdr (car this))))
-                    compilation-regexps))
-        (setq this (cdr this)))))
+       (dolist (el this)
+        (push (cons (car el) (cons type (cdr el))) compilation-regexps))))
 
 (defun compile-buffer-substring (index)
   "Get substring matched by INDEXth subexpression."
@@ -2028,6 +2079,9 @@ An error message with no file name and no file name has been seen earlier"))
                  (substring dir (length parent-expanded)))))
   dir)
 
+(add-to-list 'debug-ignored-errors "^No more errors\\( yet\\|\\)$")
+
 (provide 'compile)
 
+;;; arch-tag: 12465727-7382-4f72-b234-79855a00dd8c
 ;;; compile.el ends here