master ccc9bd7: bug-reference-bug-regexp now defines a contract for the overlay region

[Tassilo Horn]

branch: master
commit ccc9bd774c31ef5a7ba69729afbc9f97e710dfb2
Author: Tassilo Horn <tsdh@gnu.org>
Commit: Tassilo Horn <tsdh@gnu.org>

    bug-reference-bug-regexp now defines a contract for the overlay region
    
    Formerly, bug-reference-fontify placed the overlay on the complete
    match of bug-reference-bug-regexp.  That made it impossible to encode
    constraints like "must not match at BOL" in the regexp without messing
    up fontification.  Therefore, now it establishes the contract that
    subexpression 1 defines the overlay region.  Subexpression 2 must
    still match the part of the bug reference injected into
    bug-reference-url-format if that's a string.  If its a function, the
    interpretation of subexpressions > 1 is up to the function.
    
    For backwards compatibility, bug-reference-fontify checks if the
    bounds of subexpression 2..10 are within the bounds of subexpession
    1.  If not, or subexpression 1 doesn't even exist/match, we fall back
    to placing the overlay from (match-beginning 0) to (match-end 0) but
    issue a warning.
    
    * lisp/progmodes/bug-reference.el (bug-reference-bug-regexp): Document
    contract that subexpression 1 defines the overlay region and adapt the
    default value accordingly.
    (bug-reference--nonconforming-regexps): New internal variable.
    (bug-reference--overlay-bounds): New function.
    (bug-reference-fontify): Place overlay on subexpression 1's bounds if
    bug-reference-bug-regexp conforms to the documented contract.
    (bug-reference--setup-from-vc-alist): Adapt regexps to new contract.
    * doc/emacs/maintaining.texi (Bug Reference): Adapt regexp used in
    example.
---
 doc/emacs/maintaining.texi      |   8 +--
 lisp/progmodes/bug-reference.el | 119 +++++++++++++++++++++++++++-------------
 2 files changed, 85 insertions(+), 42 deletions(-)

diff --git a/doc/emacs/maintaining.texi b/doc/emacs/maintaining.texi
index 5a436a3..83059183 100644
--- a/doc/emacs/maintaining.texi
+++ b/doc/emacs/maintaining.texi
@@ -3108,7 +3108,7 @@ these local variables section would do.
 
 @smallexample
 ;; Local Variables:
-;; bug-reference-bug-regexp: "\\([Bb]ug[#-]\\)\\([0-9]+\\)"
+;; bug-reference-bug-regexp: "\\([Bb]ug[#-]\\([0-9]+\\)\\)"
 ;; bug-reference-url-format: "https://project.org/issues/%s";
 ;; End:
 @end smallexample
@@ -3118,9 +3118,9 @@ The string captured by the second regexp group in
 template in the @code{bug-reference-url-format}.
 
 Note that @code{bug-reference-url-format} may also be a function in
-order to cater for more complex scenarios, e.g., when the part before
-the actual bug number has to be used to distinguish between issues and
-merge requests where each of them has a different URL.
+order to cater for more complex scenarios, e.g., when different parts
+of the bug reference have to be used to distinguish between issues and
+merge requests resulting in different URLs.
 
 
 @heading Automatic Setup
