From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.io!.POSTED.blaine.gmane.org!not-for-mail From: Stefan Monnier via "Bug reports for GNU Emacs, the Swiss army knife of text editors" Newsgroups: gmane.emacs.bugs Subject: bug#70077: An easier way to track buffer changes Date: Mon, 08 Apr 2024 16:45:39 -0400 Message-ID: References: <86frvy51af.fsf@gnu.org> Reply-To: Stefan Monnier Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" Injection-Info: ciao.gmane.io; posting-host="blaine.gmane.org:116.202.254.214"; logging-data="24923"; mail-complaints-to="usenet@ciao.gmane.io" User-Agent: Gnus/5.13 (Gnus v5.13) Cc: acm@muc.de, yantar92@posteo.net, 70077@debbugs.gnu.org To: Eli Zaretskii Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Mon Apr 08 22:47:23 2024 Return-path: Envelope-to: geb-bug-gnu-emacs@m.gmane-mx.org Original-Received: from lists.gnu.org ([209.51.188.17]) by ciao.gmane.io with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.92) (envelope-from ) id 1rtvti-0006Bx-EZ for geb-bug-gnu-emacs@m.gmane-mx.org; Mon, 08 Apr 2024 22:47:23 +0200 Original-Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1rtvtK-0005WD-KT; Mon, 08 Apr 2024 16:46:58 -0400 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1rtvtJ-0005Vv-PD for bug-gnu-emacs@gnu.org; Mon, 08 Apr 2024 16:46:57 -0400 Original-Received: from debbugs.gnu.org ([2001:470:142:5::43]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1rtvtJ-00082M-FN for bug-gnu-emacs@gnu.org; Mon, 08 Apr 2024 16:46:57 -0400 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1rtvtQ-0001lz-A3 for bug-gnu-emacs@gnu.org; Mon, 08 Apr 2024 16:47:04 -0400 X-Loop: help-debbugs@gnu.org Resent-From: Stefan Monnier Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Mon, 08 Apr 2024 20:47:04 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 70077 X-GNU-PR-Package: emacs X-GNU-PR-Keywords: patch Original-Received: via spool by 70077-submit@debbugs.gnu.org id=B70077.17126091796563 (code B ref 70077); Mon, 08 Apr 2024 20:47:04 +0000 Original-Received: (at 70077) by debbugs.gnu.org; 8 Apr 2024 20:46:19 +0000 Original-Received: from localhost ([127.0.0.1]:47785 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1rtvsb-0001h4-FE for submit@debbugs.gnu.org; Mon, 08 Apr 2024 16:46:18 -0400 Original-Received: from mailscanner.iro.umontreal.ca ([132.204.25.50]:15124) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1rtvsR-0001f6-LN for 70077@debbugs.gnu.org; Mon, 08 Apr 2024 16:46:10 -0400 Original-Received: from pmg3.iro.umontreal.ca (localhost [127.0.0.1]) by pmg3.iro.umontreal.ca (Proxmox) with ESMTP id 5D45C441C2A; Mon, 8 Apr 2024 16:45:49 -0400 (EDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/simple; d=iro.umontreal.ca; s=mail; t=1712609141; bh=DefC+tGrm+5mDXXBCXt5f+tPfvKyMAXy9fX0ww7LxEA=; h=From:To:Cc:Subject:In-Reply-To:References:Date:From; b=AbSH/5S1kChQKq7DaBZYFTXLVNpOBbewigUrcJMGkdOz9roYHRpvV6ZyXuINhqMAp 5synTrW/P5wjJZavLNFqBpiEbpJa9J89LromNW9bgFJJ24RKsftjkM3OG9xvKN32He AF1l2cE6pgpKYtQv1RRm2jfZCGNSu67EmxtWmlZYrrBdN0qtCY3n+bPef++qVlnc+X YJNbmcudvDTaaBjcCaj/sv9gkkEgc5HhADIxEs2lEyuH1Ajxprnj9VFVJklqzjXKXq onErKB+0BsLqW93cq++mB6bCCnQuxmm2fHJV6qV29X+bXNrz8SNoqm9lRvNzI+BsyP /CfzAiNvjycnA== Original-Received: from mail01.iro.umontreal.ca (unknown [172.31.2.1]) by pmg3.iro.umontreal.ca (Proxmox) with ESMTP id 6F5464413F4; Mon, 8 Apr 2024 16:45:41 -0400 (EDT) Original-Received: from pastel (unknown [45.72.201.215]) by mail01.iro.umontreal.ca (Postfix) with ESMTPSA id 1FA35120370; Mon, 8 Apr 2024 16:45:41 -0400 (EDT) In-Reply-To: (Stefan Monnier's message of "Mon, 08 Apr 2024 11:24:38 -0400") X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: bug-gnu-emacs@gnu.org List-Id: "Bug reports for GNU Emacs, the Swiss army knife of text editors" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Original-Sender: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Xref: news.gmane.io gmane.emacs.bugs:282954 Archived-At: --=-=-= Content-Type: text/plain >> Last, but not least: this needs suitable changes in NEWS and ELisp >> manual. > Working on it. Here it is (and aso on `scratch/track-changes`). Stefan --=-=-= Content-Type: text/x-diff; charset=iso-8859-1 Content-Disposition: inline; filename=0001-lisp-emacs-lisp-track-changes.el-New-file.patch Content-Transfer-Encoding: quoted-printable >From b676b0ff3f046a1456a433a4b7741599c7ae4714 Mon Sep 17 00:00:00 2001 From: Stefan Monnier 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. * doc/lispref/text.texi (Tracking changes): New subsection. * 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` when available. (eglot--track-changes-signal): New function, partly extracted from `eglot--after-change`. (eglot--after-change): Use it. (eglot--track-changes-fetch): New function. (eglot--signal-textDocument/didChange): Use it. * 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`. --- doc/lispref/text.texi | 141 +++++ etc/NEWS | 11 + lisp/emacs-lisp/track-changes.el | 599 ++++++++++++++++++++ lisp/progmodes/eglot.el | 64 ++- lisp/vc/diff-mode.el | 85 ++- test/lisp/emacs-lisp/track-changes-tests.el | 156 +++++ 6 files changed, 1003 insertions(+), 53 deletions(-) create mode 100644 lisp/emacs-lisp/track-changes.el create mode 100644 test/lisp/emacs-lisp/track-changes-tests.el diff --git a/doc/lispref/text.texi b/doc/lispref/text.texi index 18f0ee88fe5..2875f6f6ba8 100644 --- a/doc/lispref/text.texi +++ b/doc/lispref/text.texi @@ -6375,3 +6375,144 @@ Change Hooks use @code{combine-change-calls} or @code{combine-after-change-calls} instead. @end defvar + +@node Tracking changes +@subsection Tracking changes +@cindex track-changes + +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 of bugs in the C code or because of +inappropriate 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 + +The start tracking changes, you have to call +@code{track-changes-register}, passing it a @var{signal} function as +argument. This will return a tracker @var{id} which is used to identify +your tracker to the other functions of the library. The other main +function of the library is @code{track-changes-fetch} which lets you +fetch the changes you have not yet processed. + +When the buffer is modified, the library will call the @var{signal} +function to inform you of that change and will immediately start +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 processed +the change. + +To process changes, you need to call @code{track-changes-fetch}, which +will provide you with the bounds of the changes accumulated since the +last call, as well as the previous content of that region. It will also +``re-arm'' 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 @emph{tracker}. 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. 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-nil value as the @var{immediate} argument in which case the +library will call 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-nil value for the @var{before} +argument. This will make it so the library provides you only with the +length of the previous content, just like +@code{after-change-functions}. It will also allow 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-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-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 +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. + +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 makes sure that the @var{signal} function will not be +called while you're still processing past changes. +@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 b2543ae77d9..d85b65abd0b 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1569,6 +1569,17 @@ This allows disabling JavaScript in xwidget Webkit s= essions. * New Modes and Packages in Emacs 30.1 =20 +** 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 =20 +++ diff --git a/lisp/emacs-lisp/track-changes.el b/lisp/emacs-lisp/track-chang= es.el new file mode 100644 index 00000000000..fef74074582 --- /dev/null +++ b/lisp/emacs-lisp/track-changes.el @@ -0,0 +1,599 @@ +;;; track-changes.el --- API to react to buffer modifications -*- lexical= -binding: t; -*- + +;; Copyright (C) 2024 Free Software Foundation, Inc. + +;; Author: Stefan Monnier + +;; 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 . + +;;; 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 s= tate, +;; 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) + +;;;; 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 c= an +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 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 #\\=3D'track-changes--before before-change-functi= ons).") + +(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-functio= ns' +and should thus be extra careful: don't modify the buffer, don't call a fu= nction +that may block, ... +In order to prevent the upcoming change from being combined with the previ= ous +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-function= s' +and should thus be extra careful: don't modify the buffer, don't call a fu= nction +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-tracke= rs)) + (setq track-changes--disjoint-trackers + (delq id track-changes--disjoint-trackers)) + (when (cl-every #'track-changes--tracker-nobefore track-changes--tracker= s) + (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) prevbefor= e)) + (setq before + (unless (track-changes--tracker-nobefore id) prevbefor= e))) + (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 (=3D 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 (=3D prevend (+ beg lenbefore))) + (setq endb (+ beg lenbefore)))) + (cl-assert (<=3D 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 (<=3D (point-min) beg end (point-max))) + ;; Update the tracker's state *before* running `func' so we don't ri= sk + ;; 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 (<=3D (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 (<=3D 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 par= t. + (unless (=3D (- track-changes--before-end track-changes--before-be= g) + (- 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 th= at + ;; `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 (<=3D 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 conside= r 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-tracke= rs) + (setq found t))) + found)) + ;; There's at least one `tracker' that wants to know about dis= joint + ;; 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) + (<=3D (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=B2) behavior when faced with many small c= hanges, + ;; we copy more than needed. + (new-bbeg (min (max (point-min) + (- old-bbeg + (length track-changes--before-stri= ng))) + 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=B2) behavior when faced with many small c= hanges, + ;; we copy more than needed. + (new-bend (max (min (point-max) + (+ old-bend + (length track-changes--before-stri= ng))) + 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) + (<=3D (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 + (<=3D 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. + +;; 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-gr= oup'. + (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..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) =20 ;; 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 l= ike + ;; 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))))) =20 +(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 str= ings. + (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. =20 @@ -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.") =20 +(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 @@ eglot--managed-mode ("utf-8" (eglot--setq-saving eglot-current-linepos-function #'eglot-utf-8-li= nepos) (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 f= irst (add-hook 'kill-buffer-hook #'eglot--signal-textDocument/didClose nil = t) @@ -1998,6 +2027,9 @@ eglot--managed-mode 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 @@ eglot--document-changed-hook (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 @@ eglot--after-change `(,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 @@ eglot-handle-request (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 @@ eglot--signal-textDocument/didChange ;; 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-chang= es'. 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. =20 ;;; Code: +(require 'easy-mmode) +(require 'track-changes) (eval-when-compile (require 'cl-lib)) (eval-when-compile (require 'subr-x)) -(require 'easy-mmode) =20 (autoload 'vc-find-revision "vc") (autoload 'vc-find-revision-no-save "vc") @@ -1431,38 +1432,23 @@ diff-write-contents-hooks (if (buffer-modified-p) (diff-fixup-modifs (point-min) (point-max))) nil) =20 -;; 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 @@ diff-post-command-hook (re-search-forward diff-context-mid-hunk-header-= re nil t))))) (when (and ;; Don't try to fixup changes in the hunk header. - (>=3D (car diff-unhandled-changes) start) + (>=3D beg start) ;; Don't try to fixup changes in the mid-hunk header eith= er. (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. - (>=3D (point) (cdr diff-unhandled-changes)))) - (diff-fixup-modifs (point) (cdr diff-unhandled-changes))))) - (setq diff-unhandled-changes nil)))) + (>=3D (point) end))) + (diff-fixup-modifs (point) end))))))) =20 (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= ))) =20 ;; 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 ni= l t) + (unless diff--track-changes + (setq diff--track-changes + (track-changes-register #'diff--track-changes-signal + :nobefore t)))))) =20 ;;; Handy hook functions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;= ;;; =20 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..eab9197030f --- /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 . + +;;; 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 =3D %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 + (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=3D> %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) + (random 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 (=3D (random 50) 0))) + (track-changes-tests--message "Silent insertion") + (let ((inhibit-modification-hooks t)) + (insert "a"))) + ((and 8 (guard (=3D (random 10) 0))) + (track-changes-tests--message "Revert") + (insert-file-contents file nil nil nil 'replace)) + ((and 8 (guard (=3D (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 e= nd) + (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=3D%d disjoint: %d/%d=3D%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 --=20 2.43.0 --=-=-=--