RFC: Automatic setup for bug-reference-mode

RFC: Automatic setup for bug-reference-mode

[Tassilo Horn]

Hi all,

I've been working on a feature to setup bug-reference-mode automatically
in common cases, i.e., make it guess the right
`bug-reference-url-format' and `bug-reference-bug-regexp' automatically
(if not already set).

Attach is my first attempt at doing so and I'd welcome comments.

What it achieves in the current state:

  - Setup according to VCS information
    - Only for Git at the moment (Is there a generic way to get the VCS
      URL?)
    - Project on savannah => setup GNU debbugs instance
    - GitHub: support #17 and namespace/project#17 links (both issues
      and PRs)
    - GitLab: support #17 issue links and !18 merge request including
      cross-project namespace/project#18 references.
  - Setup according to Gnus newsgroup, To, From, Cc
    - Probably too lax but works for setting our GNU debbugs instance
      for emacs-devel and other emacs-related mailing lists and
      newsgroups.

Bye,
Tassilo

--8<---------------cut here---------------start------------->8---
2 files changed, 142 insertions(+), 4 deletions(-)
lisp/progmodes/bug-reference.el | 139 +++++++++++++++++++++++++++++++++++++++-
lisp/vc/vc.el                   |   7 +-

modified   lisp/progmodes/bug-reference.el
@@ -60,6 +60,7 @@ bug-reference-url-format
 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 @@ bug-reference-bug-regexp
   :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,139 @@ bug-reference-push-button
 	(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.
+They are only called if the two variables aren't set already,
+e.g., by a local variables section.
+
+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.  Explicit user/project#17 links to possibly
+           ;; different projects are also supported.
+           (maybe-set
+            "[/@]github.com[/:]\\([.A-Za-z0-9_/-]+\\)\\.git"
+            "\\([.A-Za-z0-9_/-]+\\)?\\(?:#\\)\\([0-9]+\\)"
+            (lambda ()
+              (let ((ns-project (match-string 1 url)))
+                (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 references
+           ;; to possibly different projects are also supported.
+           (maybe-set
+            "[/@]gitlab.com[/:]\\([.A-Za-z0-9_/-]+\\)\\.git"
+            "\\(?1:[.A-Za-z0-9_/-]+\\)?\\(?3:#\\|!\\)\\(?2:[0-9]+\\)"
+            (lambda ()
+              (let ((ns-project (match-string 1 url)))
+                (lambda ()
+                  (concat "https://gitlab.com/"
+                          (or (match-string 1)
+                              ns-project)
+                          "/-/"
+                          (if (string= (match-string 3) "#")
+                              "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
+    ;; Automatic setup only if the variables aren't already set, e.g.,
+    ;; by a local variables section in the file.
+    (unless (and bug-reference-bug-regexp
+                 bug-reference-url-format)
+      (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 +281,7 @@ bug-reference-mode
   ""
   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 +294,7 @@ bug-reference-prog-mode
   ""
   nil
   (if bug-reference-prog-mode
-      (jit-lock-register #'bug-reference-fontify)
+      (bug-reference--init)
     (jit-lock-unregister #'bug-reference-fontify)
     (save-restriction
       (widen)
modified   lisp/vc/vc.el
@@ -957,7 +957,7 @@ vc-backend-for-registration
       (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 @@ vc-responsible-backend
 
 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,
--8<---------------cut here---------------end--------------->8---

Re: RFC: Automatic setup for bug-reference-mode

[Basil L. Contovounesios]

Tassilo Horn <tsdh@gnu.org> writes:

> Attach is my first attempt at doing so and I'd welcome comments.

Thanks, just some minor comments from me.

[...]

> modified   lisp/progmodes/bug-reference.el
> @@ -60,6 +60,7 @@ bug-reference-url-format
>  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)

Nit: You can use defvar-local instead.

>  ;;;###autoload
>  (put 'bug-reference-url-format 'safe-local-variable
> @@ -75,6 +76,7 @@ bug-reference-bug-regexp
>    :type 'regexp
>    :version "24.3"			; previously defconst
>    :group 'bug-reference)
> +(make-variable-buffer-local 'bug-reference-bug-regexp)

Nit: You can use ':local t' instead.

>  ;;;###autoload
>  (put 'bug-reference-bug-regexp 'safe-local-variable 'stringp)
> @@ -139,6 +141,139 @@ bug-reference-push-button
>  	(when url
>  	  (browse-url url))))))
>  
> +(defcustom bug-reference-setup-functions nil
> +  "A list of function for setting up bug-reference mode.

Nit: Either "Bug-Reference Mode" or "`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

"appropriately"

> +sequence stopping as soon as one signalled a successful setup.

The Emacs sources predominantly use the spelling "signaled".

> +They are only called if the two variables aren't set already,
> +e.g., by a local variables section.
> +
> +Also see `bug-reference-default-setup-functions'.
> +
> +The `bug-reference-setup-functions' take preference over

"take precedence"

> +`bug-reference-default-setup-functions', i.e., they are
> +called before the latter."
> +  :type '(list function)

Either 'hook or '(repeat 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."

Nit: Please follow the recommendation in "(elisp) Documentation Tips" of
fitting the first sentence on a single line.

> +  (when (buffer-file-name)
> +    (let* ((backend (vc-responsible-backend (buffer-file-name) t))

Nit: Any reason not to use the buffer-local variable buffer-file-name
instead?

> +           (url (pcase backend
> +                  ('Git (string-trim

This needs (eval-when-compile (require 'subr-x)).

> +                         (shell-command-to-string
> +                          "git ls-remote --get-url"))))))

Doesn't VC provide a robust way to get output from Git?

> +      (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:"
                                ^^^
Nit: Can this be a shy group?

> +                      "\\([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.  Explicit user/project#17 links to possibly
> +           ;; different projects are also supported.
> +           (maybe-set
> +            "[/@]github.com[/:]\\([.A-Za-z0-9_/-]+\\)\\.git"
> +            "\\([.A-Za-z0-9_/-]+\\)?\\(?:#\\)\\([0-9]+\\)"
                                       ^^^^^^^^^
Nit: Why is this in a group?

> +            (lambda ()
> +              (let ((ns-project (match-string 1 url)))
> +                (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 references
> +           ;; to possibly different projects are also supported.
> +           (maybe-set
> +            "[/@]gitlab.com[/:]\\([.A-Za-z0-9_/-]+\\)\\.git"
> +            "\\(?1:[.A-Za-z0-9_/-]+\\)?\\(?3:#\\|!\\)\\(?2:[0-9]+\\)"

Nit: Isn't this the same as "\\(?3:[!#]\\)"?

> +            (lambda ()
> +              (let ((ns-project (match-string 1 url)))
> +                (lambda ()
> +                  (concat "https://gitlab.com/"
> +                          (or (match-string 1)
> +                              ns-project)
> +                          "/-/"
> +                          (if (string= (match-string 3) "#")
> +                              "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)

  (and (derived-mode-p 'gnus-summary-mode 'gnus-article-mode)
       (bound-and-true-p gnus-newsgroup-name))

or

  (and (derived-mode-p 'gnus-mode)
       (bound-and-true-p gnus-newsgroup-name))

[...]

> +(defun bug-reference--init ()
> +  "Initialize `bug-reference-mode'."
> +  (progn

Nit: Isn't this progn redundant?

> +    ;; Automatic setup only if the variables aren't already set, e.g.,
> +    ;; by a local variables section in the file.
> +    (unless (and bug-reference-bug-regexp
> +                 bug-reference-url-format)
> +      (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
> -(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 @@ vc-responsible-backend
>  
>  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,

NO-ERROR seems to be a no-op in this patch.  Instead of changing the
function's arglist, would it be any worse to do the following?

  (ignore-errors (vc-responsible-backend ...))

Thanks,

-- 
Basil

Re: RFC: Automatic setup for bug-reference-mode

[Tassilo Horn]

"Basil L. Contovounesios" <contovob@tcd.ie> writes:

Hi Basil,

I'll incorporate your suggestions later.

>> +           (url (pcase backend
>> +                  ('Git (string-trim
>
> This needs (eval-when-compile (require 'subr-x)).

Or simply remove the "p" from "pcase", I guess.

>> +                         (shell-command-to-string
>> +                          "git ls-remote --get-url"))))))
>
> Doesn't VC provide a robust way to get output from Git?

vc-git--call maybe?

>> +      (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:"
>                                 ^^^
> Nit: Can this be a shy group?

Yes.  Is is generally better to use shy groups if we aren't going to do
anything with the groups anyway?

>>  ;;;###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 @@ vc-responsible-backend
>>  
>>  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,
>
> NO-ERROR seems to be a no-op in this patch.

Indeed.  Obviously it should have done what the docstring says.

> Instead of changing the function's arglist, would it be any worse to
> do the following?
>
>   (ignore-errors (vc-responsible-backend ...))

IMHO, that it errors if no backend is found is the actual error but we
cannot change that anymore.  And to me "what backend would this file
use" is a very common question.  Even vc.el itself encodes that (dolist
(backend vc-handled-backends) ...) form again in
`vc-backend-for-registration' in order not to trigger the error
semantics of `vc-responsible-backend'.

But that's not important to me.  I can also leave it as it is.

Bye,
Tassilo

PS: I like your style of suggesting improvements using questions which
all have a positive answer.  Did you visit a lecture of Stefan? ;-)

Re: RFC: Automatic setup for bug-reference-mode

[Basil L. Contovounesios]

Tassilo Horn <tsdh@gnu.org> writes:

> "Basil L. Contovounesios" <contovob@tcd.ie> writes:
>
>>> +           (url (pcase backend
>>> +                  ('Git (string-trim
>>
>> This needs (eval-when-compile (require 'subr-x)).
>
> Or simply remove the "p" from "pcase", I guess.

I was referring to your use of string-trim.

>>> +                         (shell-command-to-string
>>> +                          "git ls-remote --get-url"))))))
>>
>> Doesn't VC provide a robust way to get output from Git?
>
> vc-git--call maybe?

Perhaps; I'm not that familiar with VC.

>>> +      (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:"
>>                                 ^^^
>> Nit: Can this be a shy group?
>
> Yes.  Is is generally better to use shy groups if we aren't going to do
> anything with the groups anyway?

Yes, for the negligible potential performance gain, so that there's one
less group number taken, and more importantly so the reader isn't left
wondering why we're capturing this.

Personally, I often just go with what rx does, either by writing rx
forms directly or by manually copying its expansion into the program, as
that way I'm less likely to make a mistake.

>>>  ;;;###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 @@ vc-responsible-backend
>>>  
>>>  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,
>>
>> NO-ERROR seems to be a no-op in this patch.
>
> Indeed.  Obviously it should have done what the docstring says.
>
>> Instead of changing the function's arglist, would it be any worse to
>> do the following?
>>
>>   (ignore-errors (vc-responsible-backend ...))
>
> IMHO, that it errors if no backend is found is the actual error but we
> cannot change that anymore.  And to me "what backend would this file
> use" is a very common question.  Even vc.el itself encodes that (dolist
> (backend vc-handled-backends) ...) form again in
> `vc-backend-for-registration' in order not to trigger the error
> semantics of `vc-responsible-backend'.
>
> But that's not important to me.  I can also leave it as it is.

FWIW I'm happy with the optional argument you suggest.

> PS: I like your style of suggesting improvements using questions which
> all have a positive answer.  Did you visit a lecture of Stefan? ;-)

No, but I wish. ;)

Thanks,

-- 
Basil

Re: RFC: Automatic setup for bug-reference-mode

[Stefan Monnier]

> +(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.
> +They are only called if the two variables aren't set already,
> +e.g., by a local variables section.
> +
> +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)

The :group is redundant ;-)

More importantly, I'm wondering what was your motivation for introducing
two hooks (`bug-reference-setup-functions` and
`bug-reference-default-setup-functions`).  Maybe that should be
explained in a comment?

> +    (let* ((backend (vc-responsible-backend (buffer-file-name) t))
> +           (url (pcase backend
> +                  ('Git (string-trim
> +                         (shell-command-to-string
> +                          "git ls-remote --get-url"))))))

This should be moved to a new VC function.
Along the way I expect some related problems will be fixed such as:
- Unneeded forking of a shell only to immediately fork git.
- Hardcoding "git" when we have `vc-git-command`.

> +      (cl-flet ((maybe-set (url-rx bug-rx bug-url-fmt)
> +                           (when (string-match url-rx url)

This is mis-indented.  It's not your fault, but I recommend you override
the auto-indentation :-(

> +                             (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.  Explicit user/project#17 links to possibly
> +           ;; different projects are also supported.
> +           (maybe-set
> +            "[/@]github.com[/:]\\([.A-Za-z0-9_/-]+\\)\\.git"
> +            "\\([.A-Za-z0-9_/-]+\\)?\\(?:#\\)\\([0-9]+\\)"
> +            (lambda ()
> +              (let ((ns-project (match-string 1 url)))
> +                (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 references
> +           ;; to possibly different projects are also supported.
> +           (maybe-set
> +            "[/@]gitlab.com[/:]\\([.A-Za-z0-9_/-]+\\)\\.git"
> +            "\\(?1:[.A-Za-z0-9_/-]+\\)?\\(?3:#\\|!\\)\\(?2:[0-9]+\\)"
> +            (lambda ()
> +              (let ((ns-project (match-string 1 url)))
> +                (lambda ()
> +                  (concat "https://gitlab.com/"
> +                          (or (match-string 1)
> +                              ns-project)
> +                          "/-/"
> +                          (if (string= (match-string 3) "#")
> +                              "issues/"
> +                            "merge_requests/")
> +                          (match-string 2))))))))))))

Do we really need those functions returning functions?  Wouldn't it work
just as well if we do just `(setq bug-reference-url-format bug-url-fmt)`
and drop the outer `(lambda ()`?

More importantly, I think it would be even much nicer to make this into
a list of

    (URL-RX BUG-RX BUG-URL-FORMAT)

So users can easily add their own entries for other repository-repositories.

> +(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")))))

Same here: using a list to make it easy for users to add their own
mailing lists.

> +;;;###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.")

Why autoloaded?

> @@ -146,7 +281,7 @@ bug-reference-mode
>    ""
>    nil
>    (if bug-reference-mode
> -      (jit-lock-register #'bug-reference-fontify)
> +      (bug-reference--init)
>      (jit-lock-unregister #'bug-reference-fontify)
>      (save-restriction
>        (widen)

FWIW, I'd rather keep the `jit-lock-register` call next to its
matching `jit-lock-unregister`.  So if we move it to
`bug-reference--init`, we should probably move the `jit-lock-unregister`
to a matching `bug-reference--uninit`.

> modified   lisp/vc/vc.el
> @@ -957,7 +957,7 @@ vc-backend-for-registration
>        (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 @@ vc-responsible-backend
>  
>  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,
> --8<---------------cut here---------------end--------------->8---

Looks like a spurious hunk got into your patch ;-)


        Stefan

Re: RFC: Automatic setup for bug-reference-mode

[Tassilo Horn]

Stefan Monnier <monnier@iro.umontreal.ca> writes:

Hi Stefan,

>> +(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.
>> +They are only called if the two variables aren't set already,
>> +e.g., by a local variables section.
>> +
>> +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)
>
> The :group is redundant ;-)
>
> More importantly, I'm wondering what was your motivation for
> introducing two hooks (`bug-reference-setup-functions` and
> `bug-reference-default-setup-functions`).  Maybe that should be
> explained in a comment?

The docstring of bug-reference-default-setup-functions says:

  Like `bug-reference-setup-functions' for packages to hook in.

So the defcustom is for users and the default setup functions for
packages to add their own functions. But given that no such setup
function will be trivial, we can probably drop the defcustom...

>> +    (let* ((backend (vc-responsible-backend (buffer-file-name) t))
>> +           (url (pcase backend
>> +                  ('Git (string-trim
>> +                         (shell-command-to-string
>> +                          "git ls-remote --get-url"))))))
>
> This should be moved to a new VC function.
> Along the way I expect some related problems will be fixed such as:
> - Unneeded forking of a shell only to immediately fork git.
> - Hardcoding "git" when we have `vc-git-command`.

Sounds right.  I'll do that first and then come back to bug-reference.el
later...

>> +      (cl-flet ((maybe-set (url-rx bug-rx bug-url-fmt)
>> +                           (when (string-match url-rx url)
>
> This is mis-indented.  It's not your fault, but I recommend you
> override the auto-indentation :-(

That would be a hassle for aggressive-indent-mode users (like me).

>> +           ;; GitLab projects.  Here #18 is an issue and !17 is a
>> +           ;; merge request.  Explicit namespace/project#18 references
>> +           ;; to possibly different projects are also supported.
>> +           (maybe-set
>> +            "[/@]gitlab.com[/:]\\([.A-Za-z0-9_/-]+\\)\\.git"
>> +            "\\(?1:[.A-Za-z0-9_/-]+\\)?\\(?3:#\\|!\\)\\(?2:[0-9]+\\)"
>> +            (lambda ()
>> +              (let ((ns-project (match-string 1 url)))
>> +                (lambda ()
>> +                  (concat "https://gitlab.com/"
>> +                          (or (match-string 1)
>> +                              ns-project)
>> +                          "/-/"
>> +                          (if (string= (match-string 3) "#")
>> +                              "issues/"
>> +                            "merge_requests/")
>> +                          (match-string 2))))))))))))
>
> Do we really need those functions returning functions?  Wouldn't it
> work just as well if we do just `(setq bug-reference-url-format
> bug-url-fmt)` and drop the outer `(lambda ()`?

I don't think so.  The outer lambda is evaluated by maybe-set and
extracts the default namespace/project part from the repository URL.
That will be used as a fallback in the inner lambda which is evaluated
when following a bug reference #17 whereas it'll be ignored when the
namespace/project is already included in the bug reference, e.g.,
namespace/project#17.

> More importantly, I think it would be even much nicer to make this
> into a list of
>
>     (URL-RX BUG-RX BUG-URL-FORMAT)
>
> So users can easily add their own entries for other
> repository-repositories.

I agree that would be nice.

>> +(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")))))
>
> Same here: using a list to make it easy for users to add their own
> mailing lists.

Right.

>> +;;;###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.")
>
> Why autoloaded?

So that packages can add their function to that list.

>> @@ -146,7 +281,7 @@ bug-reference-mode
>>    ""
>>    nil
>>    (if bug-reference-mode
>> -      (jit-lock-register #'bug-reference-fontify)
>> +      (bug-reference--init)
>>      (jit-lock-unregister #'bug-reference-fontify)
>>      (save-restriction
>>        (widen)
>
> FWIW, I'd rather keep the `jit-lock-register` call next to its
> matching `jit-lock-unregister`.  So if we move it to
> `bug-reference--init`, we should probably move the
> `jit-lock-unregister` to a matching `bug-reference--uninit`.

Ok with me.

>> modified   lisp/vc/vc.el
>> @@ -957,7 +957,7 @@ vc-backend-for-registration
>>        (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 @@ vc-responsible-backend
>>  
>>  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,
>> --8<---------------cut here---------------end--------------->8---
>
> Looks like a spurious hunk got into your patch ;-)

Yes, indeed.  :-)

Bye,
Tassilo

Re: RFC: Automatic setup for bug-reference-mode

[Tassilo Horn]

[-- Attachment #1: Type: text/plain, Size: 506 bytes --]

Tassilo Horn <tsdh@gnu.org> writes:

>>> +    (let* ((backend (vc-responsible-backend (buffer-file-name) t))
>>> +           (url (pcase backend
>>> +                  ('Git (string-trim
>>> +                         (shell-command-to-string
>>> +                          "git ls-remote --get-url"))))))
>>
>> This should be moved to a new VC function.

Ok, I have implemented a new repository-url VC command for all VC
systems I have installed and were able to test: Git, Hg, Bzr, and SVN.
Looks right?


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-New-VC-command-repository-url.patch --]
[-- Type: text/x-patch, Size: 3788 bytes --]

From f117a8517dc32330aa9ed32f531b68daba2d7b62 Mon Sep 17 00:00:00 2001
From: Tassilo Horn <tsdh@gnu.org>
Date: Sun, 14 Jun 2020 18:24:14 +0200
Subject: [PATCH] New VC command repository-url

---
 lisp/vc/vc-bzr.el | 8 ++++++++
 lisp/vc/vc-git.el | 7 +++++++
 lisp/vc/vc-hg.el  | 7 +++++++
 lisp/vc/vc-svn.el | 9 ++++++++-
 lisp/vc/vc.el     | 4 ++++
 5 files changed, 34 insertions(+), 1 deletion(-)

diff --git a/lisp/vc/vc-bzr.el b/lisp/vc/vc-bzr.el
index e5d307e7ed..504d3dcdda 100644
--- a/lisp/vc/vc-bzr.el
+++ b/lisp/vc/vc-bzr.el
@@ -1316,6 +1316,14 @@ vc-bzr-revision-completion-table
                                              vc-bzr-revision-keywords))
                             string pred)))))
 
+(defun vc-bzr-repository-url (file-or-dir)
+  (let ((default-directory (vc-bzr-root file-or-dir)))
+    (with-temp-buffer
+      (vc-bzr-command "info" (current-buffer) nil nil)
+      (goto-char (point-min))
+      (when (re-search-forward "parent branch: \\(.*\\)$")
+        (match-string 1)))))
+
 (provide 'vc-bzr)
 
 ;;; vc-bzr.el ends here
diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el
index dcb5228265..8c9feb0e9d 100644
--- a/lisp/vc/vc-git.el
+++ b/lisp/vc/vc-git.el
@@ -101,6 +101,7 @@
 ;; - rename-file (old new)                         OK
 ;; - find-file-hook ()                             OK
 ;; - conflicted-files                              OK
+;; - repository-url (file-or-dir)                  OK
 
 ;;; Code:
 
@@ -1082,6 +1083,12 @@ vc-git-conflicted-files
                                 "DU" "AA" "UU"))
             (push (expand-file-name file directory) files)))))))
 
+(defun vc-git-repository-url (file-or-dir)
+  (let ((default-directory (vc-git-root file-or-dir)))
+    (with-temp-buffer
+      (vc-git--call (current-buffer) "ls-remote" "--get-url")
+      (buffer-substring-no-properties (point-min) (1- (point-max))))))
+
 ;; Everywhere but here, follows vc-git-command, which uses vc-do-command
 ;; from vc-dispatcher.
 (autoload 'vc-resynch-buffer "vc-dispatcher")
diff --git a/lisp/vc/vc-hg.el b/lisp/vc/vc-hg.el
index 40d7573806..b5cdf5a3a2 100644
--- a/lisp/vc/vc-hg.el
+++ b/lisp/vc/vc-hg.el
@@ -1525,6 +1525,13 @@ vc-hg-command
 (defun vc-hg-root (file)
   (vc-find-root file ".hg"))
 
+(defun vc-hg-repository-url (file-or-dir)
+  (let ((default-directory (vc-hg-root file-or-dir)))
+    (with-temp-buffer
+      (vc-hg-command (current-buffer) nil nil
+                     "config" "paths.default")
+      (buffer-substring-no-properties (point-min) (1- (point-max))))))
+
 (provide 'vc-hg)
 
 ;;; vc-hg.el ends here
diff --git a/lisp/vc/vc-svn.el b/lisp/vc/vc-svn.el
index d039bf3c6a..c439082390 100644
--- a/lisp/vc/vc-svn.el
+++ b/lisp/vc/vc-svn.el
@@ -816,7 +816,14 @@ vc-svn-revision-table
           (push (match-string 1 loglines) vc-svn-revisions)
           (setq start (+ start (match-end 0)))
           (setq loglines (buffer-substring-no-properties start (point-max)))))
-    vc-svn-revisions)))
+      vc-svn-revisions)))
+
+(defun vc-svn-repository-url (file-or-dir)
+  (let ((default-directory (vc-svn-root file-or-dir)))
+    (with-temp-buffer
+      (vc-svn-command (current-buffer) nil nil
+                      "info" "--show-item" "repos-root-url")
+      (buffer-substring-no-properties (point-min) (1- (point-max))))))
 
 (provide 'vc-svn)
 
diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el
index c640ba0420..5c335ebfaa 100644
--- a/lisp/vc/vc.el
+++ b/lisp/vc/vc.el
@@ -553,6 +553,10 @@
 ;;   Return the list of files where conflict resolution is needed in
 ;;   the project that contains DIR.
 ;;   FIXME: what should it do with non-text conflicts?
+;;
+;; - repository-url (file)
+;;
+;;   Returns the URL of the repository of the current checkout.
 
 ;;; Changes from the pre-25.1 API:
 ;;
-- 
2.27.0


[-- Attachment #3: Type: text/plain, Size: 14 bytes --]


Bye,
Tassilo

Re: RFC: Automatic setup for bug-reference-mode

[Basil L. Contovounesios]

Tassilo Horn <tsdh@gnu.org> writes:

> Looks right?

I can only comment on one thing:

> +(defun vc-bzr-repository-url (file-or-dir)
> +  (let ((default-directory (vc-bzr-root file-or-dir)))
> +    (with-temp-buffer
> +      (vc-bzr-command "info" (current-buffer) nil nil)
> +      (goto-char (point-min))
> +      (when (re-search-forward "parent branch: \\(.*\\)$")

Doesn't this need a non-nil NOERROR arg?

> +        (match-string 1)))))
> +

Thanks,

-- 
Basil

Re: RFC: Automatic setup for bug-reference-mode

[Stefan Monnier]

Tassilo Horn [2020-06-14 18:30:26] wrote:

> > This is mis-indented.  It's not your fault, but I recommend you
> > override the auto-indentation :-(
> That would be a hassle for aggressive-indent-mode users (like me).

Yes, it has downsides as well.  That was just a recommendation.
The better solution is to fix the auto-indentation, of course.

> > Why autoloaded?
> So that packages can add their function to that list.

Fair enough.  Please put this as a comment, then.

> Ok, I have implemented a new repository-url VC command for all VC
> systems I have installed and were able to test: Git, Hg, Bzr, and SVN.
> Looks right?

Looks great, thanks. (I expected that only the Git backend would be
populated).


"Basil L. Contovounesios" <contovob@tcd.ie> wrote:
> Doesn't this need a non-nil NOERROR arg?

I don't see why: if the backend doesn't implement the feature the
front-end function will signal an error, so the callers need to be
prepared to handle an error in any case.


        Stefan

Re: RFC: Automatic setup for bug-reference-mode

[Basil L. Contovounesios]

Stefan Monnier <monnier@iro.umontreal.ca> writes:

> "Basil L. Contovounesios" <contovob@tcd.ie> wrote:
>> Doesn't this need a non-nil NOERROR arg?
>
> I don't see why: if the backend doesn't implement the feature the
> front-end function will signal an error, so the callers need to be
> prepared to handle an error in any case.

Then there's no need for branching based on the return value of
re-search-forward, since we're assuming it will succeed or barf.

-- 
Basil

Re: RFC: Automatic setup for bug-reference-mode

[Tassilo Horn]

"Basil L. Contovounesios" <contovob@tcd.ie> writes:

>>> Doesn't this need a non-nil NOERROR arg?
>>
>> I don't see why: if the backend doesn't implement the feature the
>> front-end function will signal an error, so the callers need to be
>> prepared to handle an error in any case.
>
> Then there's no need for branching based on the return value of
> re-search-forward, since we're assuming it will succeed or barf.

To make both of you happy pushed a version that uses NO-ERROR and
signals a more descriptive error if the "parent branch" line couldn't be
found.

Bye,
Tassilo

Re: RFC: Automatic setup for bug-reference-mode

[Dmitry Gutov]

On 14.06.2020 19:30, Tassilo Horn wrote:
> +(defun vc-git-repository-url (file-or-dir)
> +  (let ((default-directory (vc-git-root file-or-dir)))
> +    (with-temp-buffer
> +      (vc-git--call (current-buffer) "ls-remote" "--get-url")
> +      (buffer-substring-no-properties (point-min) (1- (point-max))))))

Can it be used in vc-git-dir-extra-headers, to replace the logic that 
calculates the value of 'remote'?

Re: RFC: Automatic setup for bug-reference-mode

[Tassilo Horn]

Dmitry Gutov <dgutov@yandex.ru> writes:

> On 14.06.2020 19:30, Tassilo Horn wrote:
>> +(defun vc-git-repository-url (file-or-dir)
>> +  (let ((default-directory (vc-git-root file-or-dir)))
>> +    (with-temp-buffer
>> +      (vc-git--call (current-buffer) "ls-remote" "--get-url")
>> +      (buffer-substring-no-properties (point-min) (1- (point-max))))))
>
> Can it be used in vc-git-dir-extra-headers, to replace the logic that
> calculates the value of 'remote'?

Actually, "git ls-remote --get-url" doesn't work satisfactory which I
noticed after committing above change on a new local branch.  In that
case, it returned "." so I've changed to this version

(defun vc-git-repository-url (file-or-dir)
  (let ((default-directory (vc-git-root file-or-dir)))
    (with-temp-buffer
      (vc-git-command (current-buffer) 0 nil "remote" "get-url" "origin")
      (buffer-substring-no-properties (point-min) (1- (point-max))))))

where I explicitly name the remote "origin" (which, I know, doesn't need
to exist but still works in 99% of all cases).

Bye,
Tassilo

Re: RFC: Automatic setup for bug-reference-mode

[Dmitry Gutov]

On 14.06.2020 23:39, Tassilo Horn wrote:
> Actually, "git ls-remote --get-url" doesn't work satisfactory which I
> noticed after committing above change on a new local branch.  In that
> case, it returned "." so I've changed to this version
> 
> (defun vc-git-repository-url (file-or-dir)
>    (let ((default-directory (vc-git-root file-or-dir)))
>      (with-temp-buffer
>        (vc-git-command (current-buffer) 0 nil "remote" "get-url" "origin")
>        (buffer-substring-no-properties (point-min) (1- (point-max))))))
> 
> where I explicitly name the remote "origin" (which, I know, doesn't need
> to exist but still works in 99% of all cases).

Sounds good!

If the new version can be used in vc-git-dir-extra-headers, could you 
please make it so?

That aside, I was going to ask whether the new backend method should 
take a "remote-name" argument, but I don't know how many backends 
support different remotes. Or what other actual code is going to use 
this method anyway.

Re: RFC: Automatic setup for bug-reference-mode

[Basil L. Contovounesios]

Dmitry Gutov <dgutov@yandex.ru> writes:

> On 14.06.2020 23:39, Tassilo Horn wrote:
>> Actually, "git ls-remote --get-url" doesn't work satisfactory which I
>> noticed after committing above change on a new local branch.  In that
>> case, it returned "." so I've changed to this version
>> (defun vc-git-repository-url (file-or-dir)
>>    (let ((default-directory (vc-git-root file-or-dir)))
>>      (with-temp-buffer
>>        (vc-git-command (current-buffer) 0 nil "remote" "get-url" "origin")
>>        (buffer-substring-no-properties (point-min) (1- (point-max))))))
>> where I explicitly name the remote "origin" (which, I know, doesn't need
>> to exist but still works in 99% of all cases).
>
> Sounds good!
>
> If the new version can be used in vc-git-dir-extra-headers, could you please
> make it so?
>
> That aside, I was going to ask whether the new backend method should take a
> "remote-name" argument, but I don't know how many backends support different
> remotes. Or what other actual code is going to use this method anyway.

It would definitely be nice to somehow make this configurable.  For
example in my local Emacs checkout I have Savannah as the "upstream"
remote, and my mirror on GitLab as the "origin" remote, because that's
where I push to most of the time.

I think Forge[1] achieves this by supporting a per-repository git-config
variable which tells it which remote to use.

[1]: https://github.com/magit/forge

Thanks,

-- 
Basil

VC repository-url command (was: RFC: Automatic setup for bug-reference-mode)

[Tassilo Horn]

"Basil L. Contovounesios" <contovob@tcd.ie> writes:

>>> (defun vc-git-repository-url (file-or-dir)
>>>    (let ((default-directory (vc-git-root file-or-dir)))
>>>      (with-temp-buffer
>>>        (vc-git-command (current-buffer) 0 nil "remote" "get-url" "origin")
>>>        (buffer-substring-no-properties (point-min) (1- (point-max))))))
>>> where I explicitly name the remote "origin" (which, I know, doesn't need
>>> to exist but still works in 99% of all cases).
>>
>> Sounds good!
>>
>> If the new version can be used in vc-git-dir-extra-headers, could you
>> please make it so?

I'll have a look.

>> That aside, I was going to ask whether the new backend method should
>> take a "remote-name" argument, but I don't know how many backends
>> support different remotes. Or what other actual code is going to use
>> this method anyway.

I guess all distributed VCS do in some form or another.  With Hg, I
currently return the value of paths.default which could also be
paths.other-remote.  With Bzr, I think there's no such concept but each
branch is bound to some "parent branch" which is usually the URL from
where you cloned from.

> It would definitely be nice to somehow make this configurable.  For
> example in my local Emacs checkout I have Savannah as the "upstream"
> remote, and my mirror on GitLab as the "origin" remote, because that's
> where I push to most of the time.

I usually do the opposite: origin is the original project and tsdh is my
fork which I set as push-remote.

So I think I'll add an optional remote-name argument as suggested by
Dmitry that overrides "origin" for Git and "default" for Hg while being
ignored by the other supported backends SVN and Bzr.

Then I could also add "default remote" defvars (or defcustoms?) for Git
and Hg which are used if no remote-name was explicitly provided as
suggested by you.

As for the original task I want to implement, i.e., bug-reference
auto-setup, I'd actually want to get the remote's URL which actually
hosts the bug tracker (thinking of GitLab/GitHub repos and their forks).
So probably there I should try likely remote names such as "upstream"
before falling back to "origin"...

Bye,
Tassilo

Re: VC repository-url command

[Basil L. Contovounesios]

Tassilo Horn <tsdh@gnu.org> writes:

> "Basil L. Contovounesios" <contovob@tcd.ie> writes:
>
>> It would definitely be nice to somehow make this configurable.  For
>> example in my local Emacs checkout I have Savannah as the "upstream"
>> remote, and my mirror on GitLab as the "origin" remote, because that's
>> where I push to most of the time.
>
> I usually do the opposite: origin is the original project and tsdh is my
> fork which I set as push-remote.

Sounds convenient, I might start doing that too.

Thanks,

-- 
Basil

Re: RFC: Automatic setup for bug-reference-mode

[Stephen Leake]

Tassilo Horn <tsdh@gnu.org> writes:

> Actually, "git ls-remote --get-url" doesn't work satisfactory which I
> noticed after committing above change on a new local branch.  In that
> case, it returned "." so I've changed to this version
>
> (defun vc-git-repository-url (file-or-dir)
>   (let ((default-directory (vc-git-root file-or-dir)))
>     (with-temp-buffer
>       (vc-git-command (current-buffer) 0 nil "remote" "get-url" "origin")
>       (buffer-substring-no-properties (point-min) (1- (point-max))))))
>
> where I explicitly name the remote "origin" (which, I know, doesn't need
> to exist but still works in 99% of all cases).

I'm in the 1%; I have git repositories that don't have 'origin'; they
have 'savannah'. I migrated from monotone, where the remotes have real
names.

So some method of overriding 'origin' would be appreciated.

'git remote -v' lists all remotes; you could just pick the first one. 

-- 
-- Stephe

Re: RFC: Automatic setup for bug-reference-mode

[Tassilo Horn]

Stephen Leake <stephen_leake@stephe-leake.org> writes:

>> (defun vc-git-repository-url (file-or-dir)
>>   (let ((default-directory (vc-git-root file-or-dir)))
>>     (with-temp-buffer
>>       (vc-git-command (current-buffer) 0 nil "remote" "get-url" "origin")
>>       (buffer-substring-no-properties (point-min) (1- (point-max))))))
>>
>> where I explicitly name the remote "origin" (which, I know, doesn't need
>> to exist but still works in 99% of all cases).
>
> I'm in the 1%; I have git repositories that don't have 'origin'; they
> have 'savannah'. I migrated from monotone, where the remotes have real
> names.
>
> So some method of overriding 'origin' would be appreciated.

It already has on master, i.e., you can pass in an optional remote-name.

Bye,
Tassilo

Re: RFC: Automatic setup for bug-reference-mode

[Juri Linkov]

>>> (defun vc-git-repository-url (file-or-dir)
>>>   (let ((default-directory (vc-git-root file-or-dir)))
>>>     (with-temp-buffer
>>>       (vc-git-command (current-buffer) 0 nil "remote" "get-url" "origin")
>>>       (buffer-substring-no-properties (point-min) (1- (point-max))))))
>>>
>>> where I explicitly name the remote "origin" (which, I know, doesn't need
>>> to exist but still works in 99% of all cases).
>>
>> I'm in the 1%; I have git repositories that don't have 'origin'; they
>> have 'savannah'. I migrated from monotone, where the remotes have real
>> names.
>>
>> So some method of overriding 'origin' would be appreciated.
>
> It already has on master, i.e., you can pass in an optional remote-name.

Typing 'C-x v d' (vc-dir) on a repository without 'origin'
raises the error "Failed (status 128): git --no-pager remote get-url  ."

Re: RFC: Automatic setup for bug-reference-mode

[Dmitry Gutov]

On 18.06.2020 00:35, Juri Linkov wrote:
> Typing 'C-x v d' (vc-dir) on a repository without 'origin'
> raises the error "Failed (status 128): git --no-pager remote get-url  ."

Also noticed that (when the current branch has no default remote).

Just fixed in master.

Re: RFC: Automatic setup for bug-reference-mode

[Tassilo Horn]

Hi chaps,

>> Typing 'C-x v d' (vc-dir) on a repository without 'origin'
>> raises the error "Failed (status 128): git --no-pager remote get-url  ."
>
> Also noticed that (when the current branch has no default remote).
> Just fixed in master.

Ah, sorry, haven't seen your fix.  But I think it may still have been
wrong.  I think the actual problem was that

  git config branch.<branch>.remote

wasn't necessarily called in the given project DIR so returned the
global default remote "origin".  So I now bind default-directory to the
given DIR.

I'm not exactly sure if that is really needed but at least it was needed
for M-: (vc-git-dir-extra-headers "~/some/project/") which I used to
reproduce the problem (which still occurred).  Maybe it's not needed
when vc-dir calls it, but let's say it is a good change anyway since it
makes the function debuggable standalone.

Thanks,
Tassilo

Re: RFC: Automatic setup for bug-reference-mode

[Dmitry Gutov]

On 18.06.2020 09:06, Tassilo Horn wrote:
> I think the actual problem was that
> 
>    git config branch.<branch>.remote
> 
> wasn't necessarily called in the given project DIR so returned the
> global default remote "origin".

I... don't think so?

It returned an empty string in my testing. Which resulted in remote-url 
being nil.

 > I'm not exactly sure if that is really needed but at least it was 
needed for M-: (vc-git-dir-extra-headers "~/some/project/") which I used 
to reproduce the problem (which still occurred).  Maybe it's not needed
when vc-dir calls it, but let's say it is a good change anyway since it
makes the function debuggable standalone.

I don't mind, but a lot of VC functions depend on a changed 
default-directory value implicitly.

Re: RFC: Automatic setup for bug-reference-mode

[Tassilo Horn]

Dmitry Gutov <dgutov@yandex.ru> writes:

> On 18.06.2020 09:06, Tassilo Horn wrote:
>> I think the actual problem was that
>>    git config branch.<branch>.remote
>> wasn't necessarily called in the given project DIR so returned the
>> global default remote "origin".
>
> I... don't think so?
>
> It returned an empty string in my testing. Which resulted in
> remote-url being nil.

I've tested and written my fix with a version before your change (and
wrongly using M-: (vc-git-dir-extra-headers "repo/no/origin/remote")).
And there I got the remote "origin" (which doesn't exist in that repo).
Oh, I think that's because I did the M-: while being in vc-git.el, so it
looked at the emacs repo, not the one in the DIR argument!

Well, if you got the remote "", I still think that default-directory was
set to some non-git repo directory at that time.  At least

  ❯ git config branch.master.remote

returns successfully but empty in such a directory.

It's not exactly clear to me when vc-dir sets default-directory.  So if
you want to find out, you could checkout an emacs version before our
changes and invoke vc-dir from somewhere where default-directory is not
in some git repo.  I think you'd get that error no matter if the DIR of
vc-dir has a remote origin or not.

Bye,
Tassilo

Re: RFC: Automatic setup for bug-reference-mode

[Dmitry Gutov]

On 18.06.2020 16:37, Tassilo Horn wrote:
> Well, if you got the remote "", I still think that default-directory was
> set to some non-git repo directory at that time.  At least
> 
>    ❯ git config branch.master.remote
> 
> returns successfully but empty in such a directory.

If was "" (still is) when the current branch has no configured remote.

Which is a regular occurrence in development process based on feature 
branches.

Re: RFC: Automatic setup for bug-reference-mode

[Tassilo Horn]

Hi again,

I've pushed my second attempt on the topic of setting up
bug-reference-mode automatically to the branch
feature/bug-reference-setup.

The most essential changes wrt. the former patch are:

  - There's just one single defvar bug-reference-setup-functions instead
    of a defcustom + a defvar.

  - New setups based according to VC URL can easily be added to
    `bug-reference-setup-from-vc-alist'.  Please tell me if that's too
    complicated with the func-arity thingy in order to distinguish
    functions being valid bug-reference-url-format values from those
    that need to be evaluated to get a valid value.

  - New setups based on Gnus group/addresses can easily be added to
    `bug-reference-setup-from-gnus-alist'.

Honestly, the Gnus stuff is a bit icky but that's not really my fault.
Gnus reuses its article buffer therefore the setup for
`gnus-article-mode' buffers has to be done in
`gnus-article-prepare-hook' which doesn't match the "setup immediately
when bug-reference-mode is activated" semantics...

Bye,
Tassilo