Package: emacs;
Reported by: Joost Kremers <joostkremers <at> fastmail.fm>
Date: Tue, 30 Apr 2024 09:32:02 UTC
Severity: normal
Found in version 29.3
Done: Eli Zaretskii <eliz <at> gnu.org>
Bug is archived. No further changes may be made.
Message #23 received at 70664 <at> debbugs.gnu.org (full text, mbox):
From: Joost Kremers <joostkremers <at> fastmail.fm> To: Adam Porter <adam <at> alphapapa.net> Cc: Eli Zaretskii <eliz <at> gnu.org>, 70664 <at> debbugs.gnu.org Subject: Re: bug#70664: 29.3; vtable-insert-object cannot insert at top of table Date: Tue, 07 May 2024 12:52:56 +0200
[Message part 1 (text/plain, inline)]
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
[0001-Make-vtable-insert-object-more-versatile.patch (text/x-patch, inline)]
From d48020ff58ff9b2684365772a6161023d4ff22d5 Mon Sep 17 00:00:00 2001
From: Joost Kremers <joostkremers <at> 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
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.