6 files changed, 1037 insertions, 53 deletions

diff --git a/doc/lispref/text.texi b/doc/lispref/text.texi
index 18f0ee88fe5..8774801f41f 100644
--- a/doc/lispref/text.texi
+++ b/doc/lispref/text.texi
@@ -6375,3 +6375,151 @@ hooks during a series of changes (typically for performance reasons),
 use @code{combine-change-calls} or @code{combine-after-change-calls}
 instead.
 @end defvar
+
+@node Tracking changes
+@subsection Tracking changes
+@cindex track-changes
+@cindex change tracker
+
+Using @code{before-change-functions} and @code{after-change-functions}
+can be difficult in practice because of a number of pitfalls, such as
+the fact that the two calls are not always properly paired, or some
+calls may be missing, either because some Emacs primitives failed to
+properly pair them or because of incorrect use of
+@code{inhibit-modification-hooks}.  Furthermore,
+many restrictions apply to those hook functions, such as the fact that
+they basically should never modify the current buffer, nor use an
+operation that may block, and they proceed quickly because
+some commands may call these hooks a large number of times.
+
+The Track-Changes library fundamentally provides an alternative API,
+built on top of those hooks.  Compared to @code{after-change-functions},
+the first important difference is that, instead of providing the bounds
+of the change and the previous length, it provides the bounds of the
+change and the actual previous content of that region.  The need to
+extract information from the original contents of the buffer is one of
+the main reasons why some packages need to use both
+@code{before-change-functions} and @code{after-change-functions} and
+then try to match them up.
+
+The second difference is that it decouples the notification of a change
+from the act of processing it, and it automatically combines into
+a single change operation all the changes that occur between the first
+change and the actual processing.  This makes it natural and easy to
+process the changes at a larger granularity, such as once per command,
+and eliminates most of the restrictions that apply to the usual change
+hook functions, making it possible to use blocking operations or to
+modify the buffer.
+
+To start tracking changes, you have to call
+@code{track-changes-register}, passing it a @var{signal} function as
+argument.  This returns a tracker @var{id} which is used to identify
+your change tracker to the other functions of the library.
+When the buffer is modified, the library calls the @var{signal}
+function to inform you of that change and immediately starts
+accumulating subsequent changes into a single combined change.
+The @var{signal} function serves only to warn that a modification
+occurred but does not receive a description of the change.  Also the
+library will not call it again until after you retrieved the change.
+
+To retrieve changes, you need to call @code{track-changes-fetch}, which
+provides you with the bounds of the changes accumulated since the
+last call, as well as the previous content of that region.  It also
+``re-arms'' the @var{signal} function so that the library will call it
+again after the next buffer modification.
+
+@defun track-changes-register signal &key nobefore disjoint immediate
+This function creates a new @dfn{change tracker}.  Change trackers are kept
+abstract, so we refer to them as mere identities, and the function thus
+returns the tracker's @var{id}.
+
+@var{signal} is a function that the library will call to notify of
+a change.  It will sometimes call it with a single argument and
+sometimes with two.  Upon the first change to the buffer since this
+tracker last called @code{track-changes-fetch}, the library calls this
+@var{signal} function with a single argument holding the @var{id} of
+the tracker.
+
+By default, the call to the @var{signal} function does not happen
+immediately, but is instead postponed with a 0 seconds timer
+(@pxref{Timers}).  This is usually desired to make sure the @var{signal}
+function is not called too frequently and runs in a permissive context,
+freeing the client from performance concerns or worries about which
+operations might be problematic.  If a client wants to have more
+control, they can provide a non-@code{nil} value as the @var{immediate}
+argument in which case the library calls the @var{signal} function
+directly from @code{after-change-functions}.  Beware that it means that
+the @var{signal} function has to be careful not to modify the buffer or
+use operations that may block.
+
+If you're not interested in the actual previous content of the buffer,
+but are using this library only for its ability to combine many small
+changes into a larger one and to delay the processing to a more
+convenient time, you can specify a non-@code{nil} value for the
+@var{nobefore} argument.  In that case, @code{track-change-fetch}
+provides you only with the length of the previous content, just like
+@code{after-change-functions}.  It also allows the library to save
+some work.
+
+While you may like to accumulate many small changes into larger ones,
+you may not want to do that if the changes are too far apart.  If you
+specify a non-@code{nil} value for the @var{disjoint} argument, the library
+will let you know when a change is about to occur ``far'' from the
+currently pending ones by calling the @var{signal} function right away,
+passing it two arguments this time: the @var{id} of the tracker, and the
+number of characters that separates the upcoming change from the
+already pending changes.  This in itself does not prevent combining this
+new change with the previous ones, so if you think the upcoming change
+is indeed too far, you need to call @code{track-change-fetch}
+right away.
+Beware that when the @var{signal} function is called because of
+a disjoint change, this happens directly from
+@code{before-change-functions}, so the usual restrictions apply about
+modifying the buffer or using operations that may block.
+@end defun
+
+@defun track-changes-fetch id func
+This is the function that lets you find out what has changed in the
+buffer.  By providing the tracker @var{id} you let the library figure
+out which changes have already been seen by your tracker.  Instead of
+returning a description of the changes, @code{track-changes-fetch} calls
+the @var{func} function with that description in the form of
+3 arguments: @var{beg}, @var{end}, and @var{before}, where
+@code{@var{beg}..@var{end}} delimit the region that was modified and
+@var{before} describes the previous content of that region.
+Usually @var{before} is a string containing the previous text of the
+modified region, but if you specified a non-@code{nil} @var{nobefore} argument
+to @code{track-changes-register}, then it is replaced by the number of
+characters of that previous text.
+
+In case no changes occurred since the last call,
+@code{track-changes-fetch} simply does not call @var{func} and returns
+@code{nil}.  If changes did occur, it calls @var{func} and returns the value
+returned by @var{func}.  But note that @var{func} is called just once
+regardless of how many changes occurred: those are summarized into
+a single @var{beg}/@var{end}/@var{before} triplet.
+
+In some cases, the library is not properly notified of all changes,
+for example because of a bug in the low-level C code or because of an
+improper use of @code{inhibit-modification-hooks}.  When it detects such
+a problem, @var{func} receives a @code{@var{beg}..@var{end}} region
+which covers the whole buffer and the @var{before} argument is the
+symbol @code{error} to indicate that the library was unable to determine
+what was changed.
+
+Once @var{func} finishes, @code{track-changes-fetch} re-enables the
+@var{signal} function so that it will be called the next time a change
+occurs.  This is the reason why it calls @var{func} instead of returning
+a description: it lets you process the change without worrying about the
+risk that the @var{signal} function gets triggered in the middle of it,
+because the @var{signal} is re-enabled only after @var{func} finishes.
+@end defun
+
+@defun track-changes-unregister id
+This function tells the library that the tracker @var{id} does not need
+to know about buffer changes any more.  Most clients will never want to
+stop tracking changes, but for clients such as minor modes, it is
+important to call this function when the minor mode is disabled,
+otherwise the tracker will keep accumulating changes and consume more
+and more resources.
+@end defun
diff --git a/etc/NEWS b/etc/NEWS
index a2a3fe494cb..2cf6477ba99 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -15,6 +15,12 @@ in older Emacs versions.
 You can narrow news to a specific version by calling 'view-emacs-news'
 with a prefix argument or by typing 'C-u C-h C-n'.
 
