diff options
| author | Jim Porter | 2023-10-25 15:24:28 -0700 |
|---|---|---|
| committer | Jim Porter | 2023-11-11 21:40:12 -0800 |
| commit | e5ba52ad72d0e44b905d6dc321f1e6234491df53 (patch) | |
| tree | 2e8941200b05939fce5b7f123d502ffde8693000 | |
| parent | e56e9c19545f43c35dec85fa650f3799c6e9c308 (diff) | |
| download | emacs-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/NEWS | 5 | ||||
| -rw-r--r-- | lisp/progmodes/bug-reference.el | 35 | ||||
| -rw-r--r-- | test/lisp/progmodes/bug-reference-tests.el | 15 |
3 files changed, 43 insertions, 12 deletions
| @@ -978,6 +978,11 @@ For links in 'webjump-sites' without an explicit URI scheme, it was | |||
| 978 | previously assumed that they should be prefixed with "http://". Such | 978 | previously assumed that they should be prefixed with "http://". Such |
| 979 | URIs are now prefixed with "https://" instead. | 979 | URIs are now prefixed with "https://" instead. |
| 980 | 980 | ||
| 981 | --- | ||
| 982 | *** 'bug-reference-mode' now supports 'thing-at-point'. | ||
| 983 | Now, calling '(thing-at-point 'url)' when point is on a bug reference | ||
| 984 | will 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. |
| 670 | Enabling `bug-reference-mode' runs its auto-setup only if | 686 | Enabling `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 |