[elpa] externals/compat 7d5c47576e 05/10: Fix and test add-display-text-property and get-display-property

[ELPA Syncer]

branch: externals/compat
commit 7d5c47576ea4755ae1e40d1944816a19ebef27e5
Author: Daniel Mendler <mail@daniel-mendler.de>
Commit: Daniel Mendler <mail@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")