--- /dev/null
+;;; track-changes.el --- API to react to buffer modifications -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2024-2025 Free Software Foundation, Inc.
+
+;; Author: Stefan Monnier <monnierNOSPAMiro.umontreal.ca>
+;; Version: 1.4
+;; Package-Requires: ((emacs "24"))
+
+;; 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..))))))))
+
+;;; News:
+
+;; v1.3:
+;;
+;; - Fix bug#73041.
+;; - New `trace' setting for `track-changes-record-errors'.
+;;
+;; v1.2:
+;;
+;; - New function `track-changes-inconsistent-state-p'.
+
+;;; 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.
+;; - We could also let them provide another function to run in
+;; before-c-f to signal errors if the change is not acceptable,
+;; but contrary to before-c-f it would be called only when we
+;; move t-c--before-beg/end so it scales better when there are
+;; many small changes.
+
+(require 'cl-lib)
+
+;;;; Internal types and variables.
+
+(cl-defstruct (track-changes--tracker
+ ;; (:noinline t) ;Requires Emacs≥27
+ (:constructor nil)
+ (:constructor track-changes--tracker ( signal state
+ &optional
+ nobefore immediate)))
+ signal state nobefore immediate)
+
+(cl-defstruct (track-changes--state
+ ;; (:noinline t) ;Requires Emacs≥27
+ (: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\".")
+
+(defvar track-changes--trace nil
+ "Ring holding a trace of recent calls to the API.
+Each call is recorded as a (BUFFER-NAME . BACKTRACE).")
+
+;;;; Exposed API.
+
+(defvar track-changes-record-errors
+ ;; By default, record errors only for non-release versions, because we
+ ;; presume that these might be too old to receive fixes, so better not
+ ;; annoy the user too much about errors.
+ (string-match "\\..*\\." emacs-version)
+ "If non-nil, keep track of errors in `before/after-change-functions' calls.
+The errors are kept in `track-changes--error-log'.
+If set to `trace', then we additionally keep a trace of recent calls to the 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."
+ (track-changes--trace)
+ (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."
+ (track-changes--trace)
+ (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."
+ (track-changes--trace)
+ (cl-assert (memq id track-changes--trackers))
+ (unless (equal track-changes--buffer-size (buffer-size))
+ (track-changes--recover-from-error
+ `(buffer-size ,track-changes--buffer-size ,(buffer-size))))
+ (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)))))))
+ (unwind-protect
+ (if (null beg)
+ (progn
+ (cl-assert (null states))
+ ;; We may have been called in the middle of another
+ ;; `track-changes-fetch', in which case we may be in a clean
+ ;; state but not yet on `track-changes--clean-trackers'
+ ;;(cl-assert (memq id track-changes--clean-trackers))
+ (cl-assert (eq (track-changes--tracker-state id)
+ track-changes--state))
+ ;; Nothing to do.
+ nil)
+ ;; ID may still be in `track-changes--clean-trackers' if
+ ;; `after-change-functions' was skipped.
+ ;;(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)
+ (funcall func beg end (or before lenbefore)))
+ ;; Re-enable the tracker's signal only after running `func', so
+ ;; as to avoid nested invocations.
+ (cl-pushnew id track-changes--clean-trackers))))
+
+(defun track-changes-inconsistent-state-p ()
+ "Return whether the current buffer is in an inconsistent state.
+Ideally `before/after-change-functions' should be called for each and every
+buffer change, but some packages make transient changes without
+running those hooks.
+This function tries to detect those situations so clients can decide
+to postpone their work to a later time when the buffer is hopefully
+returned to a consistent state."
+ (or (not (equal track-changes--buffer-size (buffer-size)))
+ inhibit-modification-hooks))
+
+;;;; Auxiliary functions.
+
+(defun track-changes--backtrace (n &optional base)
+ (let ((frames nil))
+ (catch 'done
+ (mapbacktrace (lambda (&rest frame)
+ (if (>= (setq n (- n 1)) 0)
+ (push frame frames)
+ (push '... frames)
+ (throw 'done nil)))
+ (or base #'track-changes--backtrace)))
+ (nreverse frames)))
+
+(defun track-changes--trace ()
+ (when (eq 'trace track-changes-record-errors)
+ (require 'ring)
+ (declare-function ring-insert "ring" (ring item))
+ (declare-function make-ring "ring" (size))
+ (unless track-changes--trace
+ (setq track-changes--trace (make-ring 10)))
+ (ring-insert track-changes--trace
+ (cons (buffer-name)
+ (track-changes--backtrace
+ 10 #'track-changes--trace)))))
+
+(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--error-log ()
+ "List of errors encountered.
+Each element is a tuple [BUFFER-NAME BACKTRACE RECENT-KEYS TRACE].
+where both RECENT-KEYS and TRACE are sorted oldest-first and
+backtraces have the deepest frame first.")
+
+(defun track-changes--recover-from-error (&optional info)
+ ;; 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.
+ (if (not track-changes-record-errors)
+ (message "Recovering from confusing calls to `before/after-change-functions'!")
+ (warn "Missing/incorrect calls to `before/after-change-functions'!!
+Details logged to `track-changes--error-log'")
+ (push (vector (buffer-name) info
+ (track-changes--backtrace
+ 50 #'track-changes--recover-from-error)
+ (let ((rk (recent-keys 'include-cmds)))
+ (if (< (length rk) 20) rk (substring rk -20)))
+ (when (and (eq 'trace track-changes-record-errors)
+ (fboundp 'ring-elements))
+ (apply #'vector
+ (nreverse (ring-elements track-changes--trace)))))
+ 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)
+ (track-changes--trace)
+ (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
+ ;; If the distance is smaller than the size of the
+ ;; current change, then we may as well consider it
+ ;; as "near".
+ (max (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 disjointedness 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 disjointedness 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))
+ (save-restriction
+ (widen)
+ (cl-assert (<= (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 beg (max (point-min)
+ (- old-bbeg
+ (length track-changes--before-string))))))
+ (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 end (min (point-max)
+ (+ old-bend
+ (length track-changes--before-string))))))
+ (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)
+ (track-changes--trace)
+ (cl-assert track-changes--state)
+ (let ((offset (- (- end beg) len)))
+ (cl-incf track-changes--buffer-size offset)
+ (if (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)
+ (cl-incf track-changes--before-end offset))
+ (setq track-changes--before-clean nil)
+ (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 `(unexpected-after ,beg ,end ,len))
+ ;; 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
+ ;; or the tracker was unregistered in the mean time.
+ (when (and (not (memq tracker track-changes--clean-trackers))
+ (memq tracker track-changes--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 is a cheaper version of (track-changes-fetch id #'ignore),
+;; e.g. for clients that don't want to see their 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 ends here
projects / emacsconfig.git / commitdiff