Mercurial > emacs

--- a/lisp/font-core.el	Tue Mar 14 15:38:43 2006 +0000
+++ b/lisp/font-core.el	Tue Mar 14 18:23:47 2006 +0000
@@ -83,6 +83,34 @@
 settings.  See the variable `font-lock-defaults', which takes precedence.")
 (make-obsolete-variable 'font-lock-defaults-alist 'font-lock-defaults)

+(defvar font-lock-extend-region-function nil
+  "A function that determines the region to fontify after a change.
+
+This buffer-local variable is either nil, or is a function that determines the
+region to fontify.  It is usually set by the major mode.  The currently active
+font-lock after-change function calls this function after each buffer change.
+
+The function is given three parameters, the standard BEG, END, and OLD-LEN
+from after-change-functions.  It should return either a cons of the beginning
+and end buffer positions \(in that order) of the region to fontify, or nil
+\(which directs the caller to fontify a default region).  This function need
+not preserve point or the match-data, but must preserve the current
+restriction.  The region it returns may start or end in the middle of a
+line.")
+(make-variable-buffer-local 'font-lock-extend-region-function)
+
+(defun font-lock-extend-region (beg end old-len)
+  "Determine the region to fontify after a buffer change.
+
+BEG END and OLD-LEN are the standard parameters from after-change-functions.
+The return value is either nil \(which directs the caller to chose the region
+itself), or a cons of the beginning and end \(in that order) of the region.
+The region returned may start or end in the middle of a line."
+  (if font-lock-extend-region-function
+      (save-match-data
+	(save-excursion
+	  (funcall font-lock-extend-region-function beg end old-len)))))
+
 (defvar font-lock-function 'font-lock-default-function
   "A function which is called when `font-lock-mode' is toggled.
 It will be passed one argument, which is the current value of
--- a/lisp/font-lock.el	Tue Mar 14 15:38:43 2006 +0000
+++ b/lisp/font-lock.el	Tue Mar 14 18:23:47 2006 +0000
@@ -1039,7 +1039,7 @@
 	  (when font-lock-syntax-table
 	    (set-syntax-table font-lock-syntax-table))
           (goto-char beg)
-          (setq beg (line-beginning-position (- 1 font-lock-lines-before)))
+	  (setq beg (line-beginning-position))
 	  ;; check to see if we should expand the beg/end area for
 	  ;; proper multiline matches
 	  (when (and (> beg (point-min))
@@ -1090,13 +1090,18 @@
 ;; Called when any modification is made to buffer text.
 (defun font-lock-after-change-function (beg end old-len)
   (let ((inhibit-point-motion-hooks t)
-	(inhibit-quit t))
+	(inhibit-quit t)
+	(region (font-lock-extend-region beg end old-len)))
     (save-excursion
       (save-match-data
-	;; Rescan between start of lines enclosing the region.
-	(font-lock-fontify-region
-	 (progn (goto-char beg) (forward-line 0) (point))
-	 (progn (goto-char end) (forward-line 1) (point)))))))
+	(if region
+	    ;; Fontify the region the major mode has specified.
+	    (setq beg (car region) end (cdr region))
+	  ;; Fontify the whole lines which enclose the region.
+	  (setq beg (progn (goto-char beg)
+			   (forward-line (- font-lock-lines-before)))
+		end (progn (goto-char end) (forward-line 1) (point))))
+	(font-lock-fontify-region beg end)))))

 (defun font-lock-fontify-block (&optional arg)
   "Fontify some lines the way `font-lock-fontify-buffer' would.
--- a/lisp/jit-lock.el	Tue Mar 14 15:38:43 2006 +0000
+++ b/lisp/jit-lock.el	Tue Mar 14 18:23:47 2006 +0000
@@ -557,36 +557,44 @@
 in case the syntax of those lines has changed.  Refontification
 will take place when text is fontified stealthily."
   (when (and jit-lock-mode (not memory-full))
-    (save-excursion
-      (with-buffer-prepared-for-jit-lock
-       ;; It's important that the `fontified' property be set from the
-       ;; beginning of the line, else font-lock will properly change the
-       ;; text's face, but the display will have been done already and will
-       ;; be inconsistent with the buffer's content.
-       (goto-char start)
-       (setq start (line-beginning-position))
+    (let ((region (font-lock-extend-region start end old-len)))
+      (save-excursion
+	(with-buffer-prepared-for-jit-lock
+	 ;; It's important that the `fontified' property be set from the
+	 ;; beginning of the line, else font-lock will properly change the
+	 ;; text's face, but the display will have been done already and will
+	 ;; be inconsistent with the buffer's content.
+	 ;;
+	 ;; FIXME!!! (Alan Mackenzie, 2006-03-14): If start isn't at a BOL,
+	 ;; expanding the region to BOL might mis-fontify, should the BOL not
+	 ;; be at a "safe" position.
+	 (setq start (if region
+			 (car region)
+		       (goto-char start)
+		       (line-beginning-position (- 1 font-lock-lines-before))))

-       ;; If we're in text that matches a multi-line font-lock pattern,
-       ;; make sure the whole text will be redisplayed.
-       ;; I'm not sure this is ever necessary and/or sufficient.  -stef
-       (when (get-text-property start 'font-lock-multiline)
-	 (setq start (or (previous-single-property-change
-			  start 'font-lock-multiline)
-			 (point-min))))
+	 ;; If we're in text that matches a multi-line font-lock pattern,
+	 ;; make sure the whole text will be redisplayed.
+	 ;; I'm not sure this is ever necessary and/or sufficient.  -stef
+	 (when (get-text-property start 'font-lock-multiline)
+	   (setq start (or (previous-single-property-change
+			    start 'font-lock-multiline)
+			   (point-min))))

-       ;; Make sure we change at least one char (in case of deletions).
-       (setq end (min (max end (1+ start)) (point-max)))
-       ;; Request refontification.
-       (put-text-property start end 'fontified nil))
-      ;; Mark the change for deferred contextual refontification.
-      (when jit-lock-context-unfontify-pos
-	(setq jit-lock-context-unfontify-pos
-              ;; Here we use `start' because nothing guarantees that the
-              ;; text between start and end will be otherwise refontified:
-              ;; usually it will be refontified by virtue of being
-              ;; displayed, but if it's outside of any displayed area in the
-              ;; buffer, only jit-lock-context-* will re-fontify it.
-	      (min jit-lock-context-unfontify-pos start))))))
+	 (if region (setq end (cdr region)))
+	 ;; Make sure we change at least one char (in case of deletions).
+	 (setq end (min (max end (1+ start)) (point-max)))
+	 ;; Request refontification.
+	 (put-text-property start end 'fontified nil))
+	;; Mark the change for deferred contextual refontification.
+	(when jit-lock-context-unfontify-pos
+	  (setq jit-lock-context-unfontify-pos
+		;; Here we use `start' because nothing guarantees that the
+		;; text between start and end will be otherwise refontified:
+		;; usually it will be refontified by virtue of being
+		;; displayed, but if it's outside of any displayed area in the
+		;; buffer, only jit-lock-context-* will re-fontify it.
+		(min jit-lock-context-unfontify-pos start)))))))

 (provide 'jit-lock)