[Emacs-diffs] master 6f57297 1/2: Add `text-property-search-forward' and `-backward'

[Lars Ingebrigtsen]

branch: master
commit 6f572972d19397d8295727a99b687fc521bd469e
Author: Lars Ingebrigtsen <address@hidden>
Commit: Lars Ingebrigtsen <address@hidden>

    Add `text-property-search-forward' and `-backward'
    
    * doc/lispref/text.texi (Property Search): Document
    `text-property-search-forward' and `text-property-search-backward'.
    
    * lisp/emacs-lisp/text-property-search.el: New file.
---
 doc/lispref/text.texi                   |  89 ++++++++++++++
 etc/NEWS                                |   5 +
 lisp/emacs-lisp/text-property-search.el | 201 ++++++++++++++++++++++++++++++++
 3 files changed, 295 insertions(+)

diff --git a/doc/lispref/text.texi b/doc/lispref/text.texi
index e89bd0b..8cb6cf6 100644
--- a/doc/lispref/text.texi
+++ b/doc/lispref/text.texi
@@ -3180,6 +3180,95 @@ 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 &optional value predicate 
not-current
+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 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.
+
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.
+
+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:
address@hidden (the start of the match),
address@hidden (the end of the match), and
address@hidden (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:
+
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
+
address@hidden text-property-search-backward prop &optional value predicate 
not-current
+This is just like @code{text-property-search-backward}, but searches
+backward instead.  Point is placed at the beginning of the matched
+region instead of the end, though.
address@hidden defun
+
+
 @node Special Properties
 @subsection Properties with Special Meanings
 
diff --git a/etc/NEWS b/etc/NEWS
index 5aa92e2..d402401 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -164,6 +164,11 @@ non-text modes.
 'write-abbrev-file' now writes special properties like ':case-fixed'
 for abbrevs that have them.
 
++++
+** The new functions and commands `text-property-search-forward' and
+`text-property-search-backward' have been added.  These provide an
+interface that's more like functions like @code{search-forward}.
+
 
 * Changes in Specialized Modes and Packages in Emacs 27.1
 
diff --git a/lisp/emacs-lisp/text-property-search.el 
b/lisp/emacs-lisp/text-property-search.el
new file mode 100644
index 0000000..cd4471a
--- /dev/null
+++ b/lisp/emacs-lisp/text-property-search.el
@@ -0,0 +1,201 @@
+;;; text-property-search.el --- search for text properties  -*- 
lexical-binding:t -*-
+
+;; Copyright (C) 2018 Free Software Foundation, Inc.
+
+;; Author: Lars Magne Ingebrigtsen <address@hidden>
+;; Keywords: convenience
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+
+(eval-when-compile (require 'cl-lib))
+
+(cl-defstruct (prop-match)
+  beginning end value)
+
+(defun text-property-search-forward (property &optional value predicate
+                                              not-immediate)
+  "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
+match 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.
+
+If `not-immediate', if the match is under point, it will not be
+returned, but instead the next instance is returned, if any.
+
+The return value (if a match is made) is a `prop-match'
+structure.  The accessor avaliable are
+`prop-match-beginning'/`prop-match-end' (which are the region in
+the buffer that's matching, and `prop-match-value', which is the
+value of PROPERTY at the start of the region."
+  (interactive
+   (list
+    (let ((string (completing-read "Search for property: " obarray)))
+      (when (> (length string) 0)
+        (intern string obarray)))))
+  ;; We're standing in the property we're looking for, so find the
+  ;; end.
+  (if (and (text-property--match-p value (get-text-property (point) property)
+                                   predicate)
+           (not not-immediate))
+      (text-property--find-end-forward (point) property value predicate)
+    (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)
+              (setq ended
+                    (text-property--find-end-forward
+                     (point) property value predicate))
+            ;; 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--find-end-forward (start property value predicate)
+  (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 (text-property--match-p
+                       value (get-text-property (point) property) predicate)
+                (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))))
+
+
+(defun text-property-search-backward (property &optional value predicate
+                                               not-immediate)
+  "Search for the previous region that has text property PROPERTY set to VALUE.
+See `text-property-search-forward' for further documentation."
+  (interactive
+   (list
+    (let ((string (completing-read "Search for property: " obarray)))
+      (when (> (length string) 0)
+        (intern string obarray)))))
+  (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.
+   ((and (text-property--match-p
+          value (get-text-property (1- (point)) property)
+          predicate)
+         (not not-immediate))
+    (text-property--find-end-backward (1- (point)) property value predicate))
+   (t
+    (let ((origin (point))
+          (ended nil)
+          pos)
+      (forward-char -1)
+      ;; Fix the next 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 (text-property--match-p value (get-text-property (point) 
property)
+                                      predicate)
+              (setq ended
+                    (text-property--find-end-backward
+                     (point) property value predicate))
+            ;; 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)))))
+
+(defun text-property--find-end-backward (start property value predicate)
+  (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 (text-property--match-p
+                       value (get-text-property (point) property) predicate)
+                (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))))
+
+(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 'text-property-search)