diff --git a/doc/misc/vtable.texi b/doc/misc/vtable.texi index 7787493c992..8fc28499d30 100644 --- a/doc/misc/vtable.texi +++ b/doc/misc/vtable.texi @@ -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 diff --git a/lisp/emacs-lisp/vtable.el b/lisp/emacs-lisp/vtable.el index 4db3e933551..826ed21f6ff 100644 --- a/lisp/emacs-lisp/vtable.el +++ b/lisp/emacs-lisp/vtable.el @@ -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))) diff --git a/test/lisp/emacs-lisp/vtable-tests.el b/test/lisp/emacs-lisp/vtable-tests.el index 0e9be8371a7..e3bcfe9dc78 100644 --- a/test/lisp/emacs-lisp/vtable-tests.el +++ b/test/lisp/emacs-lisp/vtable-tests.el @@ -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