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.
This commit is contained in:
Lars Ingebrigtsen 2021-11-24 19:38:41 +01:00
parent 34f2878ce2
commit fde9363a57
4 changed files with 95 additions and 0 deletions

View file

@ -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,

View file

@ -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.

View file

@ -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

View file

@ -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