Subject: bug#53606: 29.0.50; Very slow Customize buffer for bibtex-biblatex-entry-alist

From: Mauro Aranda <[email-masked]>
Date: Mon, 18 Sep 2023 08:07:08 -0300

On 10/9/23 09:41, Mauro Aranda wrote:
 > On 10/9/23 07:43, Eli Zaretskii wrote:
 > >> Date: Sun, 10 Sep 2023 06:49:29 -0300
 > >> Cc: [email-masked]
 > >> From: Mauro Aranda <[email-masked]>
 > >>
 > >> On 10/9/23 02:01, Eli Zaretskii wrote:
 > >>  > Could you please profile this slow operation and post the 
completely
 > >>  > unfolded profile?  I think we should try to understand what exactly
 > >>  > takes so much time in this case.
 > >>
 > >> Here it is.  I also attach the result of C-x C-w in the report buffer,
 > >> just in case.
 > >
 > > So the hot spot seems to be widget-checklist-add-item, is that right?
 >
 > I think so.  The checklist widgets were my first suspects, since
 > creating them is rather slow.
 >
 > > And inside that widget-create-child and widget-apply?
 >
 > I don't think those functions could be the bottleneck.  Most likely it
 > is the widget-default-create function that those functions end up
 > calling.  So yes, widget-default-create in general, and
 > widget-checklist-value-create in particular should be investigated for
 > speeding them up, but I don't have any ideas at the moment.

I focused on the format handling, since there's no need to insert the
escape formats in the buffer.  So I rearranged the 4 functions that
handle the format to avoid it and here are the figures I got, when
running:
(benchmark-run 5
   (customize-option 'bibtex-biblatex-entry-alist))

 From master, inserting either :format or :entry-format:
(130.200276352 291 3.1221133909999996)

Without inserting it:
(38.244185927000004 266 2.795578699)

| How?                 | Total elapsed time (5 repetitions) | Avg | 
Times faster |
|----------------------+------------------------------------+-------+--------------|
| inserting format     |                             130.20 | 26.04 
|            1 |
| not inserting format |                              38.24 | 7.65 
|          3.4 |

All data is without native compilation.  I'd appreciate if someone could
at least run it once with native compilation, with and without my patch.

I attach a patch with the changes, and the new profiler report, but I'm
inclined to leave it as it is if the patch gets accepted.
From a413d93c6215710c669912e3ed7d5e02857b5635 Mon Sep 17 00:00:00 2001
From: Mauro Aranda <[email-masked]>
Date: Sun, 17 Sep 2023 21:00:02 -0300
Subject: [PATCH] Speed up widget creation (Bug#53606)

* lisp/wid-edit.el (widget-default-create, widget-checklist-add-item)
(widget-radio-add-item, widget-editable-list-entry-create): Don't
insert format escapes into the buffer, only to delete them after.
This avoids calls to delete-char and makes widget creation about 3
times faster.
---
 lisp/wid-edit.el | 252 +++++++++++++++++++++++++----------------------
 1 file changed, 136 insertions(+), 116 deletions(-)

diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el
index 74412414113..e9ad4f3855e 100644
--- a/lisp/wid-edit.el
+++ b/lisp/wid-edit.el
@@ -1670,78 +1670,85 @@ widget-default-completions
 (defun widget-default-create (widget)
   "Create WIDGET at point in the current buffer."
   (widget-specify-insert
-   (let ((from (point))
-	 button-begin button-end
-	 sample-begin sample-end
-	 doc-begin doc-end
-	 value-pos)
-     (insert (widget-get widget :format))
-     (goto-char from)
+   (let ((str (widget-get widget :format))
+         (onext 0) (next 0)
+         button-begin button-end
+         sample-begin sample-end
+         doc-begin doc-end
+         value-pos)
      ;; Parse escapes in format.
-     (while (re-search-forward "%\\(.\\)" nil t)
-       (let ((escape (char-after (match-beginning 1))))
-	 (delete-char -2)
-	 (cond ((eq escape ?%)
-		(insert ?%))
-	       ((eq escape ?\[)
-		(setq button-begin (point))
-		(insert (widget-get-indirect widget :button-prefix)))
-	       ((eq escape ?\])
-		(insert (widget-get-indirect widget :button-suffix))
-		(setq button-end (point)))
-	       ((eq escape ?\{)
-		(setq sample-begin (point)))
-	       ((eq escape ?\})
-		(setq sample-end (point)))
-	       ((eq escape ?n)
-		(when (widget-get widget :indent)
-		  (insert ?\n)
-		  (insert-char ?\s (widget-get widget :indent))))
-	       ((eq escape ?t)
-		(let ((image (widget-get widget :tag-glyph))
-		      (tag (substitute-command-keys
-			    (widget-get widget :tag))))
-		  (cond (image
-			 (widget-image-insert widget (or tag "image") image))
-			(tag
-			 (insert tag))
-			(t
-			 (princ (widget-get widget :value)
-				(current-buffer))))))
-	       ((eq escape ?d)
-		(let ((doc (widget-get widget :doc)))
-		  (when doc
-		    (setq doc-begin (point))
-		    (insert (substitute-command-keys doc))
-		    (while (eq (preceding-char) ?\n)
-		      (delete-char -1))
-		    (insert ?\n)
-		    (setq doc-end (point)))))
-	       ((eq escape ?h)
-		(widget-add-documentation-string-button widget))
-	       ((eq escape ?v)
-		(if (and button-begin (not button-end))
-		    (widget-apply widget :value-create)
-		  (setq value-pos (point))))
-	       (t
-		(widget-apply widget :format-handler escape)))))
+     (while (string-match "%\\(.\\)" str next)
+       (setq next (match-end 1))
+       ;; If we skipped some literal text, insert it.
+       (when (/= (- next onext) 2)
+         (insert (substring str onext (- next 2))))
+       (let ((escape (string-to-char (match-string 1 str))))
+         (cond ((eq escape ?%)
+                (insert ?%))
+               ((eq escape ?\[)
+                (setq button-begin (point))
+                (insert (widget-get-indirect widget :button-prefix)))
+               ((eq escape ?\])
+                (insert (widget-get-indirect widget :button-suffix))
+                (setq button-end (point)))
+               ((eq escape ?\{)
+                (setq sample-begin (point)))
+               ((eq escape ?\})
+                (setq sample-end (point)))
+               ((eq escape ?n)
+                (when (widget-get widget :indent)
+                  (insert ?\n)
+                  (insert-char ?\s (widget-get widget :indent))))
+               ((eq escape ?t)
+                (let ((image (widget-get widget :tag-glyph))
+                      (tag (substitute-command-keys
+                            (widget-get widget :tag))))
+                  (cond (image
+                         (widget-image-insert widget
+                                              (or tag "image") image))
+                        (tag
+                         (insert tag))
+                        (t
+                         (princ (widget-get widget :value)
+                                (current-buffer))))))
+               ((eq escape ?d)
+                (let ((doc (widget-get widget :doc)))
+                  (when doc
+                    (setq doc-begin (point))
+                    (insert (substitute-command-keys doc))
+                    (while (eq (preceding-char) ?\n)
+                      (delete-char -1))
+                    (insert ?\n)
+                    (setq doc-end (point)))))
+               ((eq escape ?h)
+                (widget-add-documentation-string-button widget))
+               ((eq escape ?v)
+                (if (and button-begin (not button-end))
+                    (widget-apply widget :value-create)
+                  (setq value-pos (point))))
+               (t
+                (widget-apply widget :format-handler escape))))
+       (setq onext next))
+     ;; Insert remaining literal text, if any.
+     (when (> (length str) next)
+       (insert (substring str next)))
      ;; Specify button, sample, and doc, and insert value.
      (and button-begin button-end
-	  (widget-specify-button widget button-begin button-end))
+          (widget-specify-button widget button-begin button-end))
      (and sample-begin sample-end
-	  (widget-specify-sample widget sample-begin sample-end))
+          (widget-specify-sample widget sample-begin sample-end))
      (and doc-begin doc-end
-	  (widget-specify-doc widget doc-begin doc-end))
+          (widget-specify-doc widget doc-begin doc-end))
      (when value-pos
        (goto-char value-pos)
        (widget-apply widget :value-create)))
    (let ((from (point-min-marker))
-	 (to (point-max-marker)))
+         (to (point-max-marker)))
      (set-marker-insertion-type from t)
      (set-marker-insertion-type to nil)
      (widget-put widget :from from)
-     (widget-put widget :to to)))
-  (widget-clear-undo))
+     (widget-put widget :to to))
+   (widget-clear-undo)))
 
 (defun widget-default-format-handler (_widget escape)
   (error "Unknown escape `%c'" escape))
