1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2026-01-02 10:11:05 -08:00

track-changes.el (track-changes-undo-only): New var

* lisp/emacs-lisp/track-changes.el (track-changes-undo-only): New var.
(track-changes-fetch): Bind it.
(track-changes--state): New slot `undo`.
(track-changes--after): Set it.

* lisp/vc/diff-mode.el (diff--track-changes-function): Use the
new var.

* doc/lispref/text.texi (Tracking changes): Mention
`track-changes-undo-only`.
This commit is contained in:
Stefan Monnier 2025-12-28 22:32:23 -05:00
parent 8f2557844d
commit e119514ae8
4 changed files with 52 additions and 4 deletions

View file

@ -6582,6 +6582,19 @@ 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
@defvar track-changes-undo-only
If your code uses @code{track-changes} to perform further modifications
to the buffer (for example, to mark the parts of the buffer that have
been edited), then you may want to refrain from making those
modifications when the changes are the result of an undo (which
presumably also undoes the modifications you had applied back when the
corresponding edit was made).
To that end @code{track-changes-fetch} binds
@code{track-changes-undo-only} to non-@code{nil} during calls to
@var{func} if the changes were the result of undo.
@end defvar
@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

View file

@ -1119,6 +1119,10 @@ convention. Also, the ':match?' predicate can now take the regexp as
either the first or second argument, so it works with both tree-sitter
convention (regexp arg second) and Emacs convention (regexp arg first).
+++
** Track-changes
*** New variable 'track-changes-undo-only' to distinguish undo changes.
** Hideshow
+++

View file

@ -3,7 +3,7 @@
;; Copyright (C) 2024-2025 Free Software Foundation, Inc.
;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
;; Version: 1.4
;; Version: 1.5
;; Package-Requires: ((emacs "24"))
;; This file is part of GNU Emacs.
@ -76,6 +76,11 @@
;;; News:
;; v1.5:
;;
;; - New variable `track-changes-undo-only' to distinguish undo changes
;; from others.
;;
;; v1.3:
;;
;; - Fix bug#73041.
@ -100,6 +105,19 @@
;; move t-c--before-beg/end so it scales better when there are
;; many small changes.
;;;; Distinguish undo-vs-nonundo
;; In practice, it seems that this distinction matters only for those
;; clients which make further buffer-changes in response to buffer changes,
;; (e.g. updating diff chunk headers on the fly, line-centering on the fly,
;; inserting criticmarkup to keep track of buffer edits, ...).
;; If all or none of the changes occurred during undo, then it's easy.
;; If some did and some didn't and we need to merge them into a single change,
;; there are two options:
;; - Do the disjoint thing.
;; - Merge them into a single change that's considered as "nonundo".
;; We currently don't implement "the disjoint way".
(require 'cl-lib)
;;;; Internal types and variables.
@ -130,6 +148,7 @@ state is created."
(beg (point-max))
(end (point-min))
(before nil)
(undo t :type boolean) ;Non-nil until proven otherwise.
(next nil))
(defvar-local track-changes--trackers ()
@ -190,6 +209,9 @@ Each call is recorded as a (BUFFER-NAME . BACKTRACE).")
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.")
(defvar track-changes-undo-only nil
"Bound to non-nil by `track-changes-fetch' if the change was an undo.")
(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.
@ -281,7 +303,10 @@ 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."
and re-enable the TRACKER corresponding to ID.
During the call to FUNC, `track-changes-undo-only' indicates if the changes
were the result of `undo'."
(track-changes--trace)
(cl-assert (memq id track-changes--trackers))
(unless (equal track-changes--buffer-size (buffer-size))
@ -289,6 +314,7 @@ and re-enable the TRACKER corresponding to ID."
`(buffer-size ,track-changes--buffer-size ,(buffer-size))))
(let ((beg nil)
(end nil)
(is-undo t)
(before t)
(lenbefore 0)
(states ()))
@ -316,6 +342,7 @@ and re-enable the TRACKER corresponding to ID."
(setq states nil)))
(dolist (state states)
(when is-undo (setq is-undo (track-changes--state-undo state)))
(let ((prevbeg (track-changes--state-beg state))
(prevend (track-changes--state-end state))
(prevbefore (track-changes--state-before state)))
@ -384,7 +411,8 @@ and re-enable the TRACKER corresponding to ID."
;; 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)))
(let ((track-changes-undo-only is-undo))
(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))))
@ -629,6 +657,8 @@ Details logged to `track-changes--error-log'")
beg end
(track-changes--state-end track-changes--state)
track-changes--before-end)))))
(unless undo-in-progress
(setf (track-changes--state-undo track-changes--state) nil))
(while track-changes--clean-trackers
(let ((tracker (pop track-changes--clean-trackers)))
(if (track-changes--tracker-immediate tracker)

View file

@ -1615,7 +1615,8 @@ else cover the whole buffer."
;; 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))
(when (and (not track-changes-undo-only)
(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)