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:
parent
34f2878ce2
commit
fde9363a57
4 changed files with 95 additions and 0 deletions
|
@ -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,
|
||||
|
|
7
etc/NEWS
7
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.
|
||||
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Add table
Reference in a new issue