From: Jim Porter Date: Wed, 28 May 2025 16:44:34 +0000 (-0700) Subject: Clean up text properties in 'visual-wrap-prefix-mode' X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=fc54671b12b06d32b583bc28874c22fcd04f6211;p=emacs.git Clean up text properties in 'visual-wrap-prefix-mode' 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) --- diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi index 5ed981557e7..448003b6e21 100644 --- a/doc/lispref/display.texi +++ b/doc/lispref/display.texi @@ -5326,6 +5326,44 @@ specification. 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, diff --git a/lisp/emacs-lisp/subr-x.el b/lisp/emacs-lisp/subr-x.el index cfd0927fe66..87cb320bf83 100644 --- a/lisp/emacs-lisp/subr-x.el +++ b/lisp/emacs-lisp/subr-x.el @@ -410,28 +410,25 @@ indivisible unit." (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 @@ -454,14 +451,41 @@ If omitted, OBJECT defaults to the current buffer." ;; 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." diff --git a/lisp/visual-wrap.el b/lisp/visual-wrap.el index 92b9abc60e3..c8ae6f8f376 100644 --- a/lisp/visual-wrap.el +++ b/lisp/visual-wrap.el @@ -226,6 +226,14 @@ by `visual-wrap-extra-indent'." (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 @@ -238,6 +246,7 @@ by `visual-wrap-extra-indent'." (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 @@ -283,7 +292,7 @@ To enable this minor mode across all buffers, enable (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 diff --git a/test/lisp/emacs-lisp/subr-x-tests.el b/test/lisp/emacs-lisp/subr-x-tests.el index 5ffbe64ae40..e0eecc3e934 100644 --- a/test/lisp/emacs-lisp/subr-x-tests.el +++ b/test/lisp/emacs-lisp/subr-x-tests.el @@ -740,6 +740,44 @@ 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 diff --git a/test/lisp/visual-wrap-tests.el b/test/lisp/visual-wrap-tests.el index 04977afe207..d057ebef074 100644 --- a/test/lisp/visual-wrap-tests.el +++ b/test/lisp/visual-wrap-tests.el @@ -1,6 +1,6 @@ ;;; 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. @@ -19,7 +19,7 @@ ;;; Commentary: -;; Tets for `visual-wrap-prefix-mode'. +;; Tests for `visual-wrap-prefix-mode'. ;;; Code: @@ -117,4 +117,40 @@ should *not* add wrapping properties to either block." 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