changeset 17623:a09fd9348b0d

Support compilers that give a message each time the file being compiled changes but don't include a file name each error message. Speed up by searching for regexps one by one instead of combining. (compile-internal): Takes more optional arguments. All five regexp alists can be given as argument. Change name of variable regexp-alist to error-regexp-alist. Change some local variables directly by setq instead of rebinding by let. (compilation-shell-minor-mode): New minor mode. Similar to compilation-minor-mode, but key bindings don't collide with shell mode. (compilation-shell-minor-mode-map, compilation-shell-minor-mode): New variables. (compile-auto-highlight): Doc fix. (compilation-error-regexp-alist): Removed unnecessary line break in first regexp. Replaced \\(\\|.* on \\) by \\(.* on \\)? in regexp for Absoft FORTRAN 77 Compiler 3.1.3. Added regexp for SPARCcompiler Pascal. Divided long line in regexp for Cray C compiler error messages. Made comment fit in line at regexp for Sun Ada (VADS, Solaris). FILE-IDX may be nil, meaning an error message with no file name, so the file name must be taken from an earlier message. LINE-IDX may be a function which is called with two arguments the file name and column strings and returns an error position descriptor. (compilation-enter-directory-regexp-alist) (compilation-leave-directory-regexp-alist): New variables. (compilation-file-regexp-alist) (compilation-nomessage-regexp-alist): New variables. (grep-regexp-alist): Removed unnecessary ^ at beginning of regexp. (compilation-enter-directory-regexp) (compilation-leave-directory-regexp): Variables deleted. Replaced by compilation-enter-directory-regexp-alist and compilation-leave-directory-regexp-alist. (compilation-buffer-p): Return true also for buffer in compilation-shell-minor-mode. (compilation-next-error-locus): Split a long line. (count-regexp-groupings): Comment about this function not being needed any more. (compilation-current-file, compilation-regexps); New variables. (compilation-parse-errors): Large parts rewritten. Don't put the regexps together in one large regexp, instead match them one by one. Support the generalized subexpression indices. (compile-collect-regexps, compile-buffer-substring): New functions supporting compilation-parse-errors.

