1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2025-12-15 10:30:25 -08:00

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).
This commit is contained in:
Jim Porter 2023-10-25 15:24:28 -07:00
parent e56e9c1954
commit e5ba52ad72
3 changed files with 43 additions and 12 deletions

View file

@ -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
+++

View file

@ -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,16 +656,30 @@ have been run, the auto-setup is inhibited.")
(run-hook-with-args-until-success
'bug-reference-auto-setup-functions)))))
(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)
(if bug-reference-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-mode))
(defun bug-reference-mode-force-auto-setup ()
"Enable `bug-reference-mode' and force auto-setup.
@ -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

View file

@ -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