mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2025-12-06 06:20:55 -08:00
Code Issues Projects Releases Wiki Activity

Fix implicit usage of the current window-width in vtable.el

Browse source 
Previously, many functions in vtable.el called 'vtable--cache',
which computed 'vtable--cache-key' based on the current selected
window and frame; this could cause vtable functions to fail or
misbehave if they were not called from the selected window and
frame that 'vtable-insert' was last called in.

Now, the vtable cache is stored with the text of the vtable, so
that functions which need to interact with some vtable text can
do so reliably without having to use the same selected window
and frame.

Also, 'vtable-update-object' has always required TABLE to be
present at point in the current buffer; now its docstring states
this.

* lisp/emacs-lisp/vtable.el (vtable--current-cache)
(vtable--cache-widths, vtable--cache-lines): Add.
(vtable-insert): Save cache in 'vtable-cache.
(vtable--ensure-cache, vtable--recompute-cache): Inline into
'vtable-insert'.
(vtable--widths, vtable--cache): Delete.
(vtable-update-object): Use 'vtable--current-cache' and
update docstring.  (Bug#69837)
(vtable-remove-object, vtable-insert-object): Use
'vtable--current-cache' and save cache in 'vtable-cache'.
(vtable--sort, vtable--alter-column-width)
(vtable-previous-column, vtable-next-column): Use
'vtable--current-cache'.
This commit is contained in:
Spencer Baugh 2025-06-19 17:20:12 -04:00 • committed by Eli Zaretskii
parent 97d2ac4f95
commit 784d5b4954
1 changed files with 61 additions and 53 deletions
Download patch file Download diff file Expand all files Collapse all files

106
lisp/emacs-lisp/vtable.el
View file

@ -282,10 +282,9 @@ If it can't be found, return nil and don't move point."
"Update OBJECT's representation in TABLE. "Update OBJECT's representation in TABLE.
If OLD-OBJECT is non-nil, replace OLD-OBJECT with OBJECT and display it. If OLD-OBJECT is non-nil, replace OLD-OBJECT with OBJECT and display it.
In either case, if the existing object is not found in the table (being In either case, if the existing object is not found in the table (being
compared with `equal'), signal an error. Note a limitation: if TABLE's compared with `equal'), signal an error.
buffer is not in a visible window, or if its window has changed width
since it was updated, updating the TABLE is not possible, and an error TABLE must be at point in the current buffer."
is signaled."
(unless old-object (unless old-object
(setq old-object object)) (setq old-object object))
(let* ((objects (vtable-objects table)) (let* ((objects (vtable-objects table))
@ -299,17 +298,16 @@ is signaled."
(while (and (cdr objects) (while (and (cdr objects)
(not (eq (cadr objects) old-object))) (not (eq (cadr objects) old-object)))
(setq objects (cdr objects))) (setq objects (cdr objects)))
(unless objects (unless (cdr objects)
(error "Can't find the old object")) (error "Can't find the old object"))
(setcar (cdr objects) object)) (setcar (cdr objects) object))
;; Then update the cache... ;; Then update the rendered vtable in the current buffer.
;; FIXME: If the table's buffer has no visible window, or if its (if-let* ((cache (vtable--current-cache))
;; width has changed since the table was updated, the cache key will (line-number (seq-position (vtable--cache-lines cache)
;; not match and the object can't be updated. (Bug #69837). old-object
(if-let* ((line-number (seq-position (car (vtable--cache table)) old-object
(lambda (a b) (lambda (a b)
(equal (car a) b)))) (equal (car a) b))))
(line (elt (car (vtable--cache table)) line-number))) (line (elt (vtable--cache-lines cache) line-number)))
(progn (progn
(setcar line object) (setcar line object)
(setcdr line (vtable--compute-cached-line table object)) (setcdr line (vtable--compute-cached-line table object))
@ -320,10 +318,11 @@ is signaled."
(start (point))) (start (point)))
(delete-line) (delete-line)
(vtable--insert-line table line line-number (vtable--insert-line table line line-number
(nth 1 (vtable--cache table)) (vtable--cache-widths cache)
(vtable--spacer table)) (vtable--spacer table))
(add-text-properties start (point) (list 'keymap keymap (add-text-properties start (point) (list 'keymap keymap
'vtable table)))) 'vtable table
'vtable-cache cache))))
;; We may have inserted a non-numerical value into a previously ;; We may have inserted a non-numerical value into a previously
;; all-numerical table, so recompute. ;; all-numerical table, so recompute.
(vtable--recompute-numerical table (cdr line))) (vtable--recompute-numerical table (cdr line)))
@ -335,11 +334,12 @@ This will also remove the displayed line."
;; First remove from the objects. ;; First remove from the objects.
(setf (vtable-objects table) (delq object (vtable-objects table))) (setf (vtable-objects table) (delq object (vtable-objects table)))
;; Then adjust the cache and display. ;; Then adjust the cache and display.
(let ((cache (vtable--cache table))
(inhibit-read-only t))
(setcar cache (delq (assq object (car cache)) (car cache)))
(save-excursion (save-excursion
(vtable-goto-table table) (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) (when (vtable-goto-object object)
(delete-line))))) (delete-line)))))
@ -400,7 +400,7 @@ This also updates the displayed table."
;; Then adjust the cache and display. ;; Then adjust the cache and display.
(save-excursion (save-excursion
(vtable-goto-table table) (vtable-goto-table table)
(let* ((cache (vtable--cache table)) (let* ((cache (vtable--current-cache))
(inhibit-read-only t) (inhibit-read-only t)
(keymap (get-text-property (point) 'keymap)) (keymap (get-text-property (point) 'keymap))
(ellipsis (if (vtable-ellipsis table) (ellipsis (if (vtable-ellipsis table)
@ -408,13 +408,14 @@ This also updates the displayed table."
'face (vtable-face table)) 'face (vtable-face table))
"")) ""))
(ellipsis-width (string-pixel-width ellipsis)) (ellipsis-width (string-pixel-width ellipsis))
(lines (vtable--cache-lines cache))
(elem (if location ; This binding mirrors the binding of `pos' above. (elem (if location ; This binding mirrors the binding of `pos' above.
(if (integerp location) (if (integerp location)
(nth location (car cache)) (nth location lines)
(or (assq location (car cache)) (or (assq location lines)
(and before (caar cache)))) (and before (car lines))))
(if before (caar cache)))) (if before (car lines))))
(pos (memq elem (car cache))) (pos (memq elem lines))
(line (cons object (vtable--compute-cached-line table object)))) (line (cons object (vtable--compute-cached-line table object))))
(if (or before (if (or before
(and pos (integerp location))) (and pos (integerp location)))
@ -433,16 +434,17 @@ This also updates the displayed table."
(forward-line 1) ; Insert *after*. (forward-line 1) ; Insert *after*.
(vtable-end-of-table))) (vtable-end-of-table)))
;; Otherwise, append the object. ;; Otherwise, append the object.
(setcar cache (nconc (car cache) (list line))) (setcar cache (nconc lines (list line)))
(vtable-end-of-table))) (vtable-end-of-table)))
(let ((start (point))) (let ((start (point)))
;; FIXME: We have to adjust colors in lines below this if we ;; FIXME: We have to adjust colors in lines below this if we
;; have :row-colors. ;; have :row-colors.
(vtable--insert-line table line 0 (vtable--insert-line table line 0
(nth 1 cache) (vtable--spacer table) (vtable--cache-widths cache) (vtable--spacer table)
ellipsis ellipsis-width) ellipsis ellipsis-width)
(add-text-properties start (point) (list 'keymap keymap (add-text-properties start (point) (list 'keymap keymap
'vtable table))) 'vtable table
'vtable-cache cache)))
;; We may have inserted a non-numerical value into a previously ;; We may have inserted a non-numerical value into a previously
;; all-numerical table, so recompute. ;; all-numerical table, so recompute.
(vtable--recompute-numerical table (cdr line)))))) (vtable--recompute-numerical table (cdr line))))))
@ -512,15 +514,11 @@ recompute the column specs when the table data has changed."
(defun vtable--spacer (table) (defun vtable--spacer (table)
(vtable--compute-width table (vtable-separator-width table))) (vtable--compute-width table (vtable-separator-width table)))
(defun vtable--recompute-cache (table) (defun vtable--cache-widths (cache)
(let* ((data (vtable--compute-cache table)) (nth 1 cache))
(widths (vtable--compute-widths table data)))
(setf (gethash (vtable--cache-key) (slot-value table '-cache))
(list data widths))))
(defun vtable--ensure-cache (table) (defun vtable--cache-lines (cache)
(or (vtable--cache table) (car cache))
(vtable--recompute-cache table)))
(defun vtable-insert (table) (defun vtable-insert (table)
(let* ((spacer (vtable--spacer table)) (let* ((spacer (vtable--spacer table))
@ -533,7 +531,12 @@ recompute the column specs when the table data has changed."
;; We maintain a cache per screen/window width, so that we render ;; We maintain a cache per screen/window width, so that we render
;; correctly if Emacs is open on two different screens (or the ;; correctly if Emacs is open on two different screens (or the
;; user resizes the frame). ;; user resizes the frame).
(widths (nth 1 (vtable--ensure-cache table)))) (cache (or (gethash (vtable--cache-key) (slot-value table '-cache))
(let* ((data (vtable--compute-cache table))
(widths (vtable--compute-widths table data)))
(setf (gethash (vtable--cache-key) (slot-value table '-cache))
(list data widths)))))
(widths (vtable--cache-widths cache)))
;; Don't insert any header or header line if the user hasn't ;; Don't insert any header or header line if the user hasn't
;; specified the columns. ;; specified the columns.
(when (slot-value table '-has-column-spec) (when (slot-value table '-has-column-spec)
@ -546,18 +549,20 @@ recompute the column specs when the table data has changed."
(add-text-properties start (point) (add-text-properties start (point)
(list 'keymap vtable-header-line-map (list 'keymap vtable-header-line-map
'rear-nonsticky t 'rear-nonsticky t
'vtable table)) 'vtable table
'vtable-cache cache))
(setq start (point)))) (setq start (point))))
(vtable--sort table) (vtable--sort table cache)
;; Insert the data. ;; Insert the data.
(let ((line-number 0)) (let ((line-number 0))
(dolist (line (car (vtable--cache table))) (dolist (line (vtable--cache-lines cache))
(vtable--insert-line table line line-number widths spacer (vtable--insert-line table line line-number widths spacer
ellipsis ellipsis-width) ellipsis ellipsis-width)
(setq line-number (1+ line-number)))) (setq line-number (1+ line-number))))
(add-text-properties start (point) (add-text-properties start (point)
(list 'rear-nonsticky t (list 'rear-nonsticky t
'vtable table)) 'vtable table
'vtable-cache cache))
(goto-char start))) (goto-char start)))
(defun vtable--insert-line (table line line-number widths spacer (defun vtable--insert-line (table line line-number widths spacer
@ -659,16 +664,22 @@ recompute the column specs when the table data has changed."
(defun vtable--cache-key () (defun vtable--cache-key ()
(cons (frame-terminal) (window-width))) (cons (frame-terminal) (window-width)))
(defun vtable--cache (table) (defun vtable--current-cache ()
(gethash (vtable--cache-key) (slot-value table '-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) (defun vtable--clear-cache (table)
(setf (gethash (vtable--cache-key) (slot-value table '-cache)) nil)) (setf (gethash (vtable--cache-key) (slot-value table '-cache)) nil))
(defun vtable--sort (table) (defun vtable--sort (table cache)
(pcase-dolist (`(,index . ,direction) (vtable-sort-by table)) (pcase-dolist (`(,index . ,direction) (vtable-sort-by table))
(let ((cache (vtable--cache table)) (let ((numerical (vtable-column--numerical
(numerical (vtable-column--numerical
(elt (vtable-columns table) index))) (elt (vtable-columns table) index)))
(numcomp (if (eq direction 'descend) (numcomp (if (eq direction 'descend)
#'> #'<)) #'> #'<))
@ -971,9 +982,6 @@ CACHE is TABLE's cache data as returned by `vtable--compute-cache'."
(when column (when column
(vtable-goto-column column)))) (vtable-goto-column column))))
(defun vtable--widths (table)
(nth 1 (vtable--ensure-cache table)))
;;; Commands. ;;; Commands.
(defvar-keymap vtable-header-mode-map (defvar-keymap vtable-header-mode-map
@ -998,7 +1006,7 @@ Interactively, N is the prefix argument."
(- (* (vtable--char-width table) (or n 1)))))) (- (* (vtable--char-width table) (or n 1))))))
(defun vtable--alter-column-width (table column delta) (defun vtable--alter-column-width (table column delta)
(let ((widths (vtable--widths table))) (let ((widths (vtable--cache-widths (vtable--current-cache))))
(setf (aref widths column) (setf (aref widths column)
(max (* (vtable--char-width table) 2) (max (* (vtable--char-width table) 2)
(+ (aref widths column) delta))) (+ (aref widths column) delta)))
@ -1020,14 +1028,14 @@ Interactively, N is the prefix argument."
(interactive) (interactive)
(vtable-goto-column (vtable-goto-column
(max 0 (1- (or (vtable-current-column) (max 0 (1- (or (vtable-current-column)
(length (vtable--widths (vtable-current-table)))))))) (length (vtable--cache-widths (vtable--current-cache))))))))
(defun vtable-next-column () (defun vtable-next-column ()
"Go to the next column." "Go to the next column."
(interactive) (interactive)
(when (vtable-current-column) (when (vtable-current-column)
(vtable-goto-column (vtable-goto-column
(min (1- (length (vtable--widths (vtable-current-table)))) (min (1- (length (vtable--cache-widths (vtable--current-cache))))
(1+ (vtable-current-column)))))) (1+ (vtable-current-column))))))
(defun vtable-revert-command () (defun vtable-revert-command ()