X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/59db4308b546cbe32d3bfe6e23dbc1899d511975..5811404f0b86c9fa92c3e0b22505a9bb05f04145:/lisp/jit-lock.el diff --git a/lisp/jit-lock.el b/lisp/jit-lock.el index 5f9196da64..0d9abbc1fe 100644 --- a/lisp/jit-lock.el +++ b/lisp/jit-lock.el @@ -1,6 +1,6 @@ ;;; jit-lock.el --- just-in-time fontification -*- lexical-binding: t -*- -;; Copyright (C) 1998, 2000-2015 Free Software Foundation, Inc. +;; Copyright (C) 1998, 2000-2016 Free Software Foundation, Inc. ;; Author: Gerd Moellmann ;; Keywords: faces files @@ -195,9 +195,11 @@ the variable `jit-lock-stealth-nice'. If you need to debug code run from jit-lock, see `jit-lock-debug-mode'." (setq jit-lock-mode arg) (cond - ((buffer-base-buffer) - ;; We're in an indirect buffer. This doesn't work because jit-lock relies - ;; on the `fontified' text-property which is shared with the base buffer. + ((and (buffer-base-buffer) + jit-lock-mode) + ;; We're in an indirect buffer, and we're turning the mode on. + ;; This doesn't work because jit-lock relies on the `fontified' + ;; text-property which is shared with the base buffer. (setq jit-lock-mode nil) (message "Not enabling jit-lock: it does not work in indirect buffer")) @@ -382,14 +384,6 @@ Defaults to the whole buffer. END can be out of bounds." (save-excursion (unless start (setq start (point-min))) (setq end (if end (min end (point-max)) (point-max))) - ;; This did bind `font-lock-beginning-of-syntax-function' to - ;; nil at some point, for an unknown reason. Don't do this; it - ;; can make highlighting slow due to expensive calls to - ;; `parse-partial-sexp' in function - ;; `font-lock-fontify-syntactically-region'. Example: paging - ;; 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 ((orig-start start) next) (save-match-data ;; Fontify chunks beginning at START. The end of a @@ -400,58 +394,62 @@ Defaults to the whole buffer. END can be out of bounds." (setq next (or (text-property-any start end 'fontified t) end)) - ;; Fontify the chunk, and mark it as fontified. - ;; We mark it first, to make sure that we don't indefinitely - ;; re-execute this fontification if an error occurs. - (put-text-property start next 'fontified t) - (pcase-let - ;; `tight' is the part we've fully refontified, and `loose' - ;; is the part we've partly refontified (some of the - ;; functions have refontified it but maybe not all). - ((`(,tight-beg ,tight-end ,loose-beg ,_loose-end) - (condition-case err - (jit-lock--run-functions start next) - ;; If the user quits (which shouldn't happen in normal - ;; on-the-fly jit-locking), make sure the fontification - ;; will be performed before displaying the block again. - (quit (put-text-property start next 'fontified nil) - (signal (car err) (cdr err)))))) - - ;; In case we fontified more than requested, take advantage of the - ;; good news. - (when (or (< tight-beg start) (> tight-end next)) - (put-text-property tight-beg tight-end 'fontified t)) - - ;; Make sure the contextual refontification doesn't re-refontify - ;; what's already been refontified. - (when (and jit-lock-context-unfontify-pos - (< jit-lock-context-unfontify-pos tight-end) - (>= jit-lock-context-unfontify-pos tight-beg) - ;; Don't move boundary forward if we have to - ;; refontify previous text. Otherwise, we risk moving - ;; it past the end of the multiline property and thus - ;; forget about this multiline region altogether. - (not (get-text-property tight-beg - 'jit-lock-defer-multiline))) - (setq jit-lock-context-unfontify-pos tight-end)) - - ;; The redisplay engine has already rendered the buffer up-to - ;; `orig-start' and won't notice if the above jit-lock-functions - ;; changed the appearance of any part of the buffer prior - ;; to that. So if `loose-beg' is before `orig-start', we need to - ;; cause a new redisplay cycle after this one so that the changes - ;; are properly reflected on screen. - ;; To make such repeated redisplay happen less often, we can - ;; eagerly extend the refontified region with - ;; jit-lock-after-change-extend-region-functions. - (when (< loose-beg orig-start) - (run-with-timer 0 nil #'jit-lock-force-redisplay - (copy-marker loose-beg) - (copy-marker orig-start))) - - ;; Find the start of the next chunk, if any. - (setq start - (text-property-any tight-end end 'fontified nil))))))))) + ;; Avoid unnecessary work if the chunk is empty (bug#23278). + (when (> next start) + ;; Fontify the chunk, and mark it as fontified. + ;; We mark it first, to make sure that we don't indefinitely + ;; re-execute this fontification if an error occurs. + (put-text-property start next 'fontified t) + (pcase-let + ;; `tight' is the part we've fully refontified, and `loose' + ;; is the part we've partly refontified (some of the + ;; functions have refontified it but maybe not all). + ((`(,tight-beg ,tight-end ,loose-beg ,_loose-end) + (condition-case err + (jit-lock--run-functions start next) + ;; If the user quits (which shouldn't happen in normal + ;; on-the-fly jit-locking), make sure the fontification + ;; will be performed before displaying the block again. + (quit (put-text-property start next 'fontified nil) + (signal (car err) (cdr err)))))) + + ;; In case we fontified more than requested, take advantage of the + ;; good news. + (when (or (< tight-beg start) (> tight-end next)) + (put-text-property tight-beg tight-end 'fontified t)) + + ;; Make sure the contextual refontification doesn't re-refontify + ;; what's already been refontified. + (when (and jit-lock-context-unfontify-pos + (< jit-lock-context-unfontify-pos tight-end) + (>= jit-lock-context-unfontify-pos tight-beg) + ;; Don't move boundary forward if we have to + ;; refontify previous text. Otherwise, we risk moving + ;; it past the end of the multiline property and thus + ;; forget about this multiline region altogether. + (not (get-text-property tight-beg + 'jit-lock-defer-multiline))) + (setq jit-lock-context-unfontify-pos tight-end)) + + ;; The redisplay engine has already rendered the buffer up-to + ;; `orig-start' and won't notice if the above jit-lock-functions + ;; changed the appearance of any part of the buffer prior + ;; to that. So if `loose-beg' is before `orig-start', we need to + ;; cause a new redisplay cycle after this one so that the changes + ;; are properly reflected on screen. + ;; To make such repeated redisplay happen less often, we can + ;; eagerly extend the refontified region with + ;; jit-lock-after-change-extend-region-functions. + (when (< loose-beg orig-start) + (run-with-timer 0 nil #'jit-lock-force-redisplay + (copy-marker loose-beg) + (copy-marker orig-start))) + + ;; Skip to the end of the fully refontified part. + (setq start tight-end))) + ;; Find the start of the next chunk, if any. + (setq start + (text-property-any start end 'fontified nil)))))))) (defun jit-lock-force-redisplay (start end) "Force the display engine to re-render START's buffer from START to END. @@ -583,11 +581,13 @@ non-nil in a repeated invocation of this function." 'fontified nil)) (setq pos (next-single-property-change pos 'fontified))))))))) - (setq jit-lock-defer-buffers nil) ;; Force fontification of the visible parts. - (let ((jit-lock-defer-timer nil)) + (let ((buffers jit-lock-defer-buffers) + (jit-lock-defer-timer nil)) + (setq jit-lock-defer-buffers nil) ;; (message "Jit-Defer Now") - (sit-for 0) + (unless (redisplay) ;FIXME: Should we `force'? + (setq jit-lock-defer-buffers buffers)) ;; (message "Jit-Defer Done") )))