From 424103a6e351a6d2d8b94f86998c90fdf6afea27 Mon Sep 17 00:00:00 2001 From: Alan Mackenzie Date: Tue, 3 Apr 2018 16:16:49 +0000 Subject: [PATCH] Introduce new macro combine-change-calls This macro is a bit like combine-after-change-calls, but also works with a non-null before-change-functions. It suppresses the operation of the change hooks on a possibly large sequence of buffer modifications, replacing them with a single invocation of before-change-functions at the start, and a single invocation of after-change-functions at the end. * lisp/subr.el (undo--combining-change-calls): New variable. (combine-change-calls-1, undo--wrap-and-run-primitive-undo): New functions. (combine-change-calls): New macro. * doc/lispref/text.texi (Change Hooks): Document combine-change-calls. * etc/NEWS: Add an entry under "Lisp Changes" for combine-change-calls. --- doc/lispref/text.texi | 28 ++++++++++- etc/NEWS | 7 +++ lisp/subr.el | 113 ++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 146 insertions(+), 2 deletions(-) diff --git a/doc/lispref/text.texi b/doc/lispref/text.texi index e992c0f561d..ebfa8b9b0f8 100644 --- a/doc/lispref/text.texi +++ b/doc/lispref/text.texi @@ -5136,8 +5136,8 @@ making. When that happens, the arguments to individual changes are made, but won't necessarily be the minimal such region, and the arguments to each successive call of @code{after-change-functions} will then delimit the part of text being -changed exactly. In general, we advise to use either before- or the -after-change hooks, but not both. +changed exactly. In general, we advise using either the before- or +the after-change hook, but not both. @defmac combine-after-change-calls body@dots{} The macro executes @var{body} normally, but arranges to call the @@ -5161,6 +5161,30 @@ because it may lead to inefficient behavior for some change hook functions. @end defmac +@defmac combine-change-calls beg end body@dots{} +This executes @var{body} normally, except any buffer changes it makes +do not trigger the calls to @code{before-change-functions} and +@code{after-change-functions}. Instead there is a single call of each +of these hooks for the region enclosed by @var{beg} and @var{end}, the +parameters supplied to @code{after-change-functions} reflecting the +changes made to the size of the region by @var{body}. + +The result of this macro is the result returned by @var{body}. + +This macro is useful when a function makes a possibly large number of +repetitive changes to the buffer, and the change hooks would otherwise +take a long time to run, were they to be run for each individual +buffer modification. Emacs itself uses this macro, for example, in +the commands @code{comment-region} and @code{uncomment-region}. + +@strong{Warning:} You must not alter the values of +@code{before-change-functions} or @code{after-change-function} within +@var{body}. + +@strong{Warning:} You must not make any buffer changes outside of the +region specified by @var{beg} and @var{end}. +@end defmac + @defvar first-change-hook This variable is a normal hook that is run whenever a buffer is changed that was previously in the unmodified state. diff --git a/etc/NEWS b/etc/NEWS index 7dc014707b3..2caeebe174c 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -451,6 +451,13 @@ socket has been pased to Emacs (Bug#24218). instead of just Microsoft platforms. This fixes a 'get-free-disk-space' bug on OS X 10.8 and later (Bug#28639). ++++ +** New macro combine-change-calls arranges to call the change hooks +('before-change-functions' and 'after-change-functions') just once +each around a sequence of lisp forms, given a region. This is +useful when a function makes a possibly large number of repetitive +changes and the change hooks are time consuming. + --- ** The function 'get-free-disk-space' returns now a non-nil value for remote systems, which support this check. diff --git a/lisp/subr.el b/lisp/subr.el index cfaa8aa4e54..98724e9413e 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -3572,6 +3572,119 @@ in BODY." . ,body) (combine-after-change-execute))) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(defvar undo--combining-change-calls nil + "Non-nil when `combine-change-calls-1' is running.") + +(defun combine-change-calls-1 (beg end body) + "Evaluate BODY, running the change hooks just once, for region \(BEG END). + +Firstly, `before-change-functions' is invoked for the region +\(BEG END), then BODY (a function) is evaluated with +`before-change-functions' and `after-change-functions' bound to +nil, then finally `after-change-functions' is invoked on the +updated region (BEG NEW-END) with a calculated OLD-LEN argument. +If `inhibit-modification-hooks' is initially non-nil, the change +hooks are not run. + +The result of `combine-change-calls-1' is the value returned by +BODY. BODY must not make a different buffer current, except +temporarily. It must not make any changes to the buffer outside +the specified region. It must not change +`before-change-functions' or `after-change-functions'. + +Additionally, the buffer modifications of BODY are recorded on +the buffer's undo list as a single \(apply ...) entry containing +the function `undo--wrap-and-run-primitive-undo'." + (let ((old-bul buffer-undo-list) + (end-marker (copy-marker end t)) + result) + (if undo--combining-change-calls + (setq result (funcall body)) + (let ((undo--combining-change-calls t)) + (if (not inhibit-modification-hooks) + (run-hook-with-args 'before-change-functions beg end)) + (if (eq buffer-undo-list t) + (setq result (funcall body)) + (let (;; (inhibit-modification-hooks t) + before-change-functions after-change-functions) + (setq result (funcall body))) + (let ((ap-elt + (list 'apply + (- end end-marker) + beg + (marker-position end-marker) + #'undo--wrap-and-run-primitive-undo + beg (marker-position end-marker) buffer-undo-list)) + (ptr buffer-undo-list)) + (if (not (eq buffer-undo-list old-bul)) + (progn + (while (and (not (eq (cdr ptr) old-bul)) + ;; In case garbage collection has removed OLD-BUL. + (cdr ptr) + ;; Don't include a timestamp entry. + (not (and (consp (cdr ptr)) + (consp (cadr ptr)) + (eq (caadr ptr) t) + (setq old-bul (cdr ptr))))) + (setq ptr (cdr ptr))) + (unless (cdr ptr) + (message "combine-change-calls: buffer-undo-list broken")) + (setcdr ptr nil) + (push ap-elt buffer-undo-list) + (setcdr buffer-undo-list old-bul))))) + (if (not inhibit-modification-hooks) + (run-hook-with-args 'after-change-functions + beg (marker-position end-marker) + (- end beg))))) + (set-marker end-marker nil) + result)) + +(defmacro combine-change-calls (beg end &rest body) + "Evaluate BODY, running the change hooks just once. + +BODY is a sequence of lisp forms to evaluate. BEG and END bound +the region the change hooks will be run for. + +Firstly, `before-change-functions' is invoked for the region +\(BEG END), then the BODY forms are evaluated with +`before-change-functions' and `after-change-functions' bound to +nil, and finally `after-change-functions' is invoked on the +updated region. The change hooks are not run if +`inhibit-modification-hooks' is initially non-nil. + +The result of `combine-change-calls' is the value returned by the +last of the BODY forms to be evaluated. BODY may not make a +different buffer current, except temporarily. BODY may not +change the buffer outside the specified region. It must not +change `before-change-functions' or `after-change-functions'. + +Additionally, the buffer modifications of BODY are recorded on +the buffer's undo list as a single \(apply ...) entry containing +the function `undo--wrap-and-run-primitive-undo'. " + `(combine-change-calls-1 ,beg ,end (lambda () ,@body))) + +(defun undo--wrap-and-run-primitive-undo (beg end list) + "Call `primitive-undo' on the undo elements in LIST. + +This function is intended to be called purely by `undo' as the +function in an \(apply DELTA BEG END FUNNAME . ARGS) undo +element. It invokes `before-change-functions' and +`after-change-functions' once each for the entire region \(BEG +END) rather than once for each individual change. + +Additionally the fresh \"redo\" elements which are generated on +`buffer-undo-list' will themselves be \"enclosed\" in +`undo--wrap-and-run-primitive-undo'. + +Undo elements of this form are generated by the macro +`combine-change-calls'." + (combine-change-calls beg end + (while list + (setq list (primitive-undo 1 list))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + (defmacro with-case-table (table &rest body) "Execute the forms in BODY with TABLE as the current case table. The value returned is the value of the last form in BODY." -- 2.39.2