xemacs-beta: lisp/packages/compile.el comparison

comparison lisp/packages/compile.el @ 2:ac2d302a0011 r19-15b2

Import from CVS: tag r19-15b2

author	cvs
date	Mon, 13 Aug 2007 08:46:35 +0200
parents	376386a54a3c
children	b82b59fe008d

comparison

equal deleted inserted replaced

-:c0c6a60d29db
+:ac2d302a0011
 ;;; compile.el --- run compiler as inferior of Emacs, parse error messages.
-;; Copyright (C) 1985, 86, 87, 93, 94, 1995 Free Software Foundation, Inc.
+;; Copyright (C) 1985, 86, 87, 93, 94, 1995, 1996 Free Software Foundation, Inc.
 ;; Copyright (C) 1995 Tinker Systems and INS Engineering Corp.
 ;; Author: Roland McGrath <roland@prep.ai.mit.edu>
 ;; Maintainer: FSF
 ;; Keywords: tools, processes
 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
 ;; General Public License for more details.
 ;; You should have received a copy of the GNU General Public License
 ;; along with XEmacs; see the file COPYING.  If not, write to the Free
-;; Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+;; 02111-1307, USA.
-;;; Synched up with: FSF 19.30.
+;;; Synched up with: FSF 19.34, with a lot of divergence.
 ;;; Commentary:
 ;; This package provides the compile and grep facilities documented in
 ;; the Emacs user's manual.
 ;;;###autoload
 (defvar compilation-window-height nil
 "*Number of lines in a compilation window.  If nil, use Emacs default.")
