diff options
Diffstat (limited to 'lisp/font-lock.el')
| -rw-r--r-- | lisp/font-lock.el | 177 |
1 files changed, 152 insertions, 25 deletions
diff --git a/lisp/font-lock.el b/lisp/font-lock.el index f001a0bfaac..093780c3914 100644 --- a/lisp/font-lock.el +++ b/lisp/font-lock.el @@ -893,7 +893,11 @@ The value of this variable is used when Font Lock mode is turned on." (set (make-local-variable 'font-lock-fontified) t) ;; Use jit-lock. (jit-lock-register 'font-lock-fontify-region - (not font-lock-keywords-only)))))) + (not font-lock-keywords-only)) + ;; Tell jit-lock how we extend the region to refontify. + (add-hook 'jit-lock-after-change-extend-region-functions + 'font-lock-extend-jit-lock-region-after-change + nil t))))) (defun font-lock-turn-off-thing-lock () (cond ((and (boundp 'fast-lock-mode) fast-lock-mode) @@ -971,6 +975,21 @@ The value of this variable is used when Font Lock mode is turned on." ;; directives correctly and cleanly. (It is the same problem as fontifying ;; multi-line strings and comments; regexps are not appropriate for the job.) +(defvar font-lock-extend-after-change-region-function nil + "A function that determines the region to refontify after a change. + +This variable is either nil, or is a function that determines the +region to refontify after a change. +It is usually set by the major mode via `font-lock-defaults'. +Font-lock 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 refontify, or nil +\(which directs the caller to fontify a default region). +This function should preserve the match-data. +The region it returns may start or end in the middle of a line.") + (defun font-lock-fontify-buffer () "Fontify the current buffer the way the function `font-lock-mode' would." (interactive) @@ -1021,6 +1040,59 @@ The value of this variable is used when Font Lock mode is turned on." Useful for things like RMAIL and Info where the whole buffer is not a very meaningful entity to highlight.") + +(defvar font-lock-beg) (defvar font-lock-end) +(defvar font-lock-extend-region-functions + '(font-lock-extend-region-wholelines + ;; This use of font-lock-multiline property is unreliable but is just + ;; a handy heuristic: in case you don't have a function that does + ;; /identification/ of multiline elements, you may still occasionally + ;; discover them by accident (or you may /identify/ them but not in all + ;; cases), in which case the font-lock-multiline property can help make + ;; sure you will properly *re*identify them during refontification. + font-lock-extend-region-multiline) + "Special hook run just before proceeding to fontify a region. +This is used to allow major modes to help font-lock find safe buffer positions +as beginning and end of the fontified region. Its most common use is to solve +the problem of /identification/ of multiline elements by providing a function +that tries to find such elements and move the boundaries such that they do +not fall in the middle of one. +Each function is called with no argument; it is expected to adjust the +dynamically bound variables `font-lock-beg' and `font-lock-end'; and return +non-nil iff it did make such an adjustment. +These functions are run in turn repeatedly until they all return nil. +Put first the functions more likely to cause a change and cheaper to compute.") +;; Mark it as a special hook which doesn't use any global setting +;; (i.e. doesn't obey the element t in the buffer-local value). +(make-variable-buffer-local 'font-lock-extend-region-functions) + +(defun font-lock-extend-region-multiline () + "Move fontification boundaries away from any `font-lock-multiline' property." + (let ((changed nil)) + (when (and (> font-lock-beg (point-min)) + (get-text-property (1- font-lock-beg) 'font-lock-multiline)) + (setq changed t) + (setq font-lock-beg (or (previous-single-property-change + font-lock-beg 'font-lock-multiline) + (point-min)))) + ;; + (when (get-text-property font-lock-end 'font-lock-multiline) + (setq changed t) + (setq font-lock-end (or (text-property-any font-lock-end (point-max) + 'font-lock-multiline nil) + (point-max)))) + changed)) + + +(defun font-lock-extend-region-wholelines () + "Move fontification boundaries to beginning of lines." + (let ((changed nil)) + (goto-char font-lock-beg) + (unless (bolp) (setq changed t font-lock-beg (line-beginning-position))) + (goto-char font-lock-end) + (unless (bolp) (setq changed t font-lock-end (line-beginning-position 2))) + changed)) + (defun font-lock-default-fontify-region (beg end loudly) (save-buffer-state ((parse-sexp-lookup-properties @@ -1032,24 +1104,21 @@ a very meaningful entity to highlight.") ;; 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))) + ;; Extend the region to fontify so that it starts and ends at + ;; safe places. + (let ((funs font-lock-extend-region-functions) + (font-lock-beg beg) + (font-lock-end end)) + (while funs + (setq funs (if (or (not (funcall (car funs))) + (eq funs font-lock-extend-region-functions)) + (cdr funs) + ;; If there's been a change, we should go through + ;; the list again since this new position may + ;; warrant a different answer from one of the fun + ;; we've already seen. + font-lock-extend-region-functions))) + (setq beg font-lock-beg end font-lock-end)) ;; Now do the fontification. (font-lock-unfontify-region beg end) (when font-lock-syntactic-keywords @@ -1083,19 +1152,77 @@ what properties to clear before refontifying a region.") ;; 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) - (region (font-lock-extend-region beg end old-len))) - (save-excursion + (save-excursion + (let ((inhibit-point-motion-hooks t) + (inhibit-quit t) + (region (if font-lock-extend-after-change-region-function + (funcall font-lock-extend-after-change-region-function + beg end old-len)))) (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)))) + ;; Actually, this is not needed because + ;; font-lock-default-fontify-region already rounds up to a whole + ;; number of lines. + ;; (setq beg (progn (goto-char beg) (line-beginning-position)) + ;; end (progn (goto-char end) (line-beginning-position 2))) + ) (font-lock-fontify-region beg end))))) +(defvar jit-lock-start) (defvar jit-lock-end) +(defun font-lock-extend-jit-lock-region-after-change (beg end old-len) + "Function meant for `jit-lock-after-change-extend-region-functions'. +This function does 2 things: +- extend the region so that it not only includes the part that was modified + but also the surrounding text whose highlighting may change as a consequence. +- anticipate (part of) the region extension that will happen later in + `font-lock-default-fontify-region', in order to avoid the need for + double-redisplay in `jit-lock-fontify-now'." + (save-excursion + ;; First extend the region as font-lock-after-change-function would. + (let ((region (if font-lock-extend-after-change-region-function + (funcall font-lock-extend-after-change-region-function + beg end old-len)))) + (if region + (setq beg (min jit-lock-start (car region)) + end (max jit-lock-end (cdr region)))) + ;; Then extend the region obeying font-lock-multiline properties, + ;; indicating which part of the buffer needs to be refontified. + ;; !!! This is the *main* user of font-lock-multiline property !!! + ;; font-lock-after-change-function could/should also do that, but it + ;; doesn't need to because font-lock-default-fontify-region does + ;; it anyway. Here OTOH we have no guarantee that + ;; font-lock-default-fontify-region will be executed on this region + ;; any time soon. + ;; Note: contrary to font-lock-default-fontify-region, we do not do + ;; any loop here because we are not looking for a safe spot: we just + ;; mark the text whose appearance may need to change as a result of + ;; the buffer modification. + (when (and (> beg (point-min)) + (get-text-property (1- beg) 'font-lock-multiline)) + (setq beg (or (previous-single-property-change + beg 'font-lock-multiline) + (point-min)))) + (setq end (or (text-property-any end (point-max) + 'font-lock-multiline nil) + (point-max))) + ;; Finally, pre-enlarge the region to a whole number of lines, to try + ;; and anticipate what font-lock-default-fontify-region will do, so as to + ;; avoid double-redisplay. + ;; We could just run `font-lock-extend-region-functions', but since + ;; the only purpose is to avoid the double-redisplay, we prefer to + ;; do here only the part that is cheap and most likely to be useful. + (when (memq 'font-lock-extend-region-wholelines + font-lock-extend-region-functions) + (goto-char beg) + (forward-line 0) + (setq jit-lock-start (min jit-lock-start (point))) + (goto-char end) + (forward-line 1) + (setq jit-lock-end (max jit-lock-end (point))))))) + (defun font-lock-fontify-block (&optional arg) "Fontify some lines the way `font-lock-fontify-buffer' would. The lines could be a function or paragraph, or a specified number of lines. |