X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;ds=sidebyside;f=lisp%2Ffont-lock.el;h=d927539e15a025aecafdd9f8e1602dd43c628123;hb=9fba8a0ce838af753969cf18f7b9f42e95890d3d;hp=937359418e678ac1def20976bcf555c5f67b9adc;hpb=b24a82be4ed4916738cbed097d8dfc96ec312435;p=chise%2Fxemacs-chise.git-

diff --git a/lisp/font-lock.el b/lisp/font-lock.el
index 9373594..d927539 100644
--- a/lisp/font-lock.el
+++ b/lisp/font-lock.el
@@ -2,7 +2,7 @@
 
 ;; Copyright (C) 1992-1995, 1997 Free Software Foundation, Inc.
 ;; Copyright (C) 1995 Amdahl Corporation.
-;; Copyright (C) 1996, 2000 Ben Wing.
+;; Copyright (C) 1996, 2000, 2001 Ben Wing.
 
 ;; Author: Jamie Zawinski <jwz@jwz.org>, for the LISPM Preservation Society.
 ;; Minimally merged with FSF 19.34 by Barry Warsaw <bwarsaw@python.org>
@@ -904,15 +904,12 @@ See the variable `font-lock-keywords' for customization."
 			  font-lock-maximum-size
 			(cdr (or (assq major-mode font-lock-maximum-size)
 				 (assq t font-lock-maximum-size))))))
-    ;; Font-lock mode will refuse to turn itself on if in batch mode, or if
-    ;; the current buffer is "invisible".  The latter is because packages
-    ;; sometimes put their temporary buffers into some particular major mode
-    ;; to get syntax tables and variables and whatnot, but we don't want the
-    ;; fact that the user has font-lock-mode on a mode hook to slow these
-    ;; things down.
-    (if (or noninteractive (eq (aref (buffer-name) 0) ?\ ))
-	(setq on-p nil))
-    (if (equal (buffer-name) " *Compiler Input*") ; hack for bytecomp...
+    ;; Font-lock mode will refuse to turn itself on if in batch mode
+    ;; to avoid potential (probably not actual, though) slowdown.  We
+    ;; used to try to "be nice" by avoiding doing this in temporary
+    ;; buffers.  But with the deferral code we don't need this, and it
+    ;; definitely screws some things up.
+    (if (noninteractive)
 	(setq on-p nil))
     (cond (on-p
 	   (make-local-hook 'after-change-functions)
@@ -1186,12 +1183,14 @@ Otherwise, changes to existing text will not be processed until the
 next redisplay cycle, avoiding excessive fontification when many
 buffer modifications are performed or a buffer is reverted.")
 
-(defvar font-lock-pending-extent-table (make-hash-table :weakness 'key))
+;; list of buffers in which there is a pending change.
+(defvar font-lock-pending-buffer-table (make-hash-table :weakness 'key))
+;; table used to keep track of ranges needing fontification.
 (defvar font-lock-range-table (make-range-table))
 
 (defun font-lock-pre-idle-hook ()
   (condition-case font-lock-error
-      (if (> (hash-table-count font-lock-pending-extent-table) 0)
+      (if (> (hash-table-count font-lock-pending-buffer-table) 0)
 	  (font-lock-fontify-pending-extents))
     (error (warn "Error caught in `font-lock-pre-idle-hook': %s"
 		 font-lock-error))))
