1840ae8a18
Fixes gf (+lookup/file) on issue/PR references for Emacs 27.x users, for example: #1234 doom-emacs#1234 hlissner/doom-emacs#1234
100 lines
4.1 KiB
EmacsLisp
100 lines
4.1 KiB
EmacsLisp
;;; emacs/vc/autoload/bug-reference-backport.el -*- lexical-binding: t; -*-
|
|
;;;###if (not EMACS28+)
|
|
;; DEPRECATED Remove when Emacs 27.x support is dropped
|
|
|
|
;; In Emacs 28, the built-in bug-reference package started consulting vc for
|
|
;; repo information (to inform its bug reference URLs). This incredibly useful
|
|
;; feature is not available in 27.x yet, so I've backported it:
|
|
|
|
(defvar bug-reference-setup-from-vc-alist
|
|
`(;;
|
|
;; GNU projects on savannah.
|
|
;;
|
|
;; Not all of them use debbugs but that doesn't really matter
|
|
;; because the auto-setup is only performed if
|
|
;; `bug-reference-url-format' and `bug-reference-bug-regexp'
|
|
;; aren't set already.
|
|
("git\\.\\(?:sv\\|savannah\\)\\.gnu\\.org:"
|
|
"\\<\\([Bb]ug ?#?\\)\\([0-9]+\\(?:#[0-9]+\\)?\\)\\>"
|
|
,(lambda (_) "https://debbugs.gnu.org/%s"))
|
|
;;
|
|
;; GitHub projects.
|
|
;;
|
|
;; Here #17 may refer to either an issue or a pull request but
|
|
;; visiting the issue/17 web page will automatically redirect to
|
|
;; the pull/17 page if 17 is a PR. Explicit user/project#17 links
|
|
;; to possibly different projects are also supported.
|
|
("[/@]github.com[/:]\\([.A-Za-z0-9_/-]+\\)\\.git"
|
|
"\\([.A-Za-z0-9_/-]+\\)?\\(?:#\\)\\([0-9]+\\)\\>"
|
|
,(lambda (groups)
|
|
(let ((ns-project (nth 1 groups)))
|
|
(lambda ()
|
|
(concat "https://github.com/"
|
|
(or
|
|
;; Explicit user/proj#18 link.
|
|
(match-string 1)
|
|
ns-project)
|
|
"/issues/"
|
|
(match-string 2))))))
|
|
;;
|
|
;; GitLab projects.
|
|
;;
|
|
;; Here #18 is an issue and !17 is a merge request. Explicit
|
|
;; namespace/project#18 or namespace/project!17 references to
|
|
;; possibly different projects are also supported.
|
|
("[/@]gitlab.com[/:]\\([.A-Za-z0-9_/-]+\\)\\.git"
|
|
"\\(?1:[.A-Za-z0-9_/-]+\\)?\\(?3:[#!]\\)\\(?2:[0-9]+\\)\\>"
|
|
,(lambda (groups)
|
|
(let ((ns-project (nth 1 groups)))
|
|
(lambda ()
|
|
(concat "https://gitlab.com/"
|
|
(or (match-string 1)
|
|
ns-project)
|
|
"/-/"
|
|
(if (string= (match-string 3) "#")
|
|
"issues/"
|
|
"merge_requests/")
|
|
(match-string 2)))))))
|
|
"An alist for setting up `bug-reference-mode' based on VC URL.
|
|
|
|
Each element has the form (URL-REGEXP BUG-REGEXP URL-FORMAT-FN).
|
|
|
|
URL-REGEXP is matched against the version control URL of the
|
|
current buffer's file. If it matches, BUG-REGEXP is set as
|
|
`bug-reference-bug-regexp'. URL-FORMAT-FN is a function of one
|
|
argument that receives a list of the groups 0 to N of matching
|
|
URL-REGEXP against the VCS URL and returns the value to be set as
|
|
`bug-reference-url-format'.")
|
|
|
|
(defun bug-reference--maybe-setup-from-vc (url url-rx bug-rx bug-url-fmt)
|
|
(when (string-match url-rx url)
|
|
(setq-local bug-reference-bug-regexp bug-rx)
|
|
(setq-local bug-reference-url-format
|
|
(let (groups)
|
|
(dotimes (i (/ (length (match-data)) 2))
|
|
(push (match-string i url) groups))
|
|
(funcall bug-url-fmt (nreverse groups))))))
|
|
|
|
;;;###autoload
|
|
(defun bug-reference-try-setup-from-vc ()
|
|
"Try setting up `bug-reference-mode' based on VC information.
|
|
Test each configuration in `bug-reference-setup-from-vc-alist'
|
|
and apply it if applicable."
|
|
(when (require 'browse-at-remote nil t)
|
|
(when-let* ((remote (car (browse-at-remote--get-remotes)))
|
|
(url (browse-at-remote--get-remote-url remote)))
|
|
(catch 'found
|
|
(dolist (config bug-reference-setup-from-vc-alist)
|
|
(and (apply #'bug-reference--maybe-setup-from-vc
|
|
url config)
|
|
(throw 'found t)))))))
|
|
|
|
;;;###autoload
|
|
(add-hook! '(bug-reference-mode-hook
|
|
bug-reference-prog-mode-hook)
|
|
(defun +vc-init-bug-reference-from-vc-h ()
|
|
(when (or bug-reference-mode
|
|
bug-reference-prog-mode)
|
|
(unless (and bug-reference-bug-regexp
|
|
bug-reference-url-format)
|
|
(bug-reference-try-setup-from-vc)))))
|