@@ -2464,14 +2471,15 @@ widget-checklist-add-item
 	  (buttons (widget-get widget :buttons))
 	  (button-args (or (widget-get type :sibling-args)
 			   (widget-get widget :button-args)))
-	  (from (point))
+          (str (widget-get widget :entry-format))
+          (onext 0) (next 0)
 	  child button)
-     (insert (widget-get widget :entry-format))
-     (goto-char from)
      ;; Parse % escapes in format.
-     (while (re-search-forward "%\\([bv%]\\)" nil t)
-       (let ((escape (char-after (match-beginning 1))))
-	 (delete-char -2)
+     (while (string-match "%\\([bv%]\\)" str next)
+       (setq next (match-end 1))
+       (when (/= (- next onext) 2)
+         (insert (substring str onext (- next 2))))
+       (let ((escape (string-to-char (match-string 1 str))))
 	 (cond ((eq escape ?%)
 		(insert ?%))
 	       ((eq escape ?b)
@@ -2492,7 +2500,10 @@ widget-checklist-add-item
 			     (widget-create-child-value
 			      widget type (car (cdr chosen)))))))
 	       (t
-		(error "Unknown escape `%c'" escape)))))
+                (error "Unknown escape `%c'" escape))))
+       (setq onext next))
+     (when (> (length str) next)
+       (insert (substring str next)))
      ;; Update properties.
      (and button child (widget-put child :button button))
      (and button (widget-put widget :buttons (cons button buttons)))
@@ -2646,16 +2657,17 @@ widget-radio-add-item
 	  (buttons (widget-get widget :buttons))
 	  (button-args (or (widget-get type :sibling-args)
 			   (widget-get widget :button-args)))
-	  (from (point))
+          (str (widget-get widget :entry-format))
+          (onext 0) (next 0)
 	  (chosen (and (null (widget-get widget :choice))
 		       (widget-apply type :match value)))
 	  child button)
-     (insert (widget-get widget :entry-format))
-     (goto-char from)
      ;; Parse % escapes in format.
-     (while (re-search-forward "%\\([bv%]\\)" nil t)
-       (let ((escape (char-after (match-beginning 1))))
-	 (delete-char -2)
+     (while (string-match "%\\([bv%]\\)" str next)
+       (setq next (match-end 1))
+       (when (/= (- next onext) 2)
+         (insert (substring str onext (- next 2))))
+       (let ((escape (string-to-char (match-string 1 str))))
 	 (cond ((eq escape ?%)
 		(insert ?%))
 	       ((eq escape ?b)
@@ -2671,7 +2683,10 @@ widget-radio-add-item
 		(unless chosen
 		  (widget-apply child :deactivate)))
 	       (t
-		(error "Unknown escape `%c'" escape)))))
+                (error "Unknown escape `%c'" escape))))
+       (setq onext next))
+     (when (> (length str) next)
+       (insert (substring str next)))
      ;; Update properties.
      (when chosen
        (widget-put widget :choice type))