@@ -1203,12 +1202,20 @@ buffer modifications are performed or a buffer is reverted.")
 
 (defun font-lock-after-change-function (beg end old-len)
   (when font-lock-mode
-    (let ((ex (make-extent beg end)))
-      (set-extent-property ex 'detachable nil)
-      (set-extent-property ex 'end-open nil)
-      (let ((exs (gethash (current-buffer) font-lock-pending-extent-table)))
-	(push ex exs)
-	(puthash (current-buffer) exs font-lock-pending-extent-table)))
+    ;; treat deletions as if the following character (or previous, if
+    ;; there is no following) were inserted. (also use the previous
+    ;; character at end of line.  this avoids a problem when you
+    ;; insert a comment on the line before a line of code: if we use
+    ;; the following char, then when you hit backspace, the following
+    ;; line of code turns the comment color.) this is a bit of a hack
+    ;; but allows us to use text properties for everything.
+    (if (= beg end)
+	(cond ((not (save-excursion (goto-char end) (eolp)))
+	       (setq end (1+ end)))
+	      ((/= beg (point-min)) (setq beg (1- beg)))
+	      (t nil)))
+    (put-text-property beg end 'font-lock-pending t)
+    (puthash (current-buffer) t font-lock-pending-buffer-table)
     (if font-lock-always-fontify-immediately
 	(font-lock-fontify-pending-extents))))
 
@@ -1218,61 +1225,55 @@ buffer modifications are performed or a buffer is reverted.")
   ;; only one buffer and one contiguous region!
   (save-match-data
     (maphash
-     #'(lambda (buffer exs)
+     #'(lambda (buffer dummy)
 	 ;; remove first, to avoid infinite reprocessing if error
-	 (remhash buffer font-lock-pending-extent-table)
+	 (remhash buffer font-lock-pending-buffer-table)
 	 (when (buffer-live-p buffer)
 	   (clear-range-table font-lock-range-table)
 	   (with-current-buffer buffer
 	     (save-excursion
 	       (save-restriction
-		 ;; if we don't widen, then the C code will fail to
-		 ;; realize that we're inside a comment.
+		 ;; if we don't widen, then the C code in
+		 ;; syntactically-sectionize will fail to realize that
+		 ;; we're inside a comment. #### We don't actually use
+		 ;; syntactically-sectionize any more.  Do we still
+		 ;; need the widen?
 		 (widen)
 		 (let ((zmacs-region-stays
 			zmacs-region-stays)) ; protect from change!
-		   (mapc
-		    #'(lambda (ex)
-			;; paranoia.
-			(when (and (extent-live-p ex)
-				   (not (extent-detached-p ex)))
-			  ;; first expand the ranges to full lines, because
-			  ;; that is what will be fontified; then use a
-			  ;; range table to merge the ranges.
-			  (let* ((beg (extent-start-position ex))
-				 (end (extent-end-position ex))
-				 (beg (progn (goto-char beg)
-					     (beginning-of-line)
-					     (point)))
-				 (end (progn (goto-char end)
-					     (forward-line 1)
-					     (point))))
-			    (detach-extent ex)
-			    (put-range-table beg end t
-					     font-lock-range-table))))
-		    exs)
+		   (map-extents
+		    #'(lambda (ex dummy-maparg)
+			;; first expand the ranges to full lines,
+			;; because that is what will be fontified;
+			;; then use a range table to merge the
+			;; ranges. (we could also do this simply using
+			;; text properties.  the range table code was
+			;; here from a previous version of this code
+			;; and works just as well.)
+			(let* ((beg (extent-start-position ex))
+			       (end (extent-end-position ex))
+			       (beg (progn (goto-char beg)
+					   (beginning-of-line)
+					   (point)))
+			       (end (progn (goto-char end)
+					   (forward-line 1)
+					   (point))))
+			  (put-range-table beg end t
+					   font-lock-range-table)))
+		    nil nil nil nil nil 'font-lock-pending t)
+		   ;; clear all pending extents first in case of error below.
+		   (put-text-property (point-min) (point-max)
+				      'font-lock-pending nil)
 		   (map-range-table
 		    #'(lambda (beg end val)
-			;; Maybe flush the internal cache used by
-			;; syntactically-sectionize.  (It'd be nice if this
-			;; was more automatic.)  Any deletions mean the
-			;; cache is invalid, and insertions at beginning or
-			;; end of line mean that the bol cache might be
-			;; invalid.
-			;; #### This code has been commented out for some time
-			;; now and is bit-rotting.  Someone should look into
-			;; this.
-;;			(if (or change-was-deletion (bobp)
-;;				(= (preceding-char) ?\n))
-;;			    (buffer-syntactic-context-flush-cache))
-			;; #### This creates some unnecessary progress gauges.
+			;; This creates some unnecessary progress gauges.
 ;;			(if (and (= beg (point-min))
 ;;				 (= end (point-max)))
 ;;			    (font-lock-fontify-buffer)
 ;;			  (font-lock-fontify-region beg end)))
 			(font-lock-fontify-region beg end))
 		    font-lock-range-table)))))))
-     font-lock-pending-extent-table)))
+     font-lock-pending-buffer-table)))
 
 ;; Syntactic fontification functions.