[elpa] externals/compat f74464f0e2: Add text-property-search functions from Emacs 27

[ELPA Syncer]

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

    Add text-property-search functions from Emacs 27
---
 compat-27.el    | 234 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 compat-tests.el |  78 +++++++++++++++++++
 compat.texi     |  99 ++++++++++++++++++++++++
 3 files changed, 411 insertions(+)

diff --git a/compat-27.el b/compat-27.el
index a96b1e9663..b52d7973c3 100644
--- a/compat-27.el
+++ b/compat-27.el
@@ -760,5 +760,239 @@ The return value is a string (or nil in case we can’t 
find it)."
         31
       30)))
 
+;;;; Defined in text-property-search.el
+
+(compat-defun make-prop-match (&rest attr)
+  "Constructor for objects of type ‘prop-match’."
+  :realname compat--make-prop-match-with-vector
+  :max-version "26.1"
+  (vector
+   'prop-match
+   (plist-get attr :beginning)
+   (plist-get attr :end)
+   (plist-get attr :value)))
+
+(compat-defun make-prop-match (&rest attr)
+  "Constructor for objects of type ‘prop-match’."
+  :realname compat--make-prop-match-with-record
+  :min-version "26.1"
+  (record
+   'prop-match
+   (plist-get attr :beginning)
+   (plist-get attr :end)
+   (plist-get attr :value)))
+
+(compat-defun prop-match-p (match)
+  "Return non-nil if MATCH is a `prop-match' object."
+  :realname compat--prop-match-p-with-vector
+  :max-version "26.1"
+  (and (vectorp match) (eq (aref match 0) 'prop-match)))
+
+(compat-defun prop-match-p (match)
+  "Return non-nil if MATCH is a `prop-match' object."
+  :realname compat--prop-match-p-with-record
+  :min-version "26.1"
+  (eq (type-of match) 'prop-match))
+
+(compat-defun prop-match-beginning (match)
+  "Retrieve the position where MATCH begins."
+  (aref match 1))
+
+(compat-defun prop-match-end (match)
+  "Retrieve the position where MATCH ends."
+  (aref match 2))
+
+(compat-defun prop-match-value (match)
+  "Retrieve the value that MATCH holds."
+  (aref match 3))
+
+(compat-defun text-property-search-forward
+    (property &optional value predicate not-current)
+  "Search for the next region of text where PREDICATE is true.
+PREDICATE is used to decide whether a value of PROPERTY should be
+considered as matching VALUE.
+
+If PREDICATE is a function, it will be called with two arguments:
+VALUE and the value of PROPERTY.  The function should return
+non-nil if these two values are to be considered a match.
+
+Two special values of PREDICATE can also be used:
+If PREDICATE is t, that means a value must `equal' VALUE to be
+considered a match.
+If PREDICATE is nil (which is the default value), a value will
+match if is not `equal' to VALUE.  Furthermore, a nil PREDICATE
+means that the match region is ended if the value changes.  For
+instance, this means that if you loop with
+
+  (while (setq prop (text-property-search-forward \\='face))
+    ...)
+
+you will get all distinct regions with non-nil `face' values in
+the buffer, and the `prop' object will have the details about the
+match.  See the manual for more details and examples about how
+VALUE and PREDICATE interact.
+
+If NOT-CURRENT is non-nil, the function will search for the first
+region that doesn't include point and has a value of PROPERTY
+that matches VALUE.
+
+If no matches can be found, return nil and don't move point.
+If found, move point to the end of the region and return a
+`prop-match' object describing the match.  To access the details
+of the match, use `prop-match-beginning' and `prop-match-end' for
+the buffer positions that limit the region, and
+`prop-match-value' for the value of PROPERTY in the region."
+  (let* ((match-p
+          (lambda (prop-value)
+            (funcall
+             (cond
+              ((eq predicate t)
+               #'equal)
+              ((eq predicate nil)
+               (lambda (val p-val)
+                 (not (equal val p-val))))
+              (predicate))
+             value prop-value)))
+         (find-end
+          (lambda (start)
+            (let (end)
+              (if (and value
+                       (null predicate))
+                  ;; This is the normal case: We're looking for areas where the
+                  ;; values aren't, so we aren't interested in sub-areas where 
the
+                  ;; property has different values, all non-matching value.
+                  (let ((ended nil))
+                    (while (not ended)
+                      (setq end (next-single-property-change (point) property))
+                      (if (not end)
+                          (progn
+                            (goto-char (point-max))
+                            (setq end (point)
+                                  ended t))
+                        (goto-char end)
+                        (unless (funcall match-p (get-text-property (point) 
property))
+                          (setq ended t)))))
+                ;; End this at the first place the property changes value.
+                (setq end (next-single-property-change (point) property nil 
(point-max)))
+                (goto-char end))
+              (make-prop-match
+               :beginning start
+               :end end
+               :value (get-text-property start property))))))
+    (cond
+     ;; No matches at the end of the buffer.
+     ((eobp)
+      nil)
+     ;; We're standing in the property we're looking for, so find the
+     ;; end.
+     ((and (funcall match-p (get-text-property (point) property))
+           (not not-current))
+      (funcall find-end (point)))
+     (t
+      (let ((origin (point))
+            (ended nil)
+            pos)
+        ;; Find the next candidate.
+        (while (not ended)
+          (setq pos (next-single-property-change (point) property))
+          (if (not pos)
+              (progn
+                (goto-char origin)
+                (setq ended t))
+            (goto-char pos)
+            (if (funcall match-p (get-text-property (point) property))
+                (setq ended (funcall find-end (point)))
+              ;; Skip past this section of non-matches.
+              (setq pos (next-single-property-change (point) property))
+              (unless pos
+                (goto-char origin)
+                (setq ended t)))))
+        (and (not (eq ended t))
+             ended))))))
+
+(compat-defun text-property-search-backward
+    (property &optional value predicate not-current)
+  "Search for the previous region of text whose PROPERTY matches VALUE.
+
+Like `text-property-search-forward', which see, but searches backward,
+and if a matching region is found, place point at the start of the region."
+  (let* ((match-p
+          (lambda (prop-value)
+            (funcall
+             (cond
+              ((eq predicate t)
+               #'equal)
+              ((eq predicate nil)
+               (lambda (val p-val)
+                 (not (equal val p-val))))
+              (predicate))
+             value prop-value)))
+         (find-end
+          (lambda (start)
+            (let (end)
+              (if (and value
+                       (null predicate))
+                  ;; This is the normal case: We're looking for areas where the
+                  ;; values aren't, so we aren't interested in sub-areas where 
the
+                  ;; property has different values, all non-matching value.
+                  (let ((ended nil))
+                    (while (not ended)
+                      (setq end (previous-single-property-change (point) 
property))
+                      (if (not end)
+                          (progn
+                            (goto-char (point-min))
+                            (setq end (point)
+                                  ended t))
+                        (goto-char (1- end))
+                        (unless (funcall match-p (get-text-property (point) 
property))
+                          (goto-char end)
+                          (setq ended t)))))
+                ;; End this at the first place the property changes value.
+                (setq end (previous-single-property-change
+                           (point) property nil (point-min)))
+                (goto-char end))
+              (make-prop-match
+               :beginning end
+               :end (1+ start)
+               :value (get-text-property end property))))))
+    (cond
+     ;; We're at the start of the buffer; no previous matches.
+     ((bobp)
+      nil)
+     ;; We're standing in the property we're looking for, so find the
+     ;; end.
+     ((funcall match-p (get-text-property (1- (point)) property))
+      (let ((origin (point))
+            (match (funcall find-end (1- (point)) property value predicate)))
+        ;; When we want to ignore the current element, then repeat the
+        ;; search if we haven't moved out of it yet.
+        (if (and not-current
+                 (equal (get-text-property (point) property)
+                        (get-text-property origin property)))
+            (text-property-search-backward property value predicate)
+          match)))
+     (t
+      (let ((origin (point))
+            (ended nil)
+            pos)
+        ;; Find the previous candidate.
+        (while (not ended)
+          (setq pos (previous-single-property-change (point) property))
+          (if (not pos)
+              (progn
+                (goto-char origin)
+                (setq ended t))
+            (goto-char (1- pos))
+            (if (funcall match-p (get-text-property (point) property))
+                (setq ended
+                      (funcall find-end (point)))
+              ;; Skip past this section of non-matches.
+              (setq pos (previous-single-property-change (point) property))
+              (unless pos
+                (goto-char origin)
+                (setq ended t)))))
+        (and (not (eq ended t))
+             ended))))))
+
 (compat--inhibit-prefixed (provide 'compat-27))
 ;;; compat-27.el ends here
diff --git a/compat-tests.el b/compat-tests.el
index a2c964b5da..85ca26d4fa 100644
--- a/compat-tests.el
+++ b/compat-tests.el
@@ -1862,5 +1862,83 @@ being compared against."
     (ought three three one.5 two one three)
     (ought three three one.5 three two one)))
 
+(ert-deftest text-property-search-forward ()
+  (when (fboundp 'text-property-search-forward)
+    (with-temp-buffer
+      (insert "one "
+              (propertize "two " 'prop 'val)
+              "three "
+              (propertize "four " 'prop 'wert)
+              "five ")
+      (goto-char (point-min))
+      (let ((match (text-property-search-forward 'prop)))
+        (should (eq (prop-match-beginning match) 5))
+        (should (eq (prop-match-end match) 9))
+        (should (eq (prop-match-value match) 'val)))
+      (let ((match (text-property-search-forward 'prop)))
+        (should (eq (prop-match-beginning match) 15))
+        (should (eq (prop-match-end match) 20))
+        (should (eq (prop-match-value match) 'wert)))
+      (should (null (text-property-search-forward 'prop)))
+      (goto-char (point-min))
+      (should (null (text-property-search-forward 'non-existant)))))
+  (with-temp-buffer
+    (insert "one "
+            (propertize "two " 'prop 'val)
+            "three "
+            (propertize "four " 'prop 'wert)
+            "five ")
+    (goto-char (point-min))
+    (let ((match (compat--text-property-search-forward 'prop)))
+      (should (eq (compat--prop-match-beginning match) 5))
+      (should (eq (compat--prop-match-end match) 9))
+      (should (eq (compat--prop-match-value match) 'val)))
+    (let ((match (compat--text-property-search-forward 'prop)))
+      (should (eq (compat--prop-match-beginning match) 15))
+      (should (eq (compat--prop-match-end match) 20))
+      (should (eq (compat--prop-match-value match) 'wert)))
+    (should (null (text-property-search-forward 'prop)))
+    (goto-char (point-min))
+    (should (null (text-property-search-forward 'non-existant)))))
+
+(ert-deftest text-property-search-backward ()
+  (when (fboundp 'text-property-search-backward)
+    (with-temp-buffer
+      (insert "one "
+              (propertize "two " 'prop 'val)
+              "three "
+              (propertize "four " 'prop 'wert)
+              "five ")
+      (goto-char (point-max))
+      (let ((match (text-property-search-backward 'prop)))
+        (should (eq (prop-match-beginning match) 15))
+        (should (eq (prop-match-end match) 20))
+        (should (eq (prop-match-value match) 'wert)))
+      (let ((match (text-property-search-backward 'prop)))
+        (should (eq (prop-match-beginning match) 5))
+        (should (eq (prop-match-end match) 9))
+        (should (eq (prop-match-value match) 'val)))
+      (should (null (text-property-search-backward 'prop)))
+      (goto-char (point-max))
+      (should (null (text-property-search-backward 'non-existant)))))
+  (with-temp-buffer
+    (insert "one "
+            (propertize "two " 'prop 'val)
+            "three "
+            (propertize "four " 'prop 'wert)
+            "five ")
+    (goto-char (point-max))
+    (let ((match (compat--text-property-search-backward 'prop)))
+      (should (eq (compat--prop-match-beginning match) 15))
+      (should (eq (compat--prop-match-end match) 20))
+      (should (eq (compat--prop-match-value match) 'wert)))
+    (let ((match (compat--text-property-search-backward 'prop)))
+      (should (eq (compat--prop-match-beginning match) 5))
+      (should (eq (compat--prop-match-end match) 9))
+      (should (eq (compat--prop-match-value match) 'val)))
+    (should (null (text-property-search-backward 'prop)))
+    (goto-char (point-max))
+    (should (null (text-property-search-backward 'non-existant)))))
+
 (provide 'compat-tests)
 ;;; compat-tests.el ends here
diff --git a/compat.texi b/compat.texi
index 59bb344c92..5ada74bc90 100644
--- a/compat.texi
+++ b/compat.texi
@@ -1612,6 +1612,105 @@ argument, which signals an error if the list of found 
files is empty.
 @code{error} can be a string with the error message.
 @end defun
 
+@defun text-property-search-forward prop &optional value predicate not-current
+Search for the next region that has text property @var{prop} set to
+@var{value} according to @var{predicate}.
+
+This function is modeled after @code{search-forward} and friends in
+that it moves point, but it returns a structure that describes the
+match instead of returning it in @code{match-beginning} and friends.
+
+If the text property can't be found, the function returns @code{nil}.
+If it's found, point is placed at the end of the region that has this
+text property match, and a @code{prop-match} structure is returned.
+
+@var{predicate} can either be @code{t} (which is a synonym for
+@code{equal}), @code{nil} (which means ``not equal''), or a predicate
+that will be called with two parameters: The first is @var{value}, and
+the second is the value of the text property we're inspecting.
+
+If @var{not-current}, if point is in a region where we have a match,
+then skip past that and find the next instance instead.
+
+The @code{prop-match} structure has the following accessors:
+@code{prop-match-beginning} (the start of the match),
+@code{prop-match-end} (the end of the match), and
+@code{prop-match-value} (the value of @var{property} at the start of
+the match).
+
+In the examples below, imagine that you're in a buffer that looks like
+this:
+
+@example
+This is a bold and here's bolditalic and this is the end.
+@end example
+
+That is, the ``bold'' words are the @code{bold} face, and the
+``italic'' word is in the @code{italic} face.
+
+With point at the start:
+
+@lisp
+(while (setq match (text-property-search-forward 'face 'bold t))
+  (push (buffer-substring (prop-match-beginning match)
+                          (prop-match-end match))
+        words))
+@end lisp
+
+This will pick out all the words that use the @code{bold} face.
+
+@lisp
+(while (setq match (text-property-search-forward 'face nil t))
+  (push (buffer-substring (prop-match-beginning match)
+                          (prop-match-end match))
+        words))
+@end lisp
+
+This will pick out all the bits that have no face properties, which
+will result in the list @samp{("This is a " "and here's " "and this is
+the end")} (only reversed, since we used @code{push}).
+
+@lisp
+(while (setq match (text-property-search-forward 'face nil nil))
+  (push (buffer-substring (prop-match-beginning match)
+                          (prop-match-end match))
+        words))
+@end lisp
+
+This will pick out all the regions where @code{face} is set to
+something, but this is split up into where the properties change, so
+the result here will be @samp{("bold" "bold" "italic")}.
+
+For a more realistic example where you might use this, consider that
+you have a buffer where certain sections represent URLs, and these are
+tagged with @code{shr-url}.
+
+@lisp
+(while (setq match (text-property-search-forward 'shr-url nil nil))
+  (push (prop-match-value match) urls))
+@end lisp
+
+This will give you a list of all those URLs.
+
+@xref{elisp,,,Property Search}.
+@end defun
+
+@defun text-property-search-backward prop &optional value predicate not-current
+This is just like @code{text-property-search-forward}, but searches
+backward instead.  Point is placed at the beginning of the matched
+region instead of the end, though.
+
+@xref{elisp,,,Property Search}.
+@end defun
+
+@defun text-property-search-backward prop &optional value predicate not-current
+This is just like @code{text-property-search-forward}, but searches
+backward instead.  Point is placed at the beginning of the matched
+region instead of the end, though.
+
+@xref{elisp,,,Property Search}.
+@end defun
+
 @subsection Missing Definitions
 Compat does not provide support for the following Lisp features
 implemented in 27.1: