Subject: Re: bug#73775: 30.0.90; vtable: can't handle 0 data rows

From: Joost Kremers <[email-masked]>
Date: Wed, 16 Oct 2024 18:19:41 +0200

Hi Adam,

Thanks for looking at this.

On Tue, Oct 15 2024, Adam Porter wrote:
> Just a few minor suggestions:
>
> +  "Compute the display widths for TABLE.
> +CACHE is TABLE's cache data as returned by `vtable--compute-cache'."
> +  (let ((widths (seq-map-indexed
> +                 (lambda (column index)
> +                   (let ((width
> +                          (or
> +                           ;; Explicit widths.
> +                           (and (vtable-column-width column)
> +                                (vtable--compute-width table
> (vtable-column-width column)))
> +                           ;; If the vtable is empty and no explicit width
> is given,
> +                           ;; set its width to 0 and deal with it below.
> +                           (if (null cache)
>
> I may be mistaken (as I haven't examined all of the relevant code), but if
> CACHE is nil when this function is called, won't it always be null? If so,
> you could check its value once, at first, rather than each time through
> this loop.

Unfortunately, it has to be checked anew in every iteration, because it
determines for each column individually if we need to (temporarily) set its
width to 0. It also needs to keep the following `seq-max` from erroring out
(due to `seq-map` returning `nil`).

> +    ;; If there are any zero-width columns, divide the remaining window
> +    ;; width evenly over them.
> +    (when (member 0 widths)
> +      (let* ((combined-width (apply #'+ widths))
> +             (n-0cols (length (seq-keep #'zerop widths)))
>
> You could use SEQ-COUNT here, which would avoid consing a new list.

There may even be a better way. If I keep track of the number of zero-width
columns in the loop above, I don't even need to count them here. I've
implemented that in the updated patch attached to this message.

> @@ -484,3 +495,8 @@ vtable--compute-columns
>                                               table))
>             (setf (elt numerical index) nil)))
>         (vtable-columns table)))
> +    ;; Check if any columns have an explicit `align' property.
> +    (unless recompute
> +      (dolist (column (vtable-columns table))
> +        (if (vtable-column-align column)
> +            (setf (vtable-column--aligned column) t))))
>
> This could be a WHEN instead of a "one-armed IF".  :)

Yes, sirree! (I don't really agree with the "one-armed if should be
when"-stance, but I'd be hard-pressed to say when I prefer "if" and when
"when", and it's hardly a hill I want to die on, so I made the change. 😆 )

-- 
Joost Kremers
Life has its moments

>From 319fdd16081962aa0a716c0b861baacf41a0f534 Mon Sep 17 00:00:00 2001
From: Joost Kremers <[email-masked]>
Date: Thu, 30 May 2024 13:28:00 +0200
Subject: [PATCH 1/4] Allow empty vtable

* lisp/emacs-lisp/vtable.el (vtable--compute-widths): Set default width
  for columns that have no explicit width and no data.
---
 lisp/emacs-lisp/vtable.el | 68 ++++++++++++++++++++++++---------------
 1 file changed, 42 insertions(+), 26 deletions(-)

diff --git a/lisp/emacs-lisp/vtable.el b/lisp/emacs-lisp/vtable.el
index d58c6894c16..b4c01cdfe6c 100644
--- a/lisp/emacs-lisp/vtable.el
+++ b/lisp/emacs-lisp/vtable.el
@@ -850,32 +850,48 @@ vtable--compute-width
     (error "Invalid spec: %s" spec))))
 
 (defun vtable--compute-widths (table cache)
-  "Compute the 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)
-                                  (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))
-    (vtable-columns table))
-   'vector))
+  "Compute the display widths for TABLE.
+CACHE is TABLE's cache data as returned by `vtable--compute-cache'."
+  (let* ((n-0cols 0) ; Count the number of zero-width columns.
+         (widths (seq-map-indexed
+                  (lambda (column index)
+                    (let ((width
+                           (or
+                            ;; Explicit widths.
+                            (and (vtable-column-width column)
+                                 (vtable--compute-width table (vtable-column-width column)))
+                            ;; If the vtable is empty and no explicit width is given,
+                            ;; set its width to 0 and deal with it below.
+                            (when (null cache)
+                              (setq n-0cols (1+ n-0cols))
+                              0)
+                            ;; Otherwise, compute based on the displayed widths of the
+                            ;; data.
+                            (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))
+                  (vtable-columns table))))
+    ;; If there are any zero-width columns, divide the remaining window
+    ;; width evenly over them.
+    (when (> n-0cols 0)
+      (let* ((combined-width (apply #'+ widths))
+             (default-width (/ (- (window-width nil t) combined-width) n-0cols)))
+        (setq widths (mapcar (lambda (width)
+                               (if (zerop width)
+                                   default-width
+                                 width))
+                             widths))))
+    (seq-into widths 'vector)))
 
 (defun vtable--compute-cache (table)
   (seq-map
-- 
2.47.0

>From 9b0509d0b3a5ae78135c63971d2b99ff0bd07ed5 Mon Sep 17 00:00:00 2001
From: Joost Kremers <[email-masked]>
Date: Thu, 30 May 2024 23:20:00 +0200
Subject: [PATCH 2/4] Enable inserting new objects into empty vtable

* lisp/emacs-lisp/vtable.el (vtable-insert-object): If the vtable is
  empty, add the new object and recreate + redisplay the table.
---
 lisp/emacs-lisp/vtable.el | 151 +++++++++++++++++++-------------------
 1 file changed, 77 insertions(+), 74 deletions(-)

diff --git a/lisp/emacs-lisp/vtable.el b/lisp/emacs-lisp/vtable.el
index b4c01cdfe6c..0aa3b4c5e76 100644
--- a/lisp/emacs-lisp/vtable.el
+++ b/lisp/emacs-lisp/vtable.el
@@ -368,86 +368,89 @@ vtable-insert-object
 case.
 
 This also updates the displayed table."
-  ;; FIXME: Inserting an object into an empty vtable currently isn't
-  ;; possible. `nconc' fails silently (twice), and `setcar' on the cache
-  ;; raises an error.
+  ;; If the vtable is empty, just add the object and regenerate the
+  ;; table.
   (if (null (vtable-objects table))
-      (error "[vtable] Cannot insert object into empty vtable"))
-  ;; First insert into the objects.
-  (let ((pos (if location
-                 (if (integerp location)
-                     (prog1
-                         (nthcdr location (vtable-objects table))
-                       ;; Do not prepend if index is too large:
-                       (setq before nil))
-                   (or (memq location (vtable-objects table))
-                       ;; Prepend if `location' is not found and
-                       ;; `before' is non-nil:
-                       (and before (vtable-objects table))))
-               ;; If `location' is nil and `before' is non-nil, we
-               ;; prepend the new object.
-               (if before (vtable-objects table)))))
-    (if (or before  ; If `before' is non-nil, `pos' should be, as well.
-            (and pos (integerp location)))
-        ;; Add the new object before.
-        (let ((old-object (car pos)))
-          (setcar pos object)
-          (setcdr pos (cons old-object (cdr pos))))
-      ;; Otherwise, add the object after.
-      (if pos
-          ;; Splice the object into the list.
-          (setcdr pos (cons object (cdr pos)))
-        ;; Otherwise, append the object.
-        (nconc (vtable-objects table) (list object)))))
-  ;; Then adjust the cache and display.
-  (save-excursion
-    (vtable-goto-table table)
-    (let* ((cache (vtable--cache table))
-           (inhibit-read-only t)
-           (keymap (get-text-property (point) 'keymap))
-           (ellipsis (if (vtable-ellipsis table)
-                         (propertize (truncate-string-ellipsis)
-                                     'face (vtable-face table))
-                       ""))
-           (ellipsis-width (string-pixel-width ellipsis))
-           (elem (if location  ; This binding mirrors the binding of `pos' above.
-                     (if (integerp location)
-                         (nth location (car cache))
-                       (or (assq location (car cache))
-                           (and before (caar cache))))
-                   (if before (caar cache))))
-           (pos (memq elem (car cache)))
-           (line (cons object (vtable--compute-cached-line table object))))
-      (if (or before
+      (progn
+        (setf (vtable-objects table) (list object))
+        (vtable--recompute-numerical table (vtable--compute-cached-line table object))
+        (vtable-goto-table table)
+        (vtable-revert-command))
+    ;; First insert into the objects.
+    (let ((pos (if location
+                   (if (integerp location)
+                       (prog1
+                           (nthcdr location (vtable-objects table))
+                         ;; Do not prepend if index is too large:
+                         (setq before nil))
+                     (or (memq location (vtable-objects table))
+                         ;; Prepend if `location' is not found and
+                         ;; `before' is non-nil:
+                         (and before (vtable-objects table))))
+                 ;; If `location' is nil and `before' is non-nil, we
+                 ;; prepend the new object.
+                 (if before (vtable-objects table)))))
+      (if (or before  ; If `before' is non-nil, `pos' should be, as well.
               (and pos (integerp location)))
-          ;; Add the new object before:.
-          (let ((old-line (car pos)))
-            (setcar pos line)
-            (setcdr pos (cons old-line (cdr pos)))
-            (unless (vtable-goto-object (car elem))
-              (vtable-beginning-of-table)))
+          ;; Add the new object before.
+          (let ((old-object (car pos)))
+            (setcar pos object)
+            (setcdr pos (cons old-object (cdr pos))))
         ;; Otherwise, add the object after.
         (if pos
             ;; Splice the object into the list.
-            (progn
-              (setcdr pos (cons line (cdr pos)))
-              (if (vtable-goto-object location)
-                  (forward-line 1)  ; Insert *after*.
-                (vtable-end-of-table)))
+            (setcdr pos (cons object (cdr pos)))
           ;; Otherwise, append the object.
-          (setcar cache (nconc (car cache) (list line)))
-          (vtable-end-of-table)))
-      (let ((start (point)))
-        ;; FIXME: We have to adjust colors in lines below this if we
-        ;; have :row-colors.
-        (vtable--insert-line table line 0
-                             (nth 1 cache) (vtable--spacer table)
-                             ellipsis ellipsis-width)
-        (add-text-properties start (point) (list 'keymap keymap
-                                                 'vtable table)))
-      ;; We may have inserted a non-numerical value into a previously
-      ;; all-numerical table, so recompute.
-      (vtable--recompute-numerical table (cdr line)))))
+          (nconc (vtable-objects table) (list object)))))
+    ;; Then adjust the cache and display.
+    (save-excursion
+      (vtable-goto-table table)
+      (let* ((cache (vtable--cache table))
+             (inhibit-read-only t)
+             (keymap (get-text-property (point) 'keymap))
+             (ellipsis (if (vtable-ellipsis table)
+                           (propertize (truncate-string-ellipsis)
+                                       'face (vtable-face table))
+                         ""))
+             (ellipsis-width (string-pixel-width ellipsis))
+             (elem (if location  ; This binding mirrors the binding of `pos' above.
+                       (if (integerp location)
+                           (nth location (car cache))
+                         (or (assq location (car cache))
+                             (and before (caar cache))))
+                     (if before (caar cache))))
+             (pos (memq elem (car cache)))
+             (line (cons object (vtable--compute-cached-line table object))))
+        (if (or before
+                (and pos (integerp location)))
+            ;; Add the new object before:.
+            (let ((old-line (car pos)))
+              (setcar pos line)
+              (setcdr pos (cons old-line (cdr pos)))
+              (unless (vtable-goto-object (car elem))
+                (vtable-beginning-of-table)))
+          ;; Otherwise, add the object after.
+          (if pos
+              ;; Splice the object into the list.
+              (progn
+                (setcdr pos (cons line (cdr pos)))
+                (if (vtable-goto-object location)
+                    (forward-line 1)  ; Insert *after*.
+                  (vtable-end-of-table)))
+            ;; Otherwise, append the object.
+            (setcar cache (nconc (car cache) (list line)))
+            (vtable-end-of-table)))
+        (let ((start (point)))
+          ;; FIXME: We have to adjust colors in lines below this if we
+          ;; have :row-colors.
+          (vtable--insert-line table line 0
+                               (nth 1 cache) (vtable--spacer table)
+                               ellipsis ellipsis-width)
+          (add-text-properties start (point) (list 'keymap keymap
+                                                   'vtable table)))
+        ;; We may have inserted a non-numerical value into a previously
+        ;; all-numerical table, so recompute.
+        (vtable--recompute-numerical table (cdr line))))))
 
 (defun vtable-column (table index)
   "Return the name of the INDEXth column in TABLE."
-- 
2.47.0

>From bfd6dcd2c8052af091824877bf92c3169962ed8c Mon Sep 17 00:00:00 2001
From: Joost Kremers <[email-masked]>
Date: Fri, 31 May 2024 01:38:54 +0200
Subject: [PATCH 3/4] vtable: allow resetting column alignment when table data
 changes

* lisp/emacs-lisp/vtable.el (vtable--compute-columns): if a column was
  not created with an explicit 'align' property, allow changing this
  property when the column data changes from numeric to non-numeric (or
  vice versa). This makes it possible to add data to an empty table,
  because in a table without data all columns are assumed to be numeric
  and right-aligned.
---
 lisp/emacs-lisp/vtable.el | 24 ++++++++++++++++++++----
 1 file changed, 20 insertions(+), 4 deletions(-)

diff --git a/lisp/emacs-lisp/vtable.el b/lisp/emacs-lisp/vtable.el
index 0aa3b4c5e76..6b6487847b9 100644
--- a/lisp/emacs-lisp/vtable.el
+++ b/lisp/emacs-lisp/vtable.el
@@ -45,7 +45,8 @@ vtable-column
   getter
   formatter
   displayer
-  -numerical)
+  -numerical
+  -aligned)
 
 (defclass vtable ()
   ((columns :initarg :columns :accessor vtable-columns)
@@ -473,7 +474,17 @@ vtable--get-value
    (t
     (elt object index))))
 
-(defun vtable--compute-columns (table)
+(defun vtable--compute-columns (table &optional recompute)
+  "Compute column specs for TABLE.
+Set the `align', `-aligned' and `-numerical' properties of each column.
+If the column contains only numerical data, set `-numerical' to t,
+otherwise to nil.  `-aligned' indicates whether the column has an
+`align' property set by the user.  If it does, `align' is not touched,
+otherwise it is set to `right' for numeric columns and to `left' for
+non-numeric columns.
+
+If RECOMPUTE is non-nil, do not set `-aligned'.  This can be used to
+recompute the column specs when the table data has changed."
   (let ((numerical (make-vector (length (vtable-columns table)) t))
         (columns (vtable-columns table)))
     ;; First determine whether there are any all-numerical columns.
@@ -484,11 +495,16 @@ vtable--compute-columns
                                              table))
            (setf (elt numerical index) nil)))
        (vtable-columns table)))
+    ;; Check if any columns have an explicit `align' property.
+    (unless recompute
+      (dolist (column (vtable-columns table))
+        (when (vtable-column-align column)
+          (setf (vtable-column--aligned column) t))))
     ;; Then fill in defaults.
     (seq-map-indexed
      (lambda (column index)
        ;; This is used when displaying.
-       (unless (vtable-column-align column)
+       (unless (vtable-column--aligned column)
          (setf (vtable-column-align column)
                (if (elt numerical index)
                    'right
@@ -813,7 +829,7 @@ vtable--recompute-numerical
          (setq recompute t)))
      line)
     (when recompute
-      (vtable--compute-columns table))))
+      (vtable--compute-columns table t))))
 
 (defun vtable--set-header-line (table widths spacer)
   (setq header-line-format
-- 
2.47.0

>From da903db0bcf310376d4ff7aaf3578bb576cfa1b7 Mon Sep 17 00:00:00 2001
From: Joost Kremers <[email-masked]>
Date: Mon, 14 Oct 2024 13:10:57 +0200
Subject: [PATCH 4/4] Update vtable documentation

* docs/misc/vtable.texi: Document creation of empty vtables.
* etc/NEWS: Announce empty vtables.
---
 doc/misc/vtable.texi | 11 +++++++++++
 etc/NEWS             |  9 +++++++++
 2 files changed, 20 insertions(+)

diff --git a/doc/misc/vtable.texi b/doc/misc/vtable.texi
index 795d7fad037..b2ead47d0bc 100644
--- a/doc/misc/vtable.texi
+++ b/doc/misc/vtable.texi
@@ -264,6 +264,10 @@ Making A Table
 more elements in the sequence than there is in @code{:columns}, only
 the @code{:columns} first elements are displayed.
 
+If the @code{:objects} list is empty (and no @code{:objects-function} is
+defined), an empty vtable is created.  In this case, a @code{:columns}
+spec must be provided.
+
 @item :objects-function
 It's often convenient to generate the objects dynamically (for
 instance, to make reversion work automatically).  In that case, this
@@ -295,6 +299,11 @@ Making A Table
 @var{n} percent of the window's width.
 @end table
 
+If no @code{width} is provided, the width is calculated based on the
+column data (provided in the @code{:objects} list or through the
+@code{:objects-function}) or, if there is no data, on the basis of the
+window width.
+
 @item min-width
 This uses the same format as @code{width}, but specifies the minimum
 width (and overrides @code{width} if @code{width} is smaller than this.
@@ -576,6 +585,8 @@ Interface Functions
 index is too small, or appended if it is too large.  In this case,
 @var{before} is ignored.
 
+If @var{table} is empty, @var{location} and @var{before} are ignored.
+
 This also updates the displayed table.
 @end defun
 
diff --git a/etc/NEWS b/etc/NEWS
index 4346fb4aedd..ecd22499767 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -662,6 +662,15 @@ This lets a Lisp program access the core functionality of the
 program, choosing the program according to the operating system's
 conventions.
 
+** 'make-vtable' can create an empty vtable
+It is now possible to create a vtable without data, by leaving the
+':objects' list empty, or by providing a ':objects-function' that
+(initially) produces no data.  In such a case, it is necessary to
+provide a ':columns' spec, so that the number of columns and their
+widths can be determined.  Columns widths can be set explicitly, or they
+will be calculated based on the window width.
+
+
 
 * Changes in Emacs 31.1 on Non-Free Operating Systems
 
-- 
2.47.0