+Temporary note:
++++ indicates that all relevant manuals in doc/ have been updated.
+--- means no change in the manuals is needed.
+When you add a new item, use the appropriate mark if you are sure it
+applies, and please also update docstrings as needed.
+
 
 * Installation Changes in Emacs 30.1
 
@@ -1586,6 +1592,18 @@ options of GNU 'ls'.
 
 * New Modes and Packages in Emacs 30.1
 
++++
+** New package Track-Changes.
+This library is a layer of abstraction above 'before-change-functions'
+and 'after-change-functions' which provides a superset of
+the functionality of 'after-change-functions':
+- It provides the actual previous text rather than only its length.
+- It takes care of accumulating and bundling changes until a time when
+  its client finds it convenient to react to them.
+- It detects most cases where some changes were not properly
+  reported (calls to 'before/after-change-functions' that are
+  incorrectly paired, missing, etc...) and reports them adequately.
+
 ** New major modes based on the tree-sitter library
 
 +++
diff --git a/lisp/emacs-lisp/track-changes.el b/lisp/emacs-lisp/track-changes.el
new file mode 100644
index 00000000000..3479fecef25
--- /dev/null
+++ b/lisp/emacs-lisp/track-changes.el
@@ -0,0 +1,619 @@
+;;; track-changes.el --- API to react to buffer modifications  -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2024  Free Software Foundation, Inc.
+
+;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This library is a layer of abstraction above `before-change-functions'
+;; and `after-change-functions' which takes care of accumulating changes
+;; until a time when its client finds it convenient to react to them.
+;;
+;; It provides an API that is easier to use correctly than our
+;; `*-change-functions' hooks.  Problems that it claims to solve:
+;;
+;; - Before and after calls are not necessarily paired.
+;; - The beg/end values don't always match.
+;; - There's usually only one call to the hooks per command but
+;;   there can be thousands of calls from within a single command,
+;;   so naive users will tend to write code that performs poorly
+;;   in those rare cases.
+;; - The hooks are run at a fairly low-level so there are things they
+;;   really shouldn't do, such as modify the buffer or wait.
+;; - The after call doesn't get enough info to rebuild the before-change state,
+;;   so some callers need to use both before-c-f and after-c-f (and then
+;;   deal with the first two points above).
+;;
+;; The new API is almost like `after-change-functions' except that:
+;; - It provides the "before string" (i.e. the previous content of
+;;   the changed area) rather than only its length.
+;; - It can combine several changes into larger ones.
+;; - Clients do not have to process changes right away, instead they
+;;   can let changes accumulate (by combining them into a larger change)
+;;   until it is convenient for them to process them.
+;; - By default, changes are signaled at most once per command.
+
+;; The API consists in the following functions:
+;;
+;;     (track-changes-register SIGNAL &key NOBEFORE DISJOINT IMMEDIATE)
+;;     (track-changes-fetch ID FUNC)
+;;     (track-changes-unregister ID)
+;;
+;; A typical use case might look like:
+;;
+;;     (defvar my-foo--change-tracker nil)
+;;     (define-minor-mode my-foo-mode
+;;       "Fooing like there's no tomorrow."
+;;       (if (null my-foo-mode)
+;;           (when my-foo--change-tracker
+;;             (track-changes-unregister my-foo--change-tracker)
+;;             (setq my-foo--change-tracker nil))
+;;         (unless my-foo--change-tracker
+;;           (setq my-foo--change-tracker
+;;                 (track-changes-register
+;;                  (lambda (id)
+;;                    (track-changes-fetch
+;;                     id (lambda (beg end before)
+;;                          ..DO THE THING..))))))))
+
+;;; Code:
+
+;; Random ideas:
+;; - We could let trackers specify a function to record auxiliary info
+;;   about a state.  This would be called from the first before-c-f
+;;   and then provided to FUNC.  TeXpresso could use it to avoid needing
+;;   the BEFORE string: it could record the total number of bytes
+;;   in the "before" state so that from `track-changes-fetch' it could
+;;   compute the number of bytes that used to be in BEG/END.
+
+(require 'cl-lib)
+
+;;;; Internal types and variables.
+
+(cl-defstruct (track-changes--tracker
+               (:noinline t)
+               (:constructor nil)
+               (:constructor track-changes--tracker ( signal state
+                                                      &optional
+                                                      nobefore immediate)))
+  signal state nobefore immediate)
+
+(cl-defstruct (track-changes--state
+               (:noinline t)
+               (:constructor nil)
+               (:constructor track-changes--state ()))
+  "Object holding a description of a buffer state.
+A buffer state is described by a BEG/END/BEFORE triplet which say how to
+recover that state from the next state.  I.e. if the buffer's contents
+reflects the next state, you can recover the previous state by replacing
+the BEG..END region with the BEFORE string.
+
+NEXT is the next state object (i.e. a more recent state).
+If NEXT is nil it means it's the most recent state and it may be incomplete
+\(BEG/END/BEFORE may be nil), in which case those fields will take their
+values from `track-changes--before-(beg|end|before)' when the next
+state is created."
+  (beg (point-max))
+  (end (point-min))
+  (before nil)
+  (next nil))
+
+(defvar-local track-changes--trackers ()
+  "List of trackers currently registered in the buffer.")
+(defvar-local track-changes--clean-trackers ()
+  "List of trackers that are clean.
+Those are the trackers that get signaled when a change is made.")
+
+(defvar-local track-changes--disjoint-trackers ()
+ "List of trackers that want to react to disjoint changes.
+These trackers are signaled every time track-changes notices
+that some upcoming changes touch another \"distant\" part of the buffer.")
+
+(defvar-local track-changes--state nil)
+
+;; `track-changes--before-*' keep track of the content of the
+;; buffer when `track-changes--state' was cleaned.
+(defvar-local track-changes--before-beg 0
+  "Beginning position of the remembered \"before string\".")
+(defvar-local track-changes--before-end 0
+  "End position of the text replacing the \"before string\".")
+(defvar-local track-changes--before-string ""
+  "String holding some contents of the buffer before the current change.
+This string is supposed to cover all the already modified areas plus
+the upcoming modifications announced via `before-change-functions'.
+If all trackers are `nobefore', then this holds the `buffer-size' before
+the current change.")
+(defvar-local track-changes--before-no t
+  "If non-nil, all the trackers are `nobefore'.
+Should be equal to (memq #\\='track-changes--before before-change-functions).")
+
+(defvar-local track-changes--before-clean 'unset
+  "Status of `track-changes--before-*' vars.
+More specifically it indicates which \"before\" they hold.
+- nil: The vars hold the \"before\" info of the current state.
+- `unset': The vars hold the \"before\" info of some older state.
+  This is what it is set to right after creating a fresh new state.
+- `set': Like nil but the state is still clean because the buffer has not
+  been modified yet.  This is what it is set to after the first
+  `before-change-functions'  but before an `after-change-functions'.")
+
+(defvar-local track-changes--buffer-size nil
+  "Current size of the buffer, as far as this library knows.
+This is used to try and detect cases where buffer modifications are \"lost\".")
+
+;;;; Exposed API.
+
+(cl-defun track-changes-register ( signal &key nobefore disjoint immediate)
+  "Register a new tracker whose change-tracking function is SIGNAL.
+Return the ID of the new tracker.
+
+SIGNAL is a function that will be called with one argument (the tracker ID)
+after the current buffer is modified, so that it can react to the change.
+Once called, SIGNAL is not called again until `track-changes-fetch'
+is called with the corresponding tracker ID.
+
+If optional argument NOBEFORE is non-nil, it means that this tracker does
+not need the BEFORE strings (it will receive their size instead).
+
+If optional argument DISJOINT is non-nil, SIGNAL is called every time just
+before combining changes from \"distant\" parts of the buffer.
+This is needed when combining disjoint changes into one bigger change
+is unacceptable, typically for performance reasons.
+These calls are distinguished from normal calls by calling SIGNAL with
+a second argument which is the distance between the upcoming change and
+the previous changes.
+BEWARE: In that case SIGNAL is called directly from `before-change-functions'
+and should thus be extra careful: don't modify the buffer, don't call a function
+that may block, ...
+In order to prevent the upcoming change from being combined with the previous
+changes, SIGNAL needs to call `track-changes-fetch' before it returns.
+
+By default SIGNAL is called after a change via a 0 seconds timer.
+If optional argument IMMEDIATE is non-nil it means SIGNAL should be called
+as soon as a change is detected,
+BEWARE: In that case SIGNAL is called directly from `after-change-functions'
+and should thus be extra careful: don't modify the buffer, don't call a function
+that may block, do as little work as possible, ...
+When IMMEDIATE is non-nil, the SIGNAL should probably not always call
+`track-changes-fetch', since that would defeat the purpose of this library."
+  (when (and nobefore disjoint)
+    ;; FIXME: Without `before-change-functions', we can discover
+    ;; a disjoint change only after the fact, which is not good enough.
+    ;; But we could use a stripped down before-change-function,
+    (error "`disjoint' not supported for `nobefore' trackers"))
+  (track-changes--clean-state)
+  (unless nobefore
+    (setq track-changes--before-no nil)
+    (add-hook 'before-change-functions #'track-changes--before nil t))
+  (add-hook 'after-change-functions  #'track-changes--after  nil t)
+  (let ((tracker (track-changes--tracker signal track-changes--state
+                                         nobefore immediate)))
+    (push tracker track-changes--trackers)
+    (push tracker track-changes--clean-trackers)
+    (when disjoint
+      (push tracker track-changes--disjoint-trackers))
+    tracker))
+
+(defun track-changes-unregister (id)
+  "Remove the tracker denoted by ID.
+Trackers can consume resources (especially if `track-changes-fetch' is
+not called), so it is good practice to unregister them when you don't
+need them any more."
+  (unless (memq id track-changes--trackers)
+    (error "Unregistering a non-registered tracker: %S" id))
+  (setq track-changes--trackers (delq id track-changes--trackers))
+  (setq track-changes--clean-trackers (delq id track-changes--clean-trackers))
+  (setq track-changes--disjoint-trackers
+        (delq id track-changes--disjoint-trackers))
+  (when (cl-every #'track-changes--tracker-nobefore track-changes--trackers)
+    (setq track-changes--before-no t)
+    (remove-hook 'before-change-functions #'track-changes--before t))
+  (when (null track-changes--trackers)
+    (mapc #'kill-local-variable
+          '(track-changes--before-beg
+            track-changes--before-end
+            track-changes--before-string
+            track-changes--buffer-size
+            track-changes--before-clean
+            track-changes--state))
+    (remove-hook 'after-change-functions  #'track-changes--after  t)))
+
+(defun track-changes-fetch (id func)
+  "Fetch the pending changes for tracker ID pass them to FUNC.
+ID is the tracker ID returned by a previous `track-changes-register'.
+FUNC is a function.  It is called with 3 arguments (BEGIN END BEFORE)
+where BEGIN..END delimit the region that was changed since the last
+time `track-changes-fetch' was called and BEFORE is a string containing
+the previous content of that region (or just its length as an integer
+if the tracker ID was registered with the `nobefore' option).
+If track-changes detected that some changes were missed, then BEFORE will
+be the symbol `error' to indicate that the buffer got out of sync.
+This reflects a bug somewhere, so please report it when it happens.
+
+If no changes occurred since the last time, it doesn't call FUNC and
+returns nil, otherwise it returns the value returned by FUNC
+and re-enable the TRACKER corresponding to ID."
+  (cl-assert (memq id track-changes--trackers))
+  (unless (equal track-changes--buffer-size (buffer-size))
+    (track-changes--recover-from-error))
+  (let ((beg nil)
+        (end nil)
+        (before t)
+        (lenbefore 0)
+        (states ()))
+    ;; Transfer the data from `track-changes--before-string'
+    ;; to the tracker's state object, if needed.
+    (track-changes--clean-state)
+    ;; We want to combine the states from most recent to oldest,
+    ;; so reverse them.
+    (let ((state (track-changes--tracker-state id)))
+      (while state
+        (push state states)
+        (setq state (track-changes--state-next state))))
+
+    (cond
+     ((eq (car states) track-changes--state)
+      (cl-assert (null (track-changes--state-before (car states))))
+      (setq states (cdr states)))
+     (t
+      ;; The states are disconnected from the latest state because
+      ;; we got out of sync!
+      (cl-assert (eq (track-changes--state-before (car states)) 'error))
+      (setq beg (point-min))
+      (setq end (point-max))
+      (setq before 'error)
+      (setq states nil)))
+
+    (dolist (state states)
+      (let ((prevbeg (track-changes--state-beg state))
+            (prevend (track-changes--state-end state))
+            (prevbefore (track-changes--state-before state)))
+        (if (eq before t)
+            (progn
+              ;; This is the most recent change.  Just initialize the vars.
+              (setq beg prevbeg)
+              (setq end prevend)
+              (setq lenbefore
+                    (if (stringp prevbefore) (length prevbefore) prevbefore))
+              (setq before
+                    (unless (track-changes--tracker-nobefore id) prevbefore)))
+          (let ((endb (+ beg lenbefore)))
+            (when (< prevbeg beg)
+              (if (not before)
+                  (setq lenbefore (+ (- beg prevbeg) lenbefore))
+                (setq before
+                      (concat (buffer-substring-no-properties
+                               prevbeg beg)
+                              before))
+                (setq lenbefore (length before)))
+              (setq beg prevbeg)
+              (cl-assert (= endb (+ beg lenbefore))))
+            (when (< endb prevend)
+              (let ((new-end (+ end (- prevend endb))))
+                (if (not before)
+                    (setq lenbefore (+ lenbefore (- new-end end)))
+                  (setq before
+                        (concat before
+                                (buffer-substring-no-properties
+                                 end new-end)))
+                  (setq lenbefore (length before)))
+                (setq end new-end)
+                (cl-assert (= prevend (+ beg lenbefore)))
+                (setq endb (+ beg lenbefore))))
+            (cl-assert (<= beg prevbeg prevend endb))
+            ;; The `prevbefore' is covered by the new one.
+            (if (not before)
+                (setq lenbefore
+                      (+ (- prevbeg beg)
+                         (if (stringp prevbefore)
+                             (length prevbefore) prevbefore)
+                         (- endb prevend)))
+              (setq before
+                    (concat (substring before 0 (- prevbeg beg))
+                            prevbefore
+                            (substring before (- (length before)
+                                                 (- endb prevend)))))
+              (setq lenbefore (length before)))))))
+    (if (null beg)
+        (progn
+          (cl-assert (null states))
+          (cl-assert (memq id track-changes--clean-trackers))
+          (cl-assert (eq (track-changes--tracker-state id)
+                         track-changes--state))
+          ;; Nothing to do.
+          nil)
+      (cl-assert (not (memq id track-changes--clean-trackers)))
+      (cl-assert (<= (point-min) beg end (point-max)))
+      ;; Update the tracker's state *before* running `func' so we don't risk
+      ;; mistakenly replaying the changes in case `func' exits non-locally.
+      (setf (track-changes--tracker-state id) track-changes--state)
+      (unwind-protect (funcall func beg end (or before lenbefore))
+        ;; Re-enable the tracker's signal only after running `func', so
+        ;; as to avoid recursive invocations.
+        (cl-pushnew id track-changes--clean-trackers)))))
+
+;;;; Auxiliary functions.
+
+(defun track-changes--clean-state ()
+  (cond
+   ((null track-changes--state)
+    (cl-assert track-changes--before-clean)
+    (cl-assert (null track-changes--buffer-size))
+    ;; No state has been created yet.  Do it now.
+    (setq track-changes--buffer-size (buffer-size))
+    (when track-changes--before-no
+      (setq track-changes--before-string (buffer-size)))
+    (setq track-changes--state (track-changes--state)))
+   (track-changes--before-clean
+    ;; If the state is already clean, there's nothing to do.
+    nil)
+   (t
+    (cl-assert (<= (track-changes--state-beg track-changes--state)
+                   (track-changes--state-end track-changes--state)))
+    (let ((actual-beg (track-changes--state-beg track-changes--state))
+          (actual-end (track-changes--state-end track-changes--state)))
+      (if track-changes--before-no
+          (progn
+            (cl-assert (integerp track-changes--before-string))
+            (setf (track-changes--state-before track-changes--state)
+                  (- track-changes--before-string
+                     (- (buffer-size) (- actual-end actual-beg))))
+            (setq track-changes--before-string (buffer-size)))
+        (cl-assert (<= track-changes--before-beg
+                       actual-beg actual-end
+                       track-changes--before-end))
+        (cl-assert (null (track-changes--state-before track-changes--state)))
+        ;; The `track-changes--before-*' vars can cover more text than the
+        ;; actually modified area, so trim it down now to the relevant part.
+        (unless (= (- track-changes--before-end track-changes--before-beg)
+                   (- actual-end actual-beg))
+          (setq track-changes--before-string
+                (substring track-changes--before-string
+                           (- actual-beg track-changes--before-beg)
+                           (- (length track-changes--before-string)
+                              (- track-changes--before-end actual-end))))
+          (setq track-changes--before-beg actual-beg)
+          (setq track-changes--before-end actual-end))
+        (setf (track-changes--state-before track-changes--state)
+              track-changes--before-string)))
+    ;; Note: We preserve `track-changes--before-*' because they may still
+    ;; be needed, in case `after-change-functions' are run before the next
+    ;; `before-change-functions'.
+    ;; Instead, we set `track-changes--before-clean' to `unset' to mean that
+    ;; `track-changes--before-*' can be reset at the next
+    ;; `before-change-functions'.
+    (setq track-changes--before-clean 'unset)
+    (let ((new (track-changes--state)))
+      (setf (track-changes--state-next track-changes--state) new)
+      (setq track-changes--state new)))))
+
+(defvar track-changes--disjoint-threshold 100
+  "Number of chars below which changes are not considered disjoint.")
+
+(defvar track-changes--error-log ()
+  "List of errors encountered.
+Each element is a triplet (BUFFER-NAME BACKTRACE RECENT-KEYS).")
+
+(defun track-changes--recover-from-error ()
+  ;; We somehow got out of sync.  This is usually the result of a bug
+  ;; elsewhere that causes the before-c-f and after-c-f to be improperly
+  ;; paired, or to be skipped altogether.
+  ;; Not much we can do, other than force a full re-synchronization.
+  (warn "Missing/incorrect calls to `before/after-change-functions'!!
+Details logged to `track-changes--error-log'")
+  (push (list (buffer-name)
+              (backtrace-frames 'track-changes--recover-from-error)
+              (recent-keys 'include-cmds))
+        track-changes--error-log)
+  (setq track-changes--before-clean 'unset)
+  (setq track-changes--buffer-size (buffer-size))
+  ;; Create a new state disconnected from the previous ones!
+  ;; Mark the previous one as junk, just to be clear.
+  (setf (track-changes--state-before track-changes--state) 'error)
+  (setq track-changes--state (track-changes--state)))
+
+(defun track-changes--before (beg end)
+  (cl-assert track-changes--state)
+  (cl-assert (<= beg end))
+  (let* ((size (- end beg))
+         (reset (lambda ()
+                  (cl-assert track-changes--before-clean)
+                  (setq track-changes--before-clean 'set)
+                  (setf track-changes--before-string
+                        (buffer-substring-no-properties beg end))
+                  (setf track-changes--before-beg beg)
+                  (setf track-changes--before-end end)))
+
+         (signal-if-disjoint
+          (lambda (pos1 pos2)
+            (let ((distance (- pos2 pos1)))
+              (when (> distance
+                       (max track-changes--disjoint-threshold
+                            ;; If the distance is smaller than the size of the
+                            ;; current change, then we may as well consider it
+                            ;; as "near".
+                            (length track-changes--before-string)
+                            size
+                            (- track-changes--before-end
+                               track-changes--before-beg)))
+                (dolist (tracker track-changes--disjoint-trackers)
+                  (funcall (track-changes--tracker-signal tracker)
+                           tracker distance))
+                ;; Return non-nil if the state was cleaned along the way.
+                track-changes--before-clean)))))
+
+    (if track-changes--before-clean
+        (progn
+          ;; Detect disjointness with previous changes here as well,
+          ;; so that if a client calls `track-changes-fetch' all the time,
+          ;; it doesn't prevent others from getting a disjointness signal.
+          (when (and track-changes--before-beg
+                     (let ((found nil))
+                       (dolist (tracker track-changes--disjoint-trackers)
+                         (unless (memq tracker track-changes--clean-trackers)
+                           (setq found t)))
+                       found))
+            ;; There's at least one `tracker' that wants to know about disjoint
+            ;; changes *and* it has unseen pending changes.
+            ;; FIXME: This can occasionally signal a tracker that's clean.
+            (if (< beg track-changes--before-beg)
+                (funcall signal-if-disjoint end track-changes--before-beg)
+              (funcall signal-if-disjoint track-changes--before-end beg)))
+          (funcall reset))
+      (cl-assert (save-restriction
+                   (widen)
+                   (<= (point-min)
+                       track-changes--before-beg
+                       track-changes--before-end
+                       (point-max))))
+      (when (< beg track-changes--before-beg)
+        (if (and track-changes--disjoint-trackers
+                 (funcall signal-if-disjoint end track-changes--before-beg))
+            (funcall reset)
+          (let* ((old-bbeg track-changes--before-beg)
+                 ;; To avoid O(N²) behavior when faced with many small changes,
+                 ;; we copy more than needed.
+                 (new-bbeg (min (max (point-min)
+                                     (- old-bbeg
+                                        (length track-changes--before-string)))
+                                beg)))
+            (setf track-changes--before-beg new-bbeg)
+            (cl-callf (lambda (old new) (concat new old))
+                track-changes--before-string
+              (buffer-substring-no-properties new-bbeg old-bbeg)))))
+
+      (when (< track-changes--before-end end)
+        (if (and track-changes--disjoint-trackers
+                 (funcall signal-if-disjoint track-changes--before-end beg))
+            (funcall reset)
+          (let* ((old-bend track-changes--before-end)
+                 ;; To avoid O(N²) behavior when faced with many small changes,
+                 ;; we copy more than needed.
+                 (new-bend (max (min (point-max)
+                                     (+ old-bend
+                                        (length track-changes--before-string)))
+                                end)))
+            (setf track-changes--before-end new-bend)
+            (cl-callf concat track-changes--before-string
+              (buffer-substring-no-properties old-bend new-bend))))))))
+
+(defun track-changes--after (beg end len)
+  (cl-assert track-changes--state)
+  (and (eq track-changes--before-clean 'unset)
+       (not track-changes--before-no)
+       ;; This can be a sign that a `before-change-functions' went missing,
+       ;; or that we called `track-changes--clean-state' between
+       ;; a `before-change-functions' and `after-change-functions'.
+       (track-changes--before beg end))
+  (setq track-changes--before-clean nil)
+  (let ((offset (- (- end beg) len)))
+    (cl-incf track-changes--before-end offset)
+    (cl-incf track-changes--buffer-size offset)
+    (if (not (or track-changes--before-no
+                 (save-restriction
+                   (widen)
+                   (<= (point-min)
+                       track-changes--before-beg
+                       beg end
+                       track-changes--before-end
+                       (point-max)))))
+        ;; BEG..END is not covered by previous `before-change-functions'!!
+        (track-changes--recover-from-error)
+      ;; Note the new changes.
+      (when (< beg (track-changes--state-beg track-changes--state))
+        (setf (track-changes--state-beg track-changes--state) beg))
+      (cl-callf (lambda (old-end) (max end (+ old-end offset)))
+          (track-changes--state-end track-changes--state))
+      (cl-assert (or track-changes--before-no
+                     (<= track-changes--before-beg
+                         (track-changes--state-beg track-changes--state)
+                         beg end
+                         (track-changes--state-end track-changes--state)
+                         track-changes--before-end)))))
+  (while track-changes--clean-trackers
+    (let ((tracker (pop track-changes--clean-trackers)))
+      (if (track-changes--tracker-immediate tracker)
+          (funcall (track-changes--tracker-signal tracker) tracker)
+        (run-with-timer 0 nil #'track-changes--call-signal
+                        (current-buffer) tracker)))))
+
+(defun track-changes--call-signal (buf tracker)
+  (when (buffer-live-p buf)
+    (with-current-buffer buf
+      ;; Silence ourselves if `track-changes-fetch' was called in the mean time.
+      (unless (memq tracker track-changes--clean-trackers)
+        (funcall (track-changes--tracker-signal tracker) tracker)))))
+
+;;;; Extra candidates for the API.
+
+;; The functions below came up during the design of this library, but
+;; I'm not sure if they're worth the trouble or not, so for now I keep
+;; them here (with a "--" in the name) for documentation.  --Stef
+
+;; This could be a good alternative to using a temp-buffer like in
+;; `eglot--virtual-pos-to-lsp-position': since presumably we've just
+;; been changing this very area of the buffer, the gap should be
+;; ready nearby, so the operation should be fairly cheap, while
+;; giving you the comfort of having access to the *full* buffer text.
+;;
+;; It may seem silly to go back to the previous state, since we could have
+;; used `before-change-functions' to run FUNC right then when we were in
+;; that state.  The advantage is that with track-changes we get to decide
+;; retroactively which state is the one for which we want to call FUNC and
+;; which BEG..END to use: when that state was current we may have known
+;; then that it would be "the one" but we didn't know what BEG and END
+;; should be because those depend on the changes that came afterwards.
+(defun track-changes--in-revert (beg end before func)
+  "Call FUNC with the buffer contents temporarily reverted to BEFORE.
+FUNC is called with no arguments and with point right after BEFORE.
+FUNC is not allowed to modify the buffer and it should refrain from using
+operations that use a cache populated from the buffer's content,
+such as `syntax-ppss'."
+  (catch 'track-changes--exit
+    (with-silent-modifications ;; This has to be outside `atomic-change-group'.
+      (atomic-change-group
+        (goto-char end)
+        (insert-before-markers before)
+        (delete-region beg end)
+        (throw 'track-changes--exit
+               (let ((inhibit-read-only nil)
+                     (buffer-read-only t))
+                 (funcall func)))))))
+
+;; This one might be useful for example if a client makes changes to
+;; the buffer and doesn't want to see its own changes.
+(defun track-changes--reset (id)
+  "Mark all past changes as handled for tracker ID.
+Re-arms ID's signal."
+  (track-changes--clean-state)
+  (setf (track-changes--tracker-state id) track-changes--state)
+  (cl-pushnew id track-changes--clean-trackers)
+  (cl-assert (not (track-changes--pending-p id))))
+
+(defun track-changes--pending-p (id)
+  "Return non-nil if there are pending changes for tracker ID."
+  (or (not track-changes--before-clean)
+      (track-changes--state-next id)))
+
+(defmacro with--track-changes (id vars &rest body)
+  (declare (indent 2) (debug (form sexp body)))
+  `(track-changes-fetch ,id (lambda ,vars ,@body)))
+
+(provide 'track-changes)
+;;; track-changes.el end here.
diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el
index 7f4284bf09d..478e7687bb3 100644
--- a/lisp/progmodes/eglot.el
+++ b/lisp/progmodes/eglot.el
@@ -110,6 +110,7 @@
 (require 'text-property-search nil t)
 (require 'diff-mode)
 (require 'diff)
+(require 'track-changes nil t)
 
 ;; These dependencies are also GNU ELPA core packages.  Because of
 ;; bug#62576, since there is a risk that M-x package-install, despite
@@ -1732,6 +1733,9 @@ return value is fed through the corresponding inverse function
   "Calculate number of UTF-16 code units from position given by LBP.
 LBP defaults to `eglot--bol'."
   (/ (- (length (encode-coding-region (or lbp (eglot--bol))
+                                      ;; FIXME: How could `point' ever be
+                                      ;; larger than `point-max' (sounds like
+                                      ;; a bug in Emacs).
                                       ;; Fix github#860
                                       (min (point) (point-max)) 'utf-16 t))
         2)
@@ -1749,6 +1753,24 @@ LBP defaults to `eglot--bol'."
          :character (progn (when pos (goto-char pos))
                            (funcall eglot-current-linepos-function)))))
 
+(defun eglot--virtual-pos-to-lsp-position (pos string)
+  "Return the LSP position at the end of STRING if it were inserted at POS."
+  (eglot--widening
+   (goto-char pos)
+   (forward-line 0)
+   ;; LSP line is zero-origin; Emacs is one-origin.
+   (let ((posline (1- (line-number-at-pos nil t)))
+         (linebeg (buffer-substring (point) pos))
+         (colfun eglot-current-linepos-function))
+     ;; Use a temp buffer because:
+     ;; - I don't know of a fast way to count newlines in a string.
+     ;; - We currently don't have `eglot-current-linepos-function' for strings.
+     (with-temp-buffer
+       (insert linebeg string)
+       (goto-char (point-max))
+       (list :line (+ posline (1- (line-number-at-pos nil t)))
+             :character (funcall colfun))))))
+
 (defvar eglot-move-to-linepos-function #'eglot-move-to-utf-16-linepos
   "Function to move to a position within a line reported by the LSP server.
 
@@ -1946,6 +1968,8 @@ For example, to keep your Company customization, add the symbol
   "A hook run by Eglot after it started/stopped managing a buffer.
 Use `eglot-managed-p' to determine if current buffer is managed.")
 
+(defvar-local eglot--track-changes nil)
+
 (define-minor-mode eglot--managed-mode
   "Mode for source buffers managed by some Eglot project."
   :init-value nil :lighter nil :keymap eglot-mode-map
@@ -1959,8 +1983,13 @@ Use `eglot-managed-p' to determine if current buffer is managed.")
       ("utf-8"
        (eglot--setq-saving eglot-current-linepos-function #'eglot-utf-8-linepos)
        (eglot--setq-saving eglot-move-to-linepos-function #'eglot-move-to-utf-8-linepos)))
-    (add-hook 'after-change-functions #'eglot--after-change nil t)
-    (add-hook 'before-change-functions #'eglot--before-change nil t)
+    (if (fboundp 'track-changes-register)
+        (unless eglot--track-changes
+          (setq eglot--track-changes
+           (track-changes-register
+            #'eglot--track-changes-signal :disjoint t)))
+      (add-hook 'after-change-functions #'eglot--after-change nil t)
+      (add-hook 'before-change-functions #'eglot--before-change nil t))
     (add-hook 'kill-buffer-hook #'eglot--managed-mode-off nil t)
     ;; Prepend "didClose" to the hook after the "nonoff", so it will run first
     (add-hook 'kill-buffer-hook #'eglot--signal-textDocument/didClose nil t)
@@ -1998,6 +2027,9 @@ Use `eglot-managed-p' to determine if current buffer is managed.")
                buffer
                (eglot--managed-buffers (eglot-current-server)))))
    (t
+    (when eglot--track-changes
+      (track-changes-unregister eglot--track-changes)
+      (setq eglot--track-changes nil))
     (remove-hook 'after-change-functions #'eglot--after-change t)
     (remove-hook 'before-change-functions #'eglot--before-change t)
     (remove-hook 'kill-buffer-hook #'eglot--managed-mode-off t)
@@ -2588,7 +2620,6 @@ buffer."
 (defun eglot--after-change (beg end pre-change-length)
   "Hook onto `after-change-functions'.
 Records BEG, END and PRE-CHANGE-LENGTH locally."
-  (cl-incf eglot--versioned-identifier)
   (pcase (car-safe eglot--recent-changes)
     (`(,lsp-beg ,lsp-end
                 (,b-beg . ,b-beg-marker)
@@ -2616,6 +2647,29 @@ Records BEG, END and PRE-CHANGE-LENGTH locally."
                `(,lsp-beg ,lsp-end ,pre-change-length
                           ,(buffer-substring-no-properties beg end)))))
     (_ (setf eglot--recent-changes :emacs-messup)))
+  (eglot--track-changes-signal nil))
+
+(defun eglot--track-changes-fetch (id)
+  (if (eq eglot--recent-changes :pending) (setq eglot--recent-changes nil))
+  (track-changes-fetch
+   id (lambda (beg end before)
+        (cond
+         ((eq eglot--recent-changes :emacs-messup) nil)
+         ((eq before 'error) (setf eglot--recent-changes :emacs-messup))
+         (t (push `(,(eglot--pos-to-lsp-position beg)
+                    ,(eglot--virtual-pos-to-lsp-position beg before)
+                    ,(length before)
+                    ,(buffer-substring-no-properties beg end))
+                  eglot--recent-changes))))))
+
+(defun eglot--track-changes-signal (id &optional distance)
+  (cl-incf eglot--versioned-identifier)
+  (cond
+   (distance (eglot--track-changes-fetch id))
+   (eglot--recent-changes nil)
+   ;; Note that there are pending changes, for the benefit of those
+   ;; who check it as a boolean.
+   (t (setq eglot--recent-changes :pending)))
   (when eglot--change-idle-timer (cancel-timer eglot--change-idle-timer))
   (let ((buf (current-buffer)))
     (setq eglot--change-idle-timer
@@ -2729,6 +2783,8 @@ When called interactively, use the currently active server"
 (defun eglot--signal-textDocument/didChange ()
   "Send textDocument/didChange to server."
   (when eglot--recent-changes
+    (when eglot--track-changes
+      (eglot--track-changes-fetch eglot--track-changes))
     (let* ((server (eglot--current-server-or-lose))
            (sync-capability (eglot-server-capable :textDocumentSync))
            (sync-kind (if (numberp sync-capability) sync-capability
@@ -2750,7 +2806,7 @@ When called interactively, use the currently active server"
                    ;; empty entries in `eglot--before-change' calls
                    ;; without an `eglot--after-change' reciprocal.
                    ;; Weed them out here.
-                   when (numberp len)
+                   when (numberp len) ;FIXME: Not needed with `track-changes'.
                    vconcat `[,(list :range `(:start ,beg :end ,end)
                                     :rangeLength len :text text)]))))
       (setq eglot--recent-changes nil)
diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el
index 66043059d14..0a618dc8f39 100644
--- a/lisp/vc/diff-mode.el
+++ b/lisp/vc/diff-mode.el
@@ -53,9 +53,10 @@
 ;; - Handle `diff -b' output in context->unified.
 
 ;;; Code:
+(require 'easy-mmode)
+(require 'track-changes)
 (eval-when-compile (require 'cl-lib))
 (eval-when-compile (require 'subr-x))
-(require 'easy-mmode)
 
 (autoload 'vc-find-revision "vc")
 (autoload 'vc-find-revision-no-save "vc")
@@ -1431,38 +1432,23 @@ else cover the whole buffer."
   (if (buffer-modified-p) (diff-fixup-modifs (point-min) (point-max)))
   nil)
 
-;; It turns out that making changes in the buffer from within an
-;; *-change-function is asking for trouble, whereas making them
-;; from a post-command-hook doesn't pose much problems
-(defvar diff-unhandled-changes nil)
-(defun diff-after-change-function (beg end _len)
-  "Remember to fixup the hunk header.
-See `after-change-functions' for the meaning of BEG, END and LEN."
-  ;; Ignoring changes when inhibit-read-only is set is strictly speaking
-  ;; incorrect, but it turns out that inhibit-read-only is normally not set
-  ;; inside editing commands, while it tends to be set when the buffer gets
-  ;; updated by an async process or by a conversion function, both of which
-  ;; would rather not be uselessly slowed down by this hook.
-  (when (and (not undo-in-progress) (not inhibit-read-only))
-    (if diff-unhandled-changes
-        (setq diff-unhandled-changes
-              (cons (min beg (car diff-unhandled-changes))
-                    (max end (cdr diff-unhandled-changes))))
-      (setq diff-unhandled-changes (cons beg end)))))
-
-(defun diff-post-command-hook ()
-  "Fixup hunk headers if necessary."
-  (when (consp diff-unhandled-changes)
-    (ignore-errors
-      (save-excursion
-        (goto-char (car diff-unhandled-changes))
-        ;; Maybe we've cut the end of the hunk before point.
-        (if (and (bolp) (not (bobp))) (backward-char 1))
-        ;; We used to fixup modifs on all the changes, but it turns out that
-        ;; it's safer not to do it on big changes, e.g. when yanking a big
-        ;; diff, or when the user edits the header, since we might then
-        ;; screw up perfectly correct values.  --Stef
-        (diff-beginning-of-hunk t)
+(defvar-local diff--track-changes nil)
+
+(defun diff--track-changes-signal (tracker)
+  (cl-assert (eq tracker diff--track-changes))
+  (track-changes-fetch tracker #'diff--track-changes-function))
+
+(defun diff--track-changes-function (beg end _before)
+  (with-demoted-errors "%S"
+    (save-excursion
+      (goto-char beg)
+      ;; Maybe we've cut the end of the hunk before point.
+      (if (and (bolp) (not (bobp))) (backward-char 1))
+      ;; We used to fixup modifs on all the changes, but it turns out that
+      ;; it's safer not to do it on big changes, e.g. when yanking a big
+      ;; diff, or when the user edits the header, since we might then
+      ;; screw up perfectly correct values.  --Stef
+      (when (ignore-errors (diff-beginning-of-hunk t))
         (let* ((style (if (looking-at "\\*\\*\\*") 'context))
                (start (line-beginning-position (if (eq style 'context) 3 2)))
                (mid (if (eq style 'context)
@@ -1470,17 +1456,16 @@ See `after-change-functions' for the meaning of BEG, END and LEN."
                           (re-search-forward diff-context-mid-hunk-header-re
                                              nil t)))))
           (when (and ;; Don't try to fixup changes in the hunk header.
-                 (>= (car diff-unhandled-changes) start)
+                 (>= beg start)
                  ;; Don't try to fixup changes in the mid-hunk header either.
                  (or (not mid)
-                     (< (cdr diff-unhandled-changes) (match-beginning 0))
-                     (> (car diff-unhandled-changes) (match-end 0)))
+                     (< end (match-beginning 0))
+                     (> beg (match-end 0)))
                  (save-excursion
-                (diff-end-of-hunk nil 'donttrustheader)
+                   (diff-end-of-hunk nil 'donttrustheader)
                    ;; Don't try to fixup changes past the end of the hunk.
-                   (>= (point) (cdr diff-unhandled-changes))))
-          (diff-fixup-modifs (point) (cdr diff-unhandled-changes)))))
-      (setq diff-unhandled-changes nil))))
+                   (>= (point) end)))
+            (diff-fixup-modifs (point) end)))))))
 
 (defun diff-next-error (arg reset)
   ;; Select a window that displays the current buffer so that point
@@ -1560,9 +1545,8 @@ a diff with \\[diff-reverse-direction].
   ;; setup change hooks
   (if (not diff-update-on-the-fly)
       (add-hook 'write-contents-functions #'diff-write-contents-hooks nil t)
-    (make-local-variable 'diff-unhandled-changes)
-    (add-hook 'after-change-functions #'diff-after-change-function nil t)
-    (add-hook 'post-command-hook #'diff-post-command-hook nil t))
+    (setq diff--track-changes
+          (track-changes-register #'diff--track-changes-signal :nobefore t)))
 
   ;; add-log support
   (setq-local add-log-current-defun-function #'diff-current-defun)
@@ -1581,12 +1565,15 @@ a diff with \\[diff-reverse-direction].
 \\{diff-minor-mode-map}"
   :group 'diff-mode :lighter " Diff"
   ;; FIXME: setup font-lock
-  ;; setup change hooks
-  (if (not diff-update-on-the-fly)
-      (add-hook 'write-contents-functions #'diff-write-contents-hooks nil t)
-    (make-local-variable 'diff-unhandled-changes)
-    (add-hook 'after-change-functions #'diff-after-change-function nil t)
-    (add-hook 'post-command-hook #'diff-post-command-hook nil t)))
+  (when diff--track-changes (track-changes-unregister diff--track-changes))
+  (remove-hook 'write-contents-functions #'diff-write-contents-hooks t)
+  (when diff-minor-mode
+    (if (not diff-update-on-the-fly)
+        (add-hook 'write-contents-functions #'diff-write-contents-hooks nil t)
+      (unless diff--track-changes
+        (setq diff--track-changes
+              (track-changes-register #'diff--track-changes-signal
+                                      :nobefore t))))))
 
 ;;; Handy hook functions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
diff --git a/test/lisp/emacs-lisp/track-changes-tests.el b/test/lisp/emacs-lisp/track-changes-tests.el
new file mode 100644
index 00000000000..ed35477cafd
--- /dev/null
+++ b/test/lisp/emacs-lisp/track-changes-tests.el
@@ -0,0 +1,156 @@
+;;; track-changes-tests.el --- tests for emacs-lisp/track-changes.el  -*- lexical-binding:t -*-
+
+;; Copyright (C) 2024  Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'track-changes)
+(require 'cl-lib)
+(require 'ert)
+
+(defun track-changes-tests--random-word ()
+  (let ((chars ()))
+    (dotimes (_ (1+ (random 12)))
+      (push (+ ?A (random (1+ (- ?z ?A)))) chars))
+    (apply #'string chars)))
+
+(defvar track-changes-tests--random-verbose nil)
+
+(defun track-changes-tests--message (&rest args)
+  (when track-changes-tests--random-verbose (apply #'message args)))
+
+(defvar track-changes-tests--random-seed
+  (let ((seed (number-to-string (random (expt 2 24)))))
+    (message "Random seed = %S" seed)
+    seed))
+
+(ert-deftest track-changes-tests--random ()
+  ;; Keep 2 buffers in sync with a third one as we make random
+  ;; changes to that 3rd one.
+  ;; We have 3 trackers: a "normal" one which we sync
+  ;; at random intervals, one which syncs via the "disjoint" signal,
+  ;; plus a third one which verifies that "nobefore" gets
+  ;; information consistent with the "normal" tracker.
+  (with-temp-buffer
+    (random track-changes-tests--random-seed)
+    (dotimes (_ 100)
+      (insert (track-changes-tests--random-word) "\n"))
+    (let* ((buf1 (generate-new-buffer " *tc1*"))
+           (buf2 (generate-new-buffer " *tc2*"))
+           (char-counts (make-vector 2 0))
+           (sync-counts (make-vector 2 0))
+           (print-escape-newlines t)
+           (file (make-temp-file "tc"))
+           (id1 (track-changes-register #'ignore))
+           (id3 (track-changes-register #'ignore :nobefore t))
+           (sync
+            (lambda (id buf n)
+              (track-changes-tests--message "!! SYNC %d !!" n)
+              (track-changes-fetch
+               id (lambda (beg end before)
+                    (when (eq n 1)
+                      (track-changes-fetch
+                       id3 (lambda (beg3 end3 before3)
+                             (should (eq beg3 beg))
+                             (should (eq end3 end))
+                             (should (eq before3
+                                         (if (symbolp before)
+                                             before (length before)))))))
+                    (cl-incf (aref sync-counts (1- n)))
+                    (cl-incf (aref char-counts (1- n)) (- end beg))
+                    (let ((after (buffer-substring beg end)))
+                      (track-changes-tests--message
+                       "Sync:\n    %S\n=>  %S\nat %d .. %d"
+                       before after beg end)
+                      (with-current-buffer buf
+                        (if (eq before 'error)
+                            (erase-buffer)
+                          (should (equal before
+                                         (buffer-substring
+                                          beg (+ beg (length before)))))
+                          (delete-region beg (+ beg (length before))))
+                        (goto-char beg)
+                        (insert after)))
+                    (should (equal (buffer-string)
+                                   (with-current-buffer buf
+                                     (buffer-string))))))))
+           (id2 (track-changes-register
+                 (lambda (id2 &optional distance)
+                   (when distance
+                     (track-changes-tests--message "Disjoint distance: %d"
+                                                   distance)
+                     (funcall sync id2 buf2 2)))
+                 :disjoint t)))
+      (write-region (point-min) (point-max) file)
+      (insert-into-buffer buf1)
+      (insert-into-buffer buf2)
+      (should (equal (buffer-hash) (buffer-hash buf1)))
+      (should (equal (buffer-hash) (buffer-hash buf2)))
+      (message "seeding with: %S" track-changes-tests--random-seed)
+      (dotimes (_ 1000)
+        (pcase (random 15)
+          (0
+           (track-changes-tests--message "Manual sync1")
+           (funcall sync id1 buf1 1))
+          (1
+           (track-changes-tests--message "Manual sync2")
+           (funcall sync id2 buf2 2))
+          ((pred (< _ 5))
+           (let* ((beg (+ (point-min) (random (1+ (buffer-size)))))
+                  (end (min (+ beg (1+ (random 100))) (point-max))))
+             (track-changes-tests--message "Fill %d .. %d" beg end)
+             (fill-region-as-paragraph beg end)))
+          ((pred (< _ 8))
+           (let* ((beg (+ (point-min) (random (1+ (buffer-size)))))
+                  (end (min (+ beg (1+ (random 12))) (point-max))))
+             (track-changes-tests--message "Delete %S at %d .. %d"
+                                           (buffer-substring beg end) beg end)
+             (delete-region beg end)))
+          ((and 8 (guard (= (random 50) 0)))
+           (track-changes-tests--message "Silent insertion")
+           (let ((inhibit-modification-hooks t))
+             (insert "a")))
+          ((and 8 (guard (= (random 10) 0)))
+           (track-changes-tests--message "Revert")
+           (insert-file-contents file nil nil nil 'replace))
+          ((and 8 (guard (= (random 3) 0)))
+           (let* ((beg (+ (point-min) (random (1+ (buffer-size)))))
+                  (end (min (+ beg (1+ (random 12))) (point-max)))
+                  (after (eq (random 2) 0)))
+             (track-changes-tests--message "Bogus %S %d .. %d"
+                                           (if after 'after 'before) beg end)
+             (if after
+                 (run-hook-with-args 'after-change-functions
+                                     beg end (- end beg))
+               (run-hook-with-args 'before-change-functions beg end))))
+          (_
+           (goto-char (+ (point-min) (random (1+ (buffer-size)))))
+           (let ((word (track-changes-tests--random-word)))
+             (track-changes-tests--message "insert %S at %d" word (point))
+             (insert  word "\n")))))
+      (message "SCOREs: default: %d/%d=%d     disjoint: %d/%d=%d"
+               (aref char-counts 0) (aref sync-counts 0)
+               (/ (aref char-counts 0) (aref sync-counts 0))
+               (aref char-counts 1) (aref sync-counts 1)
+               (/ (aref char-counts 1) (aref sync-counts 1))))))
+
+
+
+;;; track-changes-tests.el ends here