Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
emacs
Project overview
Project overview
Details
Activity
Releases
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Issues
1
Issues
1
List
Boards
Labels
Service Desk
Milestones
Merge Requests
0
Merge Requests
0
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Operations
Operations
Incidents
Environments
Packages & Registries
Packages & Registries
Container Registry
Analytics
Analytics
CI / CD
Repository
Value Stream
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
emacs
emacs
Commits
ea43151b
Commit
ea43151b
authored
Jun 11, 2020
by
Tassilo Horn
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
bug-reference-setup
parent
d8a6d2e4
Pipeline
#5826
failed with stage
in 59 minutes and 36 seconds
Changes
2
Pipelines
1
Hide whitespace changes
Inline
Side-by-side
Showing
2 changed files
with
125 additions
and
4 deletions
+125
-4
lisp/progmodes/bug-reference.el
lisp/progmodes/bug-reference.el
+120
-2
lisp/vc/vc.el
lisp/vc/vc.el
+5
-2
No files found.
lisp/progmodes/bug-reference.el
View file @
ea43151b
...
...
@@ -60,6 +60,7 @@ If you set it to a symbol in the file Local Variables section,
you need to add a `bug-reference-url-format' property to it:
\(put \\='my-bug-reference-url-format \\='bug-reference-url-format t)
so that it is considered safe, see `enable-local-variables'."
)
(
make-variable-buffer-local
'bug-reference-url-format
)
;;;###autoload
(
put
'bug-reference-url-format
'safe-local-variable
...
...
@@ -75,6 +76,7 @@ The second subexpression should match the bug reference (usually a number)."
:type
'regexp
:version
"24.3"
; previously defconst
:group
'bug-reference
)
(
make-variable-buffer-local
'bug-reference-bug-regexp
)
;;;###autoload
(
put
'bug-reference-bug-regexp
'safe-local-variable
'stringp
)
...
...
@@ -139,6 +141,122 @@ The second subexpression should match the bug reference (usually a number)."
(
when
url
(
browse-url
url
))))))
(
defcustom
bug-reference-setup-functions
nil
"A list of function for setting up bug-reference mode.
A setup function should return non-nil if it set
`bug-reference-bug-regexp' and `bug-reference-url-format'
appropiately for the current buffer. The functions are called in
sequence stopping as soon as one signalled a successful setup.
Also see `bug-reference-default-setup-functions'.
The `bug-reference-setup-functions' take preference over
`bug-reference-default-setup-functions', i.e., they are
called before the latter."
:type
'
(
list
function
)
:version
"28.1"
:group
'bug-reference
)
(
defun
bug-reference-try-setup-from-vc
()
"Try setting up `bug-reference-bug-regexp' and
`bug-reference-url-format' from the version control system of the
current file."
(
when
(
buffer-file-name
)
(
let*
((
backend
(
vc-responsible-backend
(
buffer-file-name
)
t
))
(
url
(
pcase
backend
(
'Git
(
string-trim
(
shell-command-to-string
"git ls-remote --get-url"
))))))
(
cl-flet
((
maybe-set
(
url-rx
bug-rx
bug-url-fmt
)
(
when
(
string-match
url-rx
url
)
(
setq
bug-reference-bug-regexp
bug-rx
)
(
setq
bug-reference-url-format
(
if
(
functionp
bug-url-fmt
)
(
funcall
bug-url-fmt
)
bug-url-fmt
)))))
(
when
(
and
url
;; If there's a space in the url, it's propably an
;; error message.
(
not
(
string-match-p
"[[:space:]]"
url
)))
(
or
;; GNU projects on savannah. FIXME: Only a fraction of
;; them uses debbugs.
(
maybe-set
"git\\.\\(sv\\|savannah\\)\\.gnu\\.org:"
"\\([Bb]ug ?#?\\)\\([0-9]+\\(?:#[0-9]+\\)?\\)"
"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. TODO: Support user/project#17 references linking
;; to possibly different than the current project.
(
maybe-set
"[/@]github.com[/:]\\([.A-Za-z0-9_/-]+\\)\\.git"
"\\(#\\)\\([0-9]+\\)"
(
lambda
()
(
concat
"https://github.com/"
(
match-string
1
url
)
"/issues/%s"
)))
;; GitLab projects.
(
maybe-set
"[/@]gitlab.com[/:]\\([.A-Za-z0-9_/-]+\\)\\.git"
"\\(#\\|!\\)\\([0-9]+\\)"
(
lambda
()
(
let
((
user-project
(
match-string
1
url
)))
(
lambda
()
(
concat
"https://gitlab.com/"
user-project
"/-/"
(
if
(
string=
(
match-string
1
)
"#"
)
"issues/"
"merge_requests/"
)
(
match-string
2
))))))))))))
(
defun
bug-reference-try-setup-from-gnus
()
(
when
(
and
(
memq
major-mode
'
(
gnus-summary-mode
gnus-article-mode
))
(
boundp
'gnus-newsgroup-name
)
gnus-newsgroup-name
)
(
let
((
debbugs-regexp
;; TODO: Obviously there are more, so add them.
(
regexp-opt
'
(
"emacs"
"auctex"
"reftex"
"-devel@gnu.org"
"ding@gnus.org"
))))
(
when
(
or
(
string-match-p
debbugs-regexp
gnus-newsgroup-name
)
(
and
gnus-article-buffer
(
with-current-buffer
gnus-article-buffer
(
let
((
headers
(
mail-header-extract
)))
(
when
headers
(
or
(
string-match-p
debbugs-regexp
(
or
(
mail-header
'from
headers
)
""
))
(
string-match-p
debbugs-regexp
(
or
(
mail-header
'to
headers
)
""
))
(
string-match-p
debbugs-regexp
(
or
(
mail-header
'cc
headers
)
""
))))))))
(
setq
bug-reference-bug-regexp
"\\([Bb]ug ?#?\\)\\([0-9]+\\(?:#[0-9]+\\)?\\)"
)
(
setq
bug-reference-url-format
"https://debbugs.gnu.org/%s"
)))))
;;;###autoload
(
defvar
bug-reference-default-setup-functions
(
list
#'
bug-reference-try-setup-from-vc
#'
bug-reference-try-setup-from-gnus
)
"Like `bug-reference-setup-functions' for packages to hook in."
)
(
defun
bug-reference--init
()
"Initialize `bug-reference-mode'."
(
progn
(
or
(
with-demoted-errors
"Error while running bug-reference-setup-functions: %S"
(
run-hook-with-args-until-success
'bug-reference-setup-functions
))
(
with-demoted-errors
"Error while running bug-reference-default-setup-functions: %S"
(
run-hook-with-args-until-success
'bug-reference-default-setup-functions
)))
(
jit-lock-register
#'
bug-reference-fontify
)))
;;;###autoload
(
define-minor-mode
bug-reference-mode
"Toggle hyperlinking bug references in the buffer (Bug Reference mode)."
...
...
@@ -146,7 +264,7 @@ The second subexpression should match the bug reference (usually a number)."
""
nil
(
if
bug-reference-mode
(
jit-lock-register
#'
bug-reference-fontify
)
(
bug-reference--init
)
(
jit-lock-unregister
#'
bug-reference-fontify
)
(
save-restriction
(
widen
)
...
...
@@ -159,7 +277,7 @@ The second subexpression should match the bug reference (usually a number)."
""
nil
(
if
bug-reference-prog-mode
(
jit-lock-register
#'
bug-reference-fontify
)
(
bug-reference--init
)
(
jit-lock-unregister
#'
bug-reference-fontify
)
(
save-restriction
(
widen
)
...
...
lisp/vc/vc.el
View file @
ea43151b
...
...
@@ -957,7 +957,7 @@ use."
(
throw
'found
bk
))))
;;;###autoload
(
defun
vc-responsible-backend
(
file
)
(
defun
vc-responsible-backend
(
file
&optional
no-error
)
"Return the name of a backend system that is responsible for FILE.
If FILE is already registered, return the
...
...
@@ -967,7 +967,10 @@ responsible for FILE is returned.
Note that if FILE is a symbolic link, it will not be resolved --
the responsible backend system for the symbolic link itself will
be reported."
be reported.
If NO-ERROR is nil, signal an error that no VC backend is
responsible for the given file."
(
or
(
and
(
not
(
file-directory-p
file
))
(
vc-backend
file
))
(
catch
'found
;; First try: find a responsible backend. If this is for registration,
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment