master e5ba52ad72d: Hook 'bug-reference-mode' up to 'thing-at-point'

[Jim Porter]

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

    Hook 'bug-reference-mode' up to 'thing-at-point'
    
    * lisp/progmodes/bug-reference.el (bug-reference--url-at-point): New
    function.
    (bug-reference-mode, bug-reference-prog-mode): Factor initialization
    code out to...
    (bug-reference--init): ... here.
    
    * test/lisp/progmodes/bug-reference-tests.el (test-thing-at-point):
    New test.
    
    * etc/NEWS: Announce this change (bug#66752).
---
 etc/NEWS                                   |  5 +++++
 lisp/progmodes/bug-reference.el            | 35 ++++++++++++++++++++----------
 test/lisp/progmodes/bug-reference-tests.el | 15 +++++++++++++
 3 files changed, 43 insertions(+), 12 deletions(-)

diff --git a/etc/NEWS b/etc/NEWS
index 767e4c27b43..8324eb7da1e 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -978,6 +978,11 @@ For links in 'webjump-sites' without an explicit URI 
scheme, it was
 previously assumed that they should be prefixed with "http://";.  Such
 URIs are now prefixed with "https://"; instead.
 
+---
+*** 'bug-reference-mode' now supports 'thing-at-point'.
+Now, calling '(thing-at-point 'url)' when point is on a bug reference
+will return the URL for that bug.
+
 ** Customize
 
 +++
diff --git a/lisp/progmodes/bug-reference.el b/lisp/progmodes/bug-reference.el
index bc280284588..3f6e1e68e5b 100644
--- a/lisp/progmodes/bug-reference.el
+++ b/lisp/progmodes/bug-reference.el
@@ -35,6 +35,8 @@
 
 ;;; Code:
 
+(require 'thingatpt)
+
 (defgroup bug-reference nil
   "Hyperlinking references to bug reports."
   ;; Somewhat arbitrary, by analogy with eg goto-address.
@@ -654,17 +656,31 @@ have been run, the auto-setup is inhibited.")
         (run-hook-with-args-until-success
          'bug-reference-auto-setup-functions)))))
 
-;;;###autoload
-(define-minor-mode bug-reference-mode
-  "Toggle hyperlinking bug references in the buffer (Bug Reference mode)."
-  :after-hook (bug-reference--run-auto-setup)
-  (if bug-reference-mode
-      (jit-lock-register #'bug-reference-fontify)
+(defun bug-reference--url-at-point ()
+  "`thing-at-point' provider function."
+  (get-char-property (point) 'bug-reference-url))
+
+(defun bug-reference--init (enable)
+  (if enable
+      (progn
+        (jit-lock-register #'bug-reference-fontify)
+        (setq-local thing-at-point-provider-alist
+                    (append thing-at-point-provider-alist
+                            '((url . bug-reference--url-at-point)))))
     (jit-lock-unregister #'bug-reference-fontify)
+    (setq thing-at-point-provider-alist
+          (delete '((url . bug-reference--url-at-point))
+                  thing-at-point-provider-alist))
     (save-restriction
       (widen)
       (bug-reference-unfontify (point-min) (point-max)))))
 
+;;;###autoload
+(define-minor-mode bug-reference-mode
+  "Toggle hyperlinking bug references in the buffer (Bug Reference mode)."
+  :after-hook (bug-reference--run-auto-setup)
+  (bug-reference--init bug-reference-mode))
+
 (defun bug-reference-mode-force-auto-setup ()
   "Enable `bug-reference-mode' and force auto-setup.
 Enabling `bug-reference-mode' runs its auto-setup only if
@@ -681,12 +697,7 @@ same buffer is re-used for different contexts."
 (define-minor-mode bug-reference-prog-mode
   "Like `bug-reference-mode', but only buttonize in comments and strings."
   :after-hook (bug-reference--run-auto-setup)
-  (if bug-reference-prog-mode
-      (jit-lock-register #'bug-reference-fontify)
-    (jit-lock-unregister #'bug-reference-fontify)
-    (save-restriction
-      (widen)
-      (bug-reference-unfontify (point-min) (point-max)))))
+  (bug-reference--init bug-reference-prog-mode))
 
 (provide 'bug-reference)
 ;;; bug-reference.el ends here
diff --git a/test/lisp/progmodes/bug-reference-tests.el 
b/test/lisp/progmodes/bug-reference-tests.el
index 790582aed4c..e5b207748bf 100644
--- a/test/lisp/progmodes/bug-reference-tests.el
+++ b/test/lisp/progmodes/bug-reference-tests.el
@@ -25,6 +25,7 @@
 
 (require 'bug-reference)
 (require 'ert)
+(require 'ert-x)
 
 (defun test--get-github-entry (url)
   (and (string-match
@@ -125,4 +126,18 @@
     (test--get-gitea-entry "https://gitea.com/magit/magit/";)
     "magit/magit")))
 
+(ert-deftest test-thing-at-point ()
+  "Ensure that (thing-at-point 'url) returns the bug URL."
+  (ert-with-test-buffer (:name "thingatpt")
+    (setq-local bug-reference-url-format "https://debbugs.gnu.org/%s";)
+    (insert "bug#1234")
+    (bug-reference-mode)
+    (jit-lock-fontify-now (point-min) (point-max))
+    (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";))
+    (bug-reference-mode -1)
+    ;; ... and get nil when `bug-reference-mode' is inactive.
+    (should-not (thing-at-point 'url))))
+
 ;;; bug-reference-tests.el ends here