--- a/lisp/progmodes/compile.el	Fri May 02 07:27:07 1997 +0000
+++ b/lisp/progmodes/compile.el	Sat May 03 04:37:52 1997 +0000
@@ -40,7 +40,7 @@
 
 (defvar compile-auto-highlight nil
   "*Specify how many compiler errors to highlight (and parse) initially.
-\(Highlighting applies to ean error message when the mouse is over it.)
+\(Highlighting applies to an error message when the mouse is over it.)
 If this is a number N, all compiler error messages in the first N lines
 are highlighted and parsed as soon as they arrive in Emacs.
 If t, highlight and parse the whole compilation output as soon as it arrives.
@@ -140,8 +140,7 @@
     ;; We'll insist that the number be followed by a colon or closing
     ;; paren, because otherwise this matches just about anything
     ;; containing a number with spaces around it.
-    ("\
-\\([a-zA-Z]?:?[^:( \t\n]+\\)[:(][ \t]*\\([0-9]+\\)\\([) \t]\\|\
+    ("\\([a-zA-Z]?:?[^:( \t\n]+\\)[:(][ \t]*\\([0-9]+\\)\\([) \t]\\|\
 :\\([^0-9\n]\\|\\([0-9]+:\\)\\)\\)" 1 2 5)
 
     ;; Microsoft C/C++:
@@ -184,7 +183,7 @@
     ;; Absoft FORTRAN 77 Compiler 3.1.3
     ;;  error on line 19 of fplot.f: spelling error?
     ;;  warning on line 17 of fplot.f: data type is undefined for variable d
-    ("\\(\\|.* on \\)[Ll]ine[ \t]+\\([0-9]+\\)[ \t]+\
+    ("\\(.* on \\)?[Ll]ine[ \t]+\\([0-9]+\\)[ \t]+\
 of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?:" 3 2)
 
     ;; Apollo cc, 4.3BSD fc:
@@ -214,6 +213,16 @@
     ;; IBM AIX lint is too painful to do right this way.  File name
     ;; prefixes entire sections rather than being on each line.
 
+    ;; SPARCcompiler Pascal:
+    ;;           20      linjer      : array[1..4] of linje;
+    ;; e 18480-----------^---  Inserted ';'
+    ;; and
+    ;; E 18520 line 61 -  0 is undefined
+    ;; These messages don't contain a file name. Instead the compiler gives
+    ;; a message whenever the file being compiled is changed.
+    (" +\\([0-9]+\\) +.*\n[ew] [0-9]+-+" nil 1)
+    ("[Ew] +[0-9]+ line \\([0-9]+\\) -  " nil 1)
+
     ;; Lucid Compiler, lcc 3.x
     ;; E, file.cc(35,52) Illegal operation on pointers
     ("[EW], \\([^(\n]*\\)(\\([0-9]+\\),[ \t]*\\([0-9]+\\)" 1 2 3)
@@ -223,7 +232,8 @@
 \\([0-9]+\\):\\(\\([0-9]+\\)[: \t]\\)?" 1 2 4)
 
     ;; Cray C compiler error messages
-    ("\\(cc\\| cft\\)-[0-9]+ c\\(c\\|f77\\): ERROR \\([^,\n]+, \\)* File = \\([^,\n]+\\), Line = \\([0-9]+\\)" 4 5)
+    ("\\(cc\\| cft\\)-[0-9]+ c\\(c\\|f77\\): ERROR \\([^,\n]+, \\)* File = \
+\\([^,\n]+\\), Line = \\([0-9]+\\)" 4 5)
 
     ;; IBM C/C++ Tools 2.01:
     ;;  foo.c(2:0) : informational EDC0804: Function foo is not referenced.
@@ -237,7 +247,7 @@
 
     ;; Perl -w:
     ;; syntax error at automake line 922, near "':'"
-    ("\n.* at \\([^ ]+\\) line \\([0-9]+\\)," 1 2)
+    (".* at \\([^ ]+\\) line \\([0-9]+\\)," 1 2)
     )
   "Alist that specifies how to match errors in compiler output.
 Each elt has the form (REGEXP FILE-IDX LINE-IDX [COLUMN-IDX FILE-FORMAT...])
@@ -248,6 +258,56 @@
 try; %s in the string is replaced by the text matching the FILE-IDX'th
 subexpression.")
 
+(defvar compilation-enter-directory-regexp-alist
+  '(
+    ;; Matches lines printed by the `-w' option of GNU Make.
+    (".*: 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.
+Each elt has the form (REGEXP IDX).
+If REGEXP matches, the IDX'th subexpression gives the directory name.
+
+The default value matches lines printed by the `-w' option of GNU Make.")
+
+(defvar compilation-leave-directory-regexp-alist
+  '(
+    ;; Matches lines printed by the `-w' option of GNU Make.
+    (".*: 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.
+Each elt has the form (REGEXP IDX).
+If REGEXP matches, the IDX'th subexpression gives the name of the directory
+being moved from. If IDX is nil, the last directory entered \(by a line
+matching `compilation-enter-directory-regexp-alist'\) is assumed.
+
+The default value matches lines printed by the `-w' option of GNU Make.")
+
+(defvar compilation-file-regexp-alist
+  '(
+    ;; This matches entries with date time year file-name: like
+    ;; Thu May 14 10:46:12 1992  mom3.p:
+    ("\\w\\w\\w \\w\\w\\w +[0-9]+ [0-9][0-9]:[0-9][0-9]:[0-9][0-9] [0-9][0-9][0-9][0-9]  \\(.*\\):$" 1)
+    )
+  "Alist specifying how to match lines that indicate a new current file.
+Note that the match is done at the beginning of lines.
+Each elt has the form (REGEXP IDX).
+If REGEXP matches, the IDX'th subexpression gives the file name. This is
+used with compilers that don't indicate file name in every error message.")
+
+;; There is no generally useful regexp that will match non messages, but
+;; in special cases there might be one. The lines that are not matched by
+;; a regexp take much longer time than the ones that are recognized so if
+;; you have same regexeps here, parsing is faster.
+(defvar compilation-nomessage-regexp-alist
+  '(
+    )
+  "Alist specifying how to match lines that have no message.
+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-read-command t
   "If not nil, M-x compile reads the compilation command to use.
 Otherwise, M-x compile just uses the value of `compile-command'.")
@@ -257,7 +317,7 @@
 Otherwise, it saves all modified buffers without asking.")
 
 (defvar grep-regexp-alist
-  '(("^\\([a-zA-Z]?:?[^:( \t\n]+\\)[:( \t]+\\([0-9]+\\)[:) \t]" 1 2))
+  '(("\\([a-zA-Z]?:?[^:( \t\n]+\\)[:( \t]+\\([0-9]+\\)[:) \t]" 1 2))
   "Regexp used to match grep hits.  See `compilation-error-regexp-alist'.")
 
 ;; The system null device. (Should reference NULL_DEVICE from C.)
@@ -329,22 +389,6 @@
 				    (concat \"make -k \"
 					    buffer-file-name))))))")
 
