2 files changed, 263 insertions, 149 deletions

diff --git a/lisp/emacs-lisp/vtable.el b/lisp/emacs-lisp/vtable.el
index bcdd280fb92..29791e2aaa0 100644
--- a/lisp/emacs-lisp/vtable.el
+++ b/lisp/emacs-lisp/vtable.el
@@ -67,8 +67,10 @@
    (ellipsis :initarg :ellipsis :accessor vtable-ellipsis)
    (column-colors :initarg :column-colors :accessor vtable-column-colors)
    (row-colors :initarg :row-colors :accessor vtable-row-colors)
+   (buffer :initform nil :accessor vtable-buffer)
    (-cached-colors :initform nil)
    (-cache :initform (make-hash-table :test #'equal))
+   (-current-cache :initform nil :accessor vtable--current-cache)
    (-cached-keymap :initform nil)
    (-has-column-spec :initform nil))
   "An object to hold the data for a table.")
@@ -287,8 +289,7 @@ compared with `equal'), signal an error.
 TABLE must be at point in the current buffer."
   (unless old-object
     (setq old-object object))
-  (let* ((objects (vtable-objects table))
-         (inhibit-read-only t))
+  (let ((objects (vtable-objects table)))
     ;; First replace the object in the object storage.
     (if (eq old-object (car objects))
         ;; It's at the head, so replace it there.
@@ -301,31 +302,32 @@ TABLE must be at point in the current buffer."
       (unless (cdr objects)
         (error "Can't find the old object"))
       (setcar (cdr objects) object))
-    ;; Then update the rendered vtable in the current buffer.
-    (if-let* ((cache (vtable--current-cache))
-             (line-number (seq-position (vtable--cache-lines cache)
-                                        old-object
-                                        (lambda (a b)
-                                          (equal (car a) b))))
-             (line (elt (vtable--cache-lines cache) line-number)))
-        (progn
-          (setcar line object)
-          (setcdr line (vtable--compute-cached-line table object))
-          ;; ... and redisplay the line in question.
-          (save-excursion
-            (vtable-goto-object old-object)
-            (let ((keymap (get-text-property (point) 'keymap))
-                  (start (point)))
-              (delete-line)
-              (vtable--insert-line table line line-number
-                                   (vtable--cache-widths cache)
-                                   (vtable--spacer table))
-              (add-text-properties start (point) (list 'keymap keymap
-                                                       'vtable table
-                                                       'vtable-cache cache))))
-          ;; We may have inserted a non-numerical value into a previously
-          ;; all-numerical table, so recompute.
-          (vtable--recompute-numerical table (cdr line)))
+    ;; Then update the rendered vtable in its buffer.
+    (if-let* ((cache (vtable--current-cache table))
+              (line-number (seq-position (vtable--cache-lines cache)
+                                         old-object
+                                         (lambda (a b)
+                                           (equal (car a) b))))
+              (line (elt (vtable--cache-lines cache) line-number)))
+        (with-current-buffer (vtable-buffer table)
+          (let ((inhibit-read-only t)
+                (inhibit-modification-hooks t))
+            (setcar line object)
+            (setcdr line (vtable--compute-cached-line table object))
+            ;; ... and redisplay the line in question.
+            (save-excursion
+              (vtable-goto-object old-object)
+              (let ((keymap (get-text-property (point) 'keymap))
+                    (start (point)))
+                (delete-line)
+                (vtable--insert-line table line line-number
+                                     (vtable--cache-widths cache)
+                                     (vtable--spacer table))
+                (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))))
       (error "Can't find cached object in vtable"))))
 
 (defun vtable-remove-object (table object)
@@ -334,14 +336,16 @@ This will also remove the displayed line."
   ;; First remove from the objects.
   (setf (vtable-objects table) (delq object (vtable-objects table)))
   ;; Then adjust the cache and display.
-  (save-excursion
-    (vtable-goto-table table)
-    (let ((cache (vtable--current-cache))
-          (inhibit-read-only t))
-      (setcar cache (delq (assq object (vtable--cache-lines cache))
-                          (vtable--cache-lines cache)))
-      (when (vtable-goto-object object)
-        (delete-line)))))
+  (with-current-buffer (vtable-buffer table)
+    (save-excursion
+      (vtable-goto-table table)
+      (let ((cache (vtable--current-cache table))
+            (inhibit-read-only t)
+            (inhibit-modification-hooks t))
+        (setcar cache (delq (assq object (vtable--cache-lines cache))
+                            (vtable--cache-lines cache)))
+        (when (vtable-goto-object object)
+          (delete-line))))))
 
 ;; FIXME: The fact that the `location' argument of
 ;; `vtable-insert-object' can be an integer and is then interpreted as
@@ -369,8 +373,9 @@ This also updates the displayed table."
       (progn
         (setf (vtable-objects table) (list object))
         (vtable--recompute-numerical table (vtable--compute-cached-line table object))
-        (vtable-goto-table table)
-        (vtable-revert-command))
+        (with-current-buffer (vtable-buffer table)
+          (vtable-goto-table table)
+          (vtable-revert-command)))
     ;; First insert into the objects.
     (let ((pos (if location
                    (if (integerp location)
@@ -398,56 +403,58 @@ This also updates the displayed table."
           ;; 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--current-cache))
-             (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))
-             (lines (vtable--cache-lines cache))
-             (elem (if location  ; This binding mirrors the binding of `pos' above.
-                       (if (integerp location)
-                           (nth location lines)
-                         (or (assq location lines)
-                             (and before (car lines))))
-                     (if before (car lines))))
-             (pos (memq elem lines))
-             (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 lines (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
-                               (vtable--cache-widths cache) (vtable--spacer table)
-                               ellipsis ellipsis-width)
-          (add-text-properties start (point) (list 'keymap keymap
-                                                   'vtable table
-                                                   'vtable-cache cache)))
-        ;; We may have inserted a non-numerical value into a previously
-        ;; all-numerical table, so recompute.
-        (vtable--recompute-numerical table (cdr line))))))
+    (let* ((cache (vtable--current-cache table))
+           (lines (vtable--cache-lines cache))
+           (elem (if location  ; This binding mirrors the binding of `pos' above.
+                     (if (integerp location)
+                         (nth location lines)
+                       (or (assq location lines)
+                           (and before (car lines))))
+                   (if before (car lines))))
+           (pos (memq elem lines))
+           (line (cons object (vtable--compute-cached-line table object))))
+      (with-current-buffer (vtable-buffer table)
+        (let ((inhibit-read-only t)
+              (inhibit-modification-hooks t))
+          (save-excursion
+            (vtable-goto-table table)
+            (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 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)
+              (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."
@@ -520,14 +527,14 @@ recompute the column specs when the table data has changed."
 (defun vtable--cache-lines (cache)
   (car cache))
 
-(defun vtable-insert (table)
+(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-width (string-pixel-width ellipsis))
+         (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
          ;; user resizes the frame).
@@ -549,8 +556,7 @@ recompute the column specs when the table data has changed."
         (add-text-properties start (point)
                              (list 'keymap vtable-header-line-map
                                    'rear-nonsticky t
-                                   'vtable table
-                                   'vtable-cache cache))
+                                   'vtable table))
         (setq start (point))))
     (vtable--sort table cache)
     ;; Insert the data.
@@ -561,13 +567,35 @@ recompute the column specs when the table data has changed."
         (setq line-number (1+ line-number))))
     (add-text-properties start (point)
                          (list 'rear-nonsticky t
-                               'vtable table
-                               'vtable-cache cache))
+                               'vtable table))
+    (setf (vtable--current-cache table) cache)
     (goto-char start)))
 
+(defun vtable-insert (table)
+  "Insert TABLE into the current buffer.
+The current buffer will be recorded as TABLE's buffer.  If the table is
+inserted into a buffer other than its originating buffer, signal an
+error.  A table may be reinserted into its own buffer, but insert only
+one instance per buffer.  This restriction needs to be enforced by the
+caller."
+  (if-let* ((table-buffer (vtable-buffer table)))
+      (when (not (eq table-buffer (current-buffer)))
+        (error "A vtable cannot be inserted into more than one buffer")))
+  (setf (vtable-buffer table) (current-buffer))
+  (let ((inhibit-read-only t)
+        (inhibit-modification-hooks t))
+    (vtable--insert table)))
+
+(defun vtable-set-buffer (table buffer)
+  "Associate BUFFER with TABLE.
+Use this function with care, and ensure your vtable instance renders
+itself in the new buffer."
+  (setf (vtable-buffer table) buffer))
+
 (defun vtable--insert-line (table line line-number widths spacer
                                   &optional ellipsis ellipsis-width)
   (let ((start (point))
+        (buffer (vtable-buffer table))
         (columns (vtable-columns table))
         (column-colors
          (and (vtable-column-colors table)
@@ -607,16 +635,18 @@ recompute the column specs when the table data has changed."
                       (concat
                        (vtable--limit-string
                         pre-computed (- (elt widths index)
-                                        (or ellipsis-width 0)))
+                                        (or ellipsis-width 0))
+                        buffer)
                        ellipsis)
                     pre-computed))
                  ;; Recompute widths.
                  (t
-                  (if (> (string-pixel-width value) (elt widths index))
+                  (if (> (string-pixel-width value buffer) (elt widths index))
                       (concat
                        (vtable--limit-string
                         value (- (elt widths index)
-                                 (or ellipsis-width 0)))
+                                 (or ellipsis-width 0))
+                        buffer)
                        ellipsis)
                     value))))
                (start (point))
@@ -630,14 +660,15 @@ recompute the column specs when the table data has changed."
                           (list 'space
                                 :width (list
                                         (+ (- (elt widths index)
-                                              (string-pixel-width displayed))
+                                              (string-pixel-width
+                                               displayed buffer))
                                            (if last 0 spacer)))))))
              ;; Align to the right.
              (insert (propertize " " 'display
                                  (list 'space
                                        :width (list (- (elt widths index)
                                                        (string-pixel-width
-                                                        displayed)))))
+                                                        displayed buffer)))))
                      displayed)
              (unless last
                (insert (propertize " " 'display
@@ -664,16 +695,6 @@ recompute the column specs when the table data has changed."
 (defun vtable--cache-key ()
   (cons (frame-terminal) (window-width)))
 
-(defun vtable--current-cache ()
-  "Return the current cache for the table at point.
-
-In `vtable-insert', the lines and widths of the vtable text are computed
-based on the current selected frame and window and stored in a cache.
-Subsequent interaction with the text of the vtable should use that cache
-via this function rather than by calling `vtable--cache-key' to look up
-the cache."
-  (get-text-property (point) 'vtable-cache))
-
 (defun vtable--clear-cache (table)
   (setf (gethash (vtable--cache-key) (slot-value table '-cache)) nil))
 
@@ -718,6 +739,7 @@ the cache."
 (defun vtable--insert-header-line (table widths spacer)
   ;; Insert the header directly into the buffer.
   (let ((start (point))
+        (buffer (vtable-buffer table))
         (divider (vtable-divider table))
         (cmap (define-keymap
                 "<header-line> <drag-mouse-1>" #'vtable--drag-resize-column
@@ -737,14 +759,15 @@ the cache."
                      'keymap cmap))
               (start (point))
               (indicator (vtable--indicator table index))
-              (indicator-width (string-pixel-width indicator))
+              (indicator-width (string-pixel-width indicator buffer))
               (last (= index (1- (length (vtable-columns table)))))
               displayed)
          (setq displayed
-               (if (> (string-pixel-width name)
+               (if (> (string-pixel-width name buffer)
                       (- (elt widths index) indicator-width))
                    (vtable--limit-string
-                    name (- (elt widths index) indicator-width))
+                    name (- (elt widths index) indicator-width)
+                    buffer)
                  name))
          (let* ((indicator-lead-width
                  ;; We want the indicator to not be quite flush right.
@@ -753,7 +776,7 @@ the cache."
                                         indicator-lead-width))
                 (fill-width
                  (+ (- (elt widths index)
-                       (string-pixel-width displayed)
+                       (string-pixel-width displayed buffer)
                        indicator-width
                        indicator-lead-width)
                     (if last 0 spacer))))
@@ -771,7 +794,8 @@ the cache."
              ;; This is the final column, and we have a sorting
              ;; indicator, and the table is too wide for the window.
              (let* ((pre-indicator (string-pixel-width
-                                    (buffer-substring (point-min) (point))))
+                                    (buffer-substring (point-min) (point))
+                                    buffer))
                     (pre-fill
                      (- (window-width nil t)
                         pre-indicator
@@ -850,14 +874,16 @@ If NEXT, do the next column."
            (buffer-substring (point-min) (1- (point-max))))))
   (vtable-header-mode 1))
 
-(defun vtable--limit-string (string pixels)
+
+(defun vtable--limit-string (string pixels buffer)
   (while (and (length> string 0)
-              (> (string-pixel-width string) pixels))
+              (> (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))))
+  (string-pixel-width (propertize "x" 'face (vtable-face table))
+                      (vtable-buffer table)))
 
 (defun vtable--compute-width (table spec)
   (cond
@@ -936,7 +962,7 @@ CACHE is TABLE's cache data as returned by `vtable--compute-cache'."
        ;; We stash the computed width and string here -- if there are
        ;; no formatters/displayers, we'll be using the string, and
        ;; then won't have to recreate it.
-       (list value (string-pixel-width string) string)))
+       (list value (string-pixel-width string (vtable-buffer table)) string)))
    (vtable-columns table)))
 
 (defun vtable--make-keymap (table)
@@ -967,20 +993,22 @@ CACHE is TABLE's cache data as returned by `vtable--compute-cache'."
           (vtable-keymap table))
       map)))
 
