lisp/emacs-lisp/track-changes.el: New filescratch/track-changes

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`.

1 files changed, 60 insertions, 4 deletions

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)
 
 ;; 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 @@ return value is fed through the corresponding inverse function
   "Calculate number of UTF-16 code units from position given by LBP.
 LBP defaults to `eglot--bol'."
   (/ (- (length (encode-coding-region (or lbp (eglot--bol))
+                                      ;; FIXME: How could `point' ever be
+                                      ;; larger than `point-max' (sounds like
+                                      ;; a bug in Emacs).
                                       ;; Fix github#860
                                       (min (point) (point-max)) 'utf-16 t))
         2)
@@ -1749,6 +1753,24 @@ LBP defaults to `eglot--bol'."
          :character (progn (when pos (goto-char pos))
                            (funcall eglot-current-linepos-function)))))
 
+(defun eglot--virtual-pos-to-lsp-position (pos string)
+  "Return the LSP position at the end of STRING if it were inserted at POS."
+  (eglot--widening
+   (goto-char pos)
+   (forward-line 0)
+   ;; LSP line is zero-origin; Emacs is one-origin.
+   (let ((posline (1- (line-number-at-pos nil t)))
+         (linebeg (buffer-substring (point) pos))
+         (colfun eglot-current-linepos-function))
+     ;; Use a temp buffer because:
+     ;; - I don't know of a fast way to count newlines in a string.
+     ;; - We currently don't have `eglot-current-linepos-function' for strings.
+     (with-temp-buffer
+       (insert linebeg string)
+       (goto-char (point-max))
+       (list :line (+ posline (1- (line-number-at-pos nil t)))
+             :character (funcall colfun))))))
+
 (defvar eglot-move-to-linepos-function #'eglot-move-to-utf-16-linepos
   "Function to move to a position within a line reported by the LSP server.
 
@@ -1946,6 +1968,8 @@ For example, to keep your Company customization, add the symbol
   "A hook run by Eglot after it started/stopped managing a buffer.
 Use `eglot-managed-p' to determine if current buffer is managed.")
 
+(defvar-local eglot--track-changes nil)
+
 (define-minor-mode eglot--managed-mode
   "Mode for source buffers managed by some Eglot project."
   :init-value nil :lighter nil :keymap eglot-mode-map
@@ -1959,8 +1983,13 @@ Use `eglot-managed-p' to determine if current buffer is managed.")
       ("utf-8"
        (eglot--setq-saving eglot-current-linepos-function #'eglot-utf-8-linepos)
        (eglot--setq-saving eglot-move-to-linepos-function #'eglot-move-to-utf-8-linepos)))
-    (add-hook 'after-change-functions #'eglot--after-change nil t)
-    (add-hook 'before-change-functions #'eglot--before-change nil t)
+    (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 first
     (add-hook 'kill-buffer-hook #'eglot--signal-textDocument/didClose nil t)
@@ -1998,6 +2027,9 @@ Use `eglot-managed-p' to determine if current buffer is managed.")
                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 @@ buffer."
 (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 @@ Records BEG, END and PRE-CHANGE-LENGTH locally."
                `(,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 @@ When called interactively, use the currently active server"
 (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 @@ When called interactively, use the currently active server"
                    ;; 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-changes'.
                    vconcat `[,(list :range `(:start ,beg :end ,end)
                                     :rangeLength len :text text)]))))
       (setq eglot--recent-changes nil)