unofficial mirror of emacs-devel@gnu.org 
 help / color / mirror / code / Atom feed
From: James Cash <james.nvc@gmail.com>
To: Eli Zaretskii <eliz@gnu.org>
Cc: , emacs-devel@gnu.org
Subject: Re: [PATCH] Add option COUNT argument to text-property-search functions
Date: Fri, 30 Jul 2021 16:49:17 -0400	[thread overview]
Message-ID: <87czqzle7m.fsf@gmail.com> (raw)
In-Reply-To: <83y29npo8n.fsf@gnu.org>

Eli Zaretskii <eliz@gnu.org> writes:

>> +If COUNT is a positive number, it will search forward COUNT times. If
>                                                                     ^^
> Two spaces between sentences, please, per the US English conventions.

Fixed.

> Also, could you please add tests for this new feature?

Added!

> P.S. Would it be possible for you to use the same email address in
> your contributions as the one you used in the copyright assignment?
> It will help us verify that your assignment is on file.

Ah, sorry about that; replying from the email address from which I did
the copyright assignment (which isn't subscribed to the mailing list
though, so hopefully this gets through; I suppose I should switch which
address is subscribed).

---
 lisp/emacs-lisp/text-property-search.el       | 59 ++++++++++++++-----
 .../emacs-lisp/text-property-search-tests.el  | 25 ++++++++
 2 files changed, 70 insertions(+), 14 deletions(-)

diff --git a/lisp/emacs-lisp/text-property-search.el b/lisp/emacs-lisp/text-property-search.el
index 7da02a9cb2..e4fcbf2ed1 100644
--- a/lisp/emacs-lisp/text-property-search.el
+++ b/lisp/emacs-lisp/text-property-search.el
@@ -30,7 +30,7 @@
   beginning end value)

 (defun text-property-search-forward (property &optional value predicate
-                                              not-current)
+                                              not-current count)
   "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.
@@ -59,6 +59,9 @@ text-property-search-forward
 region that doesn't include point and has a value of PROPERTY
 that matches VALUE.

+If COUNT is a positive number, it will search forward COUNT times.  If
+negative, it will perform text-property-search-backwards -COUNT times.
+
 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
@@ -71,6 +74,9 @@ text-property-search-forward
       (when (> (length string) 0)
         (intern string obarray)))))
   (cond
+   ;; Negative count means search backwards
+   ((and (numberp count) (< count 0))
+    (text-property-search-backward property value predicate not-current (- count)))
    ;; No matches at the end of the buffer.
    ((eobp)
     nil)
@@ -83,25 +89,36 @@ text-property-search-forward
    (t
     (let ((origin (point))
           (ended nil)
+          (count (or count 1))
+          (match t)
           pos)
-      ;; Find the next candidate.
+      ;; Find the COUNT-th next candidate.
       (while (not ended)
         (setq pos (next-single-property-change (point) property))
         (if (not pos)
             (progn
               (goto-char origin)
-              (setq ended t))
+              (setq ended match))
           (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))
+              (progn
+                (setq match (text-property--find-end-forward
+                             (point) property value predicate))
+                (setq origin (point))
+                (cl-decf count)
+                (if (zerop count)
+                    (setq ended match)
+                  (setq pos (next-single-property-change (point) property))
+                  (if pos
+                      (goto-char pos)
+                    (goto-char origin)
+                    (setq ended match))))
             ;; Skip past this section of non-matches.
             (setq pos (next-single-property-change (point) property))
             (unless pos
               (goto-char origin)
-              (setq ended t)))))
+              (setq ended match)))))
       (and (not (eq ended t))
            ended)))))

