aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorJim Porter2023-10-25 15:24:28 -0700
committerJim Porter2023-11-11 21:40:12 -0800
commite5ba52ad72d0e44b905d6dc321f1e6234491df53 (patch)
tree2e8941200b05939fce5b7f123d502ffde8693000
parente56e9c19545f43c35dec85fa650f3799c6e9c308 (diff)
downloademacs-e5ba52ad72d0e44b905d6dc321f1e6234491df53.tar.gz
emacs-e5ba52ad72d0e44b905d6dc321f1e6234491df53.zip
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).
-rw-r--r--etc/NEWS5
-rw-r--r--lisp/progmodes/bug-reference.el35
-rw-r--r--test/lisp/progmodes/bug-reference-tests.el15
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
978previously assumed that they should be prefixed with "http://". Such 978previously assumed that they should be prefixed with "http://". Such
979URIs are now prefixed with "https://" instead. 979URIs are now prefixed with "https://" instead.
980 980
981---
982*** 'bug-reference-mode' now supports 'thing-at-point'.
983Now, calling '(thing-at-point 'url)' when point is on a bug reference
984will return the URL for that bug.
985
981** Customize 986** Customize
982 987
983+++ 988+++
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 @@
35 35
36;;; Code: 36;;; Code:
37 37
38(require 'thingatpt)
39
38(defgroup bug-reference nil 40(defgroup bug-reference nil
39 "Hyperlinking references to bug reports." 41 "Hyperlinking references to bug reports."
40 ;; Somewhat arbitrary, by analogy with eg goto-address. 42 ;; Somewhat arbitrary, by analogy with eg goto-address.
@@ -654,17 +656,31 @@ have been run, the auto-setup is inhibited.")
654 (run-hook-with-args-until-success 656 (run-hook-with-args-until-success
655 'bug-reference-auto-setup-functions))))) 657 'bug-reference-auto-setup-functions)))))
656 658
657;;;###autoload 659(defun bug-reference--url-at-point ()
658(define-minor-mode bug-reference-mode 660 "`thing-at-point' provider function."
659 "Toggle hyperlinking bug references in the buffer (Bug Reference mode)." 661 (get-char-property (point) 'bug-reference-url))
660 :after-hook (bug-reference--run-auto-setup) 662
661 (if bug-reference-mode 663(defun bug-reference--init (enable)
662 (jit-lock-register #'bug-reference-fontify) 664 (if enable
665 (progn
666 (jit-lock-register #'bug-reference-fontify)
667 (setq-local thing-at-point-provider-alist
668 (append thing-at-point-provider-alist
669 '((url . bug-reference--url-at-point)))))
663 (jit-lock-unregister #'bug-reference-fontify) 670 (jit-lock-unregister #'bug-reference-fontify)
671 (setq thing-at-point-provider-alist
672 (delete '((url . bug-reference--url-at-point))
673 thing-at-point-provider-alist))
664 (save-restriction 674 (save-restriction
665 (widen) 675 (widen)
666 (bug-reference-unfontify (point-min) (point-max))))) 676 (bug-reference-unfontify (point-min) (point-max)))))
667 677
678;;;###autoload
679(define-minor-mode bug-reference-mode
680 "Toggle hyperlinking bug references in the buffer (Bug Reference mode)."
681 :after-hook (bug-reference--run-auto-setup)
682 (bug-reference--init bug-reference-mode))
683
668(defun bug-reference-mode-force-auto-setup () 684(defun bug-reference-mode-force-auto-setup ()
669 "Enable `bug-reference-mode' and force auto-setup. 685 "Enable `bug-reference-mode' and force auto-setup.
670Enabling `bug-reference-mode' runs its auto-setup only if 686Enabling `bug-reference-mode' runs its auto-setup only if
@@ -681,12 +697,7 @@ same buffer is re-used for different contexts."
681(define-minor-mode bug-reference-prog-mode 697(define-minor-mode bug-reference-prog-mode
682 "Like `bug-reference-mode', but only buttonize in comments and strings." 698 "Like `bug-reference-mode', but only buttonize in comments and strings."
683 :after-hook (bug-reference--run-auto-setup) 699 :after-hook (bug-reference--run-auto-setup)
684 (if bug-reference-prog-mode 700 (bug-reference--init bug-reference-prog-mode))
685 (jit-lock-register #'bug-reference-fontify)
686 (jit-lock-unregister #'bug-reference-fontify)
687 (save-restriction
688 (widen)
689 (bug-reference-unfontify (point-min) (point-max)))))
690 701
691(provide 'bug-reference) 702(provide 'bug-reference)
692;;; bug-reference.el ends here 703;;; 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 @@
25 25
26(require 'bug-reference) 26(require 'bug-reference)
27(require 'ert) 27(require 'ert)
28(require 'ert-x)
28 29
29(defun test--get-github-entry (url) 30(defun test--get-github-entry (url)
30 (and (string-match 31 (and (string-match
@@ -125,4 +126,18 @@
125 (test--get-gitea-entry "https://gitea.com/magit/magit/") 126 (test--get-gitea-entry "https://gitea.com/magit/magit/")
126 "magit/magit"))) 127 "magit/magit")))
127 128
129(ert-deftest test-thing-at-point ()
130 "Ensure that (thing-at-point 'url) returns the bug URL."
131 (ert-with-test-buffer (:name "thingatpt")
132 (setq-local bug-reference-url-format "https://debbugs.gnu.org/%s")
133 (insert "bug#1234")
134 (bug-reference-mode)
135 (jit-lock-fontify-now (point-min) (point-max))
136 (goto-char (point-min))
137 ;; Make sure we get the URL when `bug-reference-mode' is active...
138 (should (equal (thing-at-point 'url) "https://debbugs.gnu.org/1234"))
139 (bug-reference-mode -1)
140 ;; ... and get nil when `bug-reference-mode' is inactive.
141 (should-not (thing-at-point 'url))))
142
128;;; bug-reference-tests.el ends here 143;;; bug-reference-tests.el ends here