Function: make-vtable
make-vtable is a byte-compiled function defined in vtable.el.gz.
Signature
(make-vtable &key COLUMNS OBJECTS OBJECTS-FUNCTION GETTER FORMATTER DISPLAYER (USE-HEADER-LINE t) (FACE 'vtable) ACTIONS KEYMAP (SEPARATOR-WIDTH 1) DIVIDER DIVIDER-WIDTH SORT-BY (ELLIPSIS t) (INSERT t) ROW-COLORS COLUMN-COLORS)
Documentation
Create and insert a vtable at point.
The vtable object is returned. If INSERT is nil, the table won't be inserted.
See info node (vtable)Top for vtable documentation.
Probably introduced at or before Emacs version 31.1.
Source Code
;; Defined in /usr/src/emacs/lisp/emacs-lisp/vtable.el.gz
(cl-defun make-vtable (&key columns objects objects-function
getter
formatter
displayer
(use-header-line t)
(face 'vtable)
actions keymap
(separator-width 1)
divider
divider-width
sort-by
(ellipsis t)
(insert t)
row-colors
column-colors)
"Create and insert a vtable at point.
The vtable object is returned. If INSERT is nil, the table won't
be inserted.
See info node `(vtable)Top' for vtable documentation."
(when objects-function
(setq objects (funcall objects-function)))
;; We'll be altering the list, so create a copy.
(setq objects (copy-sequence objects))
(let ((table
(make-instance
'vtable
:objects objects
:objects-function objects-function
:getter getter
:formatter formatter
:displayer displayer
:use-header-line use-header-line
:face face
:actions actions
:keymap keymap
:separator-width separator-width
:sort-by sort-by
:row-colors row-colors
:column-colors column-colors
:ellipsis ellipsis)))
;; Store whether the user has specified columns or not.
(setf (slot-value table '-has-column-spec) (not (not columns)))
;; Auto-generate the columns.
(unless columns
(unless objects
(error "Can't auto-generate columns; no objects"))
(setq columns (make-list (length (car objects)) "")))
(setf (vtable-columns table)
(mapcar (lambda (column)
(cond
;; We just have the name (as a string).
((stringp column)
(make-vtable-column :name column))
;; A plist of keywords/values.
((listp column)
(apply #'make-vtable-column column))
;; A full `vtable-column' object.
(t
column)))
columns))
;; Compute missing column data.
(setf (vtable-columns table) (vtable--compute-columns table))
;; Compute the colors.
(when (or row-colors column-colors)
(setf (slot-value table '-cached-colors)
(vtable--compute-colors row-colors column-colors)))
;; Compute the divider.
(when (or divider divider-width)
(setf (vtable-divider table)
(propertize
(or (copy-sequence divider)
(propertize
" " 'display
(list 'space :width
(list (vtable--compute-width table divider-width)))))
'mouse-face 'highlight
'keymap
(define-keymap
"<drag-mouse-1>" #'vtable--drag-resize-column
"<down-mouse-1>" #'ignore))))
;; Compute the keymap.
(setf (slot-value table '-cached-keymap) (vtable--make-keymap table))
(unless sort-by
(seq-do-indexed (lambda (column index)
(when (vtable-column-primary column)
(push (cons index (vtable-column-primary column))
(vtable-sort-by table))))
(vtable-columns table)))
(when insert
(vtable-insert table))
table))