[Emacs-diffs] scratch/prop-search e66fb91: First stab at implementing text-property-search-forward

[Lars Ingebrigtsen]

branch: scratch/prop-search
commit e66fb912fd68f5b573e5f52617fc5df6d6316885
Author: Lars Ingebrigtsen <address@hidden>
Commit: Lars Ingebrigtsen <address@hidden>

    First stab at implementing text-property-search-forward
---
 doc/lispref/text.texi     | 70 +++++++++++++++++++++++++++++++++++++++++++++++
 lisp/emacs-lisp/subr-x.el | 67 +++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 137 insertions(+)

diff --git a/doc/lispref/text.texi b/doc/lispref/text.texi
index e89bd0b..a4522ea 100644
--- a/doc/lispref/text.texi
+++ b/doc/lispref/text.texi
@@ -3180,6 +3180,76 @@ buffer to scan.  Positions are relative to @var{object}. 
 The default
 for @var{object} is the current buffer.
 @end defun
 
address@hidden text-property-search-forward prop value predicate
+Search for the next region that has text property @var{prop} set to
address@hidden according to @var{predicate}.
+
+This function is modelled after @code{search-forward} and friends, and
+moves points, but returns a structure that describes the match.
+
+If we can't find the text property, the function returns @code{nil}.
+If we find it, point is placed at the end of the region that has this
+text property match, and a @code{prop-match} structure is returned.
+
address@hidden can either be @code{t} (which is a synonym for
address@hidden), @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.
+
+In the examples below, imagine that you're in a buffer that looks like
+this:
+
address@hidden
+This is a bold and here's bolditalic and this is the end.
address@hidden 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:
+
address@hidden
+(while (setq match (text-property-search-forward 'face 'bold t))
+  (push (buffer-substring (prop-match-beginning match) (prop-match-end match))
+        words))
address@hidden lisp
+
+This will pick out all the words that use the @code{bold} face.
+
address@hidden
+(while (setq match (text-property-search-forward 'face nil t))
+  (push (buffer-substring (prop-match-beginning match) (prop-match-end match))
+        words))
address@hidden 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}).
+
address@hidden
+(while (setq match (text-property-search-forward 'face nil nil))
+  (push (buffer-substring (prop-match-beginning match) (prop-match-end match))
+        words))
address@hidden 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}.
+
address@hidden
+(while (setq match (text-property-search-forward 'shr-url nil nil))
+  (push (prop-match-value match) urls))
address@hidden lisp
+
+This will give you a list of all those URLs.
+
address@hidden defun
+
+
 @node Special Properties
 @subsection Properties with Special Meanings
 
diff --git a/lisp/emacs-lisp/subr-x.el b/lisp/emacs-lisp/subr-x.el
index 7fab908..608957e 100644
--- a/lisp/emacs-lisp/subr-x.el
+++ b/lisp/emacs-lisp/subr-x.el
@@ -253,6 +253,73 @@ TRIM-LEFT and TRIM-RIGHT default to \"[ \\t\\n\\r]+\"."
       (substring string 0 (- (length string) (length suffix)))
     string))
 
+(cl-defstruct (prop-match)
+  beginning end value)
+
+(defun text-property-search-forward (property value predicate)
+  "Search for the next region that has text property PROPERTY set to VALUE.
+If not found, the return value is nil.  If found, point will be
+placed at the end of the region and an object describing the
+beginning, and the value of the property is returned.
+
+PREDICATE is called with two values.  The first is the VALUE
+parameter.  The second is the value of PROPERTY.  This predicate
+should return non-nil if there is a match.
+
+Some convenience values for PREDICATE can also be used.  `t'
+means the same as `equal'.  `nil' means almost the same as \"not
+equal\", but will also end the match if the value of PROPERTY
+changes.  See the manual for extensive examples."
+  ;; We're standing in the property we're looking for, so find the
+  ;; end.
+  (if (text-property--match-p value (get-text-property (point) property)
+                              predicate)
+      (let ((start (point))
+            (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)))
+    (let ((origin (point))
+          (ended nil)
+          pos)
+      ;; Fix 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 (text-property--match-p value (get-text-property (point) 
property)
+                                      predicate)
+              (let ((start (point))
+                    (end (next-single-property-change
+                          (point) property nil (point-max))))
+                (goto-char end)
+                (setq ended
+                      (make-prop-match
+                       :beginning start
+                       :end end
+                       :value (get-text-property start property))))
+            ;; 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))))
+
+(defun text-property--match-p (value prop-value predicate)
+  (cond
+   ((eq predicate t)
+    (setq predicate #'equal))
+   ((eq predicate nil)
+    (setq predicate (lambda (val p-val)
+                      (not (equal val p-val))))))
+  (funcall predicate value prop-value))
+
 (provide 'subr-x)
 
 ;;; subr-x.el ends here