From 1f39f91adc9883e66191457789577173639b7d69 Mon Sep 17 00:00:00 2001 From: Eshel Yaron 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 ("1@example.com" 1 email "1@example.com") ;; email addresses user portion containing dots ("foo.bar@example.com" 1 email "foo.bar@example.com") + ("foo.bar@example.com" 5 email "foo.bar@example.com") + (" fo.ba@example.com" 6 email "fo.ba@example.com") (".foobar@example.com" 1 email nil) (".foobar@example.com" 2 email "foobar@example.com") ;; email addresses domain portion containing dots and dashes -- 2.42.0