From: Alan Mackenzie <acm@muc.de>
To: Eli Zaretskii <eliz@gnu.org>
Cc: monnier@iro.umontreal.ca, emacs-devel@gnu.org
Subject: Re: bug-reference-prog-mode slows down CC Mode's scrolling by ~7%
Date: Sat, 4 Sep 2021 14:50:10 +0000 [thread overview]
Message-ID: <YTOHorezJ5Lz+S/o@ACM> (raw)
In-Reply-To: <837dfwyird.fsf@gnu.org>
Hello, Eli.
On Sat, Sep 04, 2021 at 09:09:10 +0300, Eli Zaretskii wrote:
> > Date: Fri, 3 Sep 2021 20:51:22 +0000
> > Cc: monnier@iro.umontreal.ca, emacs-devel@gnu.org
> > From: Alan Mackenzie <acm@muc.de>
> > OK, I've hacked up a trial implementation, though I haven't started
> > testing it yet. The key is to extract jit-lock--fontify-now-1 from
> > jit-lock-fontify-now, and have it call itself recursively to handle the
> > expansion of the region caused by a jit-lock-bounds returned by the
> > second or later function.
> > This should be easy to test and verify as correct, yet the recursion
> > should be invoked rarely enough that it won't lead to inefficiencies.
> > This implementation should resolve Eli's concerns about handling two
> > or more "first" functions in jit-lock-functions.
> Thanks.
OK, here's a working patch. When I run my favourite benchmark,
time-scroll on xdisp.c, ....
(defmacro time-it (&rest forms)
"Time the running of a sequence of forms using `float-time'.
Call like this: \"M-: (time-it (foo ...) (bar ...) ...)\"."
`(let ((start (float-time)))
,@forms
(- (float-time) start)))
(defun time-scroll (&optional arg)
(interactive "P")
(message "%s"
(time-it
(condition-case nil
(while t
(if arg (scroll-down) (scroll-up))
(sit-for 0))
(error nil)))))
..... it takes 21.2s.
This is with jit-lock-functions set to
(font-lock-fontify-region bug-reference-fontify t)
.. However, with the order of these functions reversed:
(bug-reference-fontify font-lock-fontify-region t)
, it takes 27.9s. So it would seem the cost of having a jit-lock
function returning a jit-lock-bounds structure when it's not the first
function is high. That's using the strategy of a full refontification of
the "extra" regions of the buffer returned in that structure. Maybe that
strategy is not optimal.
Here's the current version of the patch:
diff --git a/lisp/jit-lock.el b/lisp/jit-lock.el
index a1287926eb..0c71201e6b 100644
--- a/lisp/jit-lock.el
+++ b/lisp/jit-lock.el
@@ -378,28 +378,90 @@ jit-lock-function
'fontified 'defer)))))
(defun jit-lock--run-functions (beg end)
- (let ((tight-beg nil) (tight-end nil)
- (loose-beg beg) (loose-end end))
+ (let ((tight-beg nil) (tight-end nil) ; The region we have fully fontified.
+ (loose-beg beg) (loose-end end)) ; The maximum region we have fontified
+ ; with at least some of
+ ; `jit-lock-functions'.
(run-hook-wrapped
'jit-lock-functions
(lambda (fun)
(pcase-let*
- ((res (funcall fun beg end))
+ ;; The first function in `jit-lock-functions' can expand
+ ;; the region into `tight-beg' and `tight-end'. These
+ ;; arguments are passed to the next function (if any).
+ ;; Subsequently, the expanded region from any function is
+ ;; stored in `loose-beg' and `loose-end', and is likewise
+ ;; passed to the next function.
+ ((res (funcall fun loose-beg loose-end))
(`(,this-beg . ,this-end)
(if (eq (car-safe res) 'jit-lock-bounds)
(cdr res) (cons beg end))))
- ;; If all functions don't fontify the same region, we currently
- ;; just try to "still be correct". But we could go further and for
- ;; the chunks of text that was fontified by some functions but not
- ;; all, we could add text-properties indicating which functions were
- ;; already run to avoid running them redundantly when we get to
- ;; those chunks.
- (setq tight-beg (max (or tight-beg (point-min)) this-beg))
- (setq tight-end (min (or tight-end (point-max)) this-end))
+ (or tight-beg (setq tight-beg (min this-beg beg)))
+ (or tight-end (setq tight-end (max this-end end)))
(setq loose-beg (min loose-beg this-beg))
(setq loose-end (max loose-end this-end))
nil)))
- `(,(min tight-beg beg) ,(max tight-end end) ,loose-beg ,loose-end)))
+ `(,(or tight-beg beg) ,(or tight-end end) ,loose-beg ,loose-end)))
+
+(defun jit-lock--fontify-now-1 (start end)
+ "Fontify current buffer from START to END, possibly more.
+Return the list (RES-START RES-END), the entire region which was fontified."
+ (let ((res-start start) (res-end end) next)
+ ;; Fontify chunks beginning at START. The end of a chunk is
+ ;; either `end', or the start of a region before `end' that has
+ ;; already been fontified.
+ (while (and start (< start end))
+ ;; Determine the end of this chunk.
+ (setq next (or (text-property-any start end 'fontified t)
+ end))
+
+ ;; 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))
+
+ ;; If we've partially fontified (i.e. only run some
+ ;; `jit-lock-functions' on parts of the buffer beyond (START
+ ;; END), refontify those parts entirely.
+ (when (< loose-beg tight-beg)
+ (pcase-let
+ ((`(,sub-beg ,_)
+ (jit-lock--fontify-now-1 loose-beg tight-beg)))
+ (setq tight-beg sub-beg)))
+ (when (> loose-end tight-end)
+ (pcase-let
+ ((`(,_ ,sub-end)
+ (jit-lock--fontify-now-1 tight-end loose-end)))
+ (setq tight-end sub-end)))
+
+ (setq res-start (min res-start tight-beg)
+ res-end (max res-end tight-end))))
+
+ ;; Skip to the end of the fully refontified part.
+ (setq start next)
+ ;; Find the start of the next chunk, if any.
+ (setq start (text-property-any start end 'fontified nil)))
+
+ (list res-start res-end)))
(defun jit-lock-fontify-now (&optional start end)
"Fontify current buffer from START to END.
@@ -408,72 +470,39 @@ jit-lock-fontify-now
(save-excursion
(unless start (setq start (point-min)))
(setq end (if end (min end (point-max)) (point-max)))
- (let ((orig-start start) next)
- (save-match-data
- ;; Fontify chunks beginning at START. The end of a
- ;; chunk is either `end', or the start of a region
- ;; before `end' that has already been fontified.
- (while (and start (< start end))
- ;; Determine the end of this chunk.
- (setq next (or (text-property-any start end 'fontified t)
- end))
-
- ;; 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))))))))
+ (save-match-data
+ (let ((orig-start start))
+ (pcase-let
+ ;; `tight' is the part we've fully refontified.
+ ((`(,tight-beg ,tight-end)
+ (jit-lock--fontify-now-1 start end)))
+
+ ;; 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 `tight-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 (< tight-beg orig-start)
+ (run-with-timer 0 nil #'jit-lock-force-redisplay
+ (copy-marker tight-beg)
+ (copy-marker orig-start)))))))))
(defun jit-lock-force-redisplay (start end)
"Force the display engine to re-render START's buffer from START to END.
--
Alan Mackenzie (Nuremberg, Germany).
next prev parent reply other threads:[~2021-09-04 14:50 UTC|newest]
Thread overview: 74+ messages / expand[flat|nested] mbox.gz Atom feed top
2021-09-01 17:33 bug-reference-prog-mode slows down CC Mode's scrolling by ~7% Alan Mackenzie
2021-09-01 17:44 ` Eli Zaretskii
2021-09-01 17:55 ` Alan Mackenzie
2021-09-01 18:01 ` Eli Zaretskii
2021-09-01 18:20 ` Alan Mackenzie
2021-09-01 18:28 ` Eli Zaretskii
2021-09-01 19:19 ` Alan Mackenzie
2021-09-01 20:59 ` Stefan Monnier
2021-09-02 6:26 ` Eli Zaretskii
2021-09-02 16:57 ` Alan Mackenzie
2021-09-02 18:46 ` Stefan Monnier
2021-09-02 19:24 ` Alan Mackenzie
2021-09-02 21:08 ` Alan Mackenzie
2021-09-03 6:16 ` Eli Zaretskii
2021-09-03 12:30 ` Stefan Monnier
2021-09-03 12:38 ` Eli Zaretskii
2021-09-03 22:25 ` Stefan Monnier
2021-09-04 6:13 ` Eli Zaretskii
2021-09-04 13:36 ` Stefan Monnier
2021-09-04 13:55 ` Eli Zaretskii
2021-09-04 14:44 ` Stefan Monnier
2021-09-04 14:56 ` Eli Zaretskii
2021-09-04 15:55 ` Stefan Monnier
2021-09-04 16:12 ` Eli Zaretskii
2021-09-04 16:24 ` Stefan Monnier
2021-09-04 16:28 ` Eli Zaretskii
2021-09-04 16:40 ` Stefan Monnier
2021-09-03 6:10 ` Eli Zaretskii
2021-09-03 10:47 ` Alan Mackenzie
2021-09-03 11:24 ` Eli Zaretskii
2021-09-03 16:15 ` Alan Mackenzie
2021-09-03 12:27 ` Stefan Monnier
2021-09-03 12:19 ` Stefan Monnier
2021-09-03 12:35 ` Eli Zaretskii
2021-09-03 16:52 ` Alan Mackenzie
2021-09-03 20:51 ` Alan Mackenzie
2021-09-04 6:09 ` Eli Zaretskii
2021-09-04 14:50 ` Alan Mackenzie [this message]
2021-09-04 15:00 ` Stefan Monnier
2021-09-04 15:32 ` Alan Mackenzie
2021-09-04 15:36 ` Eli Zaretskii
2021-09-04 15:43 ` Alan Mackenzie
2021-09-04 15:48 ` Eli Zaretskii
2021-09-04 16:05 ` Alan Mackenzie
2021-09-04 16:15 ` Eli Zaretskii
2021-09-06 10:46 ` Alan Mackenzie
2021-09-06 11:10 ` Eli Zaretskii
2021-09-06 19:08 ` Alan Mackenzie
2021-09-06 19:23 ` Eli Zaretskii
2021-09-18 11:37 ` Alan Mackenzie
2021-09-18 11:59 ` Eli Zaretskii
2021-09-06 21:59 ` andrés ramírez
2021-09-07 19:47 ` Alan Mackenzie
2021-09-07 17:57 ` andrés ramírez
2021-09-06 13:24 ` Stefan Monnier
2021-09-04 16:06 ` Stefan Monnier
2021-09-04 16:23 ` Eli Zaretskii
2021-09-04 16:39 ` Stefan Monnier
2021-09-04 17:19 ` Eli Zaretskii
2021-09-04 17:47 ` Stefan Monnier
2021-09-04 18:10 ` Eli Zaretskii
2021-09-04 18:40 ` Stefan Monnier
2021-09-11 12:49 ` Eli Zaretskii
2021-09-11 17:04 ` Stefan Monnier
2021-09-11 17:17 ` Eli Zaretskii
2021-09-11 18:00 ` Stefan Monnier
2021-09-11 18:16 ` Eli Zaretskii
2021-09-11 19:55 ` Stefan Monnier
2021-09-12 3:51 ` Eli Zaretskii
2021-09-12 16:41 ` Stefan Monnier
2021-09-12 16:53 ` Eli Zaretskii
2021-09-12 17:41 ` Stefan Monnier
2021-09-12 17:55 ` Eli Zaretskii
2021-09-12 21:11 ` Stefan Monnier
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://www.gnu.org/software/emacs/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=YTOHorezJ5Lz+S/o@ACM \
--to=acm@muc.de \
--cc=eliz@gnu.org \
--cc=emacs-devel@gnu.org \
--cc=monnier@iro.umontreal.ca \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/emacs.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).