From: Tassilo Horn Date: Thu, 9 Sep 2021 20:31:47 +0000 (+0200) Subject: bug-reference-bug-regexp now defines a contract for the overlay region X-Git-Tag: emacs-28.0.90~1069 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=ccc9bd774c31ef5a7ba69729afbc9f97e710dfb2;p=emacs.git 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. --- diff --git a/doc/emacs/maintaining.texi b/doc/emacs/maintaining.texi index 5a436a30fb6..8305918336b 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 586d4eed6ce..d0493b32850 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.