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.

View in manual

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))