Github/emacs
2
0
Fork 1
mirror of git://git.sv.gnu.org/emacs.git synced 2026-02-16 17:24:23 +00:00
Code Issues Projects Releases Packages Wiki Activity

; Minor changes to 'truncate-string-pixelwise' (bug#80244)

Browse source 
Fix two bugs and add tests for them.
This commit is contained in:
Stéphane Marks 2026-01-31 21:19:48 -05:00 committed by Eli Zaretskii
parent 3107c66c84
commit e0ce881be9
2 changed files with 47 additions and 36 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

73
lisp/emacs-lisp/subr-x.el
View file

@ -419,44 +419,45 @@ can be used to avoid the cost of recomputing this for multiple calls to
this function using the same ELLIPSIS."
(declare (important-return-value t))
(if (zerop (length string))
0
string
;; Keeping a work buffer around is more efficient than creating a
;; new temporary buffer.
(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 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)))))
(let ((original-buffer (or buffer (current-buffer))))
(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))))))
;;;###autoload
(defun string-glyph-split (string)

10
test/lisp/misc-tests.el
View file

@ -249,6 +249,16 @@
;; faces, and varying face heights and compare results to each
;; character's measured width.
(ert-deftest misc-test-truncate-string-pixelwise ()
;; Test empty string without an explicit buffer.
(should (equal (truncate-string-pixelwise "" 123) ""))
;; Test fast path without an explicit buffer.
(should (equal (truncate-string-pixelwise "123" 123) "123"))
(with-temp-buffer
;; Test empty string with an explicit buffer.
(should (equal (truncate-string-pixelwise "" 123 (current-buffer)) ""))
;; Test fast path with an explicit buffer.
(should (equal (truncate-string-pixelwise "123" 123 (current-buffer)) "123")))
(dolist (c '(?W ?X ?y ?1))
(dolist (ellipsis `(nil "..." ,(truncate-string-ellipsis)))
(dolist (face '(fixed-pitch variable-pitch))