Before refontifying a region, remove any text properties we care about
so that we don't end up with stray properties. Additionally, make sure
to remove all the properties when deactivating the mode.
* lisp/emacs-lisp/subr-x.el (add-remove--display-text-property): New
function, extracted from...
(add-display-text-property): ... here.
(remove-display-text-property): New function.
* lisp/visual-wrap.el (visual-wrap--remove-properties): New function...
(visual-wrap-prefix-function, visual-wrap-prefix-mode): ... call it.
* test/lisp/emacs-lisp/subr-x-tests.el
(subr-x-test-remove-display-text-property): New test.
* test/lisp/visual-wrap-tests.el
(visual-wrap-tests/wrap-prefix-stickiness, visual-wrap-tests/cleanup):
New tests.
* doc/lispref/display.texi (Display Property): Document
'remove-display-text-property'.
* etc/NEWS: Announce 'remove-display-text-property' (bug#76018).
(cherry picked from commit
90c0c9a01ed11944c5502f809817a028a1096ee6)
If omitted, @var{object} defaults to the current buffer.
@end defun
+@defun remove-display-text-property start end spec &optional object
+Remove the display specification @var{spec} from the text from
+@var{start} to @var{end}. @var{spec} is the @sc{car} of the display
+specification to remove, e.g.@: @code{height} or @code{'(margin nil)}.
+
+If any text in the region has any other @code{display} properties, those
+properties are retained. For instance:
+
+@lisp
+@group
+(add-display-text-property 1 8 'raise 0.5)
+(add-display-text-property 4 8 'height 2.0)
+(remove-display-text-property 2 6 'raise)
+@end group
+@end lisp
+
+After doing this, the text will have the following @code{display}
+properties:
+
+@itemize @bullet
+@item
+The region from 1 to 2, only @code{raise}
+
+@item
+The region from 2 to 4, no properties
+
+@item
+The region from 4 to 6, only @code{height}
+
+@item
+The region from 6 to 8, both @code{raise} and @code{height}
+
+@end itemize
+
+@var{object} is either a string or a buffer to remove the specification
+from. If omitted, @var{object} defaults to the current buffer.
+@end defun
+
@cindex display property, unsafe evaluation
@cindex security, and display specifications
Some of the display specifications allow inclusion of Lisp forms,
(setq start (1+ start))))
(nreverse result)))
-;;;###autoload
-(defun add-display-text-property (start end spec value &optional object)
- "Add the display specification (SPEC VALUE) to the text from START to END.
-If any text in the region has a non-nil `display' property, the existing
-display specifications are retained.
-
-OBJECT is either a string or a buffer to add the specification to.
-If omitted, OBJECT defaults to the current buffer."
+(defun add-remove--display-text-property (start end spec value
+ &optional object remove)
(let ((sub-start start)
(sub-end 0)
+ (limit (if (stringp object)
+ (min (length object) end)
+ (min end (point-max))))
disp)
(while (< sub-end end)
(setq sub-end (next-single-property-change sub-start 'display object
- (if (stringp object)
- (min (length object) end)
- (min end (point-max)))))
+ limit))
(if (not (setq disp (get-text-property sub-start 'display object)))
;; No old properties in this range.
- (put-text-property sub-start sub-end 'display (list spec value)
- object)
+ (unless remove
+ (put-text-property sub-start sub-end 'display (list spec value)
+ object))
;; We have old properties.
- (let (type)
+ (let ((changed nil)
+ type)
;; Make disp into a list.
(setq disp
(cond
;; regions of text.
(setq disp (if (eq type 'list)
(remove old disp)
- (delete old disp))))
- (setq disp (cons (list spec value) disp))
- (when (eq type 'vector)
- (setq disp (seq-into disp 'vector)))
- ;; Finally update the range.
- (put-text-property sub-start sub-end 'display disp object)))
+ (delete old disp))
+ changed t))
+ (unless remove
+ (setq disp (cons (list spec value) disp)
+ changed t))
+ (when changed
+ (if (not disp)
+ (remove-text-properties sub-start sub-end '(display nil) object)
+ (when (eq type 'vector)
+ (setq disp (seq-into disp 'vector)))
+ ;; Finally update the range.
+ (put-text-property sub-start sub-end 'display disp object)))))
(setq sub-start sub-end))))
+;;;###autoload
+(defun add-display-text-property (start end spec value &optional object)
+ "Add the display specification (SPEC VALUE) to the text from START to END.
+If any text in the region has a non-nil `display' property, the existing
+display specifications are retained.
+
+OBJECT is either a string or a buffer to add the specification to.
+If omitted, OBJECT defaults to the current buffer."
+ (add-remove--display-text-property start end spec value object))
+
+;;;###autoload
+(defun remove-display-text-property (start end spec &optional object)
+ "Remove the display specification SPEC from the text from START to END.
+SPEC is the car of the display specification to remove, e.g. `height'.
+If any text in the region has other display specifications, those specs
+are retained.
+
+OBJECT is either a string or a buffer to remove the specification from.
+If omitted, OBJECT defaults to the current buffer."
+ (add-remove--display-text-property start end spec nil object 'remove))
+
;;;###autoload
(defun read-process-name (prompt)
"Query the user for a process and return the process object."
(propertize prefix 'face face)
prefix)))
+(defun visual-wrap--remove-properties (start end)
+ "Remove visual wrapping text properties from START to END."
+ ;; Remove `min-width' from any prefixes we detected.
+ (remove-display-text-property start end 'min-width)
+ ;; Remove `wrap-prefix' related properties from any lines with
+ ;; prefixes we detected.
+ (remove-text-properties start end '(wrap-prefix nil)))
+
(defun visual-wrap-prefix-function (beg end)
"Indent the region between BEG and END with visual filling."
;; Any change at the beginning of a line might change its wrap
(goto-char beg)
(forward-line 0)
(setq beg (point))
+ (visual-wrap--remove-properties beg end)
(while (< (point) end)
;; Check if the display property at the end of this line is "safe".
(if (visual-wrap--display-property-safe-p
(with-silent-modifications
(save-restriction
(widen)
- (remove-text-properties (point-min) (point-max) '(wrap-prefix nil))))))
+ (visual-wrap--remove-properties (point-min) (point-max))))))
;;;###autoload
(define-globalized-minor-mode global-visual-wrap-prefix-mode
4 8 (display ((raise 0.5) (height 2.0)))
8 12 (display (raise 0.5)))))))
+(ert-deftest subr-x-test-remove-display-text-property ()
+ (with-temp-buffer
+ (insert "Foo bar zot gazonk")
+ (add-display-text-property 4 12 'height 2.0)
+ (add-display-text-property 2 8 'raise 0.5)
+ (remove-display-text-property 6 10 'height)
+ (should (equal-including-properties
+ (buffer-string)
+ #("Foo bar zot gazonk"
+ 1 3 (display (raise 0.5))
+ 3 5 (display ((raise 0.5) (height 2.0)))
+ 5 7 (display ((raise 0.5)))
+ 9 11 (display (height 2.0))))))
+ (with-temp-buffer
+ (insert "Foo bar zot gazonk")
+ (put-text-property 4 12 'display [(height 2.0)])
+ (add-display-text-property 2 8 'raise 0.5)
+ (remove-display-text-property 6 10 'height)
+ (should (equal-including-properties
+ (buffer-string)
+ #("Foo bar zot gazonk"
+ 1 3 (display (raise 0.5))
+ 3 5 (display [(raise 0.5) (height 2.0)])
+ 5 7 (display [(raise 0.5)])
+ 9 11 (display [(height 2.0)])))))
+ (with-temp-buffer
+ (should (equal-including-properties
+ (let ((str (copy-sequence "Foo bar zot gazonk")))
+ (add-display-text-property 3 11 'height 2.0 str)
+ (add-display-text-property 1 7 'raise 0.5 str)
+ (remove-display-text-property 5 9 'height str)
+ str)
+ #("Foo bar zot gazonk"
+ 1 3 (display (raise 0.5))
+ 3 5 (display ((raise 0.5) (height 2.0)))
+ 5 7 (display ((raise 0.5)))
+ 9 11 (display (height 2.0)))))))
+
(ert-deftest subr-x-named-let ()
(let ((funs ()))
(named-let loop
;;; visual-wrap-tests.el --- Tests for `visual-wrap-prefix-mode' -*- lexical-binding: t; -*-
-;; Copyright (C) 2024 Free Software Foundation, Inc.
+;; Copyright (C) 2024-2025 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
;;; Commentary:
-;; Tets for `visual-wrap-prefix-mode'.
+;; Tests for `visual-wrap-prefix-mode'.
;;; Code:
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 2 ( wrap-prefix (space :align-to (2 . width))
+ display (min-width ((2 . width))))
+ 2 25 ( wrap-prefix (space :align-to (2 . 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 2 ( wrap-prefix (space :align-to (2 . width))
+ display (min-width ((2 . width))))
+ 2 25 ( wrap-prefix (space :align-to (2 . 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 . width))
+ display (min-width ((2 . width))))))
+ (visual-wrap-prefix-mode -1)
+ (should (equal-including-properties
+ (buffer-string)
+ "* hello\n* hi"))))
+
;; visual-wrap-tests.el ends here
projects / emacs.git / commitdiff