bug#70664: 29.3; vtable-insert-object cannot insert at top of table

[Joost Kremers]

Hi Adam, Eli,

Here's my first attempt at fixing this bug and generally making
`vtable-insert-object` more versatile (see attachment).

A few questions / comments:

- Is this the right place to send this patch? Or should it go to emacs-devel?

- There are quite a few combinations of LOCATION and BEFORE to handle, which may
  make the code a bit hard to follow. A possible alternative would be to define
  some internal helper functions, `vtable--insert-before` and
  `vtable--insert-after`. You guys be the judge. (I added a few comments to
  hopefully make it clearer)

- The patch also updates the documentation. Do check the style, though, my
  writing usually isn't so great.

- I'm sure I made all sorts of mistakes with the commit message.

- I don't know if this change warrants a NEWS entry. It's not really
  user-facing, so I didn't add one.

- The current implementation of vtable-insert-object has a bug: it puts the
  object in the right location in the object list and the cache, but not in the
  buffer. This patch also fixes this bug.

- I don't know how to write a non-interactive test for my changes, because
  `vtable-insert-object` only works if the vtable is being displayed in a
  buffer. So instead I wrote an interactive function to test all possible
  combinations of LOCATION and BEFORE:

```emacs-lisp
(defun test-vtable-insert-object-interactive ()
  "Test `vtable-insert-object'."
  (interactive)
  (let ((buffer (get-buffer-create " *vtable-test*")))
    (pop-to-buffer buffer)
    (erase-buffer)
    (let* ((object1 '("Foo" 3))
           (object2 '("Gazonk" 8))
           (table (make-vtable
                   :columns '("Name" (:name "Rank" :width 5))
                   :objects (list object1 object2))))
      (mapc (lambda (args)
              (pcase-let ((`(,object ,location ,before) args))
                (if (y-or-n-p (format "Update table with location = %s and 
before = %s?" location before))
                    (vtable-insert-object table object location before))))
            `( ; Some correct inputs.
              ;; object    location        before
              (("Fizz" 4)  ,object1        nil)
              (("Bop"  7)  ,object2        t)
              (("Zat"  5)  2               nil)
              (("Dib"  6)  3               t)
              (("Wup"  9)  nil             nil)
              (("Quam" 2)  nil             t)
              ;; And some faulty inputs.
              (("Yat"  1)  -1              nil) ; non-existing index, `before' 
is ignored.
              (("Vop"  10) 100             t)   ; non-existing index, `before' 
is ignored.
              (("Jib"  11) ("Bleh"  0)     nil) ; non-existing object.
              (("Nix"  0)  ("Ugh"   0)     t)   ; non-existing object.
              ))
      (if (y-or-n-p "Regenerate table?")
          (vtable-revert)))))
``` 

The final table should have the "Rank" column sorted in ascending order (0-11).
Regenerating the table should not change it.

-- 
Joost Kremers
Life has its moments


>From d48020ff58ff9b2684365772a6161023d4ff22d5 Mon Sep 17 00:00:00 2001
From: Joost Kremers <joostkremers@fastmail.com>
Date: Tue, 7 May 2024 11:52:27 +0200
Subject: [PATCH] Make vtable-insert-object more versatile

Rename argument AFTER-OBJECT to LOCATION; allow use of index to refer to
the insertion position; add argument BEFORE (Bug#70664).
* lisp/emacs-lisp/vtable.el (vtable-insert-object):
* doc/misc/vtable.texi (Interface Functions): Document the change.
---
 doc/misc/vtable.texi      | 18 +++++--
 lisp/emacs-lisp/vtable.el | 98 ++++++++++++++++++++++++++++++---------
 2 files changed, 89 insertions(+), 27 deletions(-)

diff --git a/doc/misc/vtable.texi b/doc/misc/vtable.texi
index dd5b70cf32f..82a12906e7a 100644
--- a/doc/misc/vtable.texi
+++ b/doc/misc/vtable.texi
@@ -548,10 +548,20 @@ Interface Functions
 table.
 @end defun
 
-@defun vtable-insert-object table object &optional after-object
-Insert @var{object} into @var{table}.  If @var{after-object}, insert
-the object after this object; otherwise append to @var{table}.  This
-also updates the displayed table.
+@defun vtable-insert-object table object &optional location before
+Insert @var{object} into @var{table}.  @var{location} should be an
+object in the table, the new object is inserted after this object, or
+before it if @var{before} is non-nil.  If @var{location} is nil,
+@var{object} is appended to @var{table}, or prepended if @var{before} is
+non-nil.
+
+@var{location} can also be an integer, a zero-based index into the
+table.  In this case, @var{object} is inserted at that index.  If the
+index is out of range, @var{object} is prepended to @var{table} if the
+index is too small, or appended if it is too large.  In this case,
+@var{before} is ignored.
+
+This also updates the displayed table.
 @end defun
 
 @defun vtable-update-object table object &optional old-object
diff --git a/lisp/emacs-lisp/vtable.el b/lisp/emacs-lisp/vtable.el
index d8e5136c666..b53df6743ea 100644
--- a/lisp/emacs-lisp/vtable.el
+++ b/lisp/emacs-lisp/vtable.el
@@ -348,19 +348,57 @@ vtable-remove-object
       (when (vtable-goto-object object)
         (delete-line)))))
 
-(defun vtable-insert-object (table object &optional after-object)
-  "Insert OBJECT into TABLE after AFTER-OBJECT.
-If AFTER-OBJECT is nil (or doesn't exist in the table), insert
-OBJECT at the end.
+;; FIXME: The fact that the `location' argument of
+;; `vtable-insert-object' can be an integer and is then interpreted as
+;; an index precludes the use of integers as objects. This seems a very
+;; unlikely use-case, so let's just accept this limitation.
+
+(defun vtable-insert-object (table object &optional location before)
+  "Insert OBJECT into TABLE at LOCATION.
+LOCATION is an object in TABLE.  OBJECT is inserted after LOCATION,
+unless BEFORE is non-nil, in which case it is inserted before LOCATION.
+
+If LOCATION is nil, or does not exist in the table, OBJECT is inserted
+at the end of the table, or at the beginning if BEFORE is non-nil.
+
+LOCATION can also be an integer, a (zero-based) index into the table.
+OBJECT is inserted at this location.  If the index is out of range,
+OBJECT is inserted at the beginning (if the index is less than 0) or
+end (if the index is too large) of the table.  BEFORE is ignored in this
+case.
+
 This also updates the displayed table."
+  ;; FIXME: Inserting an object into an empty vtable currently isn't
+  ;; possible. `nconc' fails silently (twice), and `setcar' on the cache
+  ;; raises an error.
+  (if (null (vtable-objects table))
+      (error "[vtable] Cannot insert object into empty vtable"))
   ;; First insert into the objects.
-  (let (pos)
-    (if (and after-object
-             (setq pos (memq after-object (vtable-objects table))))
-        ;; Splice into list.
-        (setcdr pos (cons object (cdr pos)))
-      ;; Append.
-      (nconc (vtable-objects table) (list object))))
+  (let ((pos (if location
+                 (if (integerp location)
+                     (prog1
+                         (nthcdr location (vtable-objects table))
+                       ;; Do not prepend if index is too large:
+                       (setq before nil))
+                   (or (memq location (vtable-objects table))
+                       ;; Prepend if `location' is not found and
+                       ;; `before' is non-nil:
+                       (and before (vtable-objects table))))
+               ;; If `location' is nil and `before' is non-nil, we
+               ;; prepend the new object.
+               (if before (vtable-objects table)))))
+    (if (or before  ; If `before' is non-nil, `pos' should be, as well.
+            (and pos (integerp location)))
+        ;; Add the new object before.
+        (let ((old-object (car pos)))
+          (setcar pos object)
+          (setcdr pos (cons old-object (cdr pos))))
+      ;; Otherwise, add the object after.
+      (if pos
+          ;; Splice the object into the list.
+          (setcdr pos (cons object (cdr pos)))
+        ;; Otherwise, append the object.
+        (nconc (vtable-objects table) (list object)))))
   ;; Then adjust the cache and display.
   (save-excursion
     (vtable-goto-table table)
@@ -372,19 +410,33 @@ vtable-insert-object
                                      'face (vtable-face table))
                        ""))
            (ellipsis-width (string-pixel-width ellipsis))
-           (elem (and after-object
-                      (assq after-object (car 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)))
            (line (cons object (vtable--compute-cached-line table object))))
-      (if (not elem)
-          ;; Append.
-          (progn
-            (setcar cache (nconc (car cache) (list line)))
-            (vtable-end-of-table))
-        ;; Splice into list.
-        (let ((pos (memq elem (car cache))))
-          (setcdr pos (cons line (cdr pos)))
-          (unless (vtable-goto-object after-object)
-            (vtable-end-of-table))))
+      (if (or before
+              (and pos (integerp location)))
+          ;; Add the new object before:.
+          (let ((old-line (car pos)))
+            (setcar pos line)
+            (setcdr pos (cons old-line (cdr pos)))
+            (unless (vtable-goto-object (car elem))
+              (vtable-beginning-of-table)))
+        ;; Otherwise, add the object after.
+        (if pos
+            ;; Splice the object into the list.
+            (progn
+              (setcdr pos (cons line (cdr pos)))
+              (if (vtable-goto-object location)
+                  (forward-line 1)  ; Insert *after*.
+                (vtable-end-of-table)))
+          ;; Otherwise, append the object.
+          (setcar cache (nconc (car 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.
-- 
2.45.0