Package: emacs;
Reported by: Stéphane Marks <shipmints <at> gmail.com>
Date: Sun, 13 Jul 2025 18:08:01 UTC
Severity: normal
Tags: patch
View this message in rfc822 format
From: Spencer Baugh <sbaugh <at> janestreet.com> To: Stéphane Marks <shipmints <at> gmail.com> Cc: Kristoffer Balintona <krisbalintona <at> gmail.com>, Joost Kremers <joostkremers <at> fastmail.fm>, 79009 <at> debbugs.gnu.org, Visuwesh <visuweshm <at> gmail.com>, Adam Porter <adam <at> alphapapa.net>, Lars Ingebrigtsen <larsi <at> gnus.org>, Augusto Stoffel <arstoffel <at> gmail.com>, ijqq <at> protonmail.com Subject: bug#79009: [PATCH] Improve 'vtable' object handling, cache handling, messages, [PATCH] Improve 'vtable' object handling, cache handling, messages Date: Tue, 15 Jul 2025 10:02:18 -0400
[Message part 1 (text/plain, inline)]
Stéphane Marks <shipmints <at> gmail.com> writes:
> On Mon, Jul 14, 2025 at 3:54 PM Spencer Baugh <sbaugh <at> janestreet.com> wrote:
>
> Stéphane Marks <shipmints <at> gmail.com> writes:
> > On Sun, Jul 13, 2025 at 2:16 PM Stéphane Marks <shipmints <at> gmail.com> wrote:
> > I've updated the broader vtable update in the referenced 78843 bug to check out if interested.
> >
> > I've removed support for the duplicate-object feature. After careful consideration, it was half baked and I think better for
> vtable
> > programmers to handle their own objects. I will be sure the documentation stresses to avoid duplicate objects as vtable's
> design is
> > predicated on unique objects (or race conditions ensue among duplicate object references).
>
> Thank you, this was going to be my first bit of feedback.
>
> Folowup question: What is the motivation for adding customizable object
> equality? Could the need for that be avoided by some changes specific
> to vtable-update-object?
>
> It's really a policy question and future proofing. I believe Lars originated this idea and probably has use cases for this in his vtable
> code.
You need to justify the addition of the feature more than that. If
there's no concrete use case we shouldn't add it.
> > Attaching the updated patch which is also formatted to avoid mere whitespace changes.
>
> Thanks for this too.
>
> > From e7bb61becb15e07ebd3e54cf2c1ea2becada09b0 Mon Sep 17 00:00:00 2001
> > From: =?UTF-8?q?St=C3=A9phane=20Marks?= <shipmints <at> gmail.com>
> > Date: Sun, 13 Jul 2025 13:32:28 -0400
> > Subject: [PATCH] Improve 'vtable' object handling, cache handling, messages
> >
> > Add object equality function override (defaults to existing 'eq'
> > behavior). Add column comparator to address object
> > sorting (defaults to existing behavior). Correct cache
> > references to prime the cache as needed. Add cache accessor
> > functions. Add table name slot to improve errors and
> > messages (defaults to "*vtable*").
> >
> > Added tests.
> >
> > * lisp/emacs-lisp/vtable.el (vtable-column): Add comparator
> > slot.
> > (vtable): Add name, object-equal slots.
> > (make-vtable): Initialize new slots.
> > (vtable-goto-object): Use object-equal.
> > (vtable-update-object): Use object-equal, use cache accessor,
> > improve messages.
> > (vtable-remove-object): Use object-equal, prime cache, use cache
> > functions, improve messages.
> > (vtable-insert-object): Use object-equal, use cache accessor,
> > improve messages.
> > (vtable-insert): Prime cache, use cache accessor.
> > (vtable--sort): Use column comparator, prime cache, use cache
> > accessor.
> > (vtable--compute-width): Improve message.
> > (vtable--widths): Use cache accessor.
> >
> > * test/lisp/emacs-lisp/vtable-tests.el
> > (test-vstable-compute-columns): Renamed to
> > test-vtable-compute-columns.
> > (test-vtable-insert-object): Changed buffer name to non-hidden.
> > (test-vtable-update-object, test-vtable-remove-object)
> > (test-vtable-object-equal, test-vtable-column-comparator): New
> > test.
> > ---
> > lisp/emacs-lisp/vtable.el | 143 ++++++++++++++++++++-------
> > test/lisp/emacs-lisp/vtable-tests.el | 106 +++++++++++++++++++-
> > 2 files changed, 210 insertions(+), 39 deletions(-)
> >
> > diff --git a/lisp/emacs-lisp/vtable.el b/lisp/emacs-lisp/vtable.el
> > index 00785113edb..31ef73d5eb4 100644
> > --- a/lisp/emacs-lisp/vtable.el
> > +++ b/lisp/emacs-lisp/vtable.el
> > @@ -45,14 +45,18 @@ vtable-column
> > getter
> > formatter
> > displayer
> > + comparator
> > -numerical
> > -aligned)
> >
> > (defclass vtable ()
> > - ((columns :initarg :columns :accessor vtable-columns)
> > + ((name :initarg :name :accessor vtable-name)
> > + (columns :initarg :columns :accessor vtable-columns)
> > (objects :initarg :objects :accessor vtable-objects)
> > (objects-function :initarg :objects-function
> > :accessor vtable-objects-function)
> > + (object-equal :initarg :object-equal
> > + :accessor vtable-object-equal)
>
> (I feel like there's probably a better name for this but I don't know
> what it would be)
>
> > (getter :initarg :getter :accessor vtable-getter)
> > (formatter :initarg :formatter :accessor vtable-formatter)
> > (displayer :initarg :displayer :accessor vtable-displayer)
> > @@ -86,7 +90,12 @@ vtable-header-line-map
> > "<follow-link>" 'mouse-face
> > "<mouse-2>" #'vtable-header-line-sort)
> >
> > -(cl-defun make-vtable (&key columns objects objects-function
> > +(cl-defun make-vtable (&key
> > + (name "*vtable*")
> > + columns
> > + objects
> > + objects-function
> > + (object-equal #'eq)
> > getter
> > formatter
> > displayer
>
> No need to reformat this.
>
> Getting ready for more slots (and I kind of like the format as it's easier for me to read).
Ah fair, I didn't notice the new key you added first, it's fine then.
> > @@ -113,8 +122,10 @@ make-vtable
> > (let ((table
> > (make-instance
> > 'vtable
> > + :name name
> > :objects objects
> > :objects-function objects-function
> > + :object-equal object-equal
> > :getter getter
> > :formatter formatter
> > :displayer displayer
> > @@ -132,7 +143,8 @@ make-vtable
> > ;; Auto-generate the columns.
> > (unless columns
> > (unless objects
> > - (error "Can't auto-generate columns; no objects"))
> > + (error "Can't auto-generate columns; no objects (vtable `%s')"
> > + (vtable-name table)))
> > (setq columns (make-list (length (car objects)) "")))
> > (setf (vtable-columns table)
> > (mapcar (lambda (column)
> > @@ -251,14 +263,15 @@ vtable-goto-object
> > Return the position of the object if found, and nil if not."
> > (let ((start (point)))
> > (vtable-beginning-of-table)
> > + (let ((predicate (vtable-object-equal (vtable-current-table))))
> > (save-restriction
> > (narrow-to-region (point) (save-excursion (vtable-end-of-table)))
> > - (if (text-property-search-forward 'vtable-object object #'eq)
> > + (if (text-property-search-forward 'vtable-object object predicate)
> > (progn
> > (forward-line -1)
> > (point))
> > (goto-char start)
> > - nil))))
> > + nil)))))
> >
> > (defun vtable-goto-table (table)
> > "Go to TABLE in the current buffer.
> > @@ -291,25 +304,32 @@ vtable-update-object
> > (let* ((objects (vtable-objects table))
> > (inhibit-read-only t))
> > ;; First replace the object in the object storage.
> > - (if (eq old-object (car objects))
> > + (if (funcall (vtable-object-equal table) old-object (car objects))
> > ;; It's at the head, so replace it there.
> > (setf (vtable-objects table)
> > (cons object (cdr objects)))
> > ;; Otherwise splice into the list.
> > (while (and (cdr objects)
> > - (not (eq (cadr objects) old-object)))
> > + (not (funcall (vtable-object-equal table)
> > + (cadr objects) old-object)))
> > (setq objects (cdr objects)))
> > - (unless objects
> > - (error "Can't find the old object"))
> > + (unless (and objects
> > + (funcall (vtable-object-equal table)
> > + (cadr objects) old-object))
> > + (error "Can't find the old object (vtable `%s')"
> > + (vtable-name table)))
> > (setcar (cdr objects) object))
> > ;; Then update the cache...
> > ;; FIXME: If the table's buffer has no visible window, or if its
> > ;; width has changed since the table was updated, the cache key will
> > ;; not match and the object can't be updated. (Bug #69837).
> > - (if-let* ((line-number (seq-position (car (vtable--cache table)) old-object
> > - (lambda (a b)
> > - (equal (car a) b))))
> > - (line (elt (car (vtable--cache table)) line-number)))
> > + (if-let* ((cache (vtable--ensure-cache table))
> > + (line-number (seq-position
> > + (vtable--cache-lines cache)
> > + (assoc old-object
> > + (vtable--cache-lines cache)
> > + (vtable-object-equal table))))
> > + (line (elt (vtable--cache-lines cache) line-number)))
>
> I think you should either remove the vtable--cache function entirely or
> make vtable--cache do what vtable--ensure-cache does.
>
> That's sensible.
>
> Better yet: adopt what I did in bug#69837, which mostly removes the code
> which looks up the cache based on the current window and frame
> attributes. Such code is not correct anyway, since when modifying part
> of a vtable that already exists, one should use the widths which are
> already in place for that vtable, as I mentioned in my patch there.
>
> Backward compatibility is a potential issue with that strategy. If we do that, we might as well support a single cache just for the
> most recently displayed vtable window. Lars clearly had a reason to implement the multi-width cache and I decided to leave it in
> place (and improve it as you've seen in the much larger patch) rather than break people's code. A cache patch coming after this
> one.
I don't think backwards compatibility is an issue. It will not break
anything to do what I described.
See my attached patch. I think we should apply that first.
> > (progn
> > (setcar line object)
> > (setcdr line (vtable--compute-cached-line table object))
> > @@ -320,28 +340,46 @@ vtable-update-object
> > (start (point)))
> > (delete-line)
> > (vtable--insert-line table line line-number
> > - (nth 1 (vtable--cache table))
> > + (vtable--cache-widths cache)
> > (vtable--spacer table))
> > (add-text-properties start (point) (list 'keymap keymap
> > 'vtable table))))
> > ;; We may have inserted a non-numerical value into a previously
> > ;; all-numerical table, so recompute.
> > (vtable--recompute-numerical table (cdr line)))
> > - (error "Can't find cached object in vtable"))))
> > + (error "Can't find cached object (vtable `%s')"
> > + (vtable-name table)))))
> >
> > (defun vtable-remove-object (table object)
> > "Remove OBJECT from TABLE.
> > This will also remove the displayed line."
> > + (let ((cache (vtable--ensure-cache table))
> > + (inhibit-read-only t))
> > + (unless (seq-contains-p (vtable-objects table)
> > + object
> > + (vtable-object-equal table))
> > + (error "Can't find the object to remove (vtable `%s')"
> > + (vtable-name table)))
> > ;; First remove from the objects.
> > - (setf (vtable-objects table) (delq object (vtable-objects table)))
> > + (setf (vtable-objects table) (seq-remove
> > + (lambda (elt)
> > + (funcall (vtable-object-equal table)
> > + elt object))
> > + (vtable-objects table)))
> > ;; Then adjust the cache and display.
> > - (let ((cache (vtable--cache table))
> > - (inhibit-read-only t))
> > - (setcar cache (delq (assq object (car cache)) (car cache)))
> > + (if-let* ((old-line (assoc object
> > + (vtable--cache-lines cache)
> > + (vtable-object-equal table))))
> > + (progn
> > + (setcar cache (delq old-line (vtable--cache-lines cache)))
> > (save-excursion
> > (vtable-goto-table table)
> > (when (vtable-goto-object object)
> > - (delete-line)))))
> > + (delete-line))))
> > + ;; At this point, the object was removed from objects, but not
> > + ;; the cache, which will stale.
> > + (error "Can't find cached object (vtable `%s')"
> > + (vtable-name table)))))
>
> So then why not look the object up in both the cache and objects first,
> before modifying either?
>
> Also sensible. Originally, I wanted to keep the structure of the code in place with minimal changes. In fact, checking both in
> advance avoids a cache bug that was also addressed in the larger patch but it's almost 6 of 1, 1/2 doz of another.
>
> Also, it seems like maybe vtable-remove-object should not actually be
> using the customizable object equality anyway?
>
> If object equality is delegated to whatever the user wants, why would remove not honor that to locate the object by user equality?
Because it should only be possible to remove objects which are literally
in the table. But this is a question about why object equality is being
added at all.
> >
> > ;; FIXME: The fact that the `location' argument of
> > ;; `vtable-insert-object' can be an integer and is then interpreted as
> > @@ -378,7 +416,16 @@ vtable-insert-object
> > (nthcdr location (vtable-objects table))
> > ;; Do not prepend if index is too large:
> > (setq before nil))
> > - (or (memq location (vtable-objects table))
> > + (or
> > + (let ((loc (vtable-objects table)))
> > + (while (and (cdr loc)
> > + (not (funcall (vtable-object-equal table)
> > + (car loc) location)))
> > + (setq loc (cdr loc)))
> > + (if (funcall (vtable-object-equal table)
> > + (car loc) location)
> > + loc
> > + nil))
>
> I think you probably should introduce a function which searches
> (vtable-objects table) for an existing object using the equality
> function, and use that everywhere; it would make the changes like this
> much simpler.
>
> Maybe. There are other idioms more repetitive than this one that also could use a bit more love.
Yes, but you're changing these ones now and making them much more
repetitive.
> > ;; Prepend if `location' is not found and
> > ;; `before' is non-nil:
> > (and before (vtable-objects table))))
> > @@ -400,7 +447,7 @@ vtable-insert-object
> > ;; Then adjust the cache and display.
> > (save-excursion
> > (vtable-goto-table table)
> > - (let* ((cache (vtable--cache table))
> > + (let* ((cache (vtable--ensure-cache table))
> > (inhibit-read-only t)
> > (keymap (get-text-property (point) 'keymap))
> > (ellipsis (if (vtable-ellipsis table)
> > @@ -410,11 +457,14 @@ vtable-insert-object
> > (ellipsis-width (string-pixel-width ellipsis))
> > (elem (if location ; This binding mirrors the binding of `pos' above.
> > (if (integerp location)
> > - (nth location (car cache))
> > - (or (assq location (car cache))
> > + (nth location (vtable--cache-lines cache))
> > + (or (assoc
> > + location
> > + (vtable--cache-lines cache)
> > + (vtable-object-equal table))
> > (and before (caar cache))))
> > (if before (caar cache))))
> > - (pos (memq elem (car cache)))
> > + (pos (memq elem (vtable--cache-lines cache)))
> > (line (cons object (vtable--compute-cached-line table object))))
> > (if (or before
> > (and pos (integerp location)))
> > @@ -433,13 +483,14 @@ vtable-insert-object
> > (forward-line 1) ; Insert *after*.
> > (vtable-end-of-table)))
> > ;; Otherwise, append the object.
> > - (setcar cache (nconc (car cache) (list line)))
> > + (setcar cache (nconc (vtable--cache-lines cache) (list line)))
> > (vtable-end-of-table)))
> > (let ((start (point)))
> > ;; FIXME: We have to adjust colors in lines below this if we
> > ;; have :row-colors.
> > (vtable--insert-line table line 0
> > - (nth 1 cache) (vtable--spacer table)
> > + (vtable--cache-widths cache)
> > + (vtable--spacer table)
> > ellipsis ellipsis-width)
> > (add-text-properties start (point) (list 'keymap keymap
> > 'vtable table)))
> > @@ -523,7 +574,8 @@ vtable--ensure-cache
> > (vtable--recompute-cache table)))
> >
> > (defun vtable-insert (table)
> > - (let* ((spacer (vtable--spacer table))
> > + (let* ((cache (vtable--ensure-cache table))
> > + (spacer (vtable--spacer table))
> > (start (point))
> > (ellipsis (if (vtable-ellipsis table)
> > (propertize (truncate-string-ellipsis)
> > @@ -533,7 +585,7 @@ vtable-insert
> > ;; We maintain a cache per screen/window width, so that we render
> > ;; correctly if Emacs is open on two different screens (or the
> > ;; user resizes the frame).
> > - (widths (nth 1 (vtable--ensure-cache table))))
> > + (widths (vtable--cache-widths cache)))
> > ;; Don't insert any header or header line if the user hasn't
> > ;; specified the columns.
> > (when (slot-value table '-has-column-spec)
> > @@ -551,7 +603,7 @@ vtable-insert
> > (vtable--sort table)
> > ;; Insert the data.
> > (let ((line-number 0))
> > - (dolist (line (car (vtable--cache table)))
> > + (dolist (line (vtable--cache-lines cache))
> > (vtable--insert-line table line line-number widths spacer
> > ellipsis ellipsis-width)
> > (setq line-number (1+ line-number))))
> > @@ -667,18 +719,26 @@ vtable--clear-cache
> >
> > (defun vtable--sort (table)
> > (pcase-dolist (`(,index . ,direction) (vtable-sort-by table))
> > - (let ((cache (vtable--cache table))
> > - (numerical (vtable-column--numerical
> > - (elt (vtable-columns table) index)))
> > + (let* ((cache (vtable--ensure-cache table))
> > + (column (elt (vtable-columns table) index))
> > + (numerical (vtable-column--numerical column))
> > (numcomp (if (eq direction 'descend)
> > #'> #'<))
> > (stringcomp (if (eq direction 'descend)
> > - #'string> #'string<)))
> > + #'string> #'string<))
> > + (comparator (vtable-column-comparator column))
> > + (comparator-func (when comparator
> > + (if (eq direction 'descend)
> > + (lambda (v1 v2)
> > + (funcall comparator v2 v1))
> > + comparator))))
> > (setcar cache
> > - (sort (car cache)
> > + (sort (vtable--cache-lines cache)
> > (lambda (e1 e2)
> > (let ((c1 (elt e1 (1+ index)))
> > (c2 (elt e2 (1+ index))))
> > + (if comparator-func
> > + (funcall comparator-func (car c1) (car c2))
> > (if numerical
> > (funcall numcomp (car c1) (car c2))
> > (funcall
> > @@ -688,7 +748,7 @@ vtable--sort
> > (format "%s" (car c1)))
> > (if (stringp (car c2))
> > (car c2)
> > - (format "%s" (car c2))))))))))))
> > + (format "%s" (car c2)))))))))))))
> >
> > (defun vtable--indicator (table index)
> > (let ((order (car (last (vtable-sort-by table)))))
> > @@ -860,7 +920,8 @@ vtable--compute-width
> > (/ (* (string-to-number (match-string 1 spec)) (window-width nil t))
> > 100))
> > (t
> > - (error "Invalid spec: %s" spec))))
> > + (error "Invalid spec: %s (vtable `%s')"
> > + spec (vtable-name table)))))
> >
> > (defun vtable--compute-widths (table cache)
> > "Compute the display widths for TABLE.
> > @@ -972,7 +1033,13 @@ vtable-revert
> > (vtable-goto-column column))))
> >
> > (defun vtable--widths (table)
> > - (nth 1 (vtable--ensure-cache table)))
> > + (vtable--cache-widths (vtable--ensure-cache table)))
> > +
> > +(defun vtable--cache-widths (cache)
> > + (nth 1 cache))
> > +
> > +(defun vtable--cache-lines (cache)
> > + (car cache))
> > ;;; Commands.
> >
> > diff --git a/test/lisp/emacs-lisp/vtable-tests.el b/test/lisp/emacs-lisp/vtable-tests.el
> > index 74fb8cc8139..6e3c09e14de 100644
> > --- a/test/lisp/emacs-lisp/vtable-tests.el
> > +++ b/test/lisp/emacs-lisp/vtable-tests.el
> > @@ -27,7 +27,7 @@
> > (require 'ert)
> > (require 'ert-x)
> >
> > -(ert-deftest test-vstable-compute-columns ()
> > +(ert-deftest test-vtable-compute-columns ()
> > (should
> > (equal (mapcar
> > (lambda (column)
> > @@ -69,4 +69,108 @@ test-vtable-insert-object
> > (mapcar #'cadr (vtable-objects table))))
> > (number-sequence 0 11))))
> >
> > +(ert-deftest test-vtable-update-object ()
> > + (let ((buffer (get-buffer-create "*vtable-test*")))
> > + (pop-to-buffer buffer)
> > + (erase-buffer)
> > + (let* ((object1 (cons "XXX" 1))
> > + (object2 (cons "YYY" 2))
> > + (table
> > + (make-vtable
> > + :use-header-line nil
> > + :object-equal #'eq ; Identity.
> > + :columns '((:name "XXX"))
> > + :objects (list object1 object2))))
> > + (should-error (vtable-update-object table "ZZZ"))
> > + (setcdr object1 3)
> > + (vtable-update-object table object1)
> > + (should (eq 3 (cdr (assoc "XXX" (vtable-objects table))))))))
> > +
> > +(ert-deftest test-vtable-remove-object ()
> > + (let ((buffer (get-buffer-create "*vtable-test*")))
> > + (pop-to-buffer buffer)
> > + (erase-buffer)
> > + (let* ((object1 (cons "XXX" 1))
> > + (object2 (cons "YYY" 2))
> > + (table
> > + (make-vtable
> > + :use-header-line nil
> > + :object-equal #'eq ; Identity.
> > + :columns '((:name "XXX"))
> > + :objects (list object1 object2))))
> > + (should-error (vtable-remove-object table "ZZZ"))
> > + (vtable-remove-object table object1)
> > + (should (eq 1 (length (vtable-objects table)))))))
> > +
> > +(ert-deftest test-vtable-object-equal ()
> > + (let ((buffer (get-buffer-create "*vtable-test*")))
> > + (pop-to-buffer buffer)
> > + (erase-buffer)
> > + (let* ((object1 "XXX")
> > + (object2 "XXX")
> > + (table-eq
> > + (progn
> > + (goto-char (point-max))
> > + (make-vtable
> > + :use-header-line nil
> > + :columns '((:name "table-eq" :width 20))
> > + :object-equal #'eq ; Identity.
> > + :objects (list object1 object2))))
> > + (table-equal
> > + (progn
> > + (goto-char (point-max))
> > + (make-vtable
> > + :use-header-line nil
> > + :columns '((:name "table-equal" :width 20))
> > + :object-equal #'equal ; Value.
> > + :objects (list object1 object2)))))
> > + (should
> > + (progn
> > + (vtable-goto-table table-eq)
> > + (vtable-goto-object object2)
> > + (equal object2 (get-text-property (point) 'vtable-object))))
> > + (should-not
> > + (progn
> > + (vtable-goto-table table-eq)
> > + (vtable-goto-object "ZZZ")
> > + (equal object1 (get-text-property (point) 'vtable-object))))
> > + (should
> > + (progn
> > + (vtable-goto-table table-equal)
> > + (vtable-goto-object object2)
> > + (equal object1 (get-text-property (point) 'vtable-object))))
> > + (should-not
> > + (progn
> > + (vtable-goto-table table-equal)
> > + (vtable-goto-object "ZZZ")
> > + (equal object1 (get-text-property (point) 'vtable-object)))))))
> > +
> > +(ert-deftest test-vtable-column-comparator ()
> > + (let ((buffer (get-buffer-create "*vtable-test*")))
> > + (pop-to-buffer buffer)
> > + (erase-buffer)
> > + (let ((table
> > + (make-vtable
> > + :use-header-line t
> > + :getter (lambda (object _index _table) object)
> > + :columns '(( :name "Date"
> > + :primary ascend
> > + :width 40
> > + :formatter (lambda (object)
> > + (let ((time (date-to-time object)))
> > + (format "%s (%d)"
> > + (format-time-string "%A, %B %d %Y" time)
> > + (car time))))
> > + :comparator (lambda (object1 object2)
> > + (let ((time1 (date-to-time object1))
> > + (time2 (date-to-time object2)))
> > + (< (car time1)
> > + (car time2))))))
> > + :objects '("Fri, 11 Jul 2025"
> > + "Thu, 10 Jul 2025"))))
> > + (should
> > + (string=
> > + "Thursday"
> > + (thing-at-point 'word))))))
> > +
> > ;;; vtable-tests.el ends here
>
> Thank you very much for adding tests.
>
> Overall this patch looks good, I am in favor of this landing soon (after
> feedback is addressed of course).
>
> Thank you for your support.
>
> (One other thing: Could you try to tell your mail client to attach the
> patch in "inline" mode? This makes the patch somewhat easier to review
> in debbugs. (This may be easiest if you use Gnus to send the patch,
> perhaps using debbugs-gnu-post-patch))
>
> I'm a gmail user, for good or for bad. I could probably just copy/paste the patch content into the body of the message, unless there
> are recipes to follow that make gmail do what you suggest. I fear gmail considers body text fair game to screw with formatting,
> etc., so attachments seem safest. I could spend some time making gnus work (I haven't been a gnus user for 25 years) with my
> gmail account (but I really really don't want to import my entire gmail account content into gnus just to send a few email
> messages with inline patches). Perhaps you can make your gnus recognize patch attachments and treat them specially? As I say,
> it's been 3 dog generations since I touched gnus. Feel free to contact me off line from this bug report if you have some
> configuration/guidelines you'd like me to look at.
Try using debbugs.el to read and reply to bug threads. You would need
to set up a mail sending client like msmtp, but you don't need to set up
fetching mail from gmail or anything.
Anyway, my patch to vtable--cache follows. I think we should apply this
first before your changes, because I believe it's a better approach.
[0001-Fix-implicit-usage-of-the-current-window-width-in-vt.patch (text/x-patch, inline)]
From db6ee9bc35a781bc1bf6c8191d4273616cf97f0f Mon Sep 17 00:00:00 2001
From: Spencer Baugh <sbaugh <at> janestreet.com>
Date: Thu, 19 Jun 2025 17:20:12 -0400
Subject: [PATCH] Fix implicit usage of the current window-width in vtable.el
Previously, many functions in vtable.el called vtable--cache,
which computed vtable--cache-key based on the current selected
window and frame; this could cause vtable functions to fail or
misbehave if they were not called from the selected window and
frame that vtable-insert was last called in.
Now, the vtable cache is stored with the text of the vtable, so
that functions which need to interact with some vtable text can
do so reliably without having to use the same selected window
and frame.
Also, vtable-update-object has always required TABLE to be
present at point in the current buffer; now its docstring states
this.
* lisp/emacs-lisp/vtable.el (vtable--current-cache)
(vtable--cache-widths, vtable--cache-lines): Add.
(vtable-insert): Save cache in 'vtable-cache.
(vtable--ensure-cache, vtable--recompute-cache): Inline into
vtable-insert.
(vtable--widths, vtable--cache): Delete.
(vtable-update-object): Use vtable--current-cache and update
docstring. (bug#69837)
(vtable-remove-object, vtable-insert-object): Use
vtable--current-cache and save cache in 'vtable-cache.
(vtable--sort, vtable--alter-column-width)
(vtable-previous-column, vtable-next-column): Use
vtable--current-cache.
---
lisp/emacs-lisp/vtable.el | 111 ++++++++++++++++++++------------------
1 file changed, 59 insertions(+), 52 deletions(-)
diff --git a/lisp/emacs-lisp/vtable.el b/lisp/emacs-lisp/vtable.el
index 00785113edb..d6be6d361f7 100644
--- a/lisp/emacs-lisp/vtable.el
+++ b/lisp/emacs-lisp/vtable.el
@@ -282,10 +282,9 @@ vtable-update-object
"Update OBJECT's representation in TABLE.
If OLD-OBJECT is non-nil, replace OLD-OBJECT with OBJECT and display it.
In either case, if the existing object is not found in the table (being
-compared with `equal'), signal an error. Note a limitation: if TABLE's
-buffer is not in a visible window, or if its window has changed width
-since it was updated, updating the TABLE is not possible, and an error
-is signaled."
+compared with `equal'), signal an error.
+
+TABLE must be at point in the current buffer."
(unless old-object
(setq old-object object))
(let* ((objects (vtable-objects table))
@@ -302,14 +301,13 @@ vtable-update-object
(unless objects
(error "Can't find the old object"))
(setcar (cdr objects) object))
- ;; Then update the cache...
- ;; FIXME: If the table's buffer has no visible window, or if its
- ;; width has changed since the table was updated, the cache key will
- ;; not match and the object can't be updated. (Bug #69837).
- (if-let* ((line-number (seq-position (car (vtable--cache table)) old-object
- (lambda (a b)
- (equal (car a) b))))
- (line (elt (car (vtable--cache table)) line-number)))
+ ;; Then update the rendered vtable in the current buffer.
+ (if-let* ((cache (vtable--current-cache))
+ (line-number (seq-position (vtable--cache-lines cache)
+ old-object
+ (lambda (a b)
+ (equal (car a) b))))
+ (line (elt (vtable--cache-lines cache) line-number)))
(progn
(setcar line object)
(setcdr line (vtable--compute-cached-line table object))
@@ -320,10 +318,11 @@ vtable-update-object
(start (point)))
(delete-line)
(vtable--insert-line table line line-number
- (nth 1 (vtable--cache table))
+ (vtable--cache-widths cache)
(vtable--spacer table))
(add-text-properties start (point) (list 'keymap keymap
- 'vtable table))))
+ 'vtable table
+ 'vtable-cache cache))))
;; We may have inserted a non-numerical value into a previously
;; all-numerical table, so recompute.
(vtable--recompute-numerical table (cdr line)))
@@ -335,11 +334,12 @@ vtable-remove-object
;; First remove from the objects.
(setf (vtable-objects table) (delq object (vtable-objects table)))
;; Then adjust the cache and display.
- (let ((cache (vtable--cache table))
- (inhibit-read-only t))
- (setcar cache (delq (assq object (car cache)) (car cache)))
- (save-excursion
- (vtable-goto-table table)
+ (save-excursion
+ (vtable-goto-table table)
+ (let ((cache (vtable--current-cache))
+ (inhibit-read-only t))
+ (setcar cache (delq (assq object (vtable--cache-lines cache))
+ (vtable--cache-lines cache)))
(when (vtable-goto-object object)
(delete-line)))))
@@ -400,7 +400,7 @@ vtable-insert-object
;; Then adjust the cache and display.
(save-excursion
(vtable-goto-table table)
- (let* ((cache (vtable--cache table))
+ (let* ((cache (vtable--current-cache))
(inhibit-read-only t)
(keymap (get-text-property (point) 'keymap))
(ellipsis (if (vtable-ellipsis table)
@@ -408,13 +408,14 @@ vtable-insert-object
'face (vtable-face table))
""))
(ellipsis-width (string-pixel-width ellipsis))
- (elem (if location ; This binding mirrors the binding of `pos' above.
+ (lines (vtable--cache-lines cache))
+ (elem (if location ; This binding mirrors the binding of `pos' above.
(if (integerp location)
- (nth location (car cache))
- (or (assq location (car cache))
- (and before (caar cache))))
- (if before (caar cache))))
- (pos (memq elem (car cache)))
+ (nth location lines)
+ (or (assq location lines)
+ (and before (car lines))))
+ (if before (car lines))))
+ (pos (memq elem lines))
(line (cons object (vtable--compute-cached-line table object))))
(if (or before
(and pos (integerp location)))
@@ -433,13 +434,13 @@ vtable-insert-object
(forward-line 1) ; Insert *after*.
(vtable-end-of-table)))
;; Otherwise, append the object.
- (setcar cache (nconc (car cache) (list line)))
+ (setcar cache (nconc (vtable--cache-lines cache) (list line)))
(vtable-end-of-table)))
(let ((start (point)))
;; FIXME: We have to adjust colors in lines below this if we
;; have :row-colors.
(vtable--insert-line table line 0
- (nth 1 cache) (vtable--spacer table)
+ (vtable--cache-widths cache) (vtable--spacer table)
ellipsis ellipsis-width)
(add-text-properties start (point) (list 'keymap keymap
'vtable table)))
@@ -512,15 +513,11 @@ vtable--compute-columns
(defun vtable--spacer (table)
(vtable--compute-width table (vtable-separator-width table)))
-(defun vtable--recompute-cache (table)
- (let* ((data (vtable--compute-cache table))
- (widths (vtable--compute-widths table data)))
- (setf (gethash (vtable--cache-key) (slot-value table '-cache))
- (list data widths))))
+(defun vtable--cache-widths (cache)
+ (nth 1 cache))
-(defun vtable--ensure-cache (table)
- (or (vtable--cache table)
- (vtable--recompute-cache table)))
+(defun vtable--cache-lines (cache)
+ (car cache))
(defun vtable-insert (table)
(let* ((spacer (vtable--spacer table))
@@ -533,7 +530,12 @@ vtable-insert
;; We maintain a cache per screen/window width, so that we render
;; correctly if Emacs is open on two different screens (or the
;; user resizes the frame).
- (widths (nth 1 (vtable--ensure-cache table))))
+ (cache (or (gethash (vtable--cache-key) (slot-value table '-cache))
+ (let* ((data (vtable--compute-cache table))
+ (widths (vtable--compute-widths table data)))
+ (setf (gethash (vtable--cache-key) (slot-value table '-cache))
+ (list data widths)))))
+ (widths (vtable--cache-widths cache)))
;; Don't insert any header or header line if the user hasn't
;; specified the columns.
(when (slot-value table '-has-column-spec)
@@ -546,18 +548,20 @@ vtable-insert
(add-text-properties start (point)
(list 'keymap vtable-header-line-map
'rear-nonsticky t
- 'vtable table))
+ 'vtable table
+ 'vtable-cache cache))
(setq start (point))))
- (vtable--sort table)
+ (vtable--sort table cache)
;; Insert the data.
(let ((line-number 0))
- (dolist (line (car (vtable--cache table)))
+ (dolist (line (vtable--cache-lines cache))
(vtable--insert-line table line line-number widths spacer
ellipsis ellipsis-width)
(setq line-number (1+ line-number))))
(add-text-properties start (point)
(list 'rear-nonsticky t
- 'vtable table))
+ 'vtable table
+ 'vtable-cache cache))
(goto-char start)))
(defun vtable--insert-line (table line line-number widths spacer
@@ -659,16 +663,22 @@ vtable--insert-line
(defun vtable--cache-key ()
(cons (frame-terminal) (window-width)))
-(defun vtable--cache (table)
- (gethash (vtable--cache-key) (slot-value table '-cache)))
+(defun vtable--current-cache ()
+ "Return the current cache for the table at point.
+
+In `vtable-insert', the lines and widths of the vtable text are computed
+based on the current selected frame and window and stored in a cache.
+Subsequent interaction with the text of the vtable should use that cache
+via this function rather than by calling `vtable--cache-key' to look up
+the cache."
+ (get-text-property (point) 'vtable-cache))
(defun vtable--clear-cache (table)
(setf (gethash (vtable--cache-key) (slot-value table '-cache)) nil))
-(defun vtable--sort (table)
+(defun vtable--sort (table cache)
(pcase-dolist (`(,index . ,direction) (vtable-sort-by table))
- (let ((cache (vtable--cache table))
- (numerical (vtable-column--numerical
+ (let ((numerical (vtable-column--numerical
(elt (vtable-columns table) index)))
(numcomp (if (eq direction 'descend)
#'> #'<))
@@ -971,9 +981,6 @@ vtable-revert
(when column
(vtable-goto-column column))))
-(defun vtable--widths (table)
- (nth 1 (vtable--ensure-cache table)))
-
;;; Commands.
(defvar-keymap vtable-header-mode-map
@@ -998,7 +1005,7 @@ vtable-narrow-current-column
(- (* (vtable--char-width table) (or n 1))))))
(defun vtable--alter-column-width (table column delta)
- (let ((widths (vtable--widths table)))
+ (let ((widths (vtable--cache-widths (vtable--current-cache))))
(setf (aref widths column)
(max (* (vtable--char-width table) 2)
(+ (aref widths column) delta)))
@@ -1020,14 +1027,14 @@ vtable-previous-column
(interactive)
(vtable-goto-column
(max 0 (1- (or (vtable-current-column)
- (length (vtable--widths (vtable-current-table))))))))
+ (length (vtable--cache-widths (vtable--current-cache))))))))
(defun vtable-next-column ()
"Go to the next column."
(interactive)
(when (vtable-current-column)
(vtable-goto-column
- (min (1- (length (vtable--widths (vtable-current-table))))
+ (min (1- (length (vtable--cache-widths (vtable--current-cache))))
(1+ (vtable-current-column))))))
(defun vtable-revert-command ()
--
2.39.3
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.