From: Stefan Monnier Date: Wed, 17 Apr 2024 01:57:05 +0000 (-0400) Subject: track-changes.el: Minor changes for version 1.0 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=563f01499b8ee41656872f757b91442583a09837;p=emacs.git track-changes.el: Minor changes for version 1.0 Arrange for the library to be usable on older Emacsen, which includes reducing the noise when `before/after-change-functions` are badly paired or missing. Also, since the signal function receives the distance (for `:disjoint`), we don't need `track-changes--disjoint-threshold`: the signal function can simply do nothing when the distance is smaller than the threshold it wants to use. * lisp/emacs-lisp/track-changes.el: Prepare header for ELPA. (track-changes--tracker, track-changes--state): Don't use `:noinline`, so as to be compatible with Emacs<27. (track-changes-record-errors): New variable. (track-changes--recover-from-error): Use it. Record only the last 20 keys and the last 50 stack frames in the error log. (track-changes--disjoint-threshold): Delete variable. (track-changes--before): Don't use it any more. * lisp/progmodes/eglot.el (eglot--track-changes-signal): Coalesce disjoint changes nearer than what used to be coalesced because of `track-changes--disjoint-threshold`. (cherry picked from commit a33ab7565e20d9c04731491f6ae38a8d35be729f) --- diff --git a/lisp/emacs-lisp/track-changes.el b/lisp/emacs-lisp/track-changes.el index 9e62b8bdf30..6e4440b7771 100644 --- a/lisp/emacs-lisp/track-changes.el +++ b/lisp/emacs-lisp/track-changes.el @@ -3,6 +3,8 @@ ;; Copyright (C) 2024 Free Software Foundation, Inc. ;; Author: Stefan Monnier +;; Version: 1.0 +;; Package-Requires: ((emacs "24")) ;; This file is part of GNU Emacs. @@ -92,7 +94,7 @@ ;;;; Internal types and variables. (cl-defstruct (track-changes--tracker - (:noinline t) + ;; (:noinline t) ;Requires Emacs≥27 (:constructor nil) (:constructor track-changes--tracker ( signal state &optional @@ -100,7 +102,7 @@ signal state nobefore immediate) (cl-defstruct (track-changes--state - (:noinline t) + ;; (:noinline t) ;Requires Emacs≥27 (:constructor nil) (:constructor track-changes--state ())) "Object holding a description of a buffer state. @@ -164,6 +166,14 @@ This is used to try and detect cases where buffer modifications are \"lost\".") ;;;; Exposed API. +(defvar track-changes-record-errors + ;; By default, record errors only for non-release versions, because we + ;; presume that these might be too old to receive fixes, so better not + ;; annoy the user too much about errors. + (string-match "\\..*\\." emacs-version) + "If non-nil, keep track of errors in `before/after-chage-functions' calls. +The errors are kept in `track-changes--error-log'.") + (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. @@ -412,9 +422,6 @@ and re-enable the TRACKER corresponding to ID." (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).") @@ -424,12 +431,19 @@ Each element is a triplet (BUFFER-NAME BACKTRACE RECENT-KEYS).") ;; 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'!! + (if (not track-changes-record-errors) + (message "Recovering from confusing calls to `before/after-change-functions'!") + (warn "Missing/incorrect calls to `before/after-change-functions'!! Details logged to `track-changes--error-log'") - (push (list (buffer-name) - (backtrace-frames 'track-changes--recover-from-error) - (recent-keys 'include-cmds)) - track-changes--error-log) + (push (list (buffer-name) + (let* ((bf (backtrace-frames + #'track-changes--recover-from-error)) + (tail (nthcdr 50 bf))) + (when tail (setcdr tail '...)) + bf) + (let ((rk (recent-keys 'include-cmds))) + (substring rk -20))) + 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! @@ -453,11 +467,10 @@ Details logged to `track-changes--error-log'") (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 consider it - ;; as "near". - (length track-changes--before-string) + ;; If the distance is smaller than the size of the + ;; current change, then we may as well consider it + ;; as "near". + (max (length track-changes--before-string) size (- track-changes--before-end track-changes--before-beg))) diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index 135433cf1f2..2dbc65cf973 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -2666,7 +2666,9 @@ Records BEG, END and PRE-CHANGE-LENGTH locally." (defun eglot--track-changes-signal (id &optional distance) (cl-incf eglot--versioned-identifier) (cond - (distance (eglot--track-changes-fetch id)) + (distance + ;; When distance is <100, we may as well coalesce the changes. + (when (> distance 100) (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. @@ -2797,6 +2799,7 @@ When called interactively, use the currently active server" (list :textDocument (eglot--VersionedTextDocumentIdentifier) :contentChanges + (let ((changes (if full-sync-p (vector `(:text ,(eglot--widening (buffer-substring-no-properties (point-min) @@ -2810,6 +2813,8 @@ When called interactively, use the currently active server" when (numberp len) ;FIXME: Not needed with `track-changes'. vconcat `[,(list :range `(:start ,beg :end ,end) :rangeLength len :text text)])))) + (message "Sending changes: %S" changes) + changes))) (setq eglot--recent-changes nil) (jsonrpc--call-deferred server))))