master a96679b742: Allow having dividers between columns in vtable

[Lars Ingebrigtsen]

branch: master
commit a96679b742fef2058497ae445516f630c77d2a25
Author: Lars Ingebrigtsen <larsi@gnus.org>
Commit: Lars Ingebrigtsen <larsi@gnus.org>

    Allow having dividers between columns in vtable
    
    * doc/misc/vtable.texi (Making A Table): Document it.
    * lisp/emacs-lisp/vtable.el (vtable): Add a divider slot.
    (make-vtable): Accept :divider and :divider-width arguments.
    (vtable--insert-line, vtable--insert-header-line): Display the
    divider.
---
 doc/misc/vtable.texi      |  7 ++++
 lisp/emacs-lisp/vtable.el | 89 ++++++++++++++++++++++++++++++-----------------
 2 files changed, 64 insertions(+), 32 deletions(-)

diff --git a/doc/misc/vtable.texi b/doc/misc/vtable.texi
index 77cb8663af..5a3957758c 100644
--- a/doc/misc/vtable.texi
+++ b/doc/misc/vtable.texi
@@ -418,6 +418,13 @@ current line, they can use the 
@code{vtable-current-object} function
 @item :separator-width
 The width of the blank space between columns.
 
+@item :divider-width
+@itemx :divider
+You can have a divider inserted between the columns.  This can either
+be specified by using @code{:divider}, which should be a string to be
+displayed between the columns, or @code{:divider-width}, which
+specifies the width of the space to be used as the divider.
+
 @item :sort-by
 This should be a list of tuples, and specifies how the table is to be
 sorted.  Each tuple should consist of an integer (the column index)
diff --git a/lisp/emacs-lisp/vtable.el b/lisp/emacs-lisp/vtable.el
index e001043444..9b820c329a 100644
--- a/lisp/emacs-lisp/vtable.el
+++ b/lisp/emacs-lisp/vtable.el
@@ -61,6 +61,7 @@
    (actions :initarg :actions :accessor vtable-actions)
    (keymap :initarg :keymap :accessor vtable-keymap)
    (separator-width :initarg :separator-width :accessor vtable-separator-width)
+   (divider :initarg :divider :accessor vtable-divider :initform nil)
    (sort-by :initarg :sort-by :accessor vtable-sort-by)
    (ellipsis :initarg :ellipsis :accessor vtable-ellipsis)
    (column-colors :initarg :column-colors :accessor vtable-column-colors)
@@ -90,6 +91,8 @@
                             (face 'vtable)
                             actions keymap
                             (separator-width 1)
+                            divider
+                            divider-width
                             sort-by
                             (ellipsis t)
                             (insert t)
@@ -120,28 +123,39 @@ be inserted."
   ;; We'll be altering the list, so create a copy.
   (setq objects (copy-sequence objects))
   (let ((table
-         (make-instance 'vtable
-                        :columns columns
-                        :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)))
+         (make-instance
+          'vtable
+          :columns columns
+          :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)))
     ;; Compute missing column data.
     (setf (vtable-columns table) (vtable--compute-columns table))
     ;; Compute colors if we have to mix them.
     (when (and row-colors column-colors)
       (setf (vtable--cached-colors table)
             (vtable--compute-colors row-colors column-colors)))
+    ;; Compute the divider.
+    (when (or divider divider-width)
+      (setf (vtable-divider table)
+            (or divider
+                (and divider-width
+                     (propertize
+                      " " 'display
+                      (list 'space :width
+                            (list (vtable--compute-width
+                                   table divider-width))))))))
     (unless sort-by
       (seq-do-indexed (lambda (column index)
                         (when (vtable-column-primary column)
@@ -420,7 +434,8 @@ This also updates the displayed table."
          (if (vtable-row-colors table)
              (elt (vtable--cached-colors table)
                   (mod line-number (length (vtable-row-colors table))))
-           (vtable-column-colors table))))
+           (vtable-column-colors table)))
+        (divider (vtable-divider table)))
     (seq-do-indexed
      (lambda (elem index)
        (let ((value (nth 0 elem))
@@ -461,32 +476,40 @@ This also updates the displayed table."
                         value (- (elt widths index) ellipsis-width))
                        ellipsis)
                     value))))
-               (start (point)))
+               (start (point))
+               ;; Don't insert the separator and the divider after the
+               ;; final column.
+               (last (= index (- (length line) 2))))
            (if (eq (vtable-column-align column) 'left)
-               (insert displayed
-                       (propertize
-                        " " 'display
-                        (list 'space
-                              :width (list
-                                      (+ (- (elt widths index)
-                                            (string-pixel-width displayed))
-                                         spacer)))))
+               (progn
+                 (insert displayed)
+                 (insert (propertize
+                          " " 'display
+                          (list 'space
+                                :width (list
+                                        (+ (- (elt widths index)
+                                              (string-pixel-width displayed))
+                                           (if last 0 spacer)))))))
              ;; Align to the right.
              (insert (propertize " " 'display
                                  (list 'space
                                        :width (list (- (elt widths index)
                                                        (string-pixel-width
                                                         displayed)))))
-                     displayed
-                     (propertize " " 'display
-                                 (list 'space
-                                       :width (list spacer)))))
+                     displayed)
+             (unless last
+               (insert (propertize " " 'display
+                                   (list 'space
+                                         :width (list spacer))))))
            (put-text-property start (point) 'vtable-column index)
            (when column-colors
              (add-face-text-property
               start (point)
               (list :background
-                    (elt column-colors (mod index (length 
column-colors)))))))))
+                    (elt column-colors (mod index (length column-colors))))))
+           (when (and divider (not last))
+             (insert divider)
+             (setq start (point))))))
      (cdr line))
     (insert "\n")
     (put-text-property start (point) 'vtable-object (car line))
@@ -556,6 +579,7 @@ This also updates the displayed table."
               (start (point))
               (indicator (vtable--indicator table index))
               (indicator-width (string-pixel-width indicator))
+              (last (= index (1- (length (vtable-columns table)))))
               displayed)
          (insert
           (setq displayed
@@ -566,11 +590,12 @@ This also updates the displayed table."
                       name (- (elt widths index) indicator-width))
                    name)
                  indicator))
+          (or (vtable-divider table) "")
           (propertize " " 'display
                       (list 'space :width
                             (list (+ (- (elt widths index)
                                         (string-pixel-width displayed))
-                                     spacer)))))
+                                     (if last 0 spacer))))))
          (put-text-property start (point) 'vtable-column index)))
      (vtable-columns table))
     (insert "\n")