Package: emacs;
Reported by: Eric Marsden <eric.marsden <at> risk-engineering.org>
Date: Wed, 28 Feb 2024 14:54:02 UTC
Severity: normal
Tags: patch
Message #50 received at 69454 <at> debbugs.gnu.org (full text, mbox):
From: Joost Kremers <joostkremers <at> fastmail.fm> To: Adam Porter <adam <at> alphapapa.net> Cc: Eli Zaretskii <eliz <at> gnu.org>, eric.marsden <at> risk-engineering.org, larsi <at> gnus.org, 69454 <at> debbugs.gnu.org Subject: Re: bug#69454: Not possible to insert an empty vtable Date: Mon, 03 Jun 2024 14:13:55 +0200
[Message part 1 (text/plain, inline)]
On Sun, Jun 02 2024, Adam Porter wrote: > IIRC I only suggested that because it would mean fewer changes to the code, but > if you've already written code to allow it, I don't object. :) In that case, I'm providing the same patch here, with an additional update for vtable.texi and NEWS:
[0001-Allow-empty-vtable.patch (text/x-patch, inline)]
From a87d2fc4637a058fad479b4ba5653947bdbb82bf Mon Sep 17 00:00:00 2001
From: Joost Kremers <joostkremers <at> fastmail.com>
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 | 67 ++++++++++++++++++++++++---------------
1 file changed, 41 insertions(+), 26 deletions(-)
diff --git a/lisp/emacs-lisp/vtable.el b/lisp/emacs-lisp/vtable.el
index cb7ea397314..07ef7d20020 100644
--- a/lisp/emacs-lisp/vtable.el
+++ b/lisp/emacs-lisp/vtable.el
@@ -850,32 +850,47 @@ 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 ((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)
+ 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 (member 0 widths)
+ (let* ((combined-width (apply #'+ widths))
+ (n-0cols (length (seq-keep #'zerop 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.45.2
[0002-Enable-inserting-new-objects-into-empty-vtable.patch (text/x-patch, inline)]
From 36b0fb11b27d8f6246a4683462823088c562b146 Mon Sep 17 00:00:00 2001
From: Joost Kremers <joostkremers <at> fastmail.com>
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 07ef7d20020..c86ae7f0955 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.45.2
[0003-vtable-allow-resetting-column-alignment-when-table-d.patch (text/x-patch, inline)]
From 63b47044325bc8d7357b6536d7575a5a73bbeb08 Mon Sep 17 00:00:00 2001
From: Joost Kremers <joostkremers <at> fastmail.com>
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 c86ae7f0955..3e9f5214db0 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))
+ (if (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.45.2
[0004-Update-vtable-documentation-and-NEWS.patch (text/x-patch, inline)]
From ebfc7ae51895d7dc468c737f2fe403fbd398d5e8 Mon Sep 17 00:00:00 2001
From: Joost Kremers <joostkremers <at> fastmail.com>
Date: Mon, 3 Jun 2024 14:07:43 +0200
Subject: [PATCH 4/4] Update vtable documentation and NEWS
* doc/misc/vtable.texi: Add note about empty vtables; add note about
column width in empty vtables.
* etc/NEWS: Add note about empty vtables.
---
doc/misc/vtable.texi | 11 +++++++++++
etc/NEWS | 8 ++++++++
2 files changed, 19 insertions(+)
diff --git a/doc/misc/vtable.texi b/doc/misc/vtable.texi
index 6003435385f..061547f5deb 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.
@@ -569,6 +578,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 5a1f7f3e443..7089b27ed75 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -2806,6 +2806,14 @@ this was not possible.) In addition, LOCATION can be an integer, a
(zero-based) index into the table at which the new object is inserted
(BEFORE is ignored in this case).
+** 'make-vtable' can create 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.
+
** JSON
---
--
2.45.2
[Message part 6 (text/plain, inline)]
-- Joost Kremers Life has its moments
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.