Add and use `font-lock-extend-region-functions'
More fallout from porting clojure-mode.
2013-02-20 Michael Sperber <mike(a)xemacs.org>
* font-lock.el (font-lock-beg)
(font-lock-extend-region-functions)
(font-lock-extend-region-multiline)
(font-lock-extend-region-wholelines)
(font-lock-default-fontify-region): Add and use
`font-lock-extend-region-functions' from GNU Emacs.
--
Regards,
Mike
diff --git a/lisp/font-lock.el b/lisp/font-lock.el
--- a/lisp/font-lock.el
+++ b/lisp/font-lock.el
＠＠ -1371,6 +1371,61 ＠＠
(font-lock-unfontify-region (point-min) (point-max))
(set (make-local-variable 'font-lock-fontified) nil))
+(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 if 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)
+ (unless (eq font-lock-end
+ (setq font-lock-end (line-beginning-position 2)))
+ (setq changed t)))
+ changed))
+
;; This used to be `font-lock-fontify-region', and before that,
;; `font-lock-fontify-region' used to be the name used for what is now
;; `font-lock-fontify-syntactically-region'.
＠＠ -1383,6 +1438,19 ＠＠
(progn
;; Use the fontification syntax table, if any.
(if font-lock-syntax-table (set-syntax-table font-lock-syntax-table))
+ (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
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches