From aacba116ee729663f078e8fb1fee2d0fee01a7a8 Mon Sep 17 00:00:00 2001 From: Joost Kremers 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