@@ -2948,51 +2963,56 @@ widget-editable-list-entry-create
   ;; Create a new entry to the list.
   (let ((type (nth 0 (widget-get widget :args)))
 	;; (widget-push-button-gui widget-editable-list-gui)
+        (str (widget-get widget :entry-format))
+        (onext 0) (next 0)
 	child delete insert)
     (widget-specify-insert
-     (save-excursion
-       (and (widget--should-indent-p)
-            (widget-get widget :indent)
-            (insert-char ?\s (widget-get widget :indent)))
-       (insert (widget-get widget :entry-format)))
-     ;; Parse % escapes in format.
-     (while (re-search-forward "%\\(.\\)" nil t)
-       (let ((escape (char-after (match-beginning 1))))
-	 (delete-char -2)
-	 (cond ((eq escape ?%)
-		(insert ?%))
-	       ((eq escape ?i)
-		(setq insert (apply 'widget-create-child-and-convert
-				    widget 'insert-button
-				    (widget-get widget :insert-button-args))))
-	       ((eq escape ?d)
-		(setq delete (apply 'widget-create-child-and-convert
-				    widget 'delete-button
-				    (widget-get widget :delete-button-args))))
-	       ((eq escape ?v)
-		(if conv
-		    (setq child (widget-create-child-value
-				 widget type value))
-		  (setq child (widget-create-child-value
-			       widget type (widget-default-get type)))))
-	       (t
-		(error "Unknown escape `%c'" escape)))))
-     (let ((buttons (widget-get widget :buttons)))
-       (if insert (push insert buttons))
-       (if delete (push delete buttons))
-       (widget-put widget :buttons buttons))
-     ;; After creating the entry, we must check if we should indent the
-     ;; following entry.  This is necessary, for example, to keep the correct
-     ;; indentation of editable lists inside group widgets.
-     (and (widget--should-indent-p t)
+     (and (widget--should-indent-p)
           (widget-get widget :indent)
-          (insert-char ?\s (widget-get widget :indent)))
-     (let ((entry-from (point-min-marker))
-	   (entry-to (point-max-marker)))
-       (set-marker-insertion-type entry-from t)
-       (set-marker-insertion-type entry-to nil)
-       (widget-put child :entry-from entry-from)
-       (widget-put child :entry-to entry-to)))
+          (insert-char ?\s (widget-get widget :indent))))
+    ;; Parse % escapes in format.
+    (while (string-match "%\\(.\\)" str next)
+      (setq next (match-end 1))
+      (when (/= (- next onext) 2)
+        (insert (substring str onext (- next 2))))
+      (let ((escape (string-to-char (match-string 1 str))))
+        (cond ((eq escape ?%)
+               (insert ?%))
+              ((eq escape ?i)
+               (setq insert (apply 'widget-create-child-and-convert
+                                   widget 'insert-button
+                                   (widget-get widget :insert-button-args))))
+              ((eq escape ?d)
+               (setq delete (apply 'widget-create-child-and-convert
+                                   widget 'delete-button
+                                   (widget-get widget :delete-button-args))))
+              ((eq escape ?v)
+               (if conv
+                   (setq child (widget-create-child-value
+                                widget type value))
+                 (setq child (widget-create-child-value
+                              widget type (widget-default-get type)))))
+              (t
+               (error "Unknown escape `%c'" escape))))
+      (setq onext next))
+    (when (> (length str) next)
+      (insert (substring str next)))
+    (let ((buttons (widget-get widget :buttons)))
+      (if insert (push insert buttons))
+      (if delete (push delete buttons))
+      (widget-put widget :buttons buttons))
+    ;; After creating the entry, we must check if we should indent the
+    ;; following entry.  This is necessary, for example, to keep the correct
+    ;; indentation of editable lists inside group widgets.
+    (and (widget--should-indent-p t)
+         (widget-get widget :indent)
+         (insert-char ?\s (widget-get widget :indent)))
+    (let ((entry-from (point-min-marker))
+          (entry-to (point-max-marker)))
+      (set-marker-insertion-type entry-from t)
+      (set-marker-insertion-type entry-to nil)
+      (widget-put child :entry-from entry-from)
+      (widget-put child :entry-to entry-to))
     (if insert (widget-put insert :widget child))
     (if delete (widget-put delete :widget child))
     child))
-- 
2.34.1