[Emacs-diffs] scratch/prop-search f83e2ac 2/2: Reimplement backward searching the hard way

[Lars Ingebrigtsen]

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

    Reimplement backward searching the hard way
---
 lisp/emacs-lisp/text-property-search.el | 82 +++++++++++++++++++++++++++++++--
 1 file changed, 79 insertions(+), 3 deletions(-)

diff --git a/lisp/emacs-lisp/text-property-search.el 
b/lisp/emacs-lisp/text-property-search.el
index 40644dc..9d05aa3 100644
--- a/lisp/emacs-lisp/text-property-search.el
+++ b/lisp/emacs-lisp/text-property-search.el
@@ -63,7 +63,7 @@ value of PROPERTY at the start of the region."
   (if (and (text-property--match-p value (get-text-property (point) property)
                                    predicate)
            (not not-immediate))
-      (text-property--find-end (point) property value predicate)
+      (text-property--find-end-forward (point) property value predicate)
     (let ((origin (point))
           (ended nil)
           pos)
@@ -78,7 +78,8 @@ value of PROPERTY at the start of the region."
           (if (text-property--match-p value (get-text-property (point) 
property)
                                       predicate)
               (setq ended
-                    (text-property--find-end (point) property value predicate))
+                    (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
@@ -87,7 +88,7 @@ value of PROPERTY at the start of the region."
       (and (not (eq ended t))
            ended))))
 
-(defun text-property--find-end (start property value predicate)
+(defun text-property--find-end-forward (start property value predicate)
   (let (end)
     (if (and value
              (null predicate))
@@ -113,6 +114,81 @@ value of PROPERTY at the start of the region."
                      :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
+    (forward-char -1)
+    (let ((origin (point))
+          (ended nil)
+          pos)
+      ;; 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)