Subject: Re: bug#68762: 30.0.50; thing-at-point for an e-mail adress stops at "."

From: Eshel Yaron <[email-masked]>
Date: Thu, 01 Feb 2024 12:10:35 +0100

Hi,

Eli Zaretskii <[email-masked]> writes:

>> Cc: [email-masked], [email-masked], [email-masked],
>>  [email-masked]
>> Date: Mon, 29 Jan 2024 14:41:02 +0200
>> From: Eli Zaretskii <[email-masked]>
>>
>> > From: Robert Pluim <[email-masked]>
>> > Cc: Eli Zaretskii <[email-masked]>,  [email-masked],
>> >   [email-masked],  [email-masked]
>> > Date: Mon, 29 Jan 2024 10:05:17 +0100
>> >
>> > >>>>> On Sun, 28 Jan 2024 08:47:49 +0100, Eshel Yaron <[email-masked]> said:
>> >
>> >     >> Robert, any comments?
>> >
>> > Not really. It would be nice if the test suite could be extended to
>> > catch this.
>>
>> Agreed.
>
> Eshel, would you like to add some tests for this?

Sure, I'm attaching below a patch with a slightly cleaner implementation
and a couple of tests.

Note that this is a complete rewrite of a function that mostly haven't
changed since 1997, so please give it a close look before installing, in
case there's some use case that didn't occur to me and isn't covered by
the existing tests.

Best,

Eshel

>From 1f39f91adc9883e66191457789577173639b7d69 Mon Sep 17 00:00:00 2001
From: Eshel Yaron <[email-masked]>
Date: Wed, 31 Jan 2024 21:37:18 +0100
Subject: [PATCH] ; Ensure 'thing-at-point-looking-at' finds full match

* lisp/thingatpt.el (thing-at-point-looking-at): Regexp-search from
the beginning forward, instead of the other way around.

* test/lisp/thingatpt-tests.el (thing-at-point-test-data): Add tests.

(Bug#68762)
---
 lisp/thingatpt.el            | 43 +++++++++++-------------------------
 test/lisp/thingatpt-tests.el |  2 ++
 2 files changed, 15 insertions(+), 30 deletions(-)

diff --git a/lisp/thingatpt.el b/lisp/thingatpt.el
index 323d3d1cf6c..b532bafff82 100644
--- a/lisp/thingatpt.el
+++ b/lisp/thingatpt.el
@@ -619,36 +619,19 @@ thing-at-point-looking-at
 
 Optional argument DISTANCE limits search for REGEXP forward and
 back from point."
-  (save-excursion
-    (let ((old-point (point))
-	  (forward-bound (and distance (+ (point) distance)))
-	  (backward-bound (and distance (- (point) distance)))
-	  match prev-pos new-pos)
-      (and (looking-at regexp)
-	   (>= (match-end 0) old-point)
-	   (setq match (point)))
-      ;; Search back repeatedly from end of next match.
-      ;; This may fail if next match ends before this match does.
-      (re-search-forward regexp forward-bound 'limit)
-      (setq prev-pos (point))
-      (while (and (setq new-pos (re-search-backward regexp backward-bound t))
-                  ;; Avoid inflooping with some regexps, such as "^",
-                  ;; matching which never moves point.
-                  (< new-pos prev-pos)
-		  (or (> (match-beginning 0) old-point)
-		      (and (looking-at regexp)	; Extend match-end past search start
-			   (>= (match-end 0) old-point)
-			   (setq match (point))))))
-      (if (not match) nil
-	(goto-char match)
-	;; Back up a char at a time in case search skipped
-	;; intermediate match straddling search start pos.
-	(while (and (not (bobp))
-		    (progn (backward-char 1) (looking-at regexp))
-		    (>= (match-end 0) old-point)
-		    (setq match (point))))
-	(goto-char match)
-	(looking-at regexp)))))
+  (let* ((old (point))
+         (beg (if distance (max (point-min) (- old distance)) (point-min)))
+         (end (and distance (min (point-max) (+ old distance))))
+         prev match)
+    (save-excursion
+      (goto-char beg)
+      (while (and (setq prev (point)
+                        match (re-search-forward regexp end t))
+                  (< (match-end 0) old))
+        ;; Avoid inflooping when `regexp' matches the empty string.
+        (unless (< prev (point)) (forward-char))))
+    (and match (<= (match-beginning 0) old (match-end 0)))))
+
 
 ;;   Email addresses
 (defvar thing-at-point-email-regexp
diff --git a/test/lisp/thingatpt-tests.el b/test/lisp/thingatpt-tests.el
index ba51f375cc6..56bc4fdc9dc 100644
--- a/test/lisp/thingatpt-tests.el
+++ b/test/lisp/thingatpt-tests.el
@@ -92,6 +92,8 @@ thing-at-point-test-data
     ("[email-masked]" 1 email "[email-masked]")
     ;; email addresses user portion containing dots
     ("[email-masked]" 1 email "[email-masked]")
+    ("[email-masked]" 5 email "[email-masked]")
+    ("  [email-masked]" 6 email "[email-masked]")
     ("[email-masked]" 1 email nil)
     ("[email-masked]" 2 email "[email-masked]")
     ;; email addresses domain portion containing dots and dashes
-- 
2.42.0