unofficial mirror of bug-gnu-emacs@gnu.org 
 help / color / mirror / code / Atom feed
* bug#70077: An easier way to track buffer changes
@ 2024-03-29 16:15 Stefan Monnier via Bug reports for GNU Emacs, the Swiss army knife of text editors
  2024-03-29 18:12 ` Eli Zaretskii
                   ` (3 more replies)
  0 siblings, 4 replies; 50+ messages in thread
From: Stefan Monnier via Bug reports for GNU Emacs, the Swiss army knife of text editors @ 2024-03-29 16:15 UTC (permalink / raw)
  To: 70077
  Cc: Nicolas Goaziou, Ihor Radchenko, Alan Mackenzie,
	João Távora, Alan Zimmerman, Frédéric Bour,
	Phillip Lord, Stephen Leake, Yuan Fu, Qiantan Hong, monnier

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

Tags: patch

Our `*-change-functions` hook are fairly tricky to use right.
Some of the issues are:

- before and after calls are not necessarily paired.
- the beg/end values don't always match.
- there can be thousands of calls from within a single command.
- these 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 worst part is that those problems occur rarely, so many coders don't
see it at first and have to learn them the hard way, sometimes forcing
them to rethink their original design.

So I think we should provide something simpler.
I attached a proof-of-concept API which aims to do that, with the
following entry points:

    (defun track-changes-register ( signal)
      "Register a new tracker and return a new tracker ID.
    SIGNAL is a function that will be called with no argument when
    the current buffer is modified, so that we can react to the change.
    Once called, SIGNAL is not called again until `track-changes-fetch'
    is called with the corresponding tracker ID."
    
    (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."
    
    (defun track-changes-fetch (id func)
      "Fetch the pending changes.
    ID is the tracker ID returned by a previous `track-changes-register'.
    FUNC is a function.  It is called with 3 arguments (BEGIN END BEFORE)
    where BEGIN..END delimit the region that was changed since the last
    time `track-changes-fetch' was called and BEFORE is a string containing
    the previous content of that region.
    
    If no changes occurred since the last time, FUNC is not called and
    we return nil, otherwise we return the value returned by FUNC,
    and re-enable the TRACKER corresponding to ID."

It's not meant as a replacement of the existing hooks since it doesn't
try to accommodate some uses such as those that use before-c-f to
implement a finer-grained form of read-only text.

The driving design was:

- Try to provide enough info such that it is possible and easy to
  maintain a copy of the buffer simply by applying the reported changes.
  E.g. for uses such as `eglot.el` or `crdt.el`.
- Make the API less synchronous: take care of combining small changes
  into larger ones, and let the clients decide when they react to changes.

If you're in the Cc, it's because I believe you have valuable experience
with those hooks, so I'd be happy to hear your thought about whether
you think this would indeed (have) be(en) better than what we have.


        Stefan



[-- Attachment #2: track-changes.el --]
[-- Type: text/x-emacs-lisp, Size: 13002 bytes --]

;;; track-changes.el --- API to react to buffer modifications  -*- lexical-binding: t; -*-

;; Copyright (C) 2024  Free Software Foundation, Inc.

;; Author: Stefan Monnier <monnier@iro.umontreal.ca>

;; This file is part of GNU Emacs.

;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.

;;; Commentary:

;; This library is a layer of abstraction above `before-change-functions'
;; and `after-change-functions' which takes care of accumulating changes
;; until a time when its client finds it convenient to react to them.

;; It provides the following operations:
;;
;;     (track-changes-register SIGNAL)
;;     (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 ()
;;                    (track-changes-fetch
;;                     my-foo--change-tracker
;;                     (lambda (beg end before)
;;                       ..DO THE THING..))))))))

;;; Code:

;; FIXME: Try and do some sanity-checks (e.g. looking at `buffer-size'),
;; to detect if/when we somehow missed some changes.
;; FIXME: The API doesn't offer an easy way to signal a "full resync"
;; kind of change, as might be needed if we lost changes.

(require 'cl-lib)

(cl-defstruct (track-changes--tracker
               (:noinline t)
               (:constructor nil)
               (:constructor track-changes--tracker ( signal state)))
  ( signal nil :read-only t)
  state)

(cl-defstruct (track-changes--state
               (:noinline t)
               (:constructor nil)
               (:constructor track-changes--state ()))
  (beg (point-max))
  (end (point-min))
  (bbeg (point-max))                    ;BEG of the BEFORE string,
  (bend (point-min))                    ;END of the BEFORE string.
  (before nil)
  (next nil))

(defvar-local track-changes--trackers ())
(defvar-local track-changes--clean-trackers ())

(defvar-local track-changes--state nil)

(defun track-changes-register ( signal)
  "Register a new tracker and return a new tracker ID.
SIGNAL is a function that will be called with no argument when
the current buffer is modified, so that we can react to the change.
Once called, SIGNAL is not called again until `track-changes-fetch'
is called with the corresponding tracker ID."
  ;; FIXME: Add an optional arg to choose between `funcall' and `funcall-later'?
  (track-changes--clean-state)
  (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)))
    (push tracker track-changes--trackers)
    (push tracker track-changes--clean-trackers)
    tracker))

