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.

diff --git a/doc/lispref/text.texi b/doc/lispref/text.texi
index e992c0f561da462c0e781548eeaf4d4cae264b1e..ebfa8b9b0f8566c7010e399313e7b5d64b994036 100644 (file)
--- 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 7dc014707b3547f97269677817768a700a568d7d..2caeebe174ce5d1303d647b65c1b31ada0f54ddf 100644 (file)
--- 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 cfaa8aa4e543efdc131ec7084f3e8979736b381d..98724e9413ea39d8f31c617fa5a6076d78b60858 100644 (file)
--- 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."