[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
bug#70664: 29.3; vtable-insert-object cannot insert at top of table
|
From: |
Joost Kremers |
|
Subject: |
bug#70664: 29.3; vtable-insert-object cannot insert at top of table |
|
Date: |
Thu, 09 May 2024 18:45:52 +0200 |
On Thu, May 09 2024, Eli Zaretskii wrote:
> This changes a public API, so it does need to be called out in NEWS,
> just in the section which lists Lisp-level changes.
OK, I added an entry, now contained in the new patch.
> A test can be interactive (since the test suite can be run
> interactively as well), but then please skip the test if it's run in
> batch mode.
Actually, once I took out the 'y-or-n-p' calls, it turned out the test runs fine
non-interactively. I included it in the patch.
> @code{nil}, in both cases.
[...]
> Two spaces between sentences, please.
Done.
Here's the new patch.
--
Joost Kremers
Life has its moments
>From aacba116ee729663f078e8fb1fee2d0fee01a7a8 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 +++--
etc/NEWS | 13 ++++
lisp/emacs-lisp/vtable.el | 98 +++++++++++++++++++++-------
test/lisp/emacs-lisp/vtable-tests.el | 30 +++++++++
4 files changed, 132 insertions(+), 27 deletions(-)
diff --git a/doc/misc/vtable.texi b/doc/misc/vtable.texi
index dd5b70cf32f..822b1097cd9 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 @code{nil},
+@var{object} is appended to @var{table}, or prepended if @var{before} is
+non-@code{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/etc/NEWS b/etc/NEWS
index e2588afeb40..6ed5bf12287 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -2563,6 +2563,19 @@ this case, would mean repeating the object in the
argument list.) When
replacing an object with a different one, passing both the new and old
objects is still necessary.
+** 'vtable-insert-object' can insert "before" or at an index.
+The signature of 'vtable-insert-object' has changed and is now:
+
+(vtable-insert-object table object &optional location before)
+
+'location' corresponds to the old 'after-object' argument; if 'before'
+is non-nil, the new object is inserted before the 'location' object,
+making it possible to insert a new object at the top of the
+table. (Before, this was not possible.) In addition, 'location' can be
+an integer, a (zero-based) index into the table at which the new object
+is inserted ('before' is ignored in this case).
+
+
** JSON
---
diff --git a/lisp/emacs-lisp/vtable.el b/lisp/emacs-lisp/vtable.el
index d8e5136c666..cb7ea397314 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.
diff --git a/test/lisp/emacs-lisp/vtable-tests.el
b/test/lisp/emacs-lisp/vtable-tests.el
index 08fdf1594a4..1d4b0650210 100644
--- a/test/lisp/emacs-lisp/vtable-tests.el
+++ b/test/lisp/emacs-lisp/vtable-tests.el
@@ -39,4 +39,34 @@ test-vstable-compute-columns
:insert nil)))
'(left right left))))
+(ert-deftest test-vtable-insert-object ()
+ (should
+ (equal (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))
+ (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.
+ ))
+ (mapcar #'cadr (vtable-objects table))))
+ (number-sequence 0 11))))
+
;;; vtable-tests.el ends here
--
2.45.0