martin/emacs
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

vtable truncate-string-pixelwise, ellipsis can be a string (bug#80026)

Browse Source 
Eliminate 'vtable--limit-string' in favor of the more efficient
'truncate-string-pixelwise'.  Remove extraneous pre-measurement
calls to 'string-pixel-width' and ellipsis concatenation as
'truncate-string-pixelwise' does both.
The 'make-vtable' 'ellipsis' keyword can be a string to override
the default returned by 'truncate-string-ellipsis'.

* lisp/emacs-lisp/vtable.el (vtable--ellipsis): New defun.
(vtable-insert-object, vtable--insert): Use 'vtable--ellipsis'.
(vtable--insert-line, vtable--insert-header-line): Call
'truncate-string-pixelwise' instead of 'vtable--limit-string'.
(vtable--limit-string): Remove function.

* test/lisp/emacs-lisp/vtable-tests.el
(test-vtable--limit-string-with-face-remapped-buffer): Remove
test, obsoleted by misc-test-truncate-string-pixelwise.

* doc/misc/vtable.texi: Document that :ellipsis can be a string.
This commit is contained in:
Stéphane Marks
2026-01-31 18:55:09 -05:00
committed by Eli Zaretskii
parent eca93f40d1
commit 48d65afa32
3 changed files with 28 additions and 64 deletions
Download Patch File Download Diff File Expand all files Collapse all files

8
doc/misc/vtable.texi
View File

@@ -461,10 +461,10 @@ The table is first sorted by the first element in this list, and then
the next, until the end is reached.
@item :ellipsis
By default, when shortening displayed values, an ellipsis will be
shown. If this is @code{nil}, no ellipsis is shown. (The text to use
as the ellipsis is determined by the @code{truncate-string-ellipsis}
function.)
Displayed values are shortened to fit column widths. This defaults to
@code{t} which shows an ellipsis using the text returned by the function
@code{truncate-string-ellipsis}. Set this to a string to use your own
ellipsis text. Set this to @code{nil} to inhibit the ellipsis.
@findex vtable-insert
@item :insert

63
lisp/emacs-lisp/vtable.el
View File

@@ -438,18 +438,15 @@ This also updates the displayed table."
(setcar cache (nconc lines (list line)))
(vtable-end-of-table)))
(let* ((start (point))
(ellipsis (if (vtable-ellipsis table)
(propertize (truncate-string-ellipsis)
'face (vtable-face table))
""))
(ellipsis-width (string-pixel-width ellipsis (current-buffer)))
(keymap (get-text-property (point) 'keymap)))
;; FIXME: We have to adjust colors in lines below this if we
;; have :row-colors.
(vtable--insert-line table line 0
(vtable--cache-widths cache)
(vtable--spacer table)
ellipsis ellipsis-width)
(vtable--ellipsis table)
(string-pixel-width
(vtable--ellipsis table) (current-buffer)))
(add-text-properties start (point) (list 'keymap keymap
'vtable table)))
;; We may have inserted a non-numerical value into a previously
@@ -518,6 +515,13 @@ recompute the column specs when the table data has changed."
column)
(vtable-columns table))))
(defun vtable--ellipsis (table)
(let ((ellipsis (vtable-ellipsis table)))
(pcase ellipsis
((pred (stringp)) ellipsis)
('nil "")
(_ (truncate-string-ellipsis)))))
(defun vtable--spacer (table)
(vtable--compute-width table (vtable-separator-width table)))
@@ -530,10 +534,8 @@ recompute the column specs when the table data has changed."
(defun vtable--insert (table)
(let* ((spacer (vtable--spacer table))
(start (point))
(ellipsis (if (vtable-ellipsis table)
(propertize (truncate-string-ellipsis)
'face (vtable-face table))
""))
(ellipsis (propertize (vtable--ellipsis table)
'face (vtable-face table)))
(ellipsis-width (string-pixel-width ellipsis (vtable-buffer table)))
;; We maintain a cache per screen/window width, so that we render
;; correctly if Emacs is open on two different screens (or the
@@ -632,23 +634,16 @@ itself in the new buffer."
;; If we don't have a displayer, use the pre-made
;; (cached) string value.
(if (> (nth 1 elem) (elt widths index))
(concat
(vtable--limit-string
pre-computed (- (elt widths index)
(or ellipsis-width 0))
buffer)
ellipsis)
(truncate-string-pixelwise pre-computed
(elt widths index)
buffer
ellipsis ellipsis-width)
pre-computed))
;; Recompute widths.
(t
(if (> (string-pixel-width value buffer) (elt widths index))
(concat
(vtable--limit-string
value (- (elt widths index)
(or ellipsis-width 0))
buffer)
ellipsis)
value))))
(truncate-string-pixelwise value
(elt widths index)
buffer
ellipsis ellipsis-width))))
(start (point))
;; Don't insert the separator after the final column.
(last (= index (- (length line) 2))))
@@ -761,14 +756,10 @@ itself in the new buffer."
(indicator (vtable--indicator table index))
(indicator-width (string-pixel-width indicator buffer))
(last (= index (1- (length (vtable-columns table)))))
displayed)
(setq displayed
(if (> (string-pixel-width name buffer)
(- (elt widths index) indicator-width))
(vtable--limit-string
name (- (elt widths index) indicator-width)
buffer)
name))
(displayed (truncate-string-pixelwise
name
(- (elt widths index) indicator-width)
buffer)))
(let* ((indicator-lead-width
(if (display-graphic-p)
;; On a graphical frame, we want the indicator to
@@ -882,12 +873,6 @@ If NEXT, do the next column."
(vtable-header-mode 1))
(defun vtable--limit-string (string pixels buffer)
(while (and (length> string 0)
(> (string-pixel-width string buffer) pixels))
(setq string (substring string 0 (1- (length string)))))
string)
(defun vtable--char-width (table)
(string-pixel-width (propertize "x" 'face (vtable-face table))
(vtable-buffer table)))

21
test/lisp/emacs-lisp/vtable-tests.el
View File

@@ -130,25 +130,4 @@
(should (= (count-lines (point-min) (point-max)) 3))
(should (not (string= line-2 line-2-new))))))))
(ert-deftest test-vtable--limit-string-with-face-remapped-buffer ()
(with-temp-buffer
(let ((text (propertize "XXXXX"
'face 'variable-pitch)))
(face-remap-add-relative 'default :height 1.5)
;; TODO: Remove the pre-31 test, eventually.
(cond ((eval-when-compile (< emacs-major-version 31))
(let* ((x-width (string-pixel-width (substring text 0 1)))
(char-limit 2)
(pixel-limit (* char-limit x-width)))
(should (eq
char-limit
(length (vtable--limit-string text pixel-limit))))))
(t
(let* ((x-width (string-pixel-width (substring text 0 1) (current-buffer)))
(char-limit 2)
(pixel-limit (* char-limit x-width)))
(should (eq
char-limit
(length (vtable--limit-string text pixel-limit (current-buffer)))))))))))
;;; vtable-tests.el ends here