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:
parent
e56e9c1954
commit
e5ba52ad72
3 changed files with 43 additions and 12 deletions
5
etc/NEWS
5
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
|
||||
|
||||
+++
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue