mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2025-12-24 06:20:43 -08:00
Code Issues Projects Releases Wiki Activity

Add support for column background colors in vtable

Browse source 
* doc/misc/vtable.texi (Making A Table): Document it.

* lisp/emacs-lisp/vtable.el (vtable): Add a column color element.
(make-vtable): Use it.
(vtable--insert-line): Insert the colors here.
This commit is contained in:
Lars Ingebrigtsen 2022-04-13 16:25:52 +02:00
parent e14e5dff2c
commit 29fae93d1c
2 changed files with 18 additions and 3 deletions
Download patch file Download diff file Expand all files Collapse all files

6
doc/misc/vtable.texi
View file

@ -387,6 +387,12 @@ The face to be used. This defaults to @code{variable-pitch}. This
face doesn't override the faces in the data, or the faces supplied by face doesn't override the faces in the data, or the faces supplied by
the getter and formatter functions. the getter and formatter functions.
@item :column-colors
If present, this should be a list of color names to be used as the
background color on the columns. If there are fewer colors here than
there are columns, the colors will be repeated. The most common use
case here is to have alternating background colors on the columns.
@item :actions @item :actions
This uses the same syntax as @code{define-keymap}, but doesn't refer This uses the same syntax as @code{define-keymap}, but doesn't refer
to commands directly. Instead each key is bound to a command that to commands directly. Instead each key is bound to a command that

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

@ -57,6 +57,7 @@
(separator-width :initarg :separator-width :accessor vtable-separator-width) (separator-width :initarg :separator-width :accessor vtable-separator-width)
(sort-by :initarg :sort-by :accessor vtable-sort-by) (sort-by :initarg :sort-by :accessor vtable-sort-by)
(ellipsis :initarg :ellipsis :accessor vtable-ellipsis) (ellipsis :initarg :ellipsis :accessor vtable-ellipsis)
(column-colors :initarg :column-colors :accessor vtable-column-colors)
(-cache :initform (make-hash-table :test #'equal))) (-cache :initform (make-hash-table :test #'equal)))
"A object to hold the data for a table.") "A object to hold the data for a table.")
@ -83,7 +84,8 @@
(separator-width 1) (separator-width 1)
sort-by sort-by
(ellipsis t) (ellipsis t)
(insert t)) (insert t)
column-colors)
"Create and insert a vtable at point. "Create and insert a vtable at point.
The vtable object is returned. If INSERT is nil, the table won't The vtable object is returned. If INSERT is nil, the table won't
be inserted." be inserted."
@ -122,6 +124,7 @@ be inserted."
:keymap keymap :keymap keymap
:separator-width separator-width :separator-width separator-width
:sort-by sort-by :sort-by sort-by
:column-colors column-colors
:ellipsis ellipsis))) :ellipsis ellipsis)))
;; Compute missing column data. ;; Compute missing column data.
(setf (vtable-columns table) (vtable--compute-columns table)) (setf (vtable-columns table) (vtable--compute-columns table))
@ -377,7 +380,8 @@ This also updates the displayed table."
(defun vtable--insert-line (table line widths spacer (defun vtable--insert-line (table line widths spacer
&optional ellipsis ellipsis-width) &optional ellipsis ellipsis-width)
(let ((start (point)) (let ((start (point))
(columns (vtable-columns table))) (columns (vtable-columns table))
(colors (vtable-column-colors table)))
(seq-do-indexed (seq-do-indexed
(lambda (elem index) (lambda (elem index)
(let ((value (nth 0 elem)) (let ((value (nth 0 elem))
@ -438,7 +442,12 @@ This also updates the displayed table."
(propertize " " 'display (propertize " " 'display
(list 'space (list 'space
:width (list spacer))))) :width (list spacer)))))
(put-text-property start (point) 'vtable-column index)))) (put-text-property start (point) 'vtable-column index)
(when colors
(add-face-text-property
start (point)
(list :background
(elt colors (mod index (length colors)))))))))
(cdr line)) (cdr line))
(insert "\n") (insert "\n")
(put-text-property start (point) 'vtable-object (car line)))) (put-text-property start (point) 'vtable-object (car line))))