master 77ece5709a1 2/2: Support text overlays for thingatpt provider helpers

[Jim Porter]

branch: master
commit 77ece5709a1d38df8cec33432e77044c308b1d6b
Author: Jim Porter <jporterbugs@gmail.com>
Commit: Jim Porter <jporterbugs@gmail.com>

    Support text overlays for thingatpt provider helpers
    
    * lisp/thingatpt.el (thing-at-point-for-text-property)
    (forward-thing-for-text-property)
    (bounds-of-thing-at-point-for-text-property): Rename to...
    (thing-at-point-for-char-property)
    (forward-thing-for-char-property)
    (bounds-of-thing-at-point-for-char-property): ... and add overlay
    support.  Update callers.
    
    * test/lisp/thingatpt-tests.el (thing-at-point-providers)
    (forward-thing-providers, bounds-of-thing-at-point-providers): Test
    overlays too.
    
    * test/lisp/progmodes/bug-reference-tests.el (test-thing-at-point): Test
    'bounds-of-thing-at-point' and 'forward-point'.
    
    * etc/NEWS: Update function names in announcement.
---
 etc/NEWS                                   |  6 ++--
 lisp/net/eww.el                            |  6 ++--
 lisp/progmodes/bug-reference.el            |  6 ++--
 lisp/thingatpt.el                          | 50 +++++++++++++++++-------------
 test/lisp/progmodes/bug-reference-tests.el |  5 ++-
 test/lisp/thingatpt-tests.el               | 30 +++++++++---------
 6 files changed, 57 insertions(+), 46 deletions(-)

diff --git a/etc/NEWS b/etc/NEWS
index 4e52d4dccb2..d72ef5b5bef 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -1745,9 +1745,9 @@ of 'bounds-of-thing-at-point' and 'forward-thing', 
respectively.
 
 ---
 *** New helper functions for text property-based thingatpt providers.
-The new helper functions 'thing-at-point-for-text-property',
-'bounds-of-thing-at-point-for-text-property', and
-'forward-thing-for-text-property' can help to help implement custom
+The new helper functions 'thing-at-point-for-char-property',
+'bounds-of-thing-at-point-for-char-property', and
+'forward-thing-for-char-property' can help to help implement custom
 thingatpt providers for "things" that are defined by a text property.
 
 ---
