emacs/test/lisp/visual-wrap-tests.el
Andrea Alberti ca5e9976b1 Pixel-direct alignment in visual-wrap-prefix-mode (bug#81039)
`visual-wrap--content-prefix' previously returned a column count
computed as

    (max (string-width prefix)
         (ceiling (string-pixel-width prefix) avg-space-width))

with two problems:

* `string-width' ignores `buffer-invisibility-spec', so an invisible
  prefix (hidden ATX markers under `markdown-ts-hide-markup', for
  example) still reserved its character count on line 1 via a
  `min-width' display property, shifting the visible heading right.

* With variable-pitch fonts, rounding the prefix width up to whole
  columns added visible padding whenever the natural width did not
  fall on an exact column boundary.

Return the prefix's natural pixel width via `string-pixel-width'
instead, which accounts for any display transformation applied to
the prefix (invisibility, `display' replacements, text scaling,
proportional fonts).  Drop the `min-width' property from
`visual-wrap--apply-to-line' so line 1 renders at its natural width.
Switch the continuation `wrap-prefix' to a mixed-unit `:align-to'
sum form:

    (space :align-to (+ (PIX) (EXTRA-INDENT . width)))

where PIX is the prefix's pixel width and EXTRA-INDENT is
`visual-wrap-extra-indent' in canonical character widths.  The
display engine resolves each term per the active frame and sums
them, so no Lisp-level unit conversion is needed.

Since `min-width' is no longer installed, the accumulation cycle
that commit 81a5beb8af (bug#73882) worked around cannot recur.
Drop the `min-width' strip from `visual-wrap--content-prefix' and
the `min-width' removal from `visual-wrap--remove-properties'.
Keep `min-width' in `visual-wrap--safe-display-specs' so that
lines where other modes install it are not skipped.

* lisp/visual-wrap.el (visual-wrap--content-prefix): Return pixel
width instead of column count; drop the `min-width' strip.
(visual-wrap--apply-to-line): Drop `min-width' on line 1; use
mixed-unit `:align-to' sum form for the continuation wrap-prefix.
(visual-wrap--adjust-prefix): Handle only string prefixes; the
numeric (pixel) case is now handled inline in `--apply-to-line'
via the mixed-unit `:align-to' sum form.
(visual-wrap--remove-properties): Drop `min-width' removal.
(visual-wrap--safe-display-specs): Add note about `min-width'.
* test/lisp/visual-wrap-tests.el: Update expected `wrap-prefix'
values to the new sum form.
(visual-wrap-tests/invisible-prefix): New test motivated by bug#81039.
(visual-wrap-tests/negative-extra-indent): New test; verify that a
large negative `visual-wrap-extra-indent' produces a valid
wrap-prefix (the display engine clamps the stretch to zero).
* test/manual/visual-wrap-test.el: New file.  Manual test suite
for visual-eyeball verification of prefix alignment behavior.

Reported-by: Andrea Alberti <a.alberti82@gmail.com>
Co-authored-by: Stefan Monnier <monnier@iro.umontreal.ca>
2026-05-26 16:56:32 -04:00

181 lines
7.9 KiB
EmacsLisp

;;; visual-wrap-tests.el --- Tests for `visual-wrap-prefix-mode' -*- lexical-binding: t; -*-
;; Copyright (C) 2024-2026 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; Tests for `visual-wrap-prefix-mode'.
;;
;; Pixel values in these tests assume the batch-mode metric of one
;; pixel per canonical character column (`string-pixel-width " "' = 1).
;;; Code:
(require 'visual-wrap)
(require 'ert)
;;; Tests:
(ert-deftest visual-wrap-tests/simple ()
"Test adding wrapping properties to text without display properties."
(with-temp-buffer
(insert "greetings\n* hello\n* hi")
(visual-wrap-prefix-function (point-min) (point-max))
(should (equal-including-properties
(buffer-string)
#("greetings\n* hello\n* hi"
10 17 (wrap-prefix (space :align-to (+ (2) (0 . width))))
18 22 (wrap-prefix (space :align-to (+ (2) (0 . width)))))))))
(ert-deftest visual-wrap-tests/safe-display ()
"Test adding wrapping properties to text with safe display properties."
(with-temp-buffer
(insert #("* hello" 2 7 (display (raise 1))))
(visual-wrap-prefix-function (point-min) (point-max))
(should (equal-including-properties
(buffer-string)
#("* hello"
0 2 (wrap-prefix (space :align-to (+ (2) (0 . width))))
2 7 (wrap-prefix (space :align-to (+ (2) (0 . width)))
display (raise 1)))))))
(ert-deftest visual-wrap-tests/unsafe-display/within-line ()
"Test adding wrapping properties to text with unsafe display properties.
When these properties don't extend across multiple lines,
`visual-wrap-prefix-mode' can still add wrapping properties."
(with-temp-buffer
(insert #("* [img]" 2 7 (display (image :type bmp))))
(visual-wrap-prefix-function (point-min) (point-max))
(should (equal-including-properties
(buffer-string)
#("* [img]"
0 2 (wrap-prefix (space :align-to (+ (2) (0 . width))))
2 7 (wrap-prefix (space :align-to (+ (2) (0 . width)))
display (image :type bmp)))))))
(ert-deftest visual-wrap-tests/unsafe-display/spanning-lines ()
"Test adding wrapping properties to text with unsafe display properties.
When these properties do extend across multiple lines,
`visual-wrap-prefix-mode' must avoid adding wrapping properties."
(with-temp-buffer
(insert #("* a\n* b" 0 7 (display (image :type bmp))))
(visual-wrap-prefix-function (point-min) (point-max))
(should (equal-including-properties
(buffer-string)
#("* a\n* b" 0 7 (display (image :type bmp)))))))
(ert-deftest visual-wrap-tests/unsafe-display/multiple-1 ()
"Test adding wrapping properties to text with unsafe display properties.
This tests a multi-line unsafe display prop immediately followed by a
single-line unsafe display prop. `visual-wrap-prefix-mode' should *not*
add wrapping properties to either block."
(with-temp-buffer
(insert #("* a\n* b"
0 4 (display ((image :type bmp)))
4 7 (display ((image :type bmp) (height 1.5)))))
(visual-wrap-prefix-function (point-min) (point-max))
(should (equal-including-properties
(buffer-string)
;; NOTE: See the note in `visual-wrap-prefix-function'. If
;; applying the change mentioned there, then this case
;; should add wrapping properties to the second block.
#("* a\n* b"
0 4 (display ((image :type bmp)))
4 7 (display ((image :type bmp) (height 1.5))))))))
(ert-deftest visual-wrap-tests/unsafe-display/multiple-2 ()
"Test adding wrapping properties to text with unsafe display properties.
This tests a multi-line unsafe display prop immediately followed by
another multi-line unsafe display prop. `visual-wrap-prefix-mode'
should *not* add wrapping properties to either block."
(with-temp-buffer
(insert #("* a\n* b\n"
0 4 (display ((image :type bmp)))
4 8 (display ((image :type bmp) (height 1.5)))))
(visual-wrap-prefix-function (point-min) (point-max))
(should (equal-including-properties
(buffer-string)
#("* a\n* b\n"
0 4 (display ((image :type bmp)))
4 8 (display ((image :type bmp) (height 1.5))))))))
(ert-deftest visual-wrap-tests/wrap-prefix-stickiness ()
"Test that `wrap-prefix' doesn't persist across multiple lines when typing.
See bug#76018."
(with-temp-buffer
(insert "* this zoo contains goats")
(visual-wrap-prefix-function (point-min) (point-max))
(should (equal-including-properties
(buffer-string)
#("* this zoo contains goats"
0 25 (wrap-prefix (space :align-to (+ (2) (0 . width)))))))
(let ((start (point)))
(insert-and-inherit "\n\nit also contains pandas")
(visual-wrap-prefix-function start (point-max)))
(should (equal-including-properties
(buffer-string)
#("* this zoo contains goats\n\nit also contains pandas"
0 25 (wrap-prefix (space :align-to (+ (2) (0 . width)))))))))
(ert-deftest visual-wrap-tests/cleanup ()
"Test that deactivating `visual-wrap-prefix-mode' cleans up text properties."
(with-temp-buffer
(insert "* hello\n* hi")
(visual-wrap-prefix-function (point-min) (point-max))
;; Make sure we've added the visual-wrapping properties.
(should (equal (text-properties-at (point-min))
'(wrap-prefix (space :align-to (+ (2) (0 . width))))))
(visual-wrap-prefix-mode -1)
(should (equal-including-properties
(buffer-string)
"* hello\n* hi"))))
(ert-deftest visual-wrap-tests/negative-extra-indent ()
"A large negative `visual-wrap-extra-indent' does not break alignment.
The mixed-unit `:align-to' sum may go negative, but the display engine
clamps the stretch width to zero (xdisp.c), so the continuation starts
at the left margin."
(with-temp-buffer
(setq-local visual-wrap-extra-indent -20)
(insert "* hello")
(visual-wrap-prefix-function (point-min) (point-max))
;; The sum (+ (2) (-20 . width)) is negative in batch mode
;; (2 - 20 = -18), but the display engine clamps to zero.
(should (equal (get-text-property (point-min) 'wrap-prefix)
'(space :align-to (+ (2) (-20 . width)))))))
(ert-deftest visual-wrap-tests/invisible-prefix ()
"Invisible prefix characters do not reserve column space.
The natural pixel width of a fully invisible prefix is zero, so the
continuation `wrap-prefix' aligns to pixel 0 and no `min-width' display
property is installed on line 1. See bug#81039."
(with-temp-buffer
(insert (propertize "### " 'invisible t))
(insert "Heading")
(visual-wrap-prefix-function (point-min) (point-max))
(should (equal (get-text-property (point-min) 'wrap-prefix)
'(space :align-to (+ (0) (0 . width)))))
;; The original bug was that `min-width' got installed on the
;; invisible prefix region, padding line 1 even though the prefix
;; rendered at zero pixels. The redesign installs no `min-width'
;; at all.
(should-not (memq 'min-width
(ensure-list
(get-text-property (point-min) 'display))))))
;; visual-wrap-tests.el ends here