(defun track-changes-unregister (id)
  "Remove the tracker denoted by ID.
Trackers can consume resources (especially if `track-changes-fetch' is
not called), so it is good practice to unregister them when you don't
need them any more."
  (unless (memq id track-changes--trackers)
    (error "Unregistering a non-registered tracker: %S" id))
  (setq track-changes--trackers (delq id track-changes--trackers))
  (setq track-changes--clean-trackers (delq id track-changes--clean-trackers))
  (when (null track-changes--trackers)
    (setq track-changes--state nil)
    (remove-hook 'before-change-functions #'track-changes--before t)
    (remove-hook 'after-change-functions  #'track-changes--after  t)))


(defun track-changes--clean-p ()
  (null (track-changes--state-before track-changes--state)))

(defun track-changes--clean-state ()
  (cond
   ((null track-changes--state)
    ;; No state has been created yet.  Do it now.
    (setq track-changes--state (track-changes--state)))
   ((track-changes--clean-p) nil)
   (t
    ;; FIXME: We may be in-between a before-c-f and an after-c-f, so we
    ;; should save some of the current buffer in case an after-c-f comes
    ;; before a before-c-f.
    (let ((new (track-changes--state)))
      (setf (track-changes--state-next track-changes--state) new)
      (setq track-changes--state new)))))

(defun track-changes--before (beg end)
  (cl-assert track-changes--state)
  (cl-assert (<= beg end))
  (if (track-changes--clean-p)
      (progn
        (setf (track-changes--state-before track-changes--state)
              (buffer-substring-no-properties beg end))
        (setf (track-changes--state-bbeg track-changes--state) beg)
        (setf (track-changes--state-bend track-changes--state) end))
    (cl-assert
     (save-restriction
       (widen)
       (<= (point-min)
           (track-changes--state-bbeg track-changes--state)
           (track-changes--state-bend track-changes--state)
           (point-max))))
    (when (< beg (track-changes--state-bbeg track-changes--state))
      (let* ((old-bbeg (track-changes--state-bbeg track-changes--state))
             ;; To avoid O(N²) behavior when faced with many small changes,
             ;; we copy more than needed.
             (new-bbeg (min (max (point-min)
                                 (- old-bbeg
                                    (length (track-changes--state-before
                                             track-changes--state))))
                            beg)))
        (setf (track-changes--state-bbeg track-changes--state) beg)
        (cl-callf (lambda (old new) (concat new old))
            (track-changes--state-before track-changes--state)
          (buffer-substring-no-properties new-bbeg old-bbeg))))

    (when (< (track-changes--state-bend track-changes--state) end)
      (let* ((old-bend (track-changes--state-bend track-changes--state))
             ;; To avoid O(N²) behavior when faced with many small changes,
             ;; we copy more than needed.
             (new-bend (max (min (point-max)
                                 (+ old-bend
                                    (length (track-changes--state-before
                                             track-changes--state))))
                            end)))
        (setf (track-changes--state-bend track-changes--state) end)
        (cl-callf concat (track-changes--state-before track-changes--state)
          (buffer-substring-no-properties old-bend new-bend))))))

(defun track-changes--after (beg end len)
  (cl-assert track-changes--state)
  (cl-assert (track-changes--state-before track-changes--state))
  (let ((offset (- (- end beg) len)))
    (cl-incf (track-changes--state-bend track-changes--state) offset)
    (cl-assert
     (save-restriction
       (widen)
       (<= (point-min)
           (track-changes--state-bbeg track-changes--state)
           beg end
           (track-changes--state-bend track-changes--state)
           (point-max))))
    ;; 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 (<= (track-changes--state-bbeg track-changes--state)
                 (track-changes--state-beg track-changes--state)
                 beg end
                 (track-changes--state-end track-changes--state)
                 (track-changes--state-bend track-changes--state)))
  (while track-changes--clean-trackers
    (let ((tracker (pop track-changes--clean-trackers)))
      ;; FIXME: Use `funcall'?
      (funcall-later (track-changes--tracker-signal tracker) ()))))

