From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.io!.POSTED.blaine.gmane.org!not-for-mail From: Alan Mackenzie Newsgroups: gmane.emacs.devel Subject: Re: bug-reference-prog-mode slows down CC Mode's scrolling by ~7% Date: Sat, 4 Sep 2021 14:50:10 +0000 Message-ID: References: <83a6kuyysv.fsf@gnu.org> <837dfwyird.fsf@gnu.org> Mime-Version: 1.0 Content-Type: text/plain; charset=us-ascii Injection-Info: ciao.gmane.io; posting-host="blaine.gmane.org:116.202.254.214"; logging-data="21787"; mail-complaints-to="usenet@ciao.gmane.io" Cc: monnier@iro.umontreal.ca, emacs-devel@gnu.org To: Eli Zaretskii Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane-mx.org@gnu.org Sat Sep 04 16:51:33 2021 Return-path: Envelope-to: ged-emacs-devel@m.gmane-mx.org Original-Received: from lists.gnu.org ([209.51.188.17]) by ciao.gmane.io with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.92) (envelope-from ) id 1mMX13-0005Tx-2D for ged-emacs-devel@m.gmane-mx.org; Sat, 04 Sep 2021 16:51:33 +0200 Original-Received: from localhost ([::1]:60102 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1mMX11-0006Yk-Kr for ged-emacs-devel@m.gmane-mx.org; Sat, 04 Sep 2021 10:51:31 -0400 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]:38294) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1mMWzn-00056E-Rw for emacs-devel@gnu.org; Sat, 04 Sep 2021 10:50:16 -0400 Original-Received: from colin.muc.de ([193.149.48.1]:18457 helo=mail.muc.de) by eggs.gnu.org with smtp (Exim 4.90_1) (envelope-from ) id 1mMWzk-0002RY-RV for emacs-devel@gnu.org; Sat, 04 Sep 2021 10:50:15 -0400 Original-Received: (qmail 50019 invoked by uid 3782); 4 Sep 2021 14:50:10 -0000 Original-Received: from acm.muc.de (p2e5d5226.dip0.t-ipconnect.de [46.93.82.38]) (using STARTTLS) by colin.muc.de (tmda-ofmipd) with ESMTP; Sat, 04 Sep 2021 16:50:10 +0200 Original-Received: (qmail 5392 invoked by uid 1000); 4 Sep 2021 14:50:10 -0000 Content-Disposition: inline In-Reply-To: <837dfwyird.fsf@gnu.org> X-Submission-Agent: TMDA/1.3.x (Ph3nix) X-Primary-Address: acm@muc.de Received-SPF: pass client-ip=193.149.48.1; envelope-from=acm@muc.de; helo=mail.muc.de X-Spam_score_int: -18 X-Spam_score: -1.9 X-Spam_bar: - X-Spam_report: (-1.9 / 5.0 requ) BAYES_00=-1.9, SPF_HELO_NONE=0.001, SPF_PASS=-0.001 autolearn=ham autolearn_force=no X-Spam_action: no action X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.1.23 Precedence: list List-Id: "Emacs development discussions." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: emacs-devel-bounces+ged-emacs-devel=m.gmane-mx.org@gnu.org Original-Sender: "Emacs-devel" Xref: news.gmane.io gmane.emacs.devel:273892 Archived-At: 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 > > 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).