GNU bug report logs - #79009
[PATCH] Improve 'vtable' object handling, cache handling, messages

Previous Next

Package: emacs;

Reported by: Stéphane Marks <shipmints <at> gmail.com>

Date: Sun, 13 Jul 2025 18:08:01 UTC

Severity: normal

Tags: patch

Full log


View this message in rfc822 format

From: Stéphane Marks <shipmints <at> gmail.com>
To: Spencer Baugh <sbaugh <at> janestreet.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 11:12:48 -0400
[Message part 1 (text/plain, inline)]
On Tue, Jul 15, 2025 at 10:02 AM Spencer Baugh <sbaugh <at> janestreet.com>
wrote:

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

The patch addresses some of the cache issues but not all of them.  I was
planning on addressing cache issues later and starting with the previous
patch to get us going.

With regard to the cache, one thing that puzzles me about it, and Lars, if
he's reading can chime in, is that the vtable buffer itself can hold only
one formatter representation at a time, munged from cache entries plus
formatters/displayers, and if the buffer is displayed in more than one
sized window, it can't hold both widths at the same time.  On table
updates, via -insert-object, -remove-object, -update-object,
-revert-command only the "current" cache is updated and the others
considered stale.  You can see in the bigger vtable update I shared, that
only one cache entry at a time is rebuilt as needed when the assigned
vtable buffer's window size changes upon selection, and the others
considered stale--so why bother with more than one.  So, if we're gonna
redo the cache (and let's assume it's an internal vtable feature that won't
impact users if we change it), we should consider doing away with the
multi-width cache and keys and just use the ambient aka most
recently-displayed cache entries anyway.  I didn't muck with the cache
further to simplify it assuming Lars had a good reason to implement it that
way.
[Message part 2 (text/html, inline)]

This bug report was last modified 20 days ago.

Previous Next


GNU bug tracking system
Copyright (C) 1999 Darren O. Benham, 1997,2003 nCipher Corporation Ltd, 1994-97 Ian Jackson.