vtable: Add column weights feature

[Tad Fisher <tadfisher@gmail.com>]

[-- Attachment #1: Type: text/plain, Size: 211 bytes --]

Hello,

This is a patch to allow allocating the full window width to vtable
columns, in proportion to a new `weight' slot value.

I would need to assign copyright if this patch were to be accepted.

Thanks,
Tad

[-- Attachment #2: 0001-vtable-Add-column-weights-feature.patch --]
[-- Type: text/x-patch, Size: 6155 bytes --]

From 6c03a268eaa81479799a12a747c299bf83363e8e Mon Sep 17 00:00:00 2001
From: Tad Fisher <tadfisher@gmail.com>
Date: Fri, 7 Oct 2022 17:57:25 -0700
Subject: [PATCH] vtable: Add column weights feature

Add a mechanism to expand the table to the full window width, while
distributing unallocated space to columns in proportion to their
`weight' value.
* lisp/emacs-lisp/vtable.el: Add column weights feature
* doc/misc/vtable.texi: Document column weights feature
---
 doc/misc/vtable.texi      | 12 ++++++
 lisp/emacs-lisp/vtable.el | 87 +++++++++++++++++++++++++++++----------
 2 files changed, 78 insertions(+), 21 deletions(-)

diff --git a/doc/misc/vtable.texi b/doc/misc/vtable.texi
index 59cd9d0..b2eb375 100644
--- a/doc/misc/vtable.texi
+++ b/doc/misc/vtable.texi
@@ -298,6 +298,18 @@ Making A Table
 given as a percentage of the window width, and you want to ensure that
 the column doesn't grow pointlessly large or unreadably narrow.
 
+@item weight
+A number that specifies how to distribute unallocated space to this
+column. After measuring all columns without a @code{weight} value, the
+remaining window width is divided proportionally among all columns with
+a @code{weight} value. For example: given a table holding two columns,
+one with @samp{:weight 1} and another with @samp{:weight 2}, the first
+will have half the width of the second, or 33% of the window width.
+
+This value is ignored when @code{width} is specified. The
+@code{min-width} and @code{max-width} slots will still apply, which may
+cause the table width to exceed the available window width.
+
 @item primary
 Whether this is the primary column---this will be used for initial
 sorting.  This should be either @code{ascend} or @code{descend} to say
diff --git a/lisp/emacs-lisp/vtable.el b/lisp/emacs-lisp/vtable.el
index 9bdf90b..ec1fd7f 100644
--- a/lisp/emacs-lisp/vtable.el
+++ b/lisp/emacs-lisp/vtable.el
@@ -40,6 +40,7 @@ vtable-column
   width
   min-width
   max-width
+  weight
   primary
   align
   getter
@@ -775,34 +776,78 @@ vtable--compute-width
    (t
     (error "Invalid spec: %s" spec))))
 
-(defun vtable--compute-widths (table cache)
-  "Compute the display widths for TABLE."
+(defun vtable--apply-column-constraints (table column width)
+  "Constrain WIDTH according to constraints in COLUMN for TABLE."
+  (when-let ((min-width (and (vtable-column-min-width column)
+                             (vtable--compute-width
+                              table (vtable-column-min-width column)))))
+    (setq width (max width min-width)))
+  (when-let ((max-width (and (vtable-column-max-width column)
+                             (vtable--compute-width
+                              table (vtable-column-max-width column)))))
+    (setq width (min width max-width)))
+  width)
+
+(defun vtable--compute-fixed-widths (table cache)
+  "Compute fixed display widths for TABLE."
   (seq-into
    (seq-map-indexed
     (lambda (column index)
-      (let ((width
-             (or
-              ;; Explicit widths.
-              (and (vtable-column-width column)
-                   (vtable--compute-width table (vtable-column-width column)))
-              ;; Compute based on the displayed widths of
-              ;; the data.
-              (seq-max (seq-map (lambda (elem)
+      (or
+       ;; Explicit width.
+       (when-let ((spec (vtable-column-width column)))
+         (let ((width (vtable--compute-width table spec)))
+           (vtable--apply-column-constraints table column width)))
+
+       ;; Non-weighted width.
+       (unless (vtable-column-weight column)
+         (let ((width (seq-max
+                       (seq-map (lambda (elem)
                                   (nth 1 (elt (cdr elem) index)))
-                                cache)))))
-        ;; Let min-width/max-width specs have their say.
-        (when-let ((min-width (and (vtable-column-min-width column)
-                                   (vtable--compute-width
-                                    table (vtable-column-min-width column)))))
-          (setq width (max width min-width)))
-        (when-let ((max-width (and (vtable-column-max-width column)
-                                   (vtable--compute-width
-                                    table (vtable-column-max-width column)))))
-          (setq width (min width max-width)))
-        width))
+                                cache))))
+           (vtable--apply-column-constraints table column width)))
+
+       0))
     (vtable-columns table))
    'vector))
 
+(defun vtable--compute-weighted-widths (table space)
+  "Compute weighted column widths for TABLE given SPACE."
+  (let* ((columns (vtable-columns table))
+         (weights (seq-into
+                   (seq-map
+                    (lambda (column)
+                       (if (vtable-column-width column) 0
+                         (or (vtable-column-weight column) 0)))
+                    columns)
+                   'vector))
+         (total-weight (seq-reduce #'+ weights 0)))
+    (if (= total-weight 0)
+        (make-vector (length columns) 0)
+      (seq-into
+       (seq-map-indexed
+        (lambda (column index)
+          (let ((weight (seq-elt weights index)))
+            (if (= 0 weight) 0
+              (let* ((rel-weight (/ weight total-weight))
+                     (width (* rel-weight space)))
+                (vtable--apply-column-constraints table column width)))))
+          columns)
+       'vector))))
+
+(defun vtable--compute-widths (table cache)
+  "Compute the display widths for TABLE."
+  (let* ((fixed-widths (vtable--compute-fixed-widths table cache))
+         (fixed-space (seq-reduce #'+ fixed-widths 0))
+         (weighted-space (- (window-width nil t)
+                            fixed-space
+                            (* (vtable--spacer table)
+                               (1- (length (vtable-columns table))))))
+         (weighted-widths (vtable--compute-weighted-widths table weighted-space)))
+    (seq-into
+     (seq-mapn #'+ fixed-widths weighted-widths)
+   'vector)))
+
 (defun vtable--compute-cache (table)
   (seq-map
    (lambda (object)
-- 
2.37.3