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
(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)
'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.
: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
projects / emacs.git / commitdiff