Show
Ignore:
Timestamp:
08/10/06 11:19:54 (2 years ago)
Author:
miyoshi
Message:

Sync up with Emacs CVS HEAD.

Files:

Legend:

Unmodified
Added
Removed
Modified
Copied
Moved
  • trunk/lisp/jit-lock.el

    r4058 r4140  
    3232 
    3333(eval-when-compile 
     34  (require 'cl) 
     35 
    3436  (defmacro with-buffer-unmodified (&rest body) 
    3537    "Eval BODY, preserving the current buffer's modified state." 
     
    332334     ;; `parse-partial-sexp' starting from `point-min', which can 
    333335     ;; take a long time in a large buffer. 
    334      (let (next) 
     336     (let ((orig-start start) next) 
    335337       (save-match-data 
    336338         ;; Fontify chunks beginning at START.  The end of a 
     
    374376             (quit (put-text-property start next 'fontified nil) 
    375377                   (funcall 'signal (car err) (cdr err)))) 
     378 
     379           ;; The redisplay engine has already rendered the buffer up-to 
     380           ;; `orig-start' and won't notice if the above jit-lock-functions 
     381           ;; changed the appearance of any part of the buffer prior 
     382           ;; to that.  So if `start' is before `orig-start', we need to 
     383           ;; cause a new redisplay cycle after this one so that any changes 
     384           ;; are properly reflected on screen. 
     385           ;; To make such repeated redisplay happen less often, we can 
     386           ;; eagerly extend the refontified region with 
     387           ;; jit-lock-after-change-extend-region-functions. 
     388           (when (< start orig-start) 
     389             (lexical-let ((start start) 
     390                           (orig-start orig-start) 
     391                           (buf (current-buffer))) 
     392               (run-with-timer 
     393                0 nil (lambda () 
     394                        (with-buffer-prepared-for-jit-lock 
     395                            (put-text-property start orig-start 
     396                                               'fontified t buf)))))) 
    376397 
    377398           ;; Find the start of the next chunk, if any. 
     
    549570              (setq jit-lock-context-unfontify-pos (point-max))))))))) 
    550571 
     572(defvar jit-lock-start) (defvar jit-lock-end) ; Dynamically scoped variables. 
     573(defvar jit-lock-after-change-extend-region-functions nil 
     574  "Hook that can extend the text to refontify after a change. 
     575This is run after every buffer change.  The functions are called with 
     576the three arguments of `after-change-functions': START END OLD-LEN. 
     577The extended region to refontify is returned indirectly by modifying 
     578the variables `jit-lock-start' and `jit-lock-end'. 
     579 
     580Note that extending the region this way is not strictly necessary, 
     581except that the nature of the redisplay code tends to otherwise leave 
     582some of the rehighlighted text displayed with the old highlight until the 
     583next redisplay.  See comment in `jit-lock-fontify-now'.") 
     584 
    551585(defun jit-lock-after-change (start end old-len) 
    552586  "Mark the rest of the buffer as not fontified after a change. 
     
    558592will take place when text is fontified stealthily." 
    559593  (when (and jit-lock-mode (not memory-full)) 
    560     (let ((region (font-lock-extend-region start end old-len))) 
    561       (save-excursion 
    562         (with-buffer-prepared-for-jit-lock 
    563          ;; It's important that the `fontified' property be set from the 
    564          ;; beginning of the line, else font-lock will properly change the 
    565          ;; text's face, but the display will have been done already and will 
    566          ;; be inconsistent with the buffer's content. 
    567          ;;  
    568          ;; FIXME!!! (Alan Mackenzie, 2006-03-14): If start isn't at a BOL, 
    569          ;; expanding the region to BOL might mis-fontify, should the BOL not 
    570          ;; be at a "safe" position. 
    571          (setq start (if region 
    572                          (car region) 
    573                        (goto-char start) 
    574                        (line-beginning-position))) 
    575  
    576          ;; If we're in text that matches a multi-line font-lock pattern, 
    577          ;; make sure the whole text will be redisplayed. 
    578          ;; I'm not sure this is ever necessary and/or sufficient.  -stef 
    579          (when (get-text-property start 'font-lock-multiline) 
    580            (setq start (or (previous-single-property-change 
    581                             start 'font-lock-multiline) 
    582                            (point-min)))) 
    583  
    584          (if region (setq end (cdr region))) 
    585          ;; Make sure we change at least one char (in case of deletions). 
    586          (setq end (min (max end (1+ start)) (point-max))) 
    587          ;; Request refontification. 
    588          (put-text-property start end 'fontified nil)) 
    589         ;; Mark the change for deferred contextual refontification. 
    590         (when jit-lock-context-unfontify-pos 
    591           (setq jit-lock-context-unfontify-pos 
    592                 ;; Here we use `start' because nothing guarantees that the 
    593                 ;; text between start and end will be otherwise refontified: 
    594                 ;; usually it will be refontified by virtue of being 
    595                 ;; displayed, but if it's outside of any displayed area in the 
    596                 ;; buffer, only jit-lock-context-* will re-fontify it. 
    597                 (min jit-lock-context-unfontify-pos start))))))) 
     594    (let ((jit-lock-start start) 
     595          (jit-lock-end end)) 
     596      (with-buffer-prepared-for-jit-lock 
     597          (run-hook-with-args 'jit-lock-after-change-extend-region-functions 
     598                              start end old-len) 
     599          ;; Make sure we change at least one char (in case of deletions). 
     600          (setq jit-lock-end (min (max jit-lock-end (1+ start)) (point-max))) 
     601          ;; Request refontification. 
     602          (put-text-property jit-lock-start jit-lock-end 'fontified nil)) 
     603      ;; Mark the change for deferred contextual refontification. 
     604      (when jit-lock-context-unfontify-pos 
     605        (setq jit-lock-context-unfontify-pos 
     606              ;; Here we use `start' because nothing guarantees that the 
     607              ;; text between start and end will be otherwise refontified: 
     608              ;; usually it will be refontified by virtue of being 
     609              ;; displayed, but if it's outside of any displayed area in the 
     610              ;; buffer, only jit-lock-context-* will re-fontify it. 
     611              (min jit-lock-context-unfontify-pos jit-lock-start)))))) 
    598612 
    599613(provide 'jit-lock)