-(defvar compilation-enter-directory-regexp
-  ".*: Entering directory `\\(.*\\)'$"
-  "Regular expression matching lines that indicate a new current directory.
-This must contain one \\(, \\) pair around the directory name.
-
-The default value matches lines printed by the `-w' option of GNU Make.")
-
-(defvar compilation-leave-directory-regexp
-  ".*: Leaving directory `\\(.*\\)'$"
-  "Regular expression matching lines that indicate restoring current directory.
-This may contain one \\(, \\) pair around the name of the directory
-being moved from.  If it does not, the last directory entered \(by a
-line matching `compilation-enter-directory-regexp'\) is assumed.
-
-The default value matches lines printed by the `-w' option of GNU Make.")
-
 (defvar compilation-directory-stack nil
   "Stack of previous directories for `compilation-leave-directory-regexp'.
 The head element is the directory the compilation was started in.")
@@ -373,7 +417,7 @@
 	   compilation-error-regexp-alist)
    (list
     ;;
-    ;; Compiler output lines.  Recognise `make[n]:' lines too.
+    ;; Compiler output lines.  Recognize `make[n]:' lines too.
     '("^\\([A-Za-z_0-9/\.+-]+\\)\\(\\[\\([0-9]+\\)\\]\\)?[ \t]*:"
       (1 font-lock-function-name-face) (3 font-lock-comment-face nil t)))
    ))
@@ -464,19 +508,27 @@
     (grep command-args)))
 
 (defun compile-internal (command error-message
-				 &optional name-of-mode parser regexp-alist
-				 name-function)
+				 &optional name-of-mode parser
+				 error-regexp-alist name-function
+				 enter-regexp-alist leave-regexp-alist
+				 file-regexp-alist nomessage-regexp-alist)
   "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.  Third argument NAME-OF-MODE is the name
-to display as the major mode in the compilation buffer.
-
-Fourth arg PARSER is the error parser function (nil means the default).  Fifth
-arg REGEXP-ALIST is the error message regexp alist to use (nil means the
-default).  Sixth arg NAME-FUNCTION is a function called to name the buffer (nil
-means the default).  The defaults for these variables are the global values of
-\`compilation-parse-errors-function', `compilation-error-regexp-alist', and
-\`compilation-buffer-name-function', respectively.
+and there are no more errors.  The rest of the arguments, 3-10 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.
+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.
+  The defaults for these variables are the global values of
+\`compilation-parse-errors-function', `compilation-error-regexp-alist',
+\`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.
 
 Returns the compilation buffer created."
   (let (outbuf)
@@ -508,9 +560,18 @@
       ;; In case the compilation buffer is current, make sure we get the global
       ;; values of compilation-error-regexp-alist, etc.
       (kill-all-local-variables))
-    (let ((regexp-alist (or regexp-alist compilation-error-regexp-alist))
-	  (parser (or parser compilation-parse-errors-function))
-	  (thisdir default-directory)
+    (or error-regexp-alist
+	(setq error-regexp-alist compilation-error-regexp-alist))
+    (or enter-regexp-alist
+	(setq enter-regexp-alist compilation-enter-directory-regexp-alist))
+    (or leave-regexp-alist
+	(setq leave-regexp-alist compilation-leave-directory-regexp-alist))
+    (or file-regexp-alist
+	(setq file-regexp-alist compilation-file-regexp-alist))
+    (or nomessage-regexp-alist
+	(setq nomessage-regexp-alist compilation-nomessage-regexp-alist))
+    (or parser (setq parser compilation-parse-errors-function))
+    (let ((thisdir default-directory)
 	  outwin)
       (save-excursion
 	;; Clear out the compilation buffer and make it writable.
@@ -536,7 +597,16 @@
 	;; (setq buffer-read-only t)  ;;; 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) regexp-alist)
+	(set (make-local-variable 'compilation-error-regexp-alist)
+	     error-regexp-alist)
+	(set (make-local-variable 'compilation-enter-directory-regexp-alist)
+	     enter-regexp-alist)
+	(set (make-local-variable 'compilation-leave-directory-regexp-alist)
+	     leave-regexp-alist)
+	(set (make-local-variable 'compilation-file-regexp-alist)
+	     file-regexp-alist)
+	(set (make-local-variable 'compilation-nomessage-regexp-alist)
+	     nomessage-regexp-alist)
 	(setq default-directory thisdir
 	      compilation-directory-stack (list default-directory))
 	(set-window-start outwin (point-min))
@@ -612,6 +682,30 @@
     map)
   "Keymap for `compilation-minor-mode'.")
 
