font-lock-extend-region-function: Final refinements.

[Alan Mackenzie]

Hi, Emacs!

It has been apparent for some time that the current mechanism for calling
font-lock-extend-region-function[*] from the two font-lock after-change
functions is incomplete - it needs to be supplemented by callng the
function from jit-lock-fontify-now and font-lock-default-fontify-region.

Here is a patch which does precisely this.  I will install it if nobody
sees any problems with it.

The Elisp manual still needs some updating - I plan to do this soon.

[*] The purpose of a (major mode specific) function in this hook is to
extend the region to be fontified to "safe" boundaries, such that Emacs
won't try to start or stop fontification in the middle of a syntactic
construct.


2006-04-30  Alan Mackenzie  <address@hidden>

        * font-lock.el (font-lock-default-fontify-region): call
        font-lock-extend-region-function, if set, to determine the region
        to fontify.

        * jit-lock.el (jit-lock-fontify-now): call
        font-lock-extend-region-function, if set, to determine the region
        to fontify.



Index: font-lock.el
===================================================================
RCS file: /cvsroot/emacs/emacs/lisp/font-lock.el,v
retrieving revision 1.296
diff -c -r1.296 font-lock.el
*** font-lock.el        15 Mar 2006 22:26:08 -0000      1.296
--- font-lock.el        30 Apr 2006 10:35:03 -0000
***************
*** 1025,1055 ****
    (save-buffer-state
        ((parse-sexp-lookup-properties
          (or parse-sexp-lookup-properties font-lock-syntactic-keywords))
!        (old-syntax-table (syntax-table)))
      (unwind-protect
        (save-restriction
          (unless font-lock-dont-widen (widen))
          ;; Use the fontification syntax table, if any.
          (when font-lock-syntax-table
            (set-syntax-table font-lock-syntax-table))
!           (goto-char beg)
!         (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))
!                    (get-text-property (1- beg) 'font-lock-multiline))
!           ;; We are just after or in a multiline match.
!           (setq beg (or (previous-single-property-change
!                          beg 'font-lock-multiline)
!                         (point-min)))
            (goto-char beg)
!           (setq beg (line-beginning-position)))
!           (setq end (or (text-property-any end (point-max)
!                                            'font-lock-multiline nil)
!                         (point-max)))
!         (goto-char end)
!         ;; Round up to a whole line.
!           (unless (bolp) (setq end (line-beginning-position 2)))
          ;; Now do the fontification.
          (font-lock-unfontify-region beg end)
          (when font-lock-syntactic-keywords
--- 1025,1060 ----
    (save-buffer-state
        ((parse-sexp-lookup-properties
          (or parse-sexp-lookup-properties font-lock-syntactic-keywords))
!        (old-syntax-table (syntax-table))
!        (extended-region (font-lock-extend-region beg end nil)))
      (unwind-protect
        (save-restriction
          (unless font-lock-dont-widen (widen))
          ;; Use the fontification syntax table, if any.
          (when font-lock-syntax-table
            (set-syntax-table font-lock-syntax-table))
!         (if extended-region
!             (setq beg (car extended-region)
!                   end (cdr extended-region))
            (goto-char beg)
!           (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))
!                      (get-text-property (1- beg) 'font-lock-multiline))
!             ;; We are just after or in a multiline match.
!             (setq beg (or (previous-single-property-change
!                            beg 'font-lock-multiline)
!                           (point-min)))
!             (goto-char beg)
!             (setq beg (line-beginning-position)))
!           (setq end (or (text-property-any end (point-max)
!                                            'font-lock-multiline nil)
!                         (point-max)))
!           (goto-char end)
!           ;; Round up to a whole line.
!           (unless (bolp) (setq end (line-beginning-position 2))))
! 
          ;; Now do the fontification.
          (font-lock-unfontify-region beg end)
          (when font-lock-syntactic-keywords
***************
*** 1085,1096 ****
  (defun font-lock-after-change-function (beg end old-len)
    (let ((inhibit-point-motion-hooks t)
        (inhibit-quit t)
!       (region (font-lock-extend-region beg end old-len)))
      (save-excursion
        (save-match-data
!       (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) (line-beginning-position))
                end (progn (goto-char end) (line-beginning-position 2))))
--- 1090,1101 ----
  (defun font-lock-after-change-function (beg end old-len)
    (let ((inhibit-point-motion-hooks t)
        (inhibit-quit t)
!       (extended-region (font-lock-extend-region beg end old-len)))
      (save-excursion
        (save-match-data
!       (if extended-region
            ;; Fontify the region the major mode has specified.
!           (setq beg (car extended-region) end (cdr extended-region))
          ;; Fontify the whole lines which enclose the region.
          (setq beg (progn (goto-char beg) (line-beginning-position))
                end (progn (goto-char end) (line-beginning-position 2))))
Index: jit-lock.el
===================================================================
RCS file: /cvsroot/emacs/emacs/lisp/jit-lock.el,v
retrieving revision 1.51
diff -c -r1.51 jit-lock.el
*** jit-lock.el 20 Mar 2006 07:52:03 -0000      1.51
--- jit-lock.el 30 Apr 2006 10:35:05 -0000
***************
*** 331,337 ****
       ;; from the end of a buffer to its start, can do repeated
       ;; `parse-partial-sexp' starting from `point-min', which can
       ;; take a long time in a large buffer.
!      (let (next)
         (save-match-data
         ;; Fontify chunks beginning at START.  The end of a
         ;; chunk is either `end', or the start of a region
--- 331,337 ----
       ;; from the end of a buffer to its start, can do repeated
       ;; `parse-partial-sexp' starting from `point-min', which can
       ;; take a long time in a large buffer.
!      (let (next extended-region)
         (save-match-data
         ;; Fontify chunks beginning at START.  The end of a
         ;; chunk is either `end', or the start of a region
***************
*** 340,354 ****
           ;; Determine the end of this chunk.
           (setq next (or (text-property-any start end 'fontified t)
                          end))
! 
!          ;; Decide which range of text should be fontified.
!          ;; The problem is that START and NEXT may be in the
!          ;; middle of something matched by a font-lock regexp.
!          ;; Until someone has a better idea, let's start
!          ;; at the start of the line containing START and
!          ;; stop at the start of the line following NEXT.
!          (goto-char next)  (setq next (line-beginning-position 2))
!          (goto-char start) (setq start (line-beginning-position))
  
             ;; Make sure the contextual refontification doesn't re-refontify
             ;; what's already been refontified.
--- 340,357 ----
           ;; Determine the end of this chunk.
           (setq next (or (text-property-any start end 'fontified t)
                          end))
!          ;; Decide which range of text should be fontified.  The problem is
!          ;; that START and NEXT may be in the middle of something matched by
!          ;; a font-lock regexp.
!          ;; If the major mode has supplied an extend-region-function, use
!          ;; this to ensure clean boundaries.  Otherwise, until someone has a
!          ;; better idea, let's start at the start of the line containing
!          ;; START and stop at the start of the line following NEXT.
!          (if (setq extended-region (font-lock-extend-region start next nil))
!              (setq start (car extended-region)
!                    next (cdr extended-region))
!            (goto-char next)  (setq next (line-beginning-position 2))
!            (goto-char start) (setq start (line-beginning-position)))
  
             ;; Make sure the contextual refontification doesn't re-refontify
             ;; what's already been refontified.
***************
*** 557,600 ****
  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))
!     (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)))
! 
!        ;; 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 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)
  
--- 560,600 ----
  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))
!     (let ((extended-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.
!        (if extended-region
!            (setq start (car extended-region)
!                  end (cdr extended-region))
!          (goto-char start)
!          (setq start (line-beginning-position))
!          ;; 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))))))))
  
  (provide 'jit-lock)
  


-- 
Alan.