[elpa] externals/compat 9083cfc4f6 05/84: Add get-display-property

[ELPA Syncer]

branch: externals/compat
commit 9083cfc4f65eea86b91cba9298fd3138f768ada1
Author: Philip Kaludercic <philipk@posteo.net>
Commit: Philip Kaludercic <philipk@posteo.net>

    Add get-display-property
---
 compat-29.1.el  | 29 +++++++++++++++++++++++++++
 compat-tests.el | 61 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 90 insertions(+)

diff --git a/compat-29.1.el b/compat-29.1.el
index 507219b27b..3ff48f4f3c 100644
--- a/compat-29.1.el
+++ b/compat-29.1.el
@@ -30,6 +30,35 @@
 (eval-when-compile (require 'compat-macs))
 (declare-function compat-maxargs-/= "compat" (func n))
 
+;;;; Defined in xdisp.c
+
+(compat-defun get-display-property (position prop &optional object properties)
+  "Get the value of the `display' property PROP at POSITION.
+If OBJECT, this should be a buffer or string where the property is
+fetched from.  If omitted, OBJECT defaults to the current buffer.
+
+If PROPERTIES, look for value of PROP in PROPERTIES instead of
+the properties at POSITION."
+  (if properties
+      (unless (listp properties)
+        (signal 'wrong-type-argument (list 'listp properties)))
+    (setq properties (get-text-property position 'display object)))
+  (cond
+   ((vectorp properties)
+    (catch 'found
+      (dotimes (i (length properties))
+        (let ((ent (aref properties i)))
+          (when (eq (car ent) prop)
+            (throw 'found (cadr ent )))))))
+   ((consp (car properties))
+    (condition-case nil
+        (cadr (assq prop properties))
+      ;; Silently handle improper lists:
+      (wrong-type-argument nil)))
+   ((and (consp (cdr properties))
+         (eq (car properties) prop))
+    (cadr properties))))
+
 ;;;; Defined in subr.el
 
 (compat-defun function-alias-p (func &optional noerror)
diff --git a/compat-tests.el b/compat-tests.el
index 20dd733aad..ac2c5e411e 100644
--- a/compat-tests.el
+++ b/compat-tests.el
@@ -1383,5 +1383,66 @@ the compatibility function."
       (compat--error cyclic-function-indirection a)
       (compat--should (list b) a t))))
 
+(ert-deftest compat-get-display-property ()
+  "Check if `compat--function-alias-p' was implemented properly."
+  ;; Based on tests from xdisp-test.el
+  (with-temp-buffer
+    (insert (propertize "foo" 'face 'bold 'display '(height 2.0))
+            " bar")
+    (compat-test get-display-property
+      (compat--should 2.0 1 'height)
+      (compat--should 2.0 2 'height)
+      (compat--should nil 2 'width)
+      (compat--should nil 5 'height)
+      (compat--should nil 5 'height)
+      (compat--should nil 2 'bold)
+      (compat--should nil 5 'bold)))
+  (let ((str (concat
+              (propertize "foo" 'face 'bold 'display '(height 2.0))
+              " bar")))
+    (compat-test get-display-property
+      (compat--should 2.0 1 'height str)
+      (compat--should 2.0 2 'height str)
+      (compat--should nil 2 'width str)
+      (compat--should nil 5 'height str)
+      (compat--should nil 5 'height str)
+      (compat--should nil 2 'bold str)
+      (compat--should nil 5 'bold str)))
+  (with-temp-buffer
+    (insert (propertize "foo" 'face 'bold 'display '((height 2.0)
+                                                     (space-width 4.0)))
+            " bar")
+    (compat-test get-display-property
+      (compat--should 2.0 1 'height)
+      (compat--should 2.0 2 'height)
+      (compat--should nil 5 'height)
+      (compat--should 4.0 1 'space-width)
+      (compat--should 4.0 2 'space-width)
+      (compat--should nil 5 'space-width)
+      (compat--should nil 2 'width)
+      (compat--should nil 5 'width)
+      (compat--should nil 2 'bold)
+      (compat--should nil 5 'bold)))
+  (with-temp-buffer
+    (insert (propertize "foo bar" 'face 'bold
+                        'display '[(height 2.0)
+                                   (space-width 20)])
+            " baz")
+    (compat-test get-display-property
+      (compat--should 2.0 1 'height)
+      (compat--should 2.0 2 'height)
+      (compat--should 2.0 5 'height)
+      (compat--should nil 8 'height)
+      (compat--should 20 1 'space-width)
+      (compat--should 20 2 'space-width)
+      (compat--should 20 5 'space-width)
+      (compat--should nil 8 'space-width)
+      (compat--should nil 2 'width)
+      (compat--should nil 5 'width)
+      (compat--should nil 8 'width)
+      (compat--should nil 2 'bold)
+      (compat--should nil 5 'bold)
+      (compat--should nil 8 'width))))
+
 (provide 'compat-tests)
 ;;; compat-tests.el ends here