Function: vtable-insert-object

vtable-insert-object is a byte-compiled function defined in vtable.el.gz.

Signature

(vtable-insert-object TABLE OBJECT &optional LOCATION BEFORE)

Documentation

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.

Probably introduced at or before Emacs version 30.1.

Source Code

;; Defined in /usr/src/emacs/lisp/emacs-lisp/vtable.el.gz
;; 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."
  ;; If the vtable is empty, just add the object and regenerate the
  ;; table.
  (if (null (vtable-objects table))
      (progn
        (setf (vtable-objects table) (list object))
        (vtable--recompute-numerical table (vtable--compute-cached-line table object))
        (with-current-buffer (vtable-buffer table)
          (vtable-goto-table table)
          (vtable-revert-command)))
    ;; First insert into the objects.
    (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.
    (let* ((cache (vtable--current-cache table))
           (lines (vtable--cache-lines cache))
           (elem (if location  ; This binding mirrors the binding of `pos' above.
                     (if (integerp location)
                         (nth location lines)
                       (or (assq location lines)
                           (and before (car lines))))
                   (if before (car lines))))
           (pos (memq elem lines))
           (line (cons object (vtable--compute-cached-line table object))))
      (with-current-buffer (vtable-buffer table)
        (let ((inhibit-read-only t)
              (inhibit-modification-hooks t))
          (save-excursion
            (vtable-goto-table 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 lines (list line)))
                (vtable-end-of-table)))
            (let* ((start (point))
                   (ellipsis (if (vtable-ellipsis table)
                                 (propertize (truncate-string-ellipsis)
                                             'face (vtable-face table))
                               ""))
                   (ellipsis-width (string-pixel-width ellipsis (current-buffer)))
                   (keymap (get-text-property (point) 'keymap)))
              ;; FIXME: We have to adjust colors in lines below this if we
              ;; have :row-colors.
              (vtable--insert-line table line 0
                                   (vtable--cache-widths cache)
                                   (vtable--spacer table)
                                   ellipsis ellipsis-width)
              (add-text-properties start (point) (list 'keymap keymap
                                                       'vtable table)))
            ;; We may have inserted a non-numerical value into a previously
            ;; all-numerical table, so recompute.
            (vtable--recompute-numerical table (cdr line))))))))