branch: externals/compat
commit 7d5c47576ea4755ae1e40d1944816a19ebef27e5
Author: Daniel Mendler <m...@daniel-mendler.de>
Commit: Daniel Mendler <m...@daniel-mendler.de>
Fix and test add-display-text-property and get-display-property
---
compat-29.el | 15 ++++++++-------
compat-tests.el | 43 +++++++++++++++++++++++++++++++++++++++++++
2 files changed, 51 insertions(+), 7 deletions(-)
diff --git a/compat-29.el b/compat-29.el
index 1819b0123b..afb52c2b56 100644
--- a/compat-29.el
+++ b/compat-29.el
@@ -421,7 +421,7 @@ be marked unmodified, effectively ignoring those changes."
(equal ,hash (buffer-hash)))
(restore-buffer-modified-p nil))))))))
-(compat-defun add-display-text-property (start end prop value ;; <UNTESTED>
+(compat-defun add-display-text-property (start end prop value ;; <OK>
&optional 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
@@ -439,7 +439,8 @@ this defaults to the current buffer."
(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))
+ (put-text-property sub-start sub-end 'display (list prop value)
+ object)
;; We have old properties.
(let ((vector nil))
;; Make disp into a list.
@@ -447,19 +448,19 @@ this defaults to the current buffer."
(cond
((vectorp disp)
(setq vector t)
- (append disp nil))
+ (seq-into disp 'list))
((not (consp (car disp)))
(list disp))
(t
disp)))
;; Remove any old instances.
- (let ((old (assoc prop disp)))
- (when old (setq disp (delete old disp))))
+ (when-let ((old (assoc prop disp)))
+ (setq disp (delete old disp)))
(setq disp (cons (list prop value) disp))
(when vector
- (setq disp (vconcat disp)))
+ (setq disp (seq-into disp 'vector)))
;; Finally update the range.
- (put-text-property sub-start sub-end 'display disp)))
+ (put-text-property sub-start sub-end 'display disp object)))
(setq sub-start sub-end))))
(compat-defmacro while-let (spec &rest body) ;; <UNTESTED>
diff --git a/compat-tests.el b/compat-tests.el
index e70347586f..25845e7e08 100644
--- a/compat-tests.el
+++ b/compat-tests.el
@@ -52,6 +52,49 @@
(setq list (funcall sym list "first" 1 #'string=))
(should (eq (compat-call plist-get list "first" #'string=) 1))))
+(ert-deftest get-display-property ()
+ (with-temp-buffer
+ (insert (propertize "foo" 'face 'bold 'display '(height 2.0)))
+ (should-equal (get-display-property 2 'height) 2.0))
+ (with-temp-buffer
+ (insert (propertize "foo" 'face 'bold 'display '((height 2.0)
+ (space-width 2.0))))
+ (should-equal (get-display-property 2 'height) 2.0)
+ (should-equal (get-display-property 2 'space-width) 2.0))
+ (with-temp-buffer
+ (insert (propertize "foo bar" 'face 'bold
+ 'display '[(height 2.0)
+ (space-width 20)]))
+ (should-equal (get-display-property 2 'height) 2.0)
+ (should-equal (get-display-property 2 'space-width) 20)))
+
+(ert-deftest 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)))
+ (with-temp-buffer
+ (should-equal (let ((str "some useless string"))
+ (add-display-text-property 4 8 'height 2.0 str)
+ (add-display-text-property 2 12 'raise 0.5 str)
+ str)
+ #("some useless string"
+ 2 4 (display (raise 0.5))
+ 4 8 (display ((raise 0.5) (height 2.0)))
+ 8 12 (display (raise 0.5))))))
+
(ert-deftest line-number-at-pos ()
(with-temp-buffer
(insert "\n\n\n")
