mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2026-09-10 07:46:51 -04:00
; Make visual-wrap-tests work in interactive sessions
* test/lisp/visual-wrap-tests.el (visual-wrap-tests--wrap-prefix) (visual-wrap-tests--string-with-properties): New wrapper functions. (visual-wrap-tests/simple, visual-wrap-tests/safe-display) (visual-wrap-tests/unsafe-display/within-line) (visual-wrap-tests/wrap-prefix-stickiness) (visual-wrap-tests/cleanup) (visual-wrap-tests/negative-extra-indent): Use the wrappers instead of hard-coded pixel values. (visual-wrap-tests/line-numbers-align-to-wrap-prefix): Don't skip on TTY frames in interactive sessions. (Bug#81253)
This commit is contained in:
Aaron Jensen
Eli Zaretskii
parent
d0b693e3e9
commit
5b8496400a
|
|
@ -21,38 +21,56 @@
|
|||
|
||||
;; 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).
|
||||
;; Expected `wrap-prefix' values use `string-pixel-width', because
|
||||
;; `visual-wrap--content-prefix' records the rendered width of the
|
||||
;; prefix. This is 1 pixel per character cell in batch/TTY, but depends
|
||||
;; on the selected frame font in graphical frames.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'visual-wrap)
|
||||
(require 'ert)
|
||||
|
||||
(defun visual-wrap-tests--wrap-prefix (prefix &optional extra-indent)
|
||||
"Return the expected `wrap-prefix' for PREFIX and EXTRA-INDENT."
|
||||
`(space :align-to (+ (,(string-pixel-width prefix (current-buffer)))
|
||||
(,(or extra-indent 0) . width))))
|
||||
|
||||
(defun visual-wrap-tests--string-with-properties (string ranges)
|
||||
"Return STRING with RANGES of text properties added.
|
||||
Each element in RANGES has the form (START END PROPERTIES)."
|
||||
(let ((string (copy-sequence string)))
|
||||
(dolist (range ranges string)
|
||||
(add-text-properties (nth 0 range) (nth 1 range) (nth 2 range)
|
||||
string))))
|
||||
|
||||
;;; 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)))))))))
|
||||
(let ((wrap-prefix (visual-wrap-tests--wrap-prefix "* ")))
|
||||
(visual-wrap-prefix-function (point-min) (point-max))
|
||||
(should (equal-including-properties
|
||||
(buffer-string)
|
||||
(visual-wrap-tests--string-with-properties
|
||||
"greetings\n* hello\n* hi"
|
||||
`((10 17 (wrap-prefix ,wrap-prefix))
|
||||
(18 22 (wrap-prefix ,wrap-prefix)))))))))
|
||||
|
||||
(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)))))))
|
||||
(let ((wrap-prefix (visual-wrap-tests--wrap-prefix "* ")))
|
||||
(visual-wrap-prefix-function (point-min) (point-max))
|
||||
(should (equal-including-properties
|
||||
(buffer-string)
|
||||
(visual-wrap-tests--string-with-properties
|
||||
"* hello"
|
||||
`((0 2 (wrap-prefix ,wrap-prefix))
|
||||
(2 7 (wrap-prefix ,wrap-prefix display (raise 1))))))))))
|
||||
|
||||
(ert-deftest visual-wrap-tests/unsafe-display/within-line ()
|
||||
"Test adding wrapping properties to text with unsafe display properties.
|
||||
|
|
@ -60,13 +78,15 @@ 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)))))))
|
||||
(let ((wrap-prefix (visual-wrap-tests--wrap-prefix "* ")))
|
||||
(visual-wrap-prefix-function (point-min) (point-max))
|
||||
(should (equal-including-properties
|
||||
(buffer-string)
|
||||
(visual-wrap-tests--string-with-properties
|
||||
"* [img]"
|
||||
`((0 2 (wrap-prefix ,wrap-prefix))
|
||||
(2 7 (wrap-prefix ,wrap-prefix
|
||||
display (image :type bmp))))))))))
|
||||
|
||||
(ert-deftest visual-wrap-tests/unsafe-display/spanning-lines ()
|
||||
"Test adding wrapping properties to text with unsafe display properties.
|
||||
|
|
@ -119,27 +139,31 @@ should *not* add wrapping properties to either block."
|
|||
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)))))))))
|
||||
(let ((wrap-prefix (visual-wrap-tests--wrap-prefix "* ")))
|
||||
(visual-wrap-prefix-function (point-min) (point-max))
|
||||
(should (equal-including-properties
|
||||
(buffer-string)
|
||||
(visual-wrap-tests--string-with-properties
|
||||
"* this zoo contains goats"
|
||||
`((0 25 (wrap-prefix ,wrap-prefix))))))
|
||||
(let ((start (point)))
|
||||
(insert-and-inherit "\n\nit also contains pandas")
|
||||
(visual-wrap-prefix-function start (point-max)))
|
||||
(should (equal-including-properties
|
||||
(buffer-string)
|
||||
(visual-wrap-tests--string-with-properties
|
||||
"* this zoo contains goats\n\nit also contains pandas"
|
||||
`((0 25 (wrap-prefix ,wrap-prefix)))))))))
|
||||
|
||||
(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))))))
|
||||
(let ((wrap-prefix (visual-wrap-tests--wrap-prefix "* ")))
|
||||
(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 ,wrap-prefix))))
|
||||
(visual-wrap-prefix-mode -1)
|
||||
(should (equal-including-properties
|
||||
(buffer-string)
|
||||
|
|
@ -153,11 +177,13 @@ 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)))))))
|
||||
(let ((wrap-prefix (visual-wrap-tests--wrap-prefix
|
||||
"* " visual-wrap-extra-indent)))
|
||||
(visual-wrap-prefix-function (point-min) (point-max))
|
||||
;; The sum is negative in batch mode (2 - 20 = -18), but the
|
||||
;; display engine clamps to zero.
|
||||
(should (equal (get-text-property (point-min) 'wrap-prefix)
|
||||
wrap-prefix)))))
|
||||
|
||||
(ert-deftest visual-wrap-tests/invisible-prefix ()
|
||||
"Invisible prefix characters do not reserve column space.
|
||||
|
|
@ -180,7 +206,7 @@ property is installed on line 1. See bug#81039."
|
|||
|
||||
(ert-deftest visual-wrap-tests/line-numbers-align-to-wrap-prefix ()
|
||||
"With line numbers, `wrap-prefix' `:align-to' aligns from text start."
|
||||
(skip-unless (display-graphic-p))
|
||||
(skip-unless (not (frame-initial-p)))
|
||||
(let ((buffer (generate-new-buffer " *visual-wrap-test*")))
|
||||
(unwind-protect
|
||||
(let ((window (display-buffer buffer)))
|
||||
|
|
|
|||
Loading…
Reference in a new issue