+;; XEmacs change
 (defvar compilation-error-list 'invalid ; only valid buffer-local
 "List of error message descriptors for visiting erring functions.
 Each error descriptor is a cons (or nil).  Its car is a marker pointing to
 an error message.  If its cdr is a marker, it points to the text of the
 line the message is about.  If its cdr is a cons, it is a list
 The value may be t instead of a list; this means that the buffer of
 error messages should be reparsed the next time the list of errors is wanted.
 Some other commands (like `diff') use this list to control the error
-message tracking facilites; if you change its structure, you should make
+message tracking facilities; if you change its structure, you should make
 sure you also change those packages.  Perhaps it is better not to change
 it at all.")
 (defvar compilation-old-error-list nil
 "Value of `compilation-error-list' after errors were parsed.")
 "List of compilation processes now running.")
 (or (assq 'compilation-in-progress minor-mode-alist)
 (setq minor-mode-alist (cons '(compilation-in-progress " Compiling")
 				 minor-mode-alist)))
+;; XEmacs change
 (defvar compilation-always-signal-completion nil
 "Always give an audible signal upon compilation completion.
 By default that signal is only given if the bottom of the compilation
 buffer is not visible in its window.")
 ;;
 ;; 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.
 ("\n\
-\\([^:( \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++:
+;;  keyboard.c(537) : warning C4005: 'min' : macro redefinition
+;;  d:\tmp\test.c(23) : error C2143: syntax error : missing ';' before 'if'
+("\n\\(\\([a-zA-Z]:\\)?[^:( \t\n-]+\\)[:(][ \t]*\\([0-9]+\\)[:) \t]" 1 3)
 ;; Borland C++:
 ;;  Error ping.c 15: Unable to open include file 'sys/types.h'
 ;;  Warning ping.c 68: Call to function 'func' with no prototype
-("\n\\(Error\\|Warning\\) \\([^:( \t\n]+\\)\
+("\n\\(Error\\|Warning\\) \\([a-zA-Z]?:?[^:( \t\n]+\\)\
 \\([0-9]+\\)\\([) \t]\\|:[^0-9\n]\\)" 2 3)
 ;; 4.3BSD lint pass 2
 ;; 	strcmp: variable # of args. llib-lc(359)  ::  /usr/src/foo/foo.c(8)
-("[ \t:]\\([^:( \t\n]+\\)[:(](+[ \t]*\\([0-9]+\\))[:) \t]*$" 1 2)
+("[ \t:]\\([a-zA-Z]?:?[^:( \t\n]+\\)[:(](+[ \t]*\\([0-9]+\\))[:) \t]*$"
+1 2)
 ;; 4.3BSD lint pass 3
 ;; 	bloofle defined( /users/wolfgang/foo.c(4) ), but never used
 ;; This used to be
-;; ("[ \t(]+\\([^:( \t\n]+\\)[:( \t]+\\([0-9]+\\)[:) \t]+" 1 2)
+;; ("[ \t(]+\\([a-zA-Z]?:?[^:( \t\n]+\\)[:( \t]+\\([0-9]+\\)[:) \t]+" 1 2)
 ;; which is regexp Impressionism - it matches almost anything!
-("([ \t]*\\([^:( \t\n]+\\)[:(][ \t]*\\([0-9]+\\))" 1 2)
+("([ \t]*\\([a-zA-Z]?:?[^:( \t\n]+\\)[:(][ \t]*\\([0-9]+\\))" 1 2)
+;; MIPS lint pass<n>; looks good for SunPro lint also
+;;  TrimMask (255) in solomon.c may be indistinguishable from TrimMasks (93) in solomon.c due to truncation
+("[^ ]+ (\\([0-9]+\\)) in \\([^ ]+\\)" 2 1)
+;;  name defined but never used: LinInt in cmap_calc.c(199)
+("in \\([^(]+\\)(\\([0-9]+\\))$" 1 2)
 ;; Ultrix 3.0 f77:
 ;;  fort: Severe: addstf.f, line 82: Missing operator or delimiter symbol
 ;; Some SGI cc version:
 ;;  cfe: Warning 835: foo.c, line 2: something
 ("\n\\(cfe\\|fort\\): [^:\n]*: \\([^ \n]*\\), line \\([0-9]+\\):" 2 3)
 ;;  Error on line 3 of t.f: Execution error unclassifiable statement
 ;; Unknown who does this:
-;;  Line 45 of "foo.c": bloofel undefined
+;;  Line 45 of "foo.c": bloofle undefined
 ;; 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
 ("\\(\n\\|on \\)[Ll]ine[ \t]+\\([0-9]+\\)[ \t]+\
-of[ \t]+\"?\\([^\":\n]+\\)\"?:" 3 2)
+of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?:" 3 2)
 ;; Apollo cc, 4.3BSD fc:
 ;;	"foo.f", line 3: Error: syntax error near end of statement
 ;; IBM RS6000:
 ;;  "vvouch.c", line 19.5: 1506-046 (S) Syntax error.
 ;;  File "foobar.ml", lines 5-8, characters 20-155: blah blah
 ;; Microtec mcc68k:
 ;;  "foo.c", line 32 pos 1; (E) syntax error; unexpected symbol: "lossage"
 ;; GNAT (as of July 94):
 ;;  "foo.adb", line 2(11): warning: file name does not match ...
-("\"\\([^,\" \n\t]+\\)\", lines? \\([0-9]+\\)[:., (-]" 1 2)
+;; IBM AIX xlc compiler:
+;;  "src/swapping.c", line 30.34: 1506-342 (W) "/*" detected in comment.
+("\"\\([^,\" \n\t]+\\)\", lines? \
+\\([0-9]+\\)\\([\(.]\\([0-9]+\\)\)?\\)?[:., (-]" 1 2 4)
 ;; MIPS RISC CC - the one distributed with Ultrix:
 ;;	ccom: Error: foo.c, line 2: syntax error
 ;; DEC AXP OSF/1 cc
 ;;  /usr/lib/cmplrs/cc/cfe: Error: foo.c: 1: blah blah
 ;; Lucid Compiler, lcc 3.x
 ;; E, file.cc(35,52) Illegal operation on pointers
 ("\n[EW], \\([^(\n]*\\)(\\([0-9]+\\),[ \t]*\\([0-9]+\\)" 1 2 3)
 ;; GNU messages with program name and optional column number.
-("\n[^0-9 \n\t:]+:[ \t]*\\([^ \n\t:]+\\):\
+("\n[a-zA-Z]?:?[^0-9 \n\t:]+:[ \t]*\\([^ \n\t:]+\\):\
 \\([0-9]+\\):\\(\\([0-9]+\\)[: \t]\\)?" 1 2 4)
 ;; jwz:
 ;; IRIX 5.2
 ;; cfe: Warning 712: foo.c, line 2: illegal combination of pointer and ...
 (defvar compilation-ask-about-save t
 "If not nil, M-x compile asks which buffers to save before compiling.
 Otherwise, it saves all modified buffers without asking.")
 (defvar grep-regexp-alist
-'(("^\\([^:( \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'.")
 (defvar grep-command "grep -n "
 "Last grep command used in \\[grep]; default for next grep.")
 "Stack of previous directories for `compilation-leave-directory-regexp'.
 The head element is the directory the compilation was started in.")
 (defvar compilation-exit-message-function nil "\
 If non-nil, called when a compilation process dies to return a status message.
-This should be a function a two arguments as passed to a process sentinel
+This should be a function of three arguments: process status, exit status,
-\(see `set-process-sentinel\); it returns a cons (MESSAGE . MODELINE) of the
+and exit message; it returns a cons (MESSAGE . MODELINE) of the strings to
-strings to write into the compilation buffer, and to put in its mode line.")
+write into the compilation buffer, and to put in its mode line.")
 ;; History of compile commands.
 (defvar compile-history nil)
 ;; History of grep commands.
 (defvar grep-history nil)
+;; XEmacs
 (defconst compilation-font-lock-keywords (purecopy
 (list
 '("^[-_.\"A-Za-z0-9/+]+\\(:\\|, line \\)[0-9]+: \\([wW]arning:\\).*$" .
 font-lock-keyword-face)
 '("^[-_.\"A-Za-z0-9/+]+\\(: *\\|, line \\)[0-9]+:.*$" . font-lock-function-name-face)
 '("^[-_.\"A-Za-z0-9/+]+\\(: *[0-9]+\\|, line [0-9]+\\)" 1 bold t)
 ))
 "Additional expressions to highlight in Compilation mode.")
 ;FSF's version.  Ours looks better.
-;(defvar compilation-font-lock-keywords
+;(defvar compilation-mode-font-lock-keywords
 ;  ;; This regexp needs a bit of rewriting.  What is the third grouping for?
-;  '(("^\\([^ \n:]*:\\([0-9]+:\\)+\\)\\(.*\\)$" 1 font-lock-function-name-face))
+;  '(("^\\([a-zA-Z]?:?[^ \n:]*:\\([0-9]+:\\)+\\)\\(.*\\)$"
-;;;;  ("^\\([^\n:]*:\\([0-9]+:\\)+\\)\\(.*\\)$" 0 font-lock-keyword-face keep)
+;     1 font-lock-function-name-face))
-;  "Additional expressions to highlight in Compilation mode.")
+;;;  ("^\\([^\n:]*:\\([0-9]+:\\)+\\)\\(.*\\)$" 0 font-lock-keyword-face keep)
+;; XEmacs change
 (put 'compilation-mode 'font-lock-defaults
 '(compilation-font-lock-keywords t))
 ;;;###autoload
 The name used for the buffer is actually whatever is returned by
 the function in `compilation-buffer-name-function', so you can set that
 to a function that generates a unique name."
 (interactive
 (if (or compilation-read-command current-prefix-arg)
+;; XEmacs change
 (list (read-shell-command "Compile command: "
 compile-command
 ;; #### minibuffer code should do this
 (if (equal (car compile-history)
 compile-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 grep command."
 (interactive
+;; XEmacs change
 (list (read-shell-command "Run grep (like this): "
 			     grep-command 'grep-history)))
 (let ((buf (compile-internal (concat command-args " " grep-null-device)
 			       "No more grep hits" "grep"
 			       ;; Give it a simpler regexp to match.
 			       nil grep-regexp-alist)))
 (save-excursion
 (set-buffer buf)
 (set (make-local-variable 'compilation-exit-message-function)
+	   ;; XEmacs change
 	   (lambda (proc msg)
 	     (let ((code (process-exit-status proc)))
 	       (if (eq (process-status proc) 'exit)
 		   (cond ((zerop code)
 			  '("finished (matches found)\n" . "matched"))
 ;; 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)
+	  ;; XEmacs change
 	  (buffer-save (current-buffer))
 	  outwin)
+;; XEmacs change
 ;; Pop up the compilation buffer.
 (setq outwin (display-buffer outbuf))
 (unwind-protect
 (progn
 	;; Clear out the compilation buffer and make it writable.
 	;; Change its default-directory to the directory where the compilation
 	;; will happen, and insert a `cd' command to indicate this.
 	(set-buffer outbuf)
 	(setq buffer-read-only nil)
 	(buffer-disable-undo (current-buffer))
 	(erase-buffer)
 	(buffer-enable-undo (current-buffer))
 	(setq default-directory thisdir)
 	(insert "cd " thisdir "\n" command "\n")
 	(set-buffer-modified-p nil)
+	;; XEmacs change
 	;; set it so the window will scroll to show compile output
 	(save-window-excursion
 	  (select-window outwin)
 	  (goto-char (point-max)))
+	;; XEmacs change
 	(compilation-mode name-of-mode)
 	;; (setq buffer-read-only t)  ;;; Non-ergonomic.
+	;; XEmacs change
 	(set (make-local-variable 'compile-command) command)
 	(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)
 	(setq default-directory thisdir
 	      compilation-directory-stack (list default-directory))
 	(set-window-start outwin (point-min))
 	(setq mode-name name-of-mode)
+	;; XEmacs change
 ;	(or (eq outwin (selected-window))
 ;	    (set-window-point outwin (point-min)))
 	(compilation-set-window-height outwin)
-	;; Set up the menus
 	;; Start the compilation.
 	(if (fboundp 'start-process)
 	    (let* ((process-environment (cons "EMACS=t" process-environment))
 		   (proc (start-process-shell-command (downcase mode-name)
 						      outbuf
 	      (set-process-sentinel proc 'compilation-sentinel)
 	      (set-process-filter proc 'compilation-filter)
 	      (set-marker (process-mark proc) (point) outbuf)
 	      (setq compilation-in-progress
 		    (cons proc compilation-in-progress)))
-	  ;; No asynchronous processes available
+	  ;; No asynchronous processes available.
-	  (message (format "Executing `%s'..." command))
+	  (message "Executing `%s'..." command)
-	  (sit-for 0) ;; Force redisplay
+	  ; FSF
+	  ; (setq mode-line-process ":run")
+	  ; (force-mode-line-update)
+	  (sit-for 0)			;; Force redisplay
 	  (let ((status (call-process shell-file-name nil outbuf nil "-c"
 				      command))))
-	  (message (format "Executing `%s'...done" command))))
+	  (message "Executing `%s'...done" command)))
 (set-buffer buffer-save)))
 ;; Make it so the next C-x ` will use this buffer.
 (setq compilation-last-buffer outbuf)))
 ! \\{compilation-mode-map}"
 (interactive "P")
 (if (setq compilation-minor-mode (if (null arg)
 				       (null compilation-minor-mode)
 				     (> (prefix-numeric-value arg) 0)))
-(compilation-setup)))
+(progn
+	(compilation-setup)
+	(run-hooks 'compilation-minor-mode-hook))))
+;; Write msg in the current buffer and hack its mode-line-process.
+(defun compilation-handle-exit (process-status exit-status msg)
+(let ((buffer-read-only nil)
+	(status (if compilation-exit-message-function
+		    (funcall compilation-exit-message-function
+			     process-status exit-status msg)
+		  (cons msg exit-status)))
+	(omax (point-max))
+	(opoint (point)))
+;; Record where we put the message, so we can ignore it
+;; later on.
+(goto-char omax)
+(insert ?\n mode-name " " (car status))
+(forward-char -1)
+(insert " at " (substring (current-time-string) 0 19))
+(forward-char 1)
+(setq mode-line-process (format ":%s [%s]" process-status (cdr status)))
+;; Force mode line redisplay soon.
+(force-mode-line-update)
+(if (and opoint (< opoint omax))
+	(goto-char opoint))
+(if compilation-finish-function
+	(funcall compilation-finish-function (current-buffer) msg))))
 ;; Called when compilation process changes state.
 (defun compilation-sentinel (proc msg)
 "Sentinel for compilation buffers."
+;; XEmacs change
 (let* ((buffer (process-buffer proc))
 	 (window (get-buffer-window buffer)))
 (if (memq (process-status proc) '(signal exit))
 	(progn
 	  (if (null (buffer-name buffer))
 	(set-buffer (process-buffer proc))
 	(let ((buffer-read-only nil))
 	  (save-excursion
 	    (goto-char (process-mark proc))
 	    (insert-before-markers string)
+	    (run-hooks 'compilation-filter-hook)
 	    (set-marker (process-mark proc) (point)))))))
 ;; Return the cdr of compilation-old-error-list for the error containing point.
 (defun compile-error-at-point ()
 (compile-reinitialize-errors nil (point))
 (while (and errors
 		(> (point) (car (car errors))))
 (setq errors (cdr errors)))
 errors))
-(defun compilation-buffer-p (buffer)
+(defsubst compilation-buffer-p (buffer)
 (save-excursion
 (set-buffer buffer)
 (or compilation-minor-mode (eq major-mode 'compilation-mode))))
 (defun compilation-next-error (n)
 (let ((w (get-buffer-window compilation-last-buffer)))
 	(if w
 	    (select-window w)
 	  (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))
 	  ;; compilation-error-list might be non-nil if we have a non-nil
 	  ;; LIMIT-SEARCH or FIND-AT-LEAST arg.  In that case its value
 	  ;; records the current position in the error list, and we must
 		;; 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))
 	    ))))))
+;; XEmacs addition
+;; FSF has added this by 19.34, but it is highly complex, why? -sb
+(defun compile-mouse-goto-error (event)
+"Visit the source for the error under the mouse.
+Use this command in a compilation log buffer."
+(interactive "e")
+(mouse-set-point event)
+(beginning-of-line)
+(compile-goto-error))
 (defun compile-goto-error (&optional argp)
 "Visit the source for the error message point is on.
 Use this command in a compilation log buffer.  Sets the mark at point there.
 \\[universal-argument] as a prefix arg means to reparse the buffer's error messages first;
 other kinds of prefix arguments are ignored."
 	;; but we didn't want to do that.
 	(set-buffer compilation-last-buffer)))
 (push-mark)
 (next-error 1))
-;; XEmacs addition
-(defun compile-mouse-goto-error (event)
-"Visit the source for the error under the mouse.
-Use this command in a compilation log buffer."
-(interactive "e")
-(mouse-set-point event)
-(beginning-of-line)
-(compile-goto-error))
 ;; XEmacs addition
 (defun compile-mouse-maybe-goto-error (event &optional click-count)
 (interactive "e")
 (if (equal (event-button event) 2)
 (if (and (not other-buffer)
 	   (compilation-buffer-p (current-buffer)))
 ;; The current buffer is a compilation buffer.
 (current-buffer)
 (if (and compilation-last-buffer (buffer-name compilation-last-buffer)
+	     (compilation-buffer-p compilation-last-buffer)
 	     (or (not other-buffer) (not (eq compilation-last-buffer
 					     (current-buffer)))))
 	compilation-last-buffer
 (let ((buffers (buffer-list)))
 	(while (and buffers (or (not (compilation-buffer-p (car buffers)))
 			   ;; We want to pass a number here only if
 			   ;; we got a numeric prefix arg, not just C-u.
 			   (and (not (consp argp))
 				(prefix-numeric-value argp))
 			   (consp argp))))
+;;;###autoload (define-key ctl-x-map "`" 'next-error)
 ;; XEmacs change
 ;;;###autoload
 (defun previous-error (&optional argp)
 "Visit previous compilation error message and corresponding source code.
 ;		      (compilation-forget-errors))
 		  (if silent
 		      (throw 'no-next-error nil)
 		    (error (concat compilation-error-message
 				   (and (get-buffer-process (current-buffer))
-					(eq (process-status (get-buffer-process
+					(eq (process-status
+					     (get-buffer-process
 							     (current-buffer)))
 					    'run)
 					" yet")))))
 	      (setq compilation-error-list (cdr next-errors))
 	      (if (null (cdr next-error))
 ;; going to the right place, widen.
 (or (= (point) (marker-position (cdr next-error)))
 	(progn
 	  (widen)
 	  (goto-char (cdr next-error))))))
-;;;###autoload (define-key ctl-x-map "`" 'next-error)
 ;; Find a buffer for file FILENAME.
 ;; Search the directories in compilation-search-path.
 ;; A nil in compilation-search-path means to try the
 ;; current directory, which is passed in DIR.
 ;; 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
+(setq error-regexp-groups
-					    (+ subexpr (nth 1 (car alist)))
+	    (cons (list subexpr
-					    (+ subexpr (nth 2 (car alist)))
+			(+ subexpr (nth 1 (car alist)))
-;;#### This is buggy in FSFmacs
+			(+ subexpr (nth 2 (car alist)))
-					    (let ((col (nth 3 (car alist))))
+			;;#### This is buggy in FSFmacs
-					      (and col
+			(let ((col (nth 3 (car alist))))
-						   (+ subexpr col))))
+			  (and col
-				      error-regexp-groups))
+			       (+ subexpr col))))
+		  error-regexp-groups))
 (setq subexpr (+ subexpr 1 (count-regexp-groupings (car (car alist)))))
 (setq alist (cdr alist)))
 ;; Set up now the expanded, abbreviated directory variables
 ;; that compile-abbreviate-directory will need, so we can
 		    ;; 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.
+	       (when (fboundp 'command-line-normalize-file-name)
+		 (setq filename (command-line-normalize-file-name filename)))
 	       (setq filename (cons filename (cons default-directory
 						   (nthcdr 4 alist))))
 	       ;; Locate the erring file and line.
 	       )
 	     )
 	    (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.
 	   (setq found-desired t)))
 (setq compilation-parsing-end (if found-desired
 	  (concat (file-name-directory
 		   (directory-file-name orig))
 		  (substring dir (length parent-expanded)))))
 dir)
 (provide 'compile)
 ;;; compile.el ends here

Mercurial > hg > xemacs-beta

comparison lisp/packages/compile.el @ 2:ac2d302a0011 r19-15b2