xemacs-beta: lisp/font-lock.el comparison

comparison lisp/font-lock.el @ 462:0784d089fdc9 r21-2-46

Import from CVS: tag r21-2-46

author	cvs
date	Mon, 13 Aug 2007 11:44:37 +0200
parents	223736d75acb
children	7039e6323819

comparison

equal deleted inserted replaced

-:120ed4009e51
+:0784d089fdc9
 "Set this to non-nil to disable font-lock deferral.
 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))))
 ;;; called when any modification is made to buffer text.  This function
 ;;; the extents are merged and pruned, and the resulting ranges fontified.
 ;;; This function could easily be adapted to other after-change-functions.
 (defun font-lock-after-change-function (beg end old-len)
 (when font-lock-mode
-(let ((ex (make-extent beg end)))
+;; treat deletions as if the following character (or previous, if
-(set-extent-property ex 'detachable nil)
+;; there is no following) were inserted.  this is a bit of a hack
-(set-extent-property ex 'end-open nil)
+;; but allows us to use text properties for everything.
-(let ((exs (gethash (current-buffer) font-lock-pending-extent-table)))
+(if (= beg end)
-	(push ex exs)
+	(cond ((/= end (point-max)) (setq end (1+ end)))
-	(puthash (current-buffer) exs font-lock-pending-extent-table)))
+	      ((/= 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))))
 (defun font-lock-fontify-pending-extents ()
 ;; ah, the beauty of mapping functions.
 ;; this function is actually shorter than the old version, which handled
 ;; 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
+		 ;; if we don't widen, then the C code in
-		 ;; realize that we're inside a comment.
+		 ;; 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
+		   (map-extents
-		    #'(lambda (ex)
+		    #'(lambda (ex dummy-maparg)
-			;; paranoia.
+			;; first expand the ranges to full lines,
-			(when (and (extent-live-p ex)
+			;; because that is what will be fontified;
-				   (not (extent-detached-p ex)))
+			;; then use a range table to merge the
-			  ;; first expand the ranges to full lines, because
+			;; ranges. (we could also do this simply using
-			  ;; that is what will be fontified; then use a
+			;; text properties.  the range table code was
-			  ;; range table to merge the ranges.
+			;; here from a previous version of this code
-			  (let* ((beg (extent-start-position ex))
+			;; and works just as well.)
-				 (end (extent-end-position ex))
+			(let* ((beg (extent-start-position ex))
-				 (beg (progn (goto-char beg)
+			       (end (extent-end-position ex))
-					     (beginning-of-line)
+			       (beg (progn (goto-char beg)
-					     (point)))
+					   (beginning-of-line)
-				 (end (progn (goto-char end)
+					   (point)))
-					     (forward-line 1)
+			       (end (progn (goto-char end)
-					     (point))))
+					   (forward-line 1)
-			    (detach-extent ex)
+					   (point))))
-			    (put-range-table beg end t
+			  (put-range-table beg end t
-					     font-lock-range-table))))
+					   font-lock-range-table)))
-		    exs)
+		    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
+			;; This creates some unnecessary progress gauges.
-			;; 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.
 ;;			(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.
 (defun font-lock-lisp-like (mode)
 ;; Note: (or (get mode 'font-lock-lisp-like) (string-match ...)) is

Mercurial > hg > xemacs-beta

comparison lisp/font-lock.el @ 462:0784d089fdc9 r21-2-46