From: Lars Ingebrigtsen <larsi@gnus.org>
Date: Wed, 13 Apr 2022 14:25:52 +0000 (+0200)
Subject: Add support for column background colors in vtable
X-Git-Tag: emacs-29.0.90~1931^2~599
X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=29fae93d1c480cc69406a19ab9ef69d84ef8142f;p=emacs.git

Add support for column background colors in vtable

* 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.
---

diff --git a/doc/misc/vtable.texi b/doc/misc/vtable.texi
index 472dee70ec0..48e6301fce0 100644
--- a/doc/misc/vtable.texi
+++ b/doc/misc/vtable.texi
@@ -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
 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
 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
diff --git a/lisp/emacs-lisp/vtable.el b/lisp/emacs-lisp/vtable.el
index 8d777335315..98106e46700 100644
--- a/lisp/emacs-lisp/vtable.el
+++ b/lisp/emacs-lisp/vtable.el
@@ -57,6 +57,7 @@
    (separator-width :initarg :separator-width :accessor vtable-separator-width)
    (sort-by :initarg :sort-by :accessor vtable-sort-by)
    (ellipsis :initarg :ellipsis :accessor vtable-ellipsis)
+   (column-colors :initarg :column-colors :accessor vtable-column-colors)
    (-cache :initform (make-hash-table :test #'equal)))
   "A object to hold the data for a table.")
 
@@ -83,7 +84,8 @@
                             (separator-width 1)
                             sort-by
                             (ellipsis t)
-                            (insert t))
+                            (insert t)
+                            column-colors)
   "Create and insert a vtable at point.
 The vtable object is returned.  If INSERT is nil, the table won't
 be inserted."
@@ -122,6 +124,7 @@ be inserted."
                         :keymap keymap
                         :separator-width separator-width
                         :sort-by sort-by
+                        :column-colors column-colors
                         :ellipsis ellipsis)))
     ;; Compute missing column data.
     (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
                                   &optional ellipsis ellipsis-width)
   (let ((start (point))
-        (columns (vtable-columns table)))
+        (columns (vtable-columns table))
+        (colors (vtable-column-colors table)))
     (seq-do-indexed
      (lambda (elem index)
        (let ((value (nth 0 elem))
@@ -438,7 +442,12 @@ This also updates the displayed table."
                      (propertize " " 'display
                                  (list 'space
                                        :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))
     (insert "\n")
     (put-text-property start (point) 'vtable-object (car line))))