[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
master fde9363: Add new function 'add-display-text-property'
From: |
Lars Ingebrigtsen |
Subject: |
master fde9363: Add new function 'add-display-text-property' |
Date: |
Wed, 24 Nov 2021 13:38:51 -0500 (EST) |
branch: master
commit fde9363a57d0d38d592122fe5ca01aaafd0afa52
Author: Lars Ingebrigtsen <larsi@gnus.org>
Commit: Lars Ingebrigtsen <larsi@gnus.org>
Add new function 'add-display-text-property'
* doc/lispref/display.texi (Display Property): Document it.
* lisp/emacs-lisp/subr-x.el (add-display-text-property): New function.
---
doc/lispref/display.texi | 25 ++++++++++++++++++++
etc/NEWS | 7 ++++++
lisp/emacs-lisp/subr-x.el | 45 ++++++++++++++++++++++++++++++++++++
test/lisp/emacs-lisp/subr-x-tests.el | 18 +++++++++++++++
4 files changed, 95 insertions(+)
diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi
index fdebba9..7204581 100644
--- a/doc/lispref/display.texi
+++ b/doc/lispref/display.texi
@@ -4904,6 +4904,31 @@ with @code{get-char-property}, for instance
(@pxref{Examining
Properties}).
@end defun
+@defun add-display-text-property start end prop value &optional append object
+Add @code{display} property @var{prop} of @var{value} to the text from
+@var{start} to @var{end}.
+
+If any text in the region has a non-@code{nil} @code{display}
+property, those properties are retained. For instance:
+
+@lisp
+(add-display-text-property 4 8 'height 2.0)
+(add-display-text-property 2 12 'raise 0.5)
+@end lisp
+
+After doing this, the region from 2 to 4 will have the @code{raise}
+@code{display} property, the region from 4 to 8 will have both the
+@code{raise} and @code{height} @code{display} properties, and finally
+the region from 8 to 12 will only have the @code{raise} @code{display}
+property.
+
+If @var{append} is non-@code{nil}, append to the list of display
+properties; otherwise prepend.
+
+If @var{object} is non-@code{nil}, it should be a string or a buffer.
+If @code{nil}, this 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/etc/NEWS b/etc/NEWS
index 24b8cb2..8b7c2f7 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -676,10 +676,17 @@ Use 'exif-parse-file' and 'exif-field' instead.
* Lisp Changes in Emacs 29.1
++++
** New function 'get-display-property'.
This is like 'get-text-property', but works on the 'display' text
property.
++++
+** New function 'add-text-display-property'.
+This is like 'put-text-property', but works on the 'display' text
+property.
+
++++
** New 'min-width' 'display' property.
This allows setting a minimum display width for a region of text.
diff --git a/lisp/emacs-lisp/subr-x.el b/lisp/emacs-lisp/subr-x.el
index 95254b9..3ec880f 100644
--- a/lisp/emacs-lisp/subr-x.el
+++ b/lisp/emacs-lisp/subr-x.el
@@ -469,6 +469,51 @@ This takes into account combining characters and grapheme
clusters."
(setq start (1+ start))))
(nreverse result)))
+;;;###autoload
+(defun add-display-text-property (start end prop value
+ &optional append object)
+ "Add display property PROP with VALUE to the text from START to END.
+If any text in the region has a non-nil `display' property, those
+properties are retained.
+
+If APPEND is non-nil, append to the list of display properties;
+otherwise prepend.
+
+If OBJECT is non-nil, it should be a string or a buffer. If nil,
+this defaults to the current buffer."
+ (let ((sub-start start)
+ (sub-end 0)
+ 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)))))
+ (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 prop value))
+ ;; We have old properties.
+ (let ((vector nil))
+ ;; Make disp into a list.
+ (setq disp
+ (cond
+ ((vectorp disp)
+ (setq vector t)
+ (seq-into disp 'list))
+ ((not (consp (car disp)))
+ (list disp))
+ (t
+ disp)))
+ (setq disp
+ (if append
+ (append disp (list (list prop value)))
+ (append (list (list prop value)) disp)))
+ (when vector
+ (setq disp (seq-into disp 'vector)))
+ ;; Finally update the range.
+ (put-text-property sub-start sub-end 'display disp)))
+ (setq sub-start sub-end))))
+
(provide 'subr-x)
;;; subr-x.el ends here
diff --git a/test/lisp/emacs-lisp/subr-x-tests.el
b/test/lisp/emacs-lisp/subr-x-tests.el
index f9cfea8..69d59e8 100644
--- a/test/lisp/emacs-lisp/subr-x-tests.el
+++ b/test/lisp/emacs-lisp/subr-x-tests.el
@@ -676,5 +676,23 @@
(buffer-string))
"foo\n")))
+(ert-deftest test-add-display-text-property ()
+ (with-temp-buffer
+ (insert "Foo bar zot gazonk")
+ (add-display-text-property 4 8 'height 2.0)
+ (add-display-text-property 2 12 'raise 0.5)
+ (should (equal (get-text-property 2 'display) '(raise 0.5)))
+ (should (equal (get-text-property 5 'display)
+ '((raise 0.5) (height 2.0))))
+ (should (equal (get-text-property 9 'display) '(raise 0.5))))
+ (with-temp-buffer
+ (insert "Foo bar zot gazonk")
+ (put-text-property 4 8 'display [(height 2.0)])
+ (add-display-text-property 2 12 'raise 0.5)
+ (should (equal (get-text-property 2 'display) '(raise 0.5)))
+ (should (equal (get-text-property 5 'display)
+ [(raise 0.5) (height 2.0)]))
+ (should (equal (get-text-property 9 'display) '(raise 0.5)))))
+
(provide 'subr-x-tests)
;;; subr-x-tests.el ends here
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- master fde9363: Add new function 'add-display-text-property',
Lars Ingebrigtsen <=