@@ -133,7 +150,7 @@ text-property--find-end-forward


 (defun text-property-search-backward (property &optional value predicate
-                                               not-current)
+                                               not-current count)
   "Search for the previous region of text whose PROPERTY matches VALUE.

 Like `text-property-search-forward', which see, but searches backward,
@@ -144,6 +161,9 @@ text-property-search-backward
       (when (> (length string) 0)
         (intern string obarray)))))
   (cond
+   ;; Negative count means search forwards
+   ((and (numberp count) (< count 0))
+    (text-property-search-forward property value predicate not-current (- count)))
    ;; We're at the start of the buffer; no previous matches.
    ((bobp)
     nil)
@@ -165,26 +185,37 @@ text-property-search-backward
    (t
     (let ((origin (point))
           (ended nil)
+          (count (or count 1))
+          (match t)
           pos)
       (forward-char -1)
-      ;; Find the previous candidate.
+      ;; Find the COUNT-th previous candidate.
       (while (not ended)
         (setq pos (previous-single-property-change (point) property))
         (if (not pos)
             (progn
               (goto-char origin)
-              (setq ended t))
+              (setq ended match))
           (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))
+              (progn
+                (setq match (text-property--find-end-backward
+                             (point) property value predicate))
+                (setq origin (point))
+                (cl-decf count)
+                (if (zerop count)
+                    (setq ended match)
+                  (setq pos (previous-single-property-change (point) property))
+                  (if pos
+                      (goto-char pos)
+                    (goto-char origin)
+                    (setq ended match))))
             ;; Skip past this section of non-matches.
             (setq pos (previous-single-property-change (point) property))
             (unless pos
               (goto-char origin)
-              (setq ended t)))))
+              (setq ended match)))))
       (and (not (eq ended t))
            ended)))))

diff --git a/test/lisp/emacs-lisp/text-property-search-tests.el b/test/lisp/emacs-lisp/text-property-search-tests.el
index 90f06c3c4c..16ff6e87fd 100644
--- a/test/lisp/emacs-lisp/text-property-search-tests.el
+++ b/test/lisp/emacs-lisp/text-property-search-tests.el
@@ -79,12 +79,32 @@ text-property-search-forward-partial-non-current-bold-t
              '("bold2")
              10))

+(ert-deftest text-property-search-forward-non-current-bold-t-count-1 ()
+  (with-test (text-property-search-forward 'face 'bold t t 1)
+             '("bold1" "bold2")))
+
+(ert-deftest text-property-search-forward-non-current-bold-t-count-2 ()
+  (with-test (text-property-search-forward 'face 'bold t t 2)
+             '("bold2")))
+
+(ert-deftest text-property-search-backwards-non-current-bold-t-count--negative-2 ()
+  (with-test (text-property-search-backward 'face 'bold t t -2)
+             '("bold2")))
+
+(ert-deftest text-property-search-forward-non-current-bold-t-count-many ()
+  (with-test (text-property-search-forward 'face 'bold t t 100)
+             '("bold2")))

 (ert-deftest text-property-search-backward-bold-t ()
   (with-test (text-property-search-backward 'face 'bold t)
              '("bold2" "bold1")
              (point-max)))

+(ert-deftest text-property-search-forward-bold-t-negative-count ()
+  (with-test (text-property-search-forward 'face 'bold t nil -1)
+             '("bold2" "bold1")
+             (point-max)))
+
 (ert-deftest text-property-search-backward-bold-nil ()
   (with-test (text-property-search-backward 'face 'bold nil)
              '( "italic2 at the end" " and this is italic1" "This is ")
@@ -110,6 +130,11 @@ text-property-search-backward-partial-non-current-bold-t
              '("bold1")
              35))

+(ert-deftest text-property-search-backward-non-current-bold-t-count-2 ()
+  (with-test (text-property-search-backward 'face 'bold t t 2)
+             '("bold1")
+             (point-max)))
+
 (defmacro with-match-test (form beginning end value &optional point)
   `(with-temp-buffer
      (text-property-setup)
--
2.25.1



      reply	other threads:[~2021-07-30 20:49 UTC|newest]

Thread overview: 8+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2021-07-30 19:20 [PATCH] Add option COUNT argument to text-property-search functions James N V Cash
2021-07-30 19:51 ` Lars Ingebrigtsen
2021-07-30 19:55   ` James N. V. Cash
2021-07-30 21:56     ` Dmitry Gutov
2021-07-31  6:56       ` Protesilaos Stavrou
2021-07-31 11:36         ` Lars Ingebrigtsen
2021-07-30 19:59 ` Eli Zaretskii
2021-07-30 20:49   ` James Cash [this message]

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

  List information: https://www.gnu.org/software/emacs/

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to=87czqzle7m.fsf@gmail.com \
    --to=james.nvc@gmail.com \
    --cc=eliz@gnu.org \
    --cc=emacs-devel@gnu.org \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line before the message body.
Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/emacs.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).