diff --git a/lisp/progmodes/bug-reference.el b/lisp/progmodes/bug-reference.el
index 586d4ee..d0493b3 100644
--- a/lisp/progmodes/bug-reference.el
+++ b/lisp/progmodes/bug-reference.el
@@ -72,24 +72,30 @@ so that it is considered safe, see 
`enable-local-variables'.")
                 (get s 'bug-reference-url-format)))))
 
 (defcustom bug-reference-bug-regexp
-  "\\([Bb]ug ?#?\\|[Pp]atch ?#\\|RFE ?#\\|PR 
[a-z+-]+/\\)\\([0-9]+\\(?:#[0-9]+\\)?\\)"
+  "\\(\\(?:[Bb]ug ?#?\\|[Pp]atch ?#\\|RFE ?#\\|PR 
[a-z+-]+/\\)\\([0-9]+\\(?:#[0-9]+\\)?\\)\\)"
   "Regular expression matching bug references.
-The second subexpression should match the bug reference (usually
-a number).
-
-The complete expression's matches will be highlighted unless
-there is a 99th subexpression.  In that case, only the matches of
-that will be highlighted.  For example, this can be used to
-define that bug references at the beginning of a line must not be
-matched by using a regexp like
-
-  \"[^\\n]\\\\(?99:\\\\([Bb]ug ?\\\\)\\\\(#[0-9]+\\\\)\\\\)\"
-
-If there wasn't this explicitly numbered group 99, the
-non-newline character before the actual bug reference would be
-highlighted, too."
+The first subexpression defines the region of the bug-reference
+overlay, i.e., the region being fontified and made clickable in
+order to browse the referenced bug in the corresponding project's
+issue tracker.
+
+If `bug-reference-url-format' is set to a format string with
+single %s placeholder, the second subexpression must match
+the (part of the) bug reference which needs to be injected in
+place of the %s in order to form the bug's ticket URL.
+
+If `bug-reference-url-format' is a function, the interpretation
+of the subexpressions larger than 1 is up to the function.
+However, it is checked that the bounds of all matching
+subexpressions from 2 to 10 are within the bounds of the
+subexpression 1 defining the overlay region.  Larger
+subexpressions may also be used by the function but may lay
+outside the bounds of subexpressions 1 and then don't contribute
+to the highlighted and clickable region."
   :type 'regexp
-  :version "24.3")                     ; previously defconst
+  ; 24.3: defconst -> defcustom
+  ; 28.1: contract about subexpression 1 defines the overlay region.
+  :version "28.1")
 
 ;;;###autoload
 (put 'bug-reference-bug-regexp 'safe-local-variable 'stringp)
@@ -119,6 +125,48 @@ highlighted, too."
 
 (defvar bug-reference-prog-mode)
 
+(defvar bug-reference--nonconforming-regexps nil
+  "Holds `bug-reference-bug-regexp' values which don't conform to
+the documented contract in order to warn about their
+non-conformance only once.")
+
+(defun bug-reference--overlay-bounds ()
+  (let ((m-b1 (match-beginning 1))
+        (m-e1 (match-end 1)))
+    (if (and m-b1 m-e1
+             (catch 'within-bounds
+               (let ((i 2))
+                 (while (<= i 10)
+                   (when (and (match-beginning i)
+                              (or (< (match-beginning i) m-b1)
+                                  (> (match-end i) m-e1)))
+                     (throw 'within-bounds nil))
+                   (cl-incf i))
+                 t)))
+        ;; All groups 2..10 are within bounds.
+        (cons m-b1 m-e1)
+      ;; The regexp doesn't fulfil the contract of
+      ;; bug-reference-bug-regexp, so fall back to the old behavior.
+      (unless (member bug-reference-bug-regexp
+                      bug-reference--nonconforming-regexps)
+        (setq bug-reference--nonconforming-regexps
+              (cons bug-reference-bug-regexp
+                    bug-reference--nonconforming-regexps))
+        (display-warning
+         'bug-reference
+         (format-message
+          "The value of `bug-reference-bug-regexp'
+
+  %S
+
+in buffer %S doesn't conform to the contract specified by its
+docstring.  The subexpression 1 should define the region of the
+bug-reference overlay and cover all other subexpressions up to
+subexpression 10."
+          bug-reference-bug-regexp
+          (buffer-name))))
+      (cons (match-beginning 0) (match-end 0)))))
+
 (defun bug-reference-fontify (start end)
   "Apply bug reference overlays to the region between START and END."
   (save-excursion
@@ -132,19 +180,14 @@ highlighted, too."
        (when (or (not bug-reference-prog-mode)
                  ;; This tests for both comment and string syntax.
                  (nth 8 (syntax-ppss)))
-          ;; We highlight the 99th subexpression if that exists,
-          ;; otherwise the complete match.  See the docstring of
-          ;; `bug-reference-bug-regexp'.
-         (let* ((s (or (match-beginning 99)
-                        (match-beginning 0)))
-                 (e (or (match-end 99)
-                        (match-end 0)))
+         (let* ((bounds (bug-reference--overlay-bounds))
                  (overlay (or
                            (let ((ov (pop overlays)))
                              (when ov
-                               (move-overlay ov s e)
+                               (move-overlay ov (car bounds) (cdr bounds))
                                ov))
-                           (let ((ov (make-overlay s e nil t nil)))
+                           (let ((ov (make-overlay (car bounds) (cdr bounds)
+                                                  nil t nil)))
                              (overlay-put ov 'category 'bug-reference)
                              ov))))
            ;; Don't put a link if format is undefined.
@@ -232,7 +275,7 @@ for the known free software forges from the variables
             ;; `bug-reference-url-format' and
             ;; `bug-reference-bug-regexp' aren't set already.
             ("git\\.\\(?:sv\\|savannah\\)\\.gnu\\.org:"
-             "\\<\\([Bb]ug ?#?\\)\\([0-9]+\\(?:#[0-9]+\\)?\\)\\>"
+             "\\<\\(\\(?:[Bb]ug ?#?\\)\\([0-9]+\\(?:#[0-9]+\\)?\\)\\)\\>"
              ,(lambda (_) "https://debbugs.gnu.org/%s";))
             ;;
             ;; GitHub projects.
@@ -243,17 +286,17 @@ for the known free software forges from the variables
             ;; user/project#17 links to possibly different projects
             ;; are also supported.
             ("[/@]github.com[/:]\\([.A-Za-z0-9_/-]+\\)\\.git"
-             "\\([.A-Za-z0-9_/-]+\\)?\\(?:#\\)\\([0-9]+\\)\\>"
+             "\\(\\([.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)
+                             (match-string 2)
                              ns-project)
                             "/issues/"
-                            (match-string 2))))))
+                            (match-string 3))))))
             ;;
             ;; Gitea instances.
             ;;
@@ -261,7 +304,7 @@ for the known free software forges from the variables
             (,(concat "[/@]"
                       (regexp-opt bug-reference-gitea-instances t)
                       "[/:]\\([.A-Za-z0-9_/-]+\\)\\.git")
-             "\\([.A-Za-z0-9_/-]+\\)?\\(?:#\\)\\([0-9]+\\)\\>"
+             "\\(\\([.A-Za-z0-9_/-]+\\)?\\(?:#\\)\\([0-9]+\\)\\)\\>"
              ,(lambda (groups)
                 (let ((host (nth 1 groups))
                       (ns-project (nth 2 groups)))
@@ -269,10 +312,10 @@ for the known free software forges from the variables
                     (concat "https://"; host "/"
                             (or
                              ;; Explicit user/proj#18 link.
-                             (match-string 1)
+                             (match-string 2)
                              ns-project)
                             "/issues/"
-                            (match-string 2))))))
+                            (match-string 3))))))
             ;;
             ;; GitLab instances.
             ;;
@@ -283,19 +326,19 @@ for the known free software forges from the variables
             (,(concat "[/@]"
                       (regexp-opt bug-reference-gitlab-instances t)
                       "[/:]\\([.A-Za-z0-9_/-]+\\)\\.git")
-             "\\(?1:[.A-Za-z0-9_/-]+\\)?\\(?3:[#!]\\)\\(?2:[0-9]+\\)\\>"
+             "\\(\\([.A-Za-z0-9_/-]+\\)?\\([#!]\\)\\([0-9]+\\)\\)\\>"
              ,(lambda (groups)
                 (let ((host (nth 1 groups))
                       (ns-project (nth 2 groups)))
                   (lambda ()
                     (concat "https://"; host "/"
-                            (or (match-string 1)
+                            (or (match-string 2)
                                 ns-project)
                             "/-/"
                             (if (string= (match-string 3) "#")
                                 "issues/"
                               "merge_requests/")
-                            (match-string 2))))))
+                            (match-string 4))))))
             ;;
             ;; Sourcehut instances.
             ;;
@@ -311,7 +354,7 @@ for the known free software forges from the variables
             (,(concat "[/@]\\(?:git\\|hg\\)."
                       (regexp-opt bug-reference-sourcehut-instances t)
                       "[/:]\\(~[.A-Za-z0-9_/-]+\\)")
-             "\\(~[.A-Za-z0-9_/-]+\\)?\\(?:#\\)\\([0-9]+\\)\\>"
+             "\\(\\(~[.A-Za-z0-9_/-]+\\)?\\(?:#\\)\\([0-9]+\\)\\)\\>"
              ,(lambda (groups)
                 (let ((host (nth 1 groups))
                       (ns-project (nth 2 groups)))
@@ -319,10 +362,10 @@ for the known free software forges from the variables
                     (concat "https://todo."; host "/"
                             (or
                              ;; Explicit user/proj#18 link.
-                             (match-string 1)
+                             (match-string 2)
                              ns-project)
                             "/"
-                            (match-string 2))))))))))
+                            (match-string 3))))))))))
 
 (defvar bug-reference-setup-from-vc-alist nil
   "An alist for setting up `bug-reference-mode' based on VC URL.