(defun track-changes-fetch (id func)
  "Fetch the pending changes.
ID is the tracker ID returned by a previous `track-changes-register'.
FUNC is a function.  It is called with 3 arguments (BEGIN END BEFORE)
where BEGIN..END delimit the region that was changed since the last
time `track-changes-fetch' was called and BEFORE is a string containing
the previous content of that region.

If no changes occurred since the last time, FUNC is not called and
we return nil, otherwise we return the value returned by FUNC,
and re-enable the TRACKER corresponding to ID."
  (let ((beg nil)
        (end nil)
        (before nil)
        (states ()))
    ;; 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))))
    (when (null (track-changes--state-before (car states)))
      (cl-assert (eq (car states) track-changes--state))
      (setq states (cdr states)))
    (if (null states)
        (progn
          (cl-assert (memq id track-changes--clean-trackers))
          nil)
      (dolist (state states)
        (let ((prevbbeg (track-changes--state-bbeg state))
              (prevbend (track-changes--state-bend state))
              (prevbefore (track-changes--state-before state)))
          (if (not before)
              (progn
                ;; This is the most recent change.  Just initialize the vars.
                (setq beg (track-changes--state-beg state))
                (setq end (track-changes--state-end state))
                (setq before prevbefore)
                (unless (and (= beg prevbbeg) (= end prevbend))
                  (setq before
                        (substring before
                                   (- beg (track-changes--state-bbeg state))
                                   (- (length before)
                                      (- (track-changes--state-bend state)
                                         end))))))
            ;; FIXME: When merging "states", we disregard the `beg/end'
            ;; in favor of `bbeg/bend' which also works but is conservative.
            (let ((endb (+ beg (length before))))
              (when (< prevbbeg beg)
                (setq before (concat (buffer-substring-no-properties
                                      prevbbeg beg)
                                     before))
                (setq beg prevbbeg)
                (cl-assert (= endb (+ beg (length before)))))
              (when (< endb prevbend)
                (let ((new-end (+ end (- prevbend endb))))
                  (setq before (concat before
                                       (buffer-substring-no-properties
                                        end new-end)))
                  (setq end new-end)
                  (cl-assert (= prevbend (+ beg (length before))))
                  (setq endb (+ beg (length before)))))
              (cl-assert (<= beg prevbbeg prevbend endb))
              ;; The `prevbefore' is covered by the new one.
              (setq before
                    (concat (substring before 0 (- prevbbeg beg))
                            prevbefore
                            (substring before (- (length before)
                                                 (- endb prevbend)))))))))
      (cl-assert (<= (point-min) beg end (point-max)))
      ;; Clean the state of the tracker before calling `func', in case
      ;; `func' performs buffer modifications.
      (track-changes--clean-state)
      ;; Update the tracker's state before running `func' so we don't risk
      ;; mistakenly replaying the changes in case `func' exits non-locally.
      (setf (track-changes--tracker-state id) track-changes--state)
      (unwind-protect (funcall func beg end before)
        ;; Re-enable the tracker's signal only after running `func', so
        ;; as to avoid recursive invocations.
        (cl-pushnew 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.

^ permalink raw reply	[flat|nested] 50+ messages in thread

end of thread, other threads:[~2024-04-13 13:44 UTC | newest]

Thread overview: 50+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2024-03-29 16:15 bug#70077: An easier way to track buffer changes Stefan Monnier via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-03-29 18:12 ` Eli Zaretskii
2024-03-29 18:53   ` Stefan Monnier via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-03-30  6:34     ` Eli Zaretskii
2024-03-30 14:58       ` Stefan Monnier via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-03-30 16:45         ` Eli Zaretskii
2024-03-31  2:57           ` Stefan Monnier via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-04-01 11:53         ` Ihor Radchenko
2024-04-01 14:51           ` Stefan Monnier via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-04-01 17:49             ` Stefan Monnier via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-04-02 14:22               ` Ihor Radchenko
2024-04-02 15:17                 ` Stefan Monnier via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-04-02 16:21                   ` Ihor Radchenko
2024-04-02 17:51                     ` Stefan Monnier via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-04-03 12:34                       ` Ihor Radchenko
2024-04-03 12:45                         ` Stefan Monnier via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-04-04 17:58                           ` Ihor Radchenko
2024-03-30  3:17   ` Stefan Monnier via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-03-30  5:09     ` Stefan Monnier via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-03-29 22:20 ` phillip.lord
2024-03-29 22:59   ` Stefan Monnier via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-03-30  6:46     ` Eli Zaretskii
2024-03-30 12:06     ` phillip.lord
2024-03-30 13:39       ` Stefan Monnier via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-03-30  9:51 ` Ihor Radchenko
2024-03-30 12:49   ` Eli Zaretskii
2024-03-30 13:19     ` Ihor Radchenko
2024-03-30 13:31       ` Eli Zaretskii
2024-03-30 14:09   ` Stefan Monnier via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-04-05 22:12 ` Stefan Monnier via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-04-06  8:43   ` Eli Zaretskii
2024-04-08 15:24     ` Stefan Monnier via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-04-08 15:53       ` Eli Zaretskii
2024-04-08 17:17         ` Stefan Monnier via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-04-08 17:27           ` Andrea Corallo
2024-04-08 18:36           ` Eli Zaretskii
2024-04-08 20:57             ` Stefan Monnier via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-04-09  4:10               ` Eli Zaretskii
2024-04-08 20:45       ` Stefan Monnier via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-04-09  3:56         ` Eli Zaretskii
2024-04-09 23:30           ` Stefan Monnier via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-04-13 13:44             ` Stefan Monnier via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-04-06 17:37   ` Dmitry Gutov
2024-04-06 19:44     ` Stefan Monnier via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-04-07 14:40       ` Stefan Monnier via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-04-07 15:47         ` Dmitry Gutov
2024-04-07 14:07   ` Ihor Radchenko
2024-04-08 16:06     ` Stefan Monnier via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-04-09 17:35       ` Ihor Radchenko
2024-04-10  2:02         ` Stefan Monnier via Bug reports for GNU Emacs, the Swiss army knife of text editors

Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/emacs.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).