From a413d93c6215710c669912e3ed7d5e02857b5635 Mon Sep 17 00:00:00 2001 From: Mauro Aranda 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