+(defvar compilation-shell-minor-mode-map
+  (let ((map (make-sparse-keymap)))
+    (define-key map [mouse-2] 'compile-mouse-goto-error)
+    (define-key map "\M-\C-m" 'compile-goto-error)
+    (define-key map "\M-\C-n" 'compilation-next-error)
+    (define-key map "\M-\C-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 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))
+    map)
+  "Keymap for `compilation-shell-minor-mode'.")
+
 (defvar compilation-mode-map
   (let ((map (cons 'keymap compilation-minor-mode-map)))
     (define-key map " " 'scroll-up)
@@ -670,6 +764,22 @@
   (set (make-local-variable 'compilation-directory-stack) nil)
   (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
@@ -787,7 +897,8 @@
 (defsubst compilation-buffer-p (buffer)
   (save-excursion
     (set-buffer buffer)
-    (or compilation-minor-mode (eq major-mode 'compilation-mode))))
+    (or compilation-shell-minor-mode compilation-minor-mode
+	(eq major-mode 'compilation-mode))))
 
 (defun compilation-next-error (n)
   "Move point to the next error in the compilation buffer.
@@ -979,7 +1090,7 @@
     (setq compilation-last-buffer (current-buffer))
     ;; `compile-reinitialize-errors' needs to see the complete filename
     ;; on the line where they clicked the mouse.  Since it only looks
-    ;; upto point, moving point to eol makes sure the filename is
+    ;; up to point, moving point to eol makes sure the filename is
     ;; visible to `compile-reinitialize-errors'.
     (end-of-line)
     (compile-reinitialize-errors nil (point))
@@ -1262,7 +1373,8 @@
 	;; Skip over multiple error messages for the same source location,
 	;; so the next C-x ` won't go to an error in the same place.
 	(while (and compilation-error-list
-		    (equal (cdr (car compilation-error-list)) (cdr next-error)))
+		    (equal (cdr (car compilation-error-list))
+			   (cdr next-error)))
 	  (setq compilation-error-list (cdr compilation-error-list))))
 
     ;; We now have a marker for the position of the error source code.
@@ -1361,6 +1473,8 @@
   )
 
 
+;; This function is not needed any more by compilation mode.
+;; Does anyone else need it or can it be deleted?
 (defun count-regexp-groupings (regexp)
   "Return the number of \\( ... \\) groupings in REGEXP (a string)."
   (let ((groupings 0)
@@ -1386,265 +1500,250 @@
 		       (setq groupings (1+ groupings))))))))
     groupings))
 
+(defvar compilation-current-file nil
+  "Used by compilation-parse-errors to store filename for file being compiled")
+
+;; This variable is not used as a global variable. It's defined here just to
+;; shut up the byte compiler. It's bound and used by compilation-parse-errors
+;; and set by compile-collect-regexps.
+(defvar compilation-regexps nil)
+
 (defun compilation-parse-errors (limit-search find-at-least)
-  "Parse the current buffer as grep, cc or lint error messages.
+  "Parse the current buffer as grep, cc, lint or other error messages.
 See variable `compilation-parse-errors-function' for the interface it uses."
   (setq compilation-error-list nil)
   (message "Parsing error messages...")
-  (let (text-buffer orig orig-expanded parent-expanded
-	regexp enter-group leave-group error-group
-	alist subexpr error-regexp-groups
-	(found-desired nil)
-	(compilation-num-errors-found 0))
+  (if (null compilation-error-regexp-alist)
+      (error "compilation-error-regexp-alist is empty!"))
+  (let* ((compilation-regexps nil) ; Variable set by compile-collect-regexps.
+	 (found-desired nil)
+	 (compilation-num-errors-found 0)
+	 ;; Set up now the expanded, abbreviated directory variables
+	 ;; that compile-abbreviate-directory will need, so we can
+	 ;; compute them just once here.
+	 (orig (abbreviate-file-name default-directory))
+	 (orig-expanded (abbreviate-file-name
+			 (file-truename default-directory)))
+	 (parent-expanded (abbreviate-file-name
+			   (expand-file-name "../" orig-expanded))))
+
+    ;; Make a list of all the regexps. Each element has the form
+    ;; (REGEXP TYPE IDX1 IDX2 ...)
+    ;; where TYPE is one of leave, enter, file, error or nomessage.
+    (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)
 
     ;; Don't reparse messages already seen at last parse.
     (goto-char compilation-parsing-end)
-    ;; Don't parse the first two lines as error messages.
-    ;; This matters for grep.
     (if (bobp)
 	(progn
-	  (forward-line 2)
-	  ;; Move back so point is before the newline.
-	  ;; This matters because some error regexps use \n instead of ^
-	  ;; to be faster.
-	  (forward-char -1)))
-
-    ;; Compile all the regexps we want to search for into one.
-    (setq regexp (concat "\\(" compilation-enter-directory-regexp "\\)\\|"
-			 "\\(" compilation-leave-directory-regexp "\\)\\|"
-			 "\\(" (mapconcat (function
-					   (lambda (elt)
-					     (concat "\\(" (car elt) "\\)")))
-					  compilation-error-regexp-alist
-					  "\\|") "\\)"))
-
-    ;; Find out how many \(...\) groupings are in each of the regexps, and set
-    ;; *-GROUP to the grouping containing each constituent regexp (whose
-    ;; subgroups will come immediately thereafter) of the big regexp we have
-    ;; just constructed.
-    (setq enter-group 1
-	  leave-group (+ enter-group
-			 (count-regexp-groupings
-			  compilation-enter-directory-regexp)
-			 1)
-	  error-group (+ leave-group
-			 (count-regexp-groupings
-			  compilation-leave-directory-regexp)
-			 1))
-
-    ;; Compile an alist (IDX FILE LINE [COL]), where IDX is the number of
-    ;; the subexpression for an entire error-regexp, and FILE and LINE (and
-    ;; possibly COL) are the numbers for the subexpressions giving the file
-    ;; name and line number (and possibly column number).
-    (setq alist (or compilation-error-regexp-alist
-		    (error "compilation-error-regexp-alist is empty!"))
-	  subexpr (1+ error-group))
-    (while alist
-      (setq error-regexp-groups
-	    (cons (list subexpr
-			(+ subexpr (nth 1 (car alist)))
-			(+ subexpr (nth 2 (car alist)))
-			(and (nth 3 (car alist))
-			     (+ subexpr (nth 3 (car alist)))))
-		  error-regexp-groups))
-      (setq subexpr (+ subexpr 1 (count-regexp-groupings (car (car alist)))))
-      (setq alist (cdr alist)))
+	  (setq compilation-current-file nil) ; No current file at start.
+	  ;; Don't parse the first two lines as error messages.
+	  ;; This matters for grep.
+	  (forward-line 2)))
 
-    ;; Set up now the expanded, abbreviated directory variables
-    ;; that compile-abbreviate-directory will need, so we can
-    ;; compute them just once here.
-    (setq orig (abbreviate-file-name default-directory)
-	  orig-expanded (abbreviate-file-name
-			 (file-truename default-directory))
-	  parent-expanded (abbreviate-file-name
-			   (expand-file-name "../" orig-expanded)))
-
-    (while (and (not found-desired)
-		;; Instead of using re-search-forward,
-		;; we use this loop which tries only at each line.
-		(progn
-		  (while (and (not (eobp))
-			      (not (looking-at regexp)))
-		    (forward-line 1))
-		  (not (eobp))))
-
-      ;; Move to the end of the match we just found.
-      (goto-char (match-end 0))
+    ;; Parse messages.
+    (while (not (or found-desired (eobp)))
+      (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
+	;; matching regexp is moved to the front of compilation-regexps
+	;; to make it match faster next time.
+	(while (and this (null alist))
+	  (if (not (looking-at (car (car this))))
+	      (progn (setq prev this)		; No match, go to next.
+		     (setq this (cdr this)))
+	    (setq alist (cdr (car this))) ; Got a match.
+;;;	    (if prev			; If not the first regexp,
+;;;		(progn			; move it to the front.
+;;;		  (setcdr prev (cdr this))
+;;;		  (setcdr this compilation-regexps)
+;;;		  (setq compilation-regexps this)))
+	    ))
+	(if (and alist			; Seen a match and not to
+		 (not (eq (setq type (car alist)) 'nomessage)))	; be ignored.
+	    (let* ((end-of-match (match-end 0))
+		   (filename
+		    (compile-buffer-substring (car (setq alist (cdr alist)))))
+		   stack)
+	      (if (eq type 'error)	; error message
+		  (let* ((linenum (if (numberp (car (setq alist (cdr alist))))
+				      (string-to-int
+				       (compile-buffer-substring (car alist)))
+				    ;; (car alist) is not a number, must be a
+				    ;; function that is called below to return
+				    ;; an error position descriptor.
+				    (car alist)))
+			 ;; Convert to integer later if linenum not a function.
+			 (column (compile-buffer-substring
+				  (car (setq  alist (cdr alist)))))
+			 this-error)
 
-      ;; Figure out which constituent regexp matched.
-      (cond ((match-beginning enter-group)
-	     ;; The match was the enter-directory regexp.
-	     (let ((dir
-		    (file-name-as-directory
-		     (expand-file-name
-		      (buffer-substring (match-beginning (+ enter-group 1))
-					(match-end (+ enter-group 1)))))))
-	       ;; The directory name in the "entering" message
-	       ;; is a truename.  Try to convert it to a form
-	       ;; like what the user typed in.
-	       (setq dir
-		     (compile-abbreviate-directory dir orig orig-expanded
-						   parent-expanded))
-	       (setq compilation-directory-stack
-		     (cons dir compilation-directory-stack))
-	       (and (file-directory-p dir)
-		    (setq default-directory dir)))
+		    ;; Check that we have a file name.
+		    (or filename
+			;; No file name in message, we must have seen it before
+			(setq filename compilation-current-file)
+			(error "\
+An error message with no file name and no file name has been seen earlier."))
 
-	     (and limit-search (>= (point) limit-search)
-		  ;; The user wanted a specific error, and we're past it.
-		  ;; We do this check here (and in the leave-group case)
-		  ;; rather than at the end of the loop because if the last
-		  ;; thing seen is an error message, we must carefully
-		  ;; discard the last error when it is the first in a new
-		  ;; file (see below in the error-group case).
-		  (setq found-desired t)))
+		    ;; 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))
+
+		    (setq filename
+			  (cons filename (cons default-directory (cdr alist))))
 
-	    ((match-beginning leave-group)
-	     ;; The match was the leave-directory regexp.
-	     (let ((beg (match-beginning (+ leave-group 1)))
-		   (stack compilation-directory-stack))
-	       (if beg
-		   (let ((dir
-			  (file-name-as-directory
-			   (expand-file-name
-			    (buffer-substring beg
-					      (match-end (+ leave-group
-							    1)))))))
-		     ;; The directory name in the "leaving" message
-		     ;; is a truename.  Try to convert it to a form
-		     ;; like what the user typed in.
-		     (setq dir
-			   (compile-abbreviate-directory dir orig orig-expanded
-							 parent-expanded))
-		     (while (and stack
-				 (not (string-equal (car stack) dir)))
-		       (setq stack (cdr stack)))))
-	       (setq compilation-directory-stack (cdr stack))
-	       (setq stack (car compilation-directory-stack))
-	       (if stack
-		   (setq default-directory stack))
-	       )
-
-	     (and limit-search (>= (point) limit-search)
-		  ;; The user wanted a specific error, and we're past it.
-		  ;; We do this check here (and in the enter-group case)
-		  ;; rather than at the end of the loop because if the last
-		  ;; thing seen is an error message, we must carefully
-		  ;; discard the last error when it is the first in a new
-		  ;; file (see below in the error-group case).
-		  (setq found-desired t)))
-
-	    ((match-beginning error-group)
-	     ;; The match was the composite error regexp.
-	     ;; Find out which individual regexp matched.
-	     (setq alist error-regexp-groups)
-	     (while (and alist
-			 (null (match-beginning (car (car alist)))))
-	       (setq alist (cdr alist)))
-	     (if alist
-		 (setq alist (car alist))
-	       (error "compilation-parse-errors: impossible regexp match!"))
-
-	     ;; Extract the file name and line number from the error message.
-	     (let ((beginning-of-match (match-beginning 0)) ;looking-at nukes
-		   (filename (buffer-substring (match-beginning (nth 1 alist))
-					       (match-end (nth 1 alist))))
-		   (linenum (string-to-int
-			     (buffer-substring
-			      (match-beginning (nth 2 alist))
-			      (match-end (nth 2 alist)))))
-		   (column (and (nth 3 alist)
-				(match-beginning (nth 3 alist))
-				(string-to-int
-				 (buffer-substring
-				  (match-beginning (nth 3 alist))
-				  (match-end (nth 3 alist)))))))
+		    ;; Locate the erring file and line.
+		    ;; Make this-error a new elt for compilation-error-list,
+		    ;; giving a marker for the current compilation buffer
+		    ;; location, and the file and line number of the error.
+		    ;; Save, as the start of the error, the beginning of the
+		    ;; line containing the match.
+		    (if (setq this-error
+			      (if (numberp linenum)
+				  (list (point-marker) filename linenum
+					(and column (string-to-int column)))
+				;; If linenum is not a number then it must be
+				;; a function returning an error position
+				;; descriptor or nil (meaning no position).
+				(save-excursion
+				  (funcall linenum filename column))))
+			
+			;; We have an error position descriptor.
+			;; If we have found as many new errors as the user
+			;; wants, or if we are past the buffer position he
+			;; indicated, then we continue to parse until we have
+			;; seen all consecutive errors in the same file. This
+			;; means that all the errors of a source file will be
+			;; seen in one parsing run, so that the error positions
+			;; will be recorded as markers in the source file
+			;; buffer that will move when the buffer is changed.
+			(if (and (or (and find-at-least
+					  (>= compilation-num-errors-found
+					      find-at-least))
+				     (and limit-search
+					  (>= end-of-match limit-search)))
+				 compilation-error-list ;At least one previous.
+				 (not (equal ; Same filename?
+				       (car (cdr (car compilation-error-list)))
+				       (car (cdr this-error)))))
+			    ;; 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
+			    ;; errors belonging to the earlier file. We don't
+			    ;; add the error just parsed so that the next
+			    ;; parsing run can get it and the following errors
+			    ;; in the same file all at once.
+			    (setq found-desired t)
 
-	       ;; 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 the 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 the 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))
-	       (setq filename (cons filename (cons default-directory
-						   (nthcdr 4 alist))))
-
+			  (goto-char end-of-match) ; Prepare for next message.
+			  ;; Don't add the same source line more than once.
+			  (and (not (and
+				     compilation-error-list
+				     (equal (cdr (car compilation-error-list))
+					    (cdr this-error))))
+			       (setq compilation-error-list
+				     (cons this-error compilation-error-list)
+				     compilation-num-errors-found
+				     (1+ compilation-num-errors-found))))))
 
-	       ;; Locate the erring file and line.
-	       ;; Cons a new elt onto compilation-error-list,
-	       ;; giving a marker for the current compilation buffer
-	       ;; location, and the file and line number of the error.
-	       (save-excursion
-		 ;; Save as the start of the error the beginning of the
-		 ;; line containing the match unless the match starts at a
-		 ;; newline, in which case the beginning of the next line.
-		 (goto-char beginning-of-match)
-		 (forward-line (if (eolp) 1 0))
-		 (let ((this (cons (point-marker)
-				   (list filename linenum column))))
-		   ;; Don't add the same source line more than once.
-		   (if (and compilation-skip-to-next-location
-			    (equal (cdr this)
-				   (cdr (car compilation-error-list))))
-		       nil
-		     (setq compilation-error-list
-			   (cons this
-				 compilation-error-list))
-		     (setq compilation-num-errors-found
-			   (1+ compilation-num-errors-found)))))
-	       (and (or (and find-at-least (> compilation-num-errors-found
-					      find-at-least))
-			(and limit-search (>= (point) limit-search)))
-		    ;; We have found as many new errors as the user wants,
-		    ;; or past the buffer position he indicated.  We
-		    ;; continue to parse until we have seen all the
-		    ;; consecutive errors in the same file, so the error
-		    ;; positions will be recorded as markers in this buffer
-		    ;; that might change.
-		    (cdr compilation-error-list) ; Must check at least two.
-		    (not (equal (car (cdr (nth 0 compilation-error-list)))
-				(car (cdr (nth 1 compilation-error-list)))))
-		    (progn
-		      ;; Discard the error just parsed, so that the next
-		      ;; parsing run can get it and the following errors in
-		      ;; the same file all at once.  If we didn't do this, we
-		      ;; would have the same problem we are trying to avoid
-		      ;; with the test above, just delayed until the next run!
-		      (setq compilation-error-list
-			    (cdr compilation-error-list))
-		      (goto-char beginning-of-match)
-		      (setq found-desired t)))
-	       )
-	     )
-	    (t
-	     (error "compilation-parse-errors: known groups didn't match!")))
+		;; Not an error message.
+		(if (eq type `file)	; Change current file.
+		    (and filename (setq compilation-current-file 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)))
+		  (and (eq type 'leave
+			   stack
+			   (setq compilation-directory-stack (cdr stack))
+			   (setq stack (car compilation-directory-stack))
+			   (setq default-directory stack)))
+		  (goto-char end-of-match) ; Prepare to look at next message.
+		  (and limit-search (>= end-of-match limit-search)
+		       ;; The user wanted a specific error, and we're past it.
+		       ;; We do this check here rather than at the end of the
+		       ;; loop because if the last thing seen is an error
+		       ;; message, we must carefully discard the last error
+		       ;; when it is the first in a new file (see above in
+		       ;; the error-message case)
+		       (setq found-desired t))))
 
-      (message "Parsing error messages...%d (%.0f%% of buffer)"
+	      ;; Go to before the last character in the message so that we will
+	      ;; see the next line also when the message ended at end of line.
+	      ;; When we ignore the last error message above, this will
+	      ;; cancel the effect of forward-line below so that point
+	      ;; doesn't move.
+	      (forward-char -1)
+
+	      ;; Is this message necessary any more?  Parsing is now so fast
+	      ;; that you might not need to know how it proceeds.
+	      (message
+	       "Parsing error messages...%d found. %.0f%% of buffer seen."
 	       compilation-num-errors-found
 	       ;; Use floating-point because (* 100 (point)) frequently
 	       ;; exceeds the range of Emacs Lisp integers.
 	       (/ (* 100.0 (point)) (point-max)))
+	      ))
 
-      (and limit-search (>= (point) limit-search)
-	   ;; The user wanted a specific error, and we're past it.
-	   (setq found-desired t)))
-    (setq compilation-parsing-end (if found-desired
-				      (point)
-				    ;; We have searched the whole buffer.
-				    (point-max))))
-  (setq compilation-error-list (nreverse compilation-error-list))
-  (message "Parsing error messages...done"))
+	(forward-line 1)))		; End of while loop. Look at next line.
+
+    (setq 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.")))
+
+(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)))))
+
+(defun compile-buffer-substring (index)
+  ;; Get substring matched by INDEXth subexpression.
+  (if index
+      (let ((beg (match-beginning index)))
+	(if beg (buffer-substring beg (match-end index))))))
 
 ;; If directory DIR is a subdir of ORIG or of ORIG's parent,
 ;; return a relative name for it starting from ORIG or its parent.