diff --git a/lisp/net/eww.el b/lisp/net/eww.el
index be43ac2f9db..32e24f9e2e5 100644
--- a/lisp/net/eww.el
+++ b/lisp/net/eww.el
@@ -1380,15 +1380,15 @@ within text input fields."
 
 (defun eww--url-at-point ()
   "`thing-at-point' provider function."
-  (thing-at-point-for-text-property 'shr-url))
+  (thing-at-point-for-char-property 'shr-url))
 
 (defun eww--forward-url (backward)
   "`forward-thing' provider function."
-  (forward-thing-for-text-property 'shr-url backward))
+  (forward-thing-for-char-property 'shr-url backward))
 
 (defun eww--bounds-of-url-at-point ()
   "`bounds-of-thing-at-point' provider function."
-  (bounds-of-thing-at-point-for-text-property 'shr-url))
+  (bounds-of-thing-at-point-for-char-property 'shr-url))
 
 ;;;###autoload
 (defun eww-browse-url (url &optional new-window)
diff --git a/lisp/progmodes/bug-reference.el b/lisp/progmodes/bug-reference.el
index 9b8e5c0b106..46163774e47 100644
--- a/lisp/progmodes/bug-reference.el
+++ b/lisp/progmodes/bug-reference.el
@@ -658,15 +658,15 @@ have been run, the auto-setup is inhibited.")
 
 (defun bug-reference--url-at-point ()
   "`thing-at-point' provider function."
-  (thing-at-point-for-text-property 'bug-reference-url))
+  (thing-at-point-for-char-property 'bug-reference-url))
 
 (defun bug-reference--forward-url (backward)
   "`forward-thing' provider function."
-  (forward-thing-for-text-property 'bug-reference-url backward))
+  (forward-thing-for-char-property 'bug-reference-url backward))
 
 (defun bug-reference--bounds-of-url-at-point ()
   "`bounds-of-thing-at-point' provider function."
-  (bounds-of-thing-at-point-for-text-property 'bug-reference-url))
+  (bounds-of-thing-at-point-for-char-property 'bug-reference-url))
 
 (defun bug-reference--init (enable)
   (if enable
diff --git a/lisp/thingatpt.el b/lisp/thingatpt.el
index ff0ed66d62d..fe9f5003f0b 100644
--- a/lisp/thingatpt.el
+++ b/lisp/thingatpt.el
@@ -828,40 +828,48 @@ treated as white space."
 
 ;; Provider helper functions
 
-(defun thing-at-point-for-text-property (property)
+(defun thing-at-point-for-char-property (property)
   "Return the \"thing\" at point.
-Each \"thing\" is a region of text with the specified text PROPERTY set."
-  (or (get-text-property (point) property)
+Each \"thing\" is a region of text with the specified text PROPERTY (or
+overlay) set."
+  (or (get-char-property (point) property)
       (and (> (point) (point-min))
-           (get-text-property (1- (point)) property))))
+           (get-char-property (1- (point)) property))))
 
 (autoload 'text-property-search-forward "text-property-search")
 (autoload 'text-property-search-backward "text-property-search")
 (autoload 'prop-match-beginning "text-property-search")
 (autoload 'prop-match-end "text-property-search")
 
-(defun forward-thing-for-text-property (property &optional backward)
+(defun forward-thing-for-char-property (property &optional backward)
   "Move forward to the end of the next \"thing\".
 If BACKWARD is non-nil, move backward to the beginning of the previous
 \"thing\" instead.  Each \"thing\" is a region of text with the
-specified text PROPERTY set."
-  (let ((search-func (if backward #'text-property-search-backward
-                       #'text-property-search-forward))
-        (pos-func (if backward #'prop-match-beginning #'prop-match-end)))
-    (when-let ((match (funcall search-func property)))
-      (goto-char (funcall pos-func match)))))
-
-(defun bounds-of-thing-at-point-for-text-property (property)
+specified text PROPERTY (or overlay) set."
+  (let ((bounds (bounds-of-thing-at-point-for-char-property property)))
+    (if backward
+        (if (and bounds (> (point) (car bounds)))
+            (goto-char (car bounds))
+          (goto-char (previous-single-char-property-change (point) property))
+          (unless (get-char-property (point) property)
+            (goto-char (previous-single-char-property-change
+                        (point) property))))
+      (if (and bounds (< (point) (cdr bounds)))
+          (goto-char (cdr bounds))
+        (unless (get-char-property (point) property)
+          (goto-char (next-single-char-property-change (point) property)))
+        (goto-char (next-single-char-property-change (point) property))))))
+
+(defun bounds-of-thing-at-point-for-char-property (property)
   "Determine the start and end buffer locations for the \"thing\" at point.
-The \"thing\" is a region of text with the specified text PROPERTY set."
+The \"thing\" is a region of text with the specified text PROPERTY (or
+overlay) set."
   (let ((pos (point)))
-    (when (or (get-text-property pos property)
+    (when (or (get-char-property pos property)
               (and (> pos (point-min))
-                   (get-text-property (setq pos (1- pos)) property)))
-      (cons (or (previous-single-property-change
-                 (min (1+ pos) (point-max)) property)
-                (point-min))
-            (or (next-single-property-change pos property)
-                (point-max))))))
+                   (get-char-property (setq pos (1- pos)) property)))
+      (cons (previous-single-char-property-change
+             (min (1+ pos) (point-max)) property)
+            (next-single-char-property-change pos property)))))
 
 ;;; thingatpt.el ends here
diff --git a/test/lisp/progmodes/bug-reference-tests.el 
b/test/lisp/progmodes/bug-reference-tests.el
index 8cca354705b..21b9d3c8ff3 100644
--- a/test/lisp/progmodes/bug-reference-tests.el
+++ b/test/lisp/progmodes/bug-reference-tests.el
@@ -136,8 +136,11 @@
     (goto-char (point-min))
     ;; Make sure we get the URL when `bug-reference-mode' is active...
     (should (equal (thing-at-point 'url) "https://debbugs.gnu.org/1234";))
+    (should (equal (bounds-of-thing-at-point 'url) '(1 . 9)))
+    (should (= (save-excursion (forward-thing 'url) (point)) 9))
     (bug-reference-mode -1)
     ;; ... and get nil when `bug-reference-mode' is inactive.
-    (should-not (thing-at-point 'url))))
+    (should-not (thing-at-point 'url))
+    (should-not (bounds-of-thing-at-point 'url))))
 
 ;;; bug-reference-tests.el ends here
diff --git a/test/lisp/thingatpt-tests.el b/test/lisp/thingatpt-tests.el
index c3b04f29ce5..cc51e3f5296 100644
--- a/test/lisp/thingatpt-tests.el
+++ b/test/lisp/thingatpt-tests.el
@@ -262,10 +262,10 @@ position to retrieve THING.")
   (with-temp-buffer
     (setq-local
      thing-at-point-provider-alist
-     `((url . ,(lambda () (thing-at-point-for-text-property 'foo-url)))
-       (url . ,(lambda () (thing-at-point-for-text-property 'bar-url)))))
-    (insert (propertize "hello" 'foo-url "foo.com") "\n"
-            (propertize "goodbye" 'bar-url "bar.com"))
+     `((url . ,(lambda () (thing-at-point-for-char-property 'foo-url)))
+       (url . ,(lambda () (thing-at-point-for-char-property 'bar-url)))))
+    (insert (propertize "hello" 'foo-url "foo.com") "\ngoodbye")
+    (overlay-put (make-overlay 7 14) 'bar-url "bar.com")
     (goto-char (point-min))
     ;; Get the URL using the first provider.
     (should (equal (thing-at-point 'url) "foo.com"))
@@ -280,10 +280,10 @@ position to retrieve THING.")
   (with-temp-buffer
     (setq-local
      forward-thing-provider-alist
-     `((url . ,(lambda (n) (forward-thing-for-text-property 'foo-url n)))
-       (url . ,(lambda (n) (forward-thing-for-text-property 'bar-url n)))))
-    (insert (propertize "hello" 'foo-url "foo.com") "there\n"
-            (propertize "goodbye" 'bar-url "bar.com"))
+     `((url . ,(lambda (n) (forward-thing-for-char-property 'foo-url n)))
+       (url . ,(lambda (n) (forward-thing-for-char-property 'bar-url n)))))
+    (insert (propertize "hello" 'foo-url "foo.com") "there\ngoodbye")
+    (overlay-put (make-overlay 12 19) 'bar-url "bar.com")
     (goto-char (point-min))
     (forward-thing 'url)                ; Move past the first URL.
     (should (= (point) 6))
@@ -301,11 +301,11 @@ position to retrieve THING.")
     (setq-local
      bounds-of-thing-at-point-provider-alist
      `((url . ,(lambda ()
-                 (bounds-of-thing-at-point-for-text-property 'foo-url)))
+                 (bounds-of-thing-at-point-for-char-property 'foo-url)))
        (url . ,(lambda ()
-                 (bounds-of-thing-at-point-for-text-property 'bar-url)))))
-    (insert (propertize "hello" 'foo-url "foo.com") "there\n"
-            (propertize "goodbye" 'bar-url "bar.com"))
+                 (bounds-of-thing-at-point-for-char-property 'bar-url)))))
+    (insert (propertize "hello" 'foo-url "foo.com") "there\ngoodbye")
+    (overlay-put (make-overlay 12 19) 'bar-url "bar.com")
     (goto-char (point-min))
     ;; Look for a URL, using the first provider above.
     (should (equal (bounds-of-thing-at-point 'url) '(1 . 6)))
@@ -325,11 +325,11 @@ position to retrieve THING.")
   (with-temp-buffer
     (setq-local
      thing-at-point-provider-alist
-     `((url . ,(lambda () (thing-at-point-for-text-property 'url))))
+     `((url . ,(lambda () (thing-at-point-for-char-property 'url))))
      forward-thing-provider-alist
-     `((url . ,(lambda (n) (forward-thing-for-text-property 'url n))))
+     `((url . ,(lambda (n) (forward-thing-for-char-property 'url n))))
      bounds-of-thing-at-point-provider-alist
-     `((url . ,(lambda () (bounds-of-thing-at-point-for-text-property 'url)))))
+     `((url . ,(lambda () (bounds-of-thing-at-point-for-char-property 'url)))))
     (insert (propertize "one" 'url "foo.com")
             (propertize "two" 'url "bar.com")
             (propertize "three" 'url "baz.com"))