From 7b850af19e73b7a72d12f96587e4b703f8862ec4 Mon Sep 17 00:00:00 2001 From: Jim Porter Date: Wed, 25 Oct 2023 15:24:28 -0700 Subject: [PATCH] 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. --- etc/NEWS | 5 ++++ lisp/progmodes/bug-reference.el | 34 ++++++++++++++-------- test/lisp/progmodes/bug-reference-tests.el | 15 ++++++++++ 3 files changed, 42 insertions(+), 12 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index 94bcb75835b..a7f8eca3e1c 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..a76f78ad69d 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,30 @@ bug-reference--run-auto-setup (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 () + (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 +696,7 @@ bug-reference-mode-force-auto-setup (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-gitea-entry (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 -- 2.25.1