Github/emacs
2
0
Fork 1
mirror of git://git.sv.gnu.org/emacs.git synced 2026-02-17 10:27:41 +00:00
Code Issues Projects Releases Packages Wiki Activity

Make 'vtable-insert-object' more versatile

Browse source 
* lisp/emacs-lisp/vtable.el (vtable-insert-object): Rename
argument AFTER-OBJECT to LOCATION; allow use of index to
refer to the insertion position; add argument BEFORE.
(Bug#70664).

* etc/NEWS:
* doc/misc/vtable.texi (Interface Functions): Document the
change.

* test/lisp/emacs-lisp/vtable-tests.el
(test-vtable-insert-object): New test.
This commit is contained in:
Joost Kremers 2024-05-07 11:52:27 +02:00 committed by Eli Zaretskii
parent 19c983dded
commit 4f27d763bb
4 changed files with 132 additions and 27 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

18
doc/misc/vtable.texi
View file

@ -548,10 +548,20 @@ Remove @var{object} from @var{table}. This also updates the displayed
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

13
etc/NEWS
View file

@ -2635,6 +2635,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
---

98
lisp/emacs-lisp/vtable.el
View file

@ -348,19 +348,57 @@ This will also remove the displayed line."
(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 @@ This also updates the displayed table."
'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.

30
test/lisp/emacs-lisp/vtable-tests.el
View file

@ -39,4 +39,34 @@
: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