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