X-Git-Url: http://git.chise.org/gitweb/?p=chise%2Fxemacs-chise.git.1;a=blobdiff_plain;f=lisp%2Ffont-lock.el;h=39697938761f0963b5400fbe164d34c8604ba63a;hp=d5e26d8ad7504af55f087fb92e33e26c5afecf77;hb=a1655b870904de973c366d85ebdc8adde4ef5e1e;hpb=c855f9c824a0fc23e52e92d65ec8a34bd51cddd7

diff --git a/lisp/font-lock.el b/lisp/font-lock.el
index d5e26d8..3969793 100644
--- a/lisp/font-lock.el
+++ b/lisp/font-lock.el
@@ -1496,17 +1496,22 @@ LIMIT can be modified by the value of its PRE-MATCH-FORM."
 START should be at the beginning of a line."
   (let ((loudly (and font-lock-verbose
 		     (>= (- end start) font-lock-message-threshold))))
-    (let ((case-fold-search font-lock-keywords-case-fold-search)
-	  (keywords (cdr (if (eq (car-safe font-lock-keywords) t)
-			     font-lock-keywords
-			   (font-lock-compile-keywords))))
-	  (bufname (buffer-name)) (count 5)
-	  keyword matcher highlights)
+    (let* ((case-fold-search font-lock-keywords-case-fold-search)
+	   (keywords (cdr (if (eq (car-safe font-lock-keywords) t)
+			      font-lock-keywords
+			    (font-lock-compile-keywords))))
+	   (bufname (buffer-name)) 
+	   (progress 5) (old-progress 5)
+	   (iter 0)
+	   (nkeywords (length keywords))
+	   keyword matcher highlights)
       ;;
       ;; Fontify each item in `font-lock-keywords' from `start' to `end'.
+      ;; In order to measure progress accurately we need to know how
+      ;; many keywords we have and how big the region is. Then progress
+      ;; is ((pos - start)/ (end - start) * nkeywords 
+      ;; 	+ iteration / nkeywords) * 100
       (while keywords
-	(when loudly (lprogress-display 'font-lock "Fontifying %s... (regexps)"
-				(setq count (+ count 5)) bufname))
 	;;
 	;; Find an occurrence of `matcher' from `start' to `end'.
 	(setq keyword (car keywords) matcher (car keyword))
@@ -1515,6 +1520,14 @@ START should be at the beginning of a line."
 		    (if (stringp matcher)
 			(re-search-forward matcher end t)
 		      (funcall matcher end)))
+	  ;; calculate progress
+	  (setq progress
+		(+ (/ (* (- (point) start) 95) (* (- end start) nkeywords))
+		   (/ (* iter 95) nkeywords) 5))
+	  (when (and loudly (> progress old-progress))
+	    (lprogress-display 'font-lock "Fontifying %s... (regexps)"
+			       progress bufname))
+	  (setq old-progress progress)
 	  ;; Apply each highlight to this instance of `matcher', which may be
 	  ;; specific highlights or more keywords anchored to `matcher'.
 	  (setq highlights (cdr keyword))
@@ -1528,6 +1541,7 @@ START should be at the beginning of a line."
 		  (and end (goto-char end)))
 	      (font-lock-fontify-anchored-keywords (car highlights) end))
 	    (setq highlights (cdr highlights))))
+	(setq iter (1+ iter))
 	(setq keywords (cdr keywords))))
     (if loudly (lprogress-display 'font-lock "Fontifying %s... " 100 (buffer-name)))))