bug#70077: An easier way to track buffer changes

[Stefan Monnier via "Bug reports for GNU Emacs, the Swiss army knife of text editors" <bug-gnu-emacs@gnu.org>]

[-- Attachment #1: Type: text/plain, Size: 1338 bytes --]

My PoC has matured into something quite usable.  The maturing part
included making it robust against mismatched or missing
`*-change-functions` calls, which it tries to detect (the problem
is then passed on to the client in the form of a change with an
unknown "before" content).
I also wrote a test which makes random changes and verifies that
the clients receive correct descriptions.

I currently use it only for Eglot and diff-mode, but I'm quite happy
with it.  For Eglot, it nicely packs up consecutive changes (like
consecutive `self-insert-command`s) into a single change yet keeps
changes to different parts of the buffer nicely separate.

The API is still about the same as before except that
`track-changes-register` now takes 3 options:

- `immediate` to control when the presence of changes is signaled
  (default to use `funcall-later` but `immediate` makes it use `funcall`
  so there is no delay).
- `disjoint` to prevent changes to different parts of the buffer from
  being combined into too large a change change.
- `nobefore` which indicates that the client doesn't actually need the
  `before` contents, so will only get the length thereof (like
  `after-change-functions` does).

I'm proposing we include it into `master`.
I have pushed the patch to `scratch/track-changes` (and attached it below).


        Stefan

[-- Attachment #2: 0001-lisp-emacs-lisp-track-changes.el-New-file.patch --]
[-- Type: text/x-diff, Size: 54837 bytes --]

From 4fd5a97052472eb1c332ea9b3f9ff90e94ad0cd1 Mon Sep 17 00:00:00 2001
From: Stefan Monnier <monnier@iro.umontreal.ca>
Date: Fri, 5 Apr 2024 17:37:32 -0400
Subject: [PATCH] lisp/emacs-lisp/track-changes.el: New file

This new package provides an API that is easier to use right than
our `*-change-functions` hooks.

The patch includes changes to `diff-mode.el` and `eglot.el` to
make use of this new package.

* lisp/emacs-lisp/track-changes.el: New file.
* test/lisp/emacs-lisp/track-changes-tests.el: New file.

* lisp/progmodes/eglot.el: Require `track-changes`.
(eglot--virtual-pos-to-lsp-position): New function.
(eglot--track-changes): New var.
(eglot--managed-mode): Use `track-changes-register` i.s.o
`after/before-change-functions`.
(eglot--before-change): Delete function.
(eglot--track-changes-signal): Rename from `eglot--after-change`
and adjust arguments accordingly.
(eglot--track-changes-fetch): New function.
(eglot--signal-textDocument/didChange): Call it and simplify now that
corner-cases are handled by `track-changes`.

* lisp/vc/diff-mode.el: Require `track-changes`.
Also require `easy-mmode` before the `eval-when-compile`s.
(diff-unhandled-changes): Delete variable.
(diff-after-change-function): Delete function.
(diff--track-changes-function): Rename from `diff-post-command-hook`
and adjust to new calling convention.
(diff--track-changes): New variable.
(diff--track-changes-signal): New function.
(diff-mode, diff-minor-mode): Use it with `track-changes-register`.
---
 lisp/emacs-lisp/track-changes.el            | 605 ++++++++++++++++++++
 lisp/progmodes/eglot.el                     | 105 ++--
 lisp/vc/diff-mode.el                        | 107 ++--
 test/lisp/emacs-lisp/track-changes-tests.el | 149 +++++
 4 files changed, 852 insertions(+), 114 deletions(-)
 create mode 100644 lisp/emacs-lisp/track-changes.el
 create mode 100644 test/lisp/emacs-lisp/track-changes-tests.el

diff --git a/lisp/emacs-lisp/track-changes.el b/lisp/emacs-lisp/track-changes.el
new file mode 100644
index 00000000000..7644a7de98d
--- /dev/null
+++ b/lisp/emacs-lisp/track-changes.el
@@ -0,0 +1,605 @@
+;;; 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:
+
+(require 'cl-lib)
+
+(unless (fboundp 'funcall-later)
+  (defun funcall-later (&rest args)
+    ;; FIXME: Not sure if `run-with-timer' preserves ordering between
+    ;; different calls with the same target time.
+   (apply #'run-with-timer 0 nil args)))
+
+;;;; 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.
+BEG..END is the area that was changed and BEFORE is its previous content.
+If the current buffer currently holds the content of the next state, you can get
+the contents of the previous state with:
+
+    (concat (buffer-substring (point-min) beg)
+                before
+                (buffer-substring end (point-max)))
+
+NEXT is the next state object (i.e. a more recent state).
+If NEXT is nil it means it's 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 create."
+  (beg (point-max))
+  (end (point-min))
+  (before nil)
+  (next nil))
+
+(defvar-local track-changes--trackers ()
+  "List of trackers currently registered in the current 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 (point-min)
+  "Beginning position of the remembered \"before string\".")
+(defvar-local track-changes--before-end (point-min)
+  "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
+  "If non-nil, the `track-changes--before-*' vars are old.
+More specifically it means they cover a part of the buffer relevant
+for the previous state.
+It can take two non-nil values:
+- `unset': Means that the vars cover some older state.
+  This is what it is set right after creating a fresh new state.
+- `set': Means the vars reflect the current buffer state.
+  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 and return a new tracker ID.
+SIGNAL is a function that will be called with one argument (the tracker ID)
+after the current buffer is modified, so that we 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).
+
+By default SIGNAL is called as soon as convenient after a change, which is
+usually right after the end of the current command.
+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 preferably not always call
+`track-changes-fetch', since that would defeat the purpose of this library.
+
+If optional argument DISJOINT is non-nil, SIGNAL is called every time we are
+about to combine 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."
+  (when (and nobefore disjoint)
+    ;; FIXME: Without `before-change-functions', we can only discover
+    ;; a disjoint change after the fact, which is not good enough.
+    ;; But we could use  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.
+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 some error caused us to miss some changes, 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, FUNC is not called and
+we return nil, otherwise we return 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 (<= (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 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
+  "Distance 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)
+        (funcall-later #'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.
+
+;; This could be a good alternative to using a temp-buffer like I used in
+;; Eglot, since presumably we've just been changing this very area of the
+;; buffer, so the gap should be ready nearby,
+;; 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)))))))
+
+(defun track-changes--reset (id)
+  "Mark all past changes as handled for tracker ID.
+Does not re-enable ID's signal."
+  (track-changes--clean-state)
+  (setf (track-changes--tracker-state id) track-changes--state))
+
+(defun track-changes--pending-p (id)
+  "Return non-nil if there are pending changes for tracker ID."
+  (not (memq id track-changes--clean-trackers)))
+
+(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..00c09d7f06b 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)
 
 ;; 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 @@ eglot-utf-16-linepos
   "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 @@ eglot--pos-to-lsp-position
          :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 @@ eglot-managed-mode-hook
   "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,9 @@ eglot--managed-mode
       ("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)
+    (unless eglot--track-changes
+      (setq eglot--track-changes
+            (track-changes-register #'eglot--track-changes-signal :disjoint 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,8 +2023,9 @@ eglot--managed-mode
                buffer
                (eglot--managed-buffers (eglot-current-server)))))
    (t
-    (remove-hook 'after-change-functions #'eglot--after-change t)
-    (remove-hook 'before-change-functions #'eglot--before-change t)
+    (when eglot--track-changes
+      (track-changes-unregister eglot--track-changes)
+      (setq eglot--track-changes nil))
     (remove-hook 'kill-buffer-hook #'eglot--managed-mode-off t)
     (remove-hook 'kill-buffer-hook #'eglot--signal-textDocument/didClose t)
     (remove-hook 'before-revert-hook #'eglot--signal-textDocument/didClose t)
@@ -2568,54 +2594,29 @@ jsonrpc-connection-ready-p
 
 (defvar-local eglot--change-idle-timer nil "Idle timer for didChange signals.")
 
-(defun eglot--before-change (beg end)
-  "Hook onto `before-change-functions' with BEG and END."
-  (when (listp eglot--recent-changes)
-    ;; Records BEG and END, crucially convert them into LSP
-    ;; (line/char) positions before that information is lost (because
-    ;; the after-change thingy doesn't know if newlines were
-    ;; deleted/added).  Also record markers of BEG and END
-    ;; (github#259)
-    (push `(,(eglot--pos-to-lsp-position beg)
-            ,(eglot--pos-to-lsp-position end)
-            (,beg . ,(copy-marker beg nil))
-            (,end . ,(copy-marker end t)))
-          eglot--recent-changes)))
-
 (defvar eglot--document-changed-hook '(eglot--signal-textDocument/didChange)
   "Internal hook for doing things when the document changes.")
 
-(defun eglot--after-change (beg end pre-change-length)
-  "Hook onto `after-change-functions'.
-Records BEG, END and PRE-CHANGE-LENGTH locally."
+(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)
+        (if (stringp before)
+            (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)
+          (setf eglot--recent-changes :emacs-messup)))))
+
+(defun eglot--track-changes-signal (id &optional distance)
   (cl-incf eglot--versioned-identifier)
-  (pcase (car-safe eglot--recent-changes)
-    (`(,lsp-beg ,lsp-end
-                (,b-beg . ,b-beg-marker)
-                (,b-end . ,b-end-marker))
-     ;; github#259 and github#367: with `capitalize-word' & friends,
-     ;; `before-change-functions' records the whole word's `b-beg' and
-     ;; `b-end'.  Similarly, when `fill-paragraph' coalesces two
-     ;; lines, `b-beg' and `b-end' mark end of first line and end of
-     ;; second line, resp.  In both situations, `beg' and `end'
-     ;; received here seemingly contradict that: they will differ by 1
-     ;; and encompass the capitalized character or, in the coalescing
-     ;; case, the replacement of the newline with a space.  We keep
-     ;; both markers and positions to detect and correct this.  In
-     ;; this specific case, we ignore `beg', `len' and
-     ;; `pre-change-len' and send richer information about the region
-     ;; from the markers.  I've also experimented with doing this
-     ;; unconditionally but it seems to break when newlines are added.
-     (if (and (= b-end b-end-marker) (= b-beg b-beg-marker)
-              (or (/= beg b-beg) (/= end b-end)))
-         (setcar eglot--recent-changes
-                 `(,lsp-beg ,lsp-end ,(- b-end-marker b-beg-marker)
-                            ,(buffer-substring-no-properties b-beg-marker
-                                                             b-end-marker)))
-       (setcar eglot--recent-changes
-               `(,lsp-beg ,lsp-end ,pre-change-length
-                          ,(buffer-substring-no-properties beg end)))))
-    (_ (setf eglot--recent-changes :emacs-messup)))
+  (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 +2730,7 @@ eglot-handle-request
 (defun eglot--signal-textDocument/didChange ()
   "Send textDocument/didChange to server."
   (when eglot--recent-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
@@ -2745,13 +2747,8 @@ eglot--signal-textDocument/didChange
                               (buffer-substring-no-properties (point-min)
                                                               (point-max)))))
           (cl-loop for (beg end len text) in (reverse eglot--recent-changes)
-                   ;; github#259: `capitalize-word' and commands based
-                   ;; on `casify_region' will cause multiple duplicate
-                   ;; empty entries in `eglot--before-change' calls
-                   ;; without an `eglot--after-change' reciprocal.
-                   ;; Weed them out here.
-                   when (numberp len)
                    vconcat `[,(list :range `(:start ,beg :end ,end)
+                                    ;; `rangeLength' is obsolete.
                                     :rangeLength len :text text)]))))
       (setq eglot--recent-changes nil)
       (jsonrpc--call-deferred server))))
diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el
index 66043059d14..e7ac517b72f 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,56 +1432,40 @@ diff-write-contents-hooks
   (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)
-        (let* ((style (if (looking-at "\\*\\*\\*") 'context))
-               (start (line-beginning-position (if (eq style 'context) 3 2)))
-               (mid (if (eq style 'context)
-                        (save-excursion
-                          (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)
-                 ;; 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)))
-                 (save-excursion
-		(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))))
+(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
+      (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)
+                      (save-excursion
+                        (re-search-forward diff-context-mid-hunk-header-re
+                                           nil t)))))
+        (when (and ;; Don't try to fixup changes in the hunk header.
+               (>= beg start)
+               ;; Don't try to fixup changes in the mid-hunk header either.
+               (or (not mid)
+                   (< end (match-beginning 0))
+                   (> beg (match-end 0)))
+               (save-excursion
+		 (diff-end-of-hunk nil 'donttrustheader)
+                 ;; Don't try to fixup changes past the end of the hunk.
+                 (>= (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 @@ diff-mode
   ;; 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 @@ diff-minor-mode
 \\{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..cdccbe80299
--- /dev/null
+++ b/test/lisp/emacs-lisp/track-changes-tests.el
@@ -0,0 +1,149 @@
+;;; 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)))
+
+(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
+    (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)))
+      (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
-- 
2.43.0