-(defun vtable-revert ()
-  "Regenerate the table under point."
-  (let ((table (vtable-current-table))
-        (object (vtable-current-object))
-        (column (vtable-current-column))
-        (inhibit-read-only t))
-    (unless table
-      (user-error "No table under point"))
-    (delete-region (vtable-beginning-of-table) (vtable-end-of-table))
-    (vtable-insert table)
-    (when object
-      (vtable-goto-object object))
-    (when column
-      (vtable-goto-column column))))
+(defun vtable-revert (&optional table)
+  "Regenerate TABLE, defaulting to the table under point."
+  (setq table (or table (vtable-current-table)))
+  (unless table
+    (user-error "No table under point"))
+  (with-current-buffer (vtable-buffer table)
+    (let ((object (vtable-current-object))
+          (column (vtable-current-column))
+          (inhibit-read-only t)
+          (inhibit-modification-hooks t))
+      (delete-region (vtable-beginning-of-table) (vtable-end-of-table))
+      (vtable--insert table)
+      (when object
+        (vtable-goto-object object))
+      (when column
+        (vtable-goto-column column)))))
 
 ;;; Commands.
 
@@ -1006,14 +1034,14 @@ Interactively, N is the prefix argument."
                                 (- (* (vtable--char-width table) (or n 1))))))
 
 (defun vtable--alter-column-width (table column delta)
-  (let ((widths (vtable--cache-widths (vtable--current-cache))))
+  (let ((widths (vtable--cache-widths (vtable--current-cache table))))
     (setf (aref widths column)
           (max (* (vtable--char-width table) 2)
                (+ (aref widths column) delta)))
     ;; Store the width so it'll be respected on a revert.
     (setf (vtable-column-width (elt (vtable-columns table) column))
           (format "%dpx" (aref widths column)))
-    (vtable-revert)))
+    (vtable-revert table)))
 
 (defun vtable-widen-current-column (&optional n)
   "Widen the current column by N characters.
@@ -1028,24 +1056,29 @@ Interactively, N is the prefix argument."
   (interactive)
   (vtable-goto-column
    (max 0 (1- (or (vtable-current-column)
-                  (length (vtable--cache-widths (vtable--current-cache))))))))
+                  (length (vtable--cache-widths
+                           (vtable--current-cache (vtable-current-table)))))))))
 
 (defun vtable-next-column ()
   "Go to the next column."
   (interactive)
   (when (vtable-current-column)
     (vtable-goto-column
-     (min (1- (length (vtable--cache-widths (vtable--current-cache))))
+     (min (1- (length (vtable--cache-widths
+                       (vtable--current-cache (vtable-current-table)))))
           (1+ (vtable-current-column))))))
 
-(defun vtable-revert-command ()
-  "Re-query data and regenerate the table under point."
+(defun vtable-revert-command (&optional table)
+  "Re-query data and regenerate TABLE.
+If TABLE is nil, use the table under point."
   (interactive)
-  (let ((table (vtable-current-table)))
-    (when (vtable-objects-function table)
-      (setf (vtable-objects table) (funcall (vtable-objects-function table))))
-    (vtable--clear-cache table))
-  (vtable-revert))
+  (setq table (or table (vtable-current-table)))
+  (unless table
+    (user-error "No table found"))
+  (when (vtable-objects-function table)
+    (setf (vtable-objects table) (funcall (vtable-objects-function table))))
+  (vtable--clear-cache table)
+  (vtable-revert table))
 
 (defun vtable-sort-by-current-column ()
   "Sort the table under point by the column under point."
@@ -1067,8 +1100,8 @@ Interactively, N is the prefix argument."
                                   (if (eq (cdr last) 'ascend)
                                       'descend
                                     'ascend)
-                                'ascend))))))
-  (vtable-revert))
+                                'ascend)))))
+    (vtable-revert table)))
 
 (defun vtable-header-line-sort (e)
   "Sort a vtable from the header line."
diff --git a/test/lisp/emacs-lisp/vtable-tests.el b/test/lisp/emacs-lisp/vtable-tests.el
index 74fb8cc8139..f865206dc19 100644
--- a/test/lisp/emacs-lisp/vtable-tests.el
+++ b/test/lisp/emacs-lisp/vtable-tests.el
@@ -27,16 +27,19 @@
 (require 'ert)
 (require 'ert-x)
 
-(ert-deftest test-vstable-compute-columns ()
+(defun vtable-tests--make-no-header-2-object-table ()
+  (make-vtable :columns '("a" "b" "c")
+               :objects '(("foo" 1 2)
+                          ("bar" 3 :zot))
+               :insert nil))
+
+(ert-deftest test-vtable-compute-columns ()
   (should
    (equal (mapcar
            (lambda (column)
              (vtable-column-align column))
            (vtable--compute-columns
-            (make-vtable :columns '("a" "b" "c")
-                         :objects '(("foo" 1 2)
-                                    ("bar" 3 :zot))
-                         :insert nil)))
+            (vtable-tests--make-no-header-2-object-table)))
           '(left right left))))
 
 (ert-deftest test-vtable-insert-object ()
@@ -69,4 +72,82 @@
               (mapcar #'cadr (vtable-objects table))))
           (number-sequence 0 11))))
 
+(ert-deftest test-vtable-unique-buffer ()
+  (let ((table (vtable-tests--make-no-header-2-object-table)))
+    (with-temp-buffer
+      (vtable-insert table)
+      (with-temp-buffer
+        (should-error (vtable-insert table)))
+      (with-temp-buffer
+        (vtable-set-buffer table (current-buffer))
+        (vtable-insert table)))))
+
+(ert-deftest test-vtable-read-only-buffer ()
+  (let ((table (vtable-tests--make-no-header-2-object-table)))
+    (with-temp-buffer
+      (setq buffer-read-only t)
+      (vtable-insert table))))
+
+(ert-deftest test-vtable-non-current-buffer-insert-object ()
+  (let ((table (vtable-tests--make-no-header-2-object-table))
+        (obj '("baz" 4 5)))
+    (with-temp-buffer
+      (vtable-insert table)
+      (should (= (count-lines (point-min) (point-max)) 2))
+      (with-temp-buffer
+        (vtable-insert-object table obj))
+      (should (= (count-lines (point-min) (point-max)) 3)))))
+
+(ert-deftest test-vtable-non-current-buffer-remove-object ()
+  (let ((table (vtable-tests--make-no-header-2-object-table))
+        (obj '("baz" 4 5)))
+    (with-temp-buffer
+      (vtable-insert table)
+      (vtable-insert-object table obj)
+      (should (= (count-lines (point-min) (point-max)) 3))
+      (with-temp-buffer
+        (vtable-remove-object table obj))
+      (should (= (count-lines (point-min) (point-max)) 2)))))
+
+(ert-deftest test-vtable-non-current-buffer-update-object ()
+  (let ((table (vtable-tests--make-no-header-2-object-table))
+        (obj '("baz" 4 5))
+        (obj-2 '("qux" 6 7)))
+    (with-temp-buffer
+      (vtable-insert table)
+      (vtable-insert-object table obj)
+      (should (= (count-lines (point-min) (point-max)) 3))
+      (let ((line-2 (progn
+                      (goto-char (point-min))
+                      (forward-line 2)
+                      (buffer-substring (point) (point-max)))))
+        (with-temp-buffer
+          (vtable-update-object table obj-2 obj))
+        (let ((line-2-new (progn
+                            (goto-char (point-min))
+                            (forward-line 2)
+                            (buffer-substring (point) (point-max)))))
+          (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)
+      (cond ((< emacs-major-version 31) ; TODO: Remove the pre-31 test, eventually.
+             (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