emacs-31 a3a72ae355b: Fix 'truncate-string-pixelwise' to restore the window buffer

branch: emacs-31
commit a3a72ae355b0459a88328ed6a86c00c4519d99ac
Author: Stéphane Marks <[email protected]>
Commit: Sean Whitton <[email protected]>

    Fix 'truncate-string-pixelwise' to restore the window buffer
    
    * lisp/emacs-lisp/subr-x.el (truncate-string-pixelwise): Safely
    save/restore the selected window's buffer, and not the reference
    or current buffers.  Guard dedicated windows.  Remove the work
    buffer from the window's buffer list.  Bind
    'buffer-list-update-hook' 'window-scroll-functions'
    'window-configuration-change-hook' to nil around the window
    buffer swap.  (Bug#81262; see also bug#80244.)
---
 lisp/emacs-lisp/subr-x.el | 79 ++++++++++++++++++++++++++---------------------
 1 file changed, 44 insertions(+), 35 deletions(-)

diff --git a/lisp/emacs-lisp/subr-x.el b/lisp/emacs-lisp/subr-x.el
index d5a39b77c2e..ebc330fea80 100644
--- a/lisp/emacs-lisp/subr-x.el
+++ b/lisp/emacs-lisp/subr-x.el
@@ -426,42 +426,51 @@ this function using the same ELLIPSIS."
       string
     ;; Keeping a work buffer around is more efficient than creating a
     ;; new temporary buffer.
-    (let ((original-buffer (or buffer (current-buffer))))
+    (let* ((window (selected-window))
+           (original-buffer (window-buffer window))
+           (window-dedication (window-dedicated-p window))
+           (buffer-list-update-hook)
+           (window-scroll-functions)
+           (window-configuration-change-hook))
       (with-work-buffer
-       (work-buffer--prepare-pixelwise string buffer)
-       (set-window-buffer nil (current-buffer) 'keep-margins)
-       ;; Use a binary search to prune the number of calls to
-       ;; `window-text-pixel-size'.
-       ;; These are 1-based buffer indexes.
-       (let* ((low 1)
-              (high (1+ (length string)))
-              mid)
-         (when (> (car (window-text-pixel-size nil 1 high)) max-pixels)
-           (when (and ellipsis (not (stringp ellipsis)))
-             (setq ellipsis (truncate-string-ellipsis)))
-           (setq ellipsis-pixels (if ellipsis
-                                     (if ellipsis-pixels
-                                         ellipsis-pixels
-                                       (string-pixel-width ellipsis buffer))
-                                   0))
-           (let ((adjusted-pixels
-                  (if (> max-pixels ellipsis-pixels)
-                      (- max-pixels ellipsis-pixels)
-                    max-pixels)))
-             (while (<= low high)
-               (setq mid (floor (+ low high) 2))
-               (if (<= (car (window-text-pixel-size nil 1 mid))
-                       adjusted-pixels)
-                   (setq low (1+ mid))
-                 (setq high (1- mid))))))
-         (set-window-buffer nil original-buffer 'keep-margins)
-         (if mid
-             ;; Binary search ran.
-             (if (and ellipsis (> max-pixels ellipsis-pixels))
-                 (concat (substring string 0 (1- high)) ellipsis)
-               (substring string 0 (1- high)))
-           ;; Fast path.
-           string))))))
+        ;; Use a binary search to prune the number of calls to
+        ;; `window-text-pixel-size'.
+        ;; These are 1-based buffer indexes.
+        (unwind-protect
+            (let* ((low 1)
+                   (high (1+ (length string)))
+                   mid)
+              (work-buffer--prepare-pixelwise string buffer)
+              (set-window-dedicated-p window nil)
+              (set-window-buffer window (current-buffer) 'keep-margins)
+              (when (> (car (window-text-pixel-size nil 1 high)) max-pixels)
+                (when (and ellipsis (not (stringp ellipsis)))
+                  (setq ellipsis (truncate-string-ellipsis)))
+                (setq ellipsis-pixels (if ellipsis
+                                          (if ellipsis-pixels
+                                              ellipsis-pixels
+                                            (string-pixel-width ellipsis buffer))
+                                        0))
+                (let ((adjusted-pixels
+                       (if (> max-pixels ellipsis-pixels)
+                           (- max-pixels ellipsis-pixels)
+                         max-pixels)))
+                  (while (<= low high)
+                    (setq mid (floor (+ low high) 2))
+                    (if (<= (car (window-text-pixel-size nil 1 mid))
+                            adjusted-pixels)
+                        (setq low (1+ mid))
+                      (setq high (1- mid))))))
+              (if mid
+                  ;; Binary search ran.
+                  (if (and ellipsis (> max-pixels ellipsis-pixels))
+                      (concat (substring string 0 (1- high)) ellipsis)
+                    (substring string 0 (1- high)))
+                ;; Fast path.
+                string))
+          (set-window-buffer window original-buffer 'keep-margins)
+          (set-window-dedicated-p window window-dedication)
+          (unrecord-window-buffer window (current-buffer) t))))))
 
 ;;;###autoload
 (defun string-glyph-split (string)