changeset 5472:ed690a728e13

(compilation-buffer-p): Move defsubst before all callers. (compilation-forget-errors): Reset compilation-parsing-end to 1 here. (compile-reinitialize-errors): Don't reset compilation-parsing-end after calling compilation-forget-errors. Comment out gratuitous switch-to-buffer call; what was the rationale for it? Don't check compilation-parsing-end (removed local AT-START); instead always append to compilation-old-error-list, it will be nil if at start. If compilation-error-list is non-nil before calling the parser, restore its previous value afterwards; it still indicates the current error position. Subtract the length of the existing compilation-error-list from FIND-AT-LEAST when calling the parser. (compilation-parse-errors): Don't check LIMIT-SEARCH at end of loop. Inside check it inside each case of the cond; in error case we must discard the last new error before stopping (just as for FIND-AT-LEAST). Use floating-point in buffer percentage calculation, to avoid integer overflow.
author Roland McGrath <roland@gnu.org>
date Thu, 06 Jan 1994 15:25:19 +0000
parents e034ade52ca0
children e080a27c1dd6
files lisp/progmodes/compile.el
diffstat 1 files changed, 65 insertions(+), 29 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/progmodes/compile.el	Thu Jan 06 12:36:43 1994 +0000
+++ b/lisp/progmodes/compile.el	Thu Jan 06 15:25:19 1994 +0000
@@ -1,6 +1,6 @@
 ;;; compile.el --- run compiler as inferior of Emacs, parse error messages.
 
-;; Copyright (C) 1985, 86, 87, 93 Free Software Foundation, Inc.
+;; Copyright (C) 1985, 86, 87, 93, 94 Free Software Foundation, Inc.
 
 ;; Author: Roland McGrath <roland@prep.ai.mit.edu>
 ;; Maintainer: FSF
@@ -500,6 +500,9 @@
       (setq errors (cdr errors)))
     errors))
 
+(defsubst compilation-buffer-p (buffer)
+  (assq 'compilation-error-list (buffer-local-variables buffer)))
+
 (defun compilation-next-error (n)
   "Move point to the next error in the compilation buffer.
 Does NOT find the source line like \\[next-error]."
@@ -631,8 +634,7 @@
     ;; discard the info we have, to force reparsing.
     (if (or (eq compilation-error-list t)
 	    (consp argp))
-	(progn (compilation-forget-errors)
-	       (setq compilation-parsing-end 1)))
+	(compilation-forget-errors))
     (if (and compilation-error-list
 	     (or (not limit-search)
 		 (> compilation-parsing-end limit-search))
@@ -641,18 +643,32 @@
 	;; Since compilation-error-list is non-nil, it points to a specific
 	;; error the user wanted.  So don't move it around.
 	nil
-      (switch-to-buffer compilation-last-buffer)
+      ;; This was here for a long time (before my rewrite); why? --roland
+      ;;(switch-to-buffer compilation-last-buffer)
       (set-buffer-modified-p nil)
       (if (< compilation-parsing-end (point-max))
-	  (let ((at-start (= compilation-parsing-end 1)))
+	  ;; compilation-error-list might be non-nil if we have a non-nil
+	  ;; LIMIT-SEARCH of FIND-AT-LEAST arg.  In that case its value
+	  ;; records the current position in the error list, and we must
+	  ;; preserve that after reparsing.
+	  (let ((error-list-pos compilation-error-list))
 	    (funcall compilation-parse-errors-function
-		     limit-search find-at-least)
-	    ;; Remember the entire list for compilation-forget-errors.
-	    ;; If this is an incremental parse, append to previous list.
-	    (if at-start
-		(setq compilation-old-error-list compilation-error-list)
-	      (setq compilation-old-error-list
-		    (nconc compilation-old-error-list compilation-error-list)))
+		     limit-search
+		     (and find-at-least
+			  ;; We only need enough new parsed errors to reach
+			  ;; FIND-AT-LEAST errors past the current
+			  ;; position.
+			  (- find-at-least (length compilation-error-list))))
+	    ;; Remember the entire list for compilation-forget-errors.  If
+	    ;; this is an incremental parse, append to previous list.  If
+	    ;; we are parsing anew, compilation-forget-errors cleared
+	    ;; compilation-old-error-list above.
+	    (setq compilation-old-error-list
+		  (nconc compilation-old-error-list compilation-error-list))
+	    (if error-list-pos
+		;; We started in the middle of an existing list of parsed
+		;; errors before parsing more; restore that position.
+		(setq compilation-error-list error-list-pos))
 	    )))))
 
 (defun compile-goto-error (&optional argp)
@@ -687,9 +703,6 @@
 
   (next-error 1))
 
-(defsubst compilation-buffer-p (buffer)
-  (assq 'compilation-error-list (buffer-local-variables buffer)))
-
 ;; Return a compilation buffer.
 ;; If the current buffer is a compilation buffer, return it.
 ;; If compilation-last-buffer is set to a live buffer, use that.
@@ -926,7 +939,8 @@
 	  (set-marker (cdr next-error) nil)))
     (setq compilation-old-error-list (cdr compilation-old-error-list)))
   (setq compilation-error-list nil
-	compilation-directory-stack nil))
+	compilation-directory-stack nil
+	compilation-parsing-end 1))
 
 
 (defun count-regexp-groupings (regexp)
@@ -1041,8 +1055,17 @@
 	       (setq compilation-directory-stack
 		     (cons dir compilation-directory-stack))
 	       (and (file-directory-p dir)
-		    (setq default-directory dir))))
-	    
+		    (setq default-directory dir)))
+
+	     (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)))
+
 	    ((match-beginning leave-group)
 	     ;; The match was the leave-directory regexp.
 	     (let ((beg (match-beginning (+ leave-group 1)))
@@ -1067,8 +1090,17 @@
 	       (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.
@@ -1109,13 +1141,15 @@
 				 compilation-error-list))
 		     (setq compilation-num-errors-found
 			   (1+ compilation-num-errors-found)))))
-	       (and find-at-least (>= compilation-num-errors-found
-				      find-at-least)
-		    ;; We have found as many new errors as the user wants.
-		    ;; 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.
+	       (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)))))
@@ -1134,9 +1168,11 @@
 	    (t
 	     (error "compilation-parse-errors: known groups didn't match!")))
 
-      (message "Parsing error messages...%d (%d%% of buffer)"
+      (message "Parsing error messages...%d (%.0f%% of buffer)"
 	       compilation-num-errors-found
-	       (/ (* 100 (point)) (point-max)))
+	       ;; 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.