From 0db50c3fd5580cfa077d81c484a29f2821ceb02d Mon Sep 17 00:00:00 2001 From: Tassilo Horn Date: Thu, 2 Sep 2021 22:07:16 +0200 Subject: Support forges by type rather than by host Formerly, bug-reference-setup-from-vc-alist basically had one entry per host (like gitlab.com). Restructure so that it's easy to add new hosts being just an instance of some type of forge such as SourceHut, Gitea, or GitLab. While we're at it, add support for gitea.com, salsa.debian.org, and framagit.org, the latter two being GitLab instances. * lisp/progmodes/bug-reference.el (bug-reference-gitea-instances) (bug-reference-gitlab-instances,bug-reference-sourcehut-instances): New variables listing online instances of those forges. (bug-reference--setup-from-vc-alist): New function (and variable for caching) using the former three new variables to generate suitable VC auto-setup alist. (bug-reference-try-setup-from-vc): Use both bug-reference-setup-from-vc-alist and bug-reference--setup-from-vc-alist. --- lisp/progmodes/bug-reference.el | 234 ++++++++++++++++++++++++---------------- 1 file changed, 143 insertions(+), 91 deletions(-) (limited to 'lisp/progmodes/bug-reference.el') diff --git a/lisp/progmodes/bug-reference.el b/lisp/progmodes/bug-reference.el index 9b9c58eb1f2..c0c9d5e659a 100644 --- a/lisp/progmodes/bug-reference.el +++ b/lisp/progmodes/bug-reference.el @@ -153,95 +153,144 @@ The second subexpression should match the bug reference (usually a number)." (push (match-string i url) groups)) (funcall bug-url-fmt (nreverse groups)))))) -(defvar bug-reference-setup-from-vc-alist - `(;; - ;; GNU projects on savannah. - ;; - ;; Not all of them use debbugs but that doesn't really matter - ;; because the auto-setup is only performed if - ;; `bug-reference-url-format' and `bug-reference-bug-regexp' - ;; aren't set already. - ("git\\.\\(?:sv\\|savannah\\)\\.gnu\\.org:" - "\\<\\([Bb]ug ?#?\\)\\([0-9]+\\(?:#[0-9]+\\)?\\)\\>" - ,(lambda (_) "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. - ("[/@]github.com[/:]\\([.A-Za-z0-9_/-]+\\)\\.git" - "\\([.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) - ns-project) - "/issues/" - (match-string 2)))))) - ;; - ;; Codeberg projects. - ;; - ;; The systematics is exactly as for Github projects. - ("[/@]codeberg.org[/:]\\([.A-Za-z0-9_/-]+\\)\\.git" - "\\([.A-Za-z0-9_/-]+\\)?\\(?:#\\)\\([0-9]+\\)\\>" - ,(lambda (groups) - (let ((ns-project (nth 1 groups))) - (lambda () - (concat "https://codeberg.org/" - (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 or namespace/project!17 references to - ;; possibly different projects are also supported. - ("[/@]gitlab.com[/:]\\([.A-Za-z0-9_/-]+\\)\\.git" - "\\(?1:[.A-Za-z0-9_/-]+\\)?\\(?3:[#!]\\)\\(?2:[0-9]+\\)\\>" - ,(lambda (groups) - (let ((ns-project (nth 1 groups))) - (lambda () - (concat "https://gitlab.com/" - (or (match-string 1) - ns-project) - "/-/" - (if (string= (match-string 3) "#") - "issues/" - "merge_requests/") - (match-string 2)))))) - ;; - ;; Sourcehut projects. - ;; - ;; #19 is an issue. Other project's issues can be referenced as - ;; #~user/project#19. - ;; - ;; Caveat: The code assumes that a project on git.sr.ht or - ;; hg.sr.ht has a tracker of the same name on todo.sh.ht. That's - ;; a very common setup but all sr.ht services are loosely coupled, - ;; so you can have a repo without tracker, or a repo with a - ;; tracker using a different name, etc. So we can only try to - ;; make a good guess. - ("[/@]\\(?:git\\|hg\\).sr.ht[/:]\\(~[.A-Za-z0-9_/-]+\\)" - "\\(~[.A-Za-z0-9_/-]+\\)?\\(?:#\\)\\([0-9]+\\)\\>" - ,(lambda (groups) - (let ((ns-project (nth 1 groups))) - (lambda () - (concat "https://todo.sr.ht/" - (or - ;; Explicit user/proj#18 link. - (match-string 1) - ns-project) - "/" - (match-string 2))))))) +(defvar bug-reference-gitea-instances '("gitea.com" + "codeberg.org") + "List of Gitea forge instances. +When the value is changed after bug-reference has already been +loaded, and performed an auto-setup, evaluate +`(bug-reference--setup-from-vc-alist t)' for rebuilding the value +of `bug-reference--setup-from-vc-alist'.") + +(defvar bug-reference-gitlab-instances '("gitlab.com" + "salsa.debian.org" + "framagit.org") + "List of GitLab forge instances. +When the value is changed after bug-reference has already been +loaded, and performed an auto-setup, evaluate +`(bug-reference--setup-from-vc-alist t)' for rebuilding the value +of `bug-reference--setup-from-vc-alist'.") + +(defvar bug-reference-sourcehut-instances '("sr.ht") + "List of SourceHut forge instances. +When the value is changed after bug-reference has already been +loaded, and performed an auto-setup, evaluate +`(bug-reference--setup-from-vc-alist t)' for rebuilding the value +of `bug-reference--setup-from-vc-alist'.") + +(defvar bug-reference--setup-from-vc-alist nil + "An alist for setting up ‘bug-reference-mode’ based on VC URL. +This is like `bug-reference-setup-from-vc-alist' but generated +for the known free software forges from the variables +`bug-reference-gitea-instances', +`bug-reference-gitlab-instances', and +`bug-reference-sourcehut-instances'.") + +(defun bug-reference--setup-from-vc-alist (&optional rebuild) + (if (and bug-reference--setup-from-vc-alist + (null rebuild)) + bug-reference--setup-from-vc-alist + (setq bug-reference--setup-from-vc-alist + `(;; + ;; GNU projects on savannah. + ;; + ;; Not all of them use debbugs but that doesn't really + ;; matter because the auto-setup is only performed if + ;; `bug-reference-url-format' and + ;; `bug-reference-bug-regexp' aren't set already. + ("git\\.\\(?:sv\\|savannah\\)\\.gnu\\.org:" + "\\<\\([Bb]ug ?#?\\)\\([0-9]+\\(?:#[0-9]+\\)?\\)\\>" + ,(lambda (_) "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. + ("[/@]github.com[/:]\\([.A-Za-z0-9_/-]+\\)\\.git" + "\\([.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) + ns-project) + "/issues/" + (match-string 2)))))) + ;; + ;; Gitea instances. + ;; + ;; The systematics is exactly as for Github projects. + (,(concat "[/@]" + (regexp-opt bug-reference-gitea-instances t) + "[/:]\\([.A-Za-z0-9_/-]+\\)\\.git") + "\\([.A-Za-z0-9_/-]+\\)?\\(?:#\\)\\([0-9]+\\)\\>" + ,(lambda (groups) + (let ((host (nth 1 groups)) + (ns-project (nth 2 groups))) + (lambda () + (concat "https://" host "/" + (or + ;; Explicit user/proj#18 link. + (match-string 1) + ns-project) + "/issues/" + (match-string 2)))))) + ;; + ;; GitLab instances. + ;; + ;; Here #18 is an issue and !17 is a merge request. + ;; Explicit namespace/project#18 or namespace/project!17 + ;; references to possibly different projects are also + ;; supported. + (,(concat "[/@]" + (regexp-opt bug-reference-gitlab-instances t) + "[/:]\\([.A-Za-z0-9_/-]+\\)\\.git") + "\\(?1:[.A-Za-z0-9_/-]+\\)?\\(?3:[#!]\\)\\(?2:[0-9]+\\)\\>" + ,(lambda (groups) + (let ((host (nth 1 groups)) + (ns-project (nth 2 groups))) + (lambda () + (concat "https://" host "/" + (or (match-string 1) + ns-project) + "/-/" + (if (string= (match-string 3) "#") + "issues/" + "merge_requests/") + (match-string 2)))))) + ;; + ;; Sourcehut instances. + ;; + ;; #19 is an issue. Other project's issues can be + ;; #referenced as ~user/project#19. + ;; + ;; Caveat: The code assumes that a project on git.sr.ht or + ;; hg.sr.ht has a tracker of the same name on todo.sh.ht. + ;; That's a very common setup but all sr.ht services are + ;; loosely coupled, so you can have a repo without + ;; tracker, or a repo with a tracker using a different + ;; name, etc. So we can only try to make a good guess. + (,(concat "[/@]\\(?:git\\|hg\\)." + (regexp-opt bug-reference-sourcehut-instances t) + "[/:]\\(~[.A-Za-z0-9_/-]+\\)") + "\\(~[.A-Za-z0-9_/-]+\\)?\\(?:#\\)\\([0-9]+\\)\\>" + ,(lambda (groups) + (let ((host (nth 1 groups)) + (ns-project (nth 2 groups))) + (lambda () + (concat "https://todo." host "/" + (or + ;; Explicit user/proj#18 link. + (match-string 1) + ns-project) + "/" + (match-string 2)))))))))) + +(defvar bug-reference-setup-from-vc-alist nil "An alist for setting up `bug-reference-mode' based on VC URL. Each element has the form (URL-REGEXP BUG-REGEXP URL-FORMAT-FN). @@ -256,7 +305,8 @@ URL-REGEXP against the VCS URL and returns the value to be set as (defun bug-reference-try-setup-from-vc () "Try setting up `bug-reference-mode' based on VC information. Test each configuration in `bug-reference-setup-from-vc-alist' -and apply it if applicable." +and `bug-reference--setup-from-vc-alist' and apply it if +applicable." (let ((file-or-dir (or buffer-file-name ;; Catches modes such as vc-dir and Magit. default-directory))) @@ -269,7 +319,9 @@ and apply it if applicable." (vc-call-backend backend 'repository-url))))) (when url (catch 'found - (dolist (config bug-reference-setup-from-vc-alist) + (dolist (config (append + bug-reference-setup-from-vc-alist + (bug-reference--setup-from-vc-alist))) (when (apply #'bug-reference-maybe-setup-from-vc url config) (throw 'found t))))))))) -- cgit v1.2.3 From 163e3052c8ffd840c41b638dc15a9b1a5922642f Mon Sep 17 00:00:00 2001 From: Tassilo Horn Date: Mon, 6 Sep 2021 21:47:38 +0200 Subject: Add possibility to override the default highlighting * lisp/progmodes/bug-reference.el (bug-reference-fontify): Highlight 99th group if it exists. (bug-reference-bug-regexp): Document that regexp group 99 can be used to override the default behavior of highlighting the complete match. (bug-reference--run-auto-setup): Use run-hook-with-args-until-success instead of throw/catch. --- lisp/progmodes/bug-reference.el | 29 +++++++++++++++++++++++------ 1 file changed, 23 insertions(+), 6 deletions(-) (limited to 'lisp/progmodes/bug-reference.el') diff --git a/lisp/progmodes/bug-reference.el b/lisp/progmodes/bug-reference.el index c0c9d5e659a..33548344f3f 100644 --- a/lisp/progmodes/bug-reference.el +++ b/lisp/progmodes/bug-reference.el @@ -74,7 +74,20 @@ so that it is considered safe, see `enable-local-variables'.") (defcustom bug-reference-bug-regexp "\\([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 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." :type 'regexp :version "24.3") ; previously defconst @@ -113,7 +126,13 @@ The second subexpression should match the bug reference (usually a number)." (when (or (not bug-reference-prog-mode) ;; This tests for both comment and string syntax. (nth 8 (syntax-ppss))) - (let ((overlay (make-overlay (match-beginning 0) (match-end 0) + ;; We highlight the 99th subexpression if that exists, + ;; otherwise the complete match. See the docstring of + ;; `bug-reference-bug-regexp'. + (let ((overlay (make-overlay (or (match-beginning 99) + (match-beginning 0)) + (or (match-end 99) + (match-end 0)) nil t nil))) (overlay-put overlay 'category 'bug-reference) ;; Don't put a link if format is undefined @@ -564,10 +583,8 @@ guesswork is based on these variables: bug-reference-url-format) (with-demoted-errors "Error during bug-reference auto-setup: %S" - (catch 'setup - (dolist (f bug-reference-auto-setup-functions) - (when (funcall f) - (throw 'setup t)))))))) + (run-hook-with-args-until-success + 'bug-reference-auto-setup-functions))))) ;;;###autoload (define-minor-mode bug-reference-mode -- cgit v1.2.3 From 5c18d35acba751b2011d6746cf9c3c781e88db73 Mon Sep 17 00:00:00 2001 From: Tassilo Horn Date: Sat, 11 Sep 2021 00:04:46 +0200 Subject: Improve overlay placement performance * lisp/progmodes/bug-reference.el (bug-reference--overlays-in): New function. (bug-reference-unfontify): Use it. (bug-reference-fontify): Reuse and move existing overlays instead of deleting all and creating them anew. --- lisp/progmodes/bug-reference.el | 45 +++++++++++++++++++++++++++-------------- 1 file changed, 30 insertions(+), 15 deletions(-) (limited to 'lisp/progmodes/bug-reference.el') diff --git a/lisp/progmodes/bug-reference.el b/lisp/progmodes/bug-reference.el index 33548344f3f..586d4eed6ce 100644 --- a/lisp/progmodes/bug-reference.el +++ b/lisp/progmodes/bug-reference.el @@ -105,21 +105,27 @@ highlighted, too." (bug-reference-set-overlay-properties) +(defun bug-reference--overlays-in (start end) + "Return bug reference overlays in the region between START and END." + (let (overlays) + (dolist (o (overlays-in start end)) + (when (eq (overlay-get o 'category) 'bug-reference) + (push o overlays))) + (nreverse overlays))) + (defun bug-reference-unfontify (start end) "Remove bug reference overlays from the region between START and END." - (dolist (o (overlays-in start end)) - (when (eq (overlay-get o 'category) 'bug-reference) - (delete-overlay o)))) + (mapc #'delete-overlay (bug-reference--overlays-in start end))) (defvar bug-reference-prog-mode) (defun bug-reference-fontify (start end) "Apply bug reference overlays to the region between START and END." (save-excursion - (let ((beg-line (progn (goto-char start) (line-beginning-position))) - (end-line (progn (goto-char end) (line-end-position)))) - ;; Remove old overlays. - (bug-reference-unfontify beg-line end-line) + (let* ((beg-line (progn (goto-char start) (line-beginning-position))) + (end-line (progn (goto-char end) (line-end-position))) + ;; Reuse existing overlays overlays. + (overlays (bug-reference--overlays-in beg-line end-line))) (goto-char beg-line) (while (and (< (point) end-line) (re-search-forward bug-reference-bug-regexp end-line 'move)) @@ -129,19 +135,28 @@ highlighted, too." ;; We highlight the 99th subexpression if that exists, ;; otherwise the complete match. See the docstring of ;; `bug-reference-bug-regexp'. - (let ((overlay (make-overlay (or (match-beginning 99) - (match-beginning 0)) - (or (match-end 99) - (match-end 0)) - nil t nil))) - (overlay-put overlay 'category 'bug-reference) - ;; Don't put a link if format is undefined + (let* ((s (or (match-beginning 99) + (match-beginning 0))) + (e (or (match-end 99) + (match-end 0))) + (overlay (or + (let ((ov (pop overlays))) + (when ov + (move-overlay ov s e) + ov)) + (let ((ov (make-overlay s e nil t nil))) + (overlay-put ov 'category 'bug-reference) + ov)))) + ;; Don't put a link if format is undefined. (when bug-reference-url-format (overlay-put overlay 'bug-reference-url (if (stringp bug-reference-url-format) (format bug-reference-url-format (match-string-no-properties 2)) - (funcall bug-reference-url-format)))))))))) + (funcall bug-reference-url-format))))))) + ;; Delete remaining but unused overlays. + (dolist (ov overlays) + (delete-overlay ov))))) ;; Taken from button.el. (defun bug-reference-push-button (&optional pos _use-mouse-action) -- cgit v1.2.3 From ccc9bd774c31ef5a7ba69729afbc9f97e710dfb2 Mon Sep 17 00:00:00 2001 From: Tassilo Horn Date: Thu, 9 Sep 2021 22:31:47 +0200 Subject: 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(-) (limited to 'lisp/progmodes/bug-reference.el') 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. -- cgit v1.2.3 From 140d722848fda03b193f05e716f00eca93b854a8 Mon Sep 17 00:00:00 2001 From: Tassilo Horn Date: Sat, 11 Sep 2021 11:59:06 +0200 Subject: ; Add some TODOs for the bug-reference--instances variables --- lisp/progmodes/bug-reference.el | 9 +++++++++ 1 file changed, 9 insertions(+) (limited to 'lisp/progmodes/bug-reference.el') diff --git a/lisp/progmodes/bug-reference.el b/lisp/progmodes/bug-reference.el index d0493b32850..e5d77a0a334 100644 --- a/lisp/progmodes/bug-reference.el +++ b/lisp/progmodes/bug-reference.el @@ -230,6 +230,9 @@ subexpression 10." (push (match-string i url) groups)) (funcall bug-url-fmt (nreverse groups)))))) +;; TODO: Change to alist with (HOST PROTOCOL) entries because +;; self-hosted instances might be accessed with http rather than +;; https. (defvar bug-reference-gitea-instances '("gitea.com" "codeberg.org") "List of Gitea forge instances. @@ -238,6 +241,9 @@ loaded, and performed an auto-setup, evaluate `(bug-reference--setup-from-vc-alist t)' for rebuilding the value of `bug-reference--setup-from-vc-alist'.") +;; TODO: Change to alist with (HOST PROTOCOL) entries because +;; self-hosted instances might be accessed with http rather than +;; https. (defvar bug-reference-gitlab-instances '("gitlab.com" "salsa.debian.org" "framagit.org") @@ -247,6 +253,9 @@ loaded, and performed an auto-setup, evaluate `(bug-reference--setup-from-vc-alist t)' for rebuilding the value of `bug-reference--setup-from-vc-alist'.") +;; TODO: Change to alist with (HOST PROTOCOL) entries because +;; self-hosted instances might be accessed with http rather than +;; https. (defvar bug-reference-sourcehut-instances '("sr.ht") "List of SourceHut forge instances. When the value is changed after bug-reference has already been -- cgit v1.2.3 From 6e60e746535e74d49f4a61b78a7844fa221dbba8 Mon Sep 17 00:00:00 2001 From: Tassilo Horn Date: Sat, 11 Sep 2021 22:49:29 +0200 Subject: Refactor bug-reference setup for software forges * lisp/progmodes/bug-reference.el (bug-reference-gitea-instances) (bug-reference-gitlab-instances,bug-reference-sourcehut-instances): Delete defvars. Those are replaced with bug-reference-forge-alist. (bug-reference-forge-alist): New variable. (bug-reference--build-forge-setup-entry): New cl-defgeneric with methods for github, gitlab, gitea, and sourcehut instances. (bug-reference--setup-from-vc-alist): Use bug-reference-forge-alist and bug-reference--build-forge-setup-entry. * doc/emacs/maintaining.texi (Bug Reference): Mention that the first group in bug-reference-bug-regexp defines the overlay bounds. Also mention bug-reference-forge-alist in VCS setup section. --- doc/emacs/maintaining.texi | 20 ++- lisp/progmodes/bug-reference.el | 281 +++++++++++++++++++--------------------- 2 files changed, 145 insertions(+), 156 deletions(-) (limited to 'lisp/progmodes/bug-reference.el') diff --git a/doc/emacs/maintaining.texi b/doc/emacs/maintaining.texi index 8305918336b..4ec2b2d72a6 100644 --- a/doc/emacs/maintaining.texi +++ b/doc/emacs/maintaining.texi @@ -3113,6 +3113,10 @@ these local variables section would do. ;; End: @end smallexample +The string captured by the first regexp group defines the bounds of +the overlay bug-reference creates, i.e., the part which is highlighted +and made clickable. + The string captured by the second regexp group in @code{bug-reference-bug-regexp} is used to replace the @code{%s} template in the @code{bug-reference-url-format}. @@ -3135,20 +3139,22 @@ variables itself by calling the functions in one is able to set the variables. @vindex bug-reference-setup-from-vc-alist +@vindex bug-reference-forge-alist @vindex bug-reference-setup-from-mail-alist @vindex bug-reference-setup-from-irc-alist Right now, there are three types of setup functions. @enumerate @item -Setup for version-controlled files configurable by the variable -@code{bug-reference-setup-from-vc-alist}. The default is able to +Setup for version-controlled files configurable by the variables +@code{bug-reference-forge-alist}, and +@code{bug-reference-setup-from-vc-alist}. The defaults are able to setup GNU projects where @url{https://debbugs.gnu.org} is used as issue tracker and issues are usually referenced as @code{bug#13} (but -many different notations are considered, too), Sourcehut projects -where issues are referenced using the notation @code{#17}, Codeberg -and Github projects where both bugs and pull requests are referenced -using the same notation, and GitLab projects where bugs are referenced -with @code{#17}, too, but merge requests use the @code{!18} notation. +many different notations are considered, too), and several kinds of +modern software forges such as GitLab, Gitea, SourceHut, or GitHub. +If you deploy a self-hosted instance of such a forge, the easiest way +to tell bug-reference about it is through +@code{bug-reference-forge-alist}. @item Setup for email guessing from mail folder/mbox names, and mail header diff --git a/lisp/progmodes/bug-reference.el b/lisp/progmodes/bug-reference.el index e5d77a0a334..a596b27cd08 100644 --- a/lisp/progmodes/bug-reference.el +++ b/lisp/progmodes/bug-reference.el @@ -26,17 +26,17 @@ ;; This file provides minor modes for putting clickable overlays on ;; references to bugs. A bug reference is text like "PR foo/29292"; ;; this is mapped to a URL using a user-supplied format; see -;; `bug-reference-url-format' and `bug-reference-bug-regexp'. More +;; `bug-reference-url-format' and `bug-reference-bug-regexp'. More ;; extensive documentation is in (info "(emacs) Bug Reference"). ;; Two minor modes are provided. One works on any text in the buffer; -;; the other operates only on comments and strings. By default, the +;; the other operates only on comments and strings. By default, the ;; URL link is followed by invoking C-c RET or mouse-2. ;;; Code: (defgroup bug-reference nil - "Hyperlinking references to bug reports" + "Hyperlinking references to bug reports." ;; Somewhat arbitrary, by analogy with eg goto-address. :group 'comm) @@ -125,10 +125,7 @@ to the highlighted and clickable region." (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.") +(defvar bug-reference--nonconforming-regexps nil) (defun bug-reference--overlay-bounds () (let ((m-b1 (match-beginning 1)) @@ -171,27 +168,27 @@ subexpression 10." "Apply bug reference overlays to the region between START and END." (save-excursion (let* ((beg-line (progn (goto-char start) (line-beginning-position))) - (end-line (progn (goto-char end) (line-end-position))) + (end-line (progn (goto-char end) (line-end-position))) ;; Reuse existing overlays overlays. (overlays (bug-reference--overlays-in beg-line end-line))) (goto-char beg-line) (while (and (< (point) end-line) - (re-search-forward bug-reference-bug-regexp end-line 'move)) - (when (or (not bug-reference-prog-mode) - ;; This tests for both comment and string syntax. - (nth 8 (syntax-ppss))) - (let* ((bounds (bug-reference--overlay-bounds)) + (re-search-forward bug-reference-bug-regexp end-line 'move)) + (when (or (not bug-reference-prog-mode) + ;; This tests for both comment and string syntax. + (nth 8 (syntax-ppss))) + (let* ((bounds (bug-reference--overlay-bounds)) (overlay (or (let ((ov (pop overlays))) (when ov (move-overlay ov (car bounds) (cdr bounds)) ov)) (let ((ov (make-overlay (car bounds) (cdr bounds) - nil t nil))) + nil t nil))) (overlay-put ov 'category 'bug-reference) ov)))) - ;; Don't put a link if format is undefined. - (when bug-reference-url-format + ;; Don't put a link if format is undefined. + (when bug-reference-url-format (overlay-put overlay 'bug-reference-url (if (stringp bug-reference-url-format) (format bug-reference-url-format @@ -212,14 +209,14 @@ subexpression 10." (if (and (not (integerp pos)) (eventp pos)) ;; POS is a mouse event; switch to the proper window/buffer (let ((posn (event-start pos))) - (with-current-buffer (window-buffer (posn-window posn)) - (bug-reference-push-button (posn-point posn) t))) + (with-current-buffer (window-buffer (posn-window posn)) + (bug-reference-push-button (posn-point posn) t))) ;; POS is just normal position. (dolist (o (overlays-at pos)) ;; It should only be possible to have one URL overlay. (let ((url (overlay-get o 'bug-reference-url))) - (when url - (browse-url url)))))) + (when url + (browse-url url)))))) (defun bug-reference-maybe-setup-from-vc (url url-rx bug-rx bug-url-fmt) (when (string-match url-rx url) @@ -230,54 +227,123 @@ subexpression 10." (push (match-string i url) groups)) (funcall bug-url-fmt (nreverse groups)))))) -;; TODO: Change to alist with (HOST PROTOCOL) entries because -;; self-hosted instances might be accessed with http rather than -;; https. -(defvar bug-reference-gitea-instances '("gitea.com" - "codeberg.org") - "List of Gitea forge instances. -When the value is changed after bug-reference has already been -loaded, and performed an auto-setup, evaluate -`(bug-reference--setup-from-vc-alist t)' for rebuilding the value -of `bug-reference--setup-from-vc-alist'.") - -;; TODO: Change to alist with (HOST PROTOCOL) entries because -;; self-hosted instances might be accessed with http rather than -;; https. -(defvar bug-reference-gitlab-instances '("gitlab.com" - "salsa.debian.org" - "framagit.org") - "List of GitLab forge instances. -When the value is changed after bug-reference has already been -loaded, and performed an auto-setup, evaluate -`(bug-reference--setup-from-vc-alist t)' for rebuilding the value -of `bug-reference--setup-from-vc-alist'.") - -;; TODO: Change to alist with (HOST PROTOCOL) entries because -;; self-hosted instances might be accessed with http rather than -;; https. -(defvar bug-reference-sourcehut-instances '("sr.ht") - "List of SourceHut forge instances. -When the value is changed after bug-reference has already been -loaded, and performed an auto-setup, evaluate -`(bug-reference--setup-from-vc-alist t)' for rebuilding the value -of `bug-reference--setup-from-vc-alist'.") - (defvar bug-reference--setup-from-vc-alist nil - "An alist for setting up ‘bug-reference-mode’ based on VC URL. + "An alist for setting up `bug-reference-mode' based on VC URL. This is like `bug-reference-setup-from-vc-alist' but generated -for the known free software forges from the variables -`bug-reference-gitea-instances', -`bug-reference-gitlab-instances', and -`bug-reference-sourcehut-instances'.") +from a few default entries, and the value of +`bug-reference-forge-alist'.") + +(defvar bug-reference-forge-alist + '(("github.com" github "https") + ("gitea.com" gitea "https") + ("codeberg.org" gitea "https") + ("gitlab.com" gitlab "https") + ("framagit.org" gitlab "https") + ("salsa.debian.org" gitlab "https") + ("sr.ht" sourcehut "https")) + "An alist of forge instances. +Each entry has the form (HOST-DOMAIN FORGE-TYPE PROTOCOL). +HOST-DOMAIN is the host- and domain name, e.g., gitlab.com, +salsa.debian.org, or sr.ht. +FORGE-TYPE is the type of the forge, e.g., gitlab, gitea, +sourcehut, or github. +PROTOCOL is the protocol for accessing the forge's issue tracker, +usually \"https\" but for self-hosted forge instances not +accessible via the internet it might also be \"http\".") + +(cl-defgeneric bug-reference--build-forge-setup-entry + (host-domain forge-type protocol) + "Build an entry for `bug-reference--setup-from-vc-alist'. +HOST-DOMAIN is the host- and domain name, e.g., gitlab.com, or +sr.ht. + +FORGE-TYPE is the type of the forge, e.g., gitlab, gitea, +sourcehut, or github. + +PROTOCOL is the protocol for accessing the forge's issue tracker, +usually https but for self-hosted forge instances not accessible +via the internet it might also be http.") + +;; GitHub: 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. +(cl-defmethod bug-reference--build-forge-setup-entry + (host-domain (_forge-type (eql github)) protocol) + `(,(concat "[/@]" host-domain "[/:]\\([.A-Za-z0-9_/-]+\\)\\.git") + "\\(\\([.A-Za-z0-9_/-]+\\)?\\(?:#\\)\\([0-9]+\\)\\)\\>" + ,(lambda (groups) + (let ((ns-project (nth 1 groups))) + (lambda () + (format "%s://%s/%s/issues/%s" + protocol host-domain + (or (match-string-no-properties 2) ns-project) + (match-string-no-properties 3))))))) + +;; GitLab: Here #18 is an issue and !17 is a merge request. Explicit +;; namespace/project#18 or namespace/project!17 references to possibly +;; different projects are also supported. +(cl-defmethod bug-reference--build-forge-setup-entry + (host-domain (_forge-type (eql gitlab)) protocol) + `(,(concat "[/@]" (regexp-quote host-domain) + "[/:]\\([.A-Za-z0-9_/-]+\\)\\.git") + "\\(\\([.A-Za-z0-9_/-]+\\)?\\([#!]\\)\\([0-9]+\\)\\)\\>" + ,(lambda (groups) + (let ((ns-project (nth 1 groups))) + (lambda () + (format "%s://%s/%s/-/%s/%s" + protocol host-domain + (or (match-string-no-properties 2) ns-project) + (if (string= (match-string-no-properties 3) "#") + "issues/" + "merge_requests/") + (match-string-no-properties 4))))))) + +;; Gitea: The systematics is exactly as for Github projects. +(cl-defmethod bug-reference--build-forge-setup-entry + (host-domain (_forge-type (eql gitea)) protocol) + `(,(concat "[/@]" (regexp-quote host-domain) + "[/:]\\([.A-Za-z0-9_/-]+\\)\\.git") + "\\(\\([.A-Za-z0-9_/-]+\\)?\\(?:#\\)\\([0-9]+\\)\\)\\>" + ,(lambda (groups) + (let ((ns-project (nth 1 groups))) + (lambda () + (format "%s://%s/%s/issues/%s" + protocol host-domain + (or (match-string-no-properties 2) ns-project) + (match-string-no-properties 3))))))) + +;; Sourcehut: #19 is an issue. Other project's issues can be +;; referenced as ~user/project#19. +;; +;; Caveat: The code assumes that a project on git.sr.ht or hg.sr.ht +;; has a tracker of the same name on todo.sh.ht. That's a very common +;; setup but all sr.ht services are loosely coupled, so you can have a +;; repo without tracker, or a repo with a tracker using a different +;; name, etc. So we can only try to make a good guess. +(cl-defmethod bug-reference--build-forge-setup-entry + (host-domain (_forge-type (eql sourcehut)) protocol) + `(,(concat "[/@]\\(?:git\\|hg\\)." (regexp-quote host-domain) + "[/:]\\(~[.A-Za-z0-9_/-]+\\)") + "\\(\\(~[.A-Za-z0-9_/-]+\\)?\\(?:#\\)\\([0-9]+\\)\\)\\>" + ,(lambda (groups) + (let ((ns-project (nth 1 groups))) + (lambda () + (format "%s://todo.%s/%s/%s" + protocol host-domain + (or (match-string-no-properties 2) ns-project) + (match-string-no-properties 3))))))) (defun bug-reference--setup-from-vc-alist (&optional rebuild) + "Compute the `bug-reference--setup-from-vc-alist' value. +If REBUILD is non-nil, compute it again even if has been computed +already. The value contains a few default entries, and entries +generated from `bug-reference-forge-alist'." (if (and bug-reference--setup-from-vc-alist (null rebuild)) bug-reference--setup-from-vc-alist (setq bug-reference--setup-from-vc-alist - `(;; - ;; GNU projects on savannah. + `(;; GNU projects on savannah. ;; ;; Not all of them use debbugs but that doesn't really ;; matter because the auto-setup is only performed if @@ -286,95 +352,12 @@ for the known free software forges from the variables ("git\\.\\(?:sv\\|savannah\\)\\.gnu\\.org:" "\\<\\(\\(?:[Bb]ug ?#?\\)\\([0-9]+\\(?:#[0-9]+\\)?\\)\\)\\>" ,(lambda (_) "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. - ("[/@]github.com[/:]\\([.A-Za-z0-9_/-]+\\)\\.git" - "\\(\\([.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 2) - ns-project) - "/issues/" - (match-string 3)))))) - ;; - ;; Gitea instances. - ;; - ;; The systematics is exactly as for Github projects. - (,(concat "[/@]" - (regexp-opt bug-reference-gitea-instances t) - "[/:]\\([.A-Za-z0-9_/-]+\\)\\.git") - "\\(\\([.A-Za-z0-9_/-]+\\)?\\(?:#\\)\\([0-9]+\\)\\)\\>" - ,(lambda (groups) - (let ((host (nth 1 groups)) - (ns-project (nth 2 groups))) - (lambda () - (concat "https://" host "/" - (or - ;; Explicit user/proj#18 link. - (match-string 2) - ns-project) - "/issues/" - (match-string 3)))))) - ;; - ;; GitLab instances. - ;; - ;; Here #18 is an issue and !17 is a merge request. - ;; Explicit namespace/project#18 or namespace/project!17 - ;; references to possibly different projects are also - ;; supported. - (,(concat "[/@]" - (regexp-opt bug-reference-gitlab-instances t) - "[/:]\\([.A-Za-z0-9_/-]+\\)\\.git") - "\\(\\([.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 2) - ns-project) - "/-/" - (if (string= (match-string 3) "#") - "issues/" - "merge_requests/") - (match-string 4)))))) - ;; - ;; Sourcehut instances. - ;; - ;; #19 is an issue. Other project's issues can be - ;; #referenced as ~user/project#19. - ;; - ;; Caveat: The code assumes that a project on git.sr.ht or - ;; hg.sr.ht has a tracker of the same name on todo.sh.ht. - ;; That's a very common setup but all sr.ht services are - ;; loosely coupled, so you can have a repo without - ;; tracker, or a repo with a tracker using a different - ;; name, etc. So we can only try to make a good guess. - (,(concat "[/@]\\(?:git\\|hg\\)." - (regexp-opt bug-reference-sourcehut-instances t) - "[/:]\\(~[.A-Za-z0-9_/-]+\\)") - "\\(\\(~[.A-Za-z0-9_/-]+\\)?\\(?:#\\)\\([0-9]+\\)\\)\\>" - ,(lambda (groups) - (let ((host (nth 1 groups)) - (ns-project (nth 2 groups))) - (lambda () - (concat "https://todo." host "/" - (or - ;; Explicit user/proj#18 link. - (match-string 2) - ns-project) - "/" - (match-string 3)))))))))) + + ;; Entries for the software forges of + ;; `bug-reference-forge-alist'. + ,@(mapcar (lambda (entry) + (apply #'bug-reference--build-forge-setup-entry entry)) + bug-reference-forge-alist))))) (defvar bug-reference-setup-from-vc-alist nil "An alist for setting up `bug-reference-mode' based on VC URL. -- cgit v1.2.3 From f02624b34201aae3d69287e5ae86d466e5c4a6b3 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Mon, 13 Sep 2021 06:04:32 +0200 Subject: ; Minor doc fixes found by checkdoc --- lisp/dnd.el | 2 +- lisp/files.el | 2 +- lisp/progmodes/bat-mode.el | 2 +- lisp/progmodes/bug-reference.el | 2 +- lisp/progmodes/cfengine.el | 9 ++++--- lisp/progmodes/compile.el | 8 +++---- lisp/progmodes/cperl-mode.el | 46 +++++++++++++++--------------------- lisp/progmodes/ebnf2ps.el | 2 +- lisp/progmodes/ebrowse.el | 6 ++--- lisp/progmodes/flymake.el | 4 ++-- lisp/progmodes/hideif.el | 2 +- lisp/textmodes/css-mode.el | 4 ++-- lisp/textmodes/enriched.el | 2 +- lisp/textmodes/flyspell.el | 8 +++---- lisp/textmodes/ispell.el | 9 ++++--- lisp/textmodes/page-ext.el | 2 +- lisp/textmodes/picture.el | 2 +- lisp/textmodes/refbib.el | 2 +- lisp/textmodes/reftex-cite.el | 4 ++-- lisp/textmodes/reftex-index.el | 4 ++-- lisp/textmodes/reftex-vars.el | 8 +++---- lisp/textmodes/reftex.el | 3 ++- lisp/textmodes/sgml-mode.el | 4 ++-- lisp/textmodes/table.el | 11 ++++----- lisp/textmodes/tex-mode.el | 2 +- lisp/textmodes/texinfo.el | 16 ++++++------- lisp/vc/vc-hg.el | 4 ++-- lisp/windmove.el | 2 +- test/lisp/progmodes/flymake-tests.el | 10 ++++---- 29 files changed, 86 insertions(+), 96 deletions(-) (limited to 'lisp/progmodes/bug-reference.el') diff --git a/lisp/dnd.el b/lisp/dnd.el index e641b2843a9..44316154b0f 100644 --- a/lisp/dnd.el +++ b/lisp/dnd.el @@ -77,7 +77,7 @@ and is the default except for MS-Windows." (defcustom dnd-open-file-other-window nil - "If non-nil, always use find-file-other-window to open dropped files." + "If non-nil, always use `find-file-other-window' to open dropped files." :version "22.1" :type 'boolean) diff --git a/lisp/files.el b/lisp/files.el index 7e4bdab5075..67c4628468b 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -1108,7 +1108,7 @@ customize the variable `user-emacs-directory-warning'." (defun exec-path () "Return list of directories to search programs to run in remote subprocesses. The remote host is identified by `default-directory'. For remote -hosts that do not support subprocesses, this returns `nil'. +hosts that do not support subprocesses, this returns nil. If `default-directory' is a local directory, this function returns the value of the variable `exec-path'." (let ((handler (find-file-name-handler default-directory 'exec-path))) diff --git a/lisp/progmodes/bat-mode.el b/lisp/progmodes/bat-mode.el index 7ba8a69775e..2cc8dfce668 100644 --- a/lisp/progmodes/bat-mode.el +++ b/lisp/progmodes/bat-mode.el @@ -175,7 +175,7 @@ ;;;###autoload (define-derived-mode bat-mode prog-mode "Bat" - "Major mode for editing DOS/Windows batch files.\n + "Major mode for editing DOS/Windows batch files. Start a new script from `bat-template'. Read help pages for DOS commands with `bat-cmd-help'. Navigate between sections using `imenu'. Run script using `bat-run' and `bat-run-args'.\n diff --git a/lisp/progmodes/bug-reference.el b/lisp/progmodes/bug-reference.el index a596b27cd08..54d4b141656 100644 --- a/lisp/progmodes/bug-reference.el +++ b/lisp/progmodes/bug-reference.el @@ -651,7 +651,7 @@ guesswork is based on these variables: "Enable `bug-reference-mode' and force auto-setup. Enabling `bug-reference-mode' runs its auto-setup only if `bug-reference-bug-regexp' and `bug-reference-url-format' are not -set already. This function sets the latter to `nil' +set already. This function sets the latter to nil buffer-locally, so that the auto-setup will always run. This is mostly intended for MUA modes like `rmail-mode' where the diff --git a/lisp/progmodes/cfengine.el b/lisp/progmodes/cfengine.el index 4649e506541..53914616cdc 100644 --- a/lisp/progmodes/cfengine.el +++ b/lisp/progmodes/cfengine.el @@ -47,8 +47,8 @@ ;; (add-hook 'cfengine3-mode-hook 'eldoc-mode) ;; You may also find the command `cfengine3-reformat-json-string' -;; useful, just bind it to a key you prefer. It will take the current -;; string and reformat it as JSON. So if you're editing JSON inside +;; useful, just bind it to a key you prefer. It will take the current +;; string and reformat it as JSON. So if you're editing JSON inside ;; the policy, it's a quick way to make it more legible without ;; manually reindenting it. For instance: @@ -140,8 +140,7 @@ bundle agent rcfiles \"/tmp/netrc\" comment => \"my netrc\", perms => mog(\"600\", \"tzz\", \"tzz\"); -} -" +}" :version "24.4" :type '(list (choice (const :tag "Anchor at beginning of promise" promise) @@ -1193,7 +1192,7 @@ Intended as the value of `indent-line-function'." ;; CATEGORY: [a-zA-Z_]+: (defun cfengine3--current-function () - "Look up current CFEngine 3 function" + "Look up current CFEngine 3 function." (let* ((syntax (cfengine3-make-syntax-cache)) (flist (assq 'functions syntax))) (when flist diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el index af7b8292b74..8d1486b6e68 100644 --- a/lisp/progmodes/compile.el +++ b/lisp/progmodes/compile.el @@ -86,7 +86,7 @@ This is bound before running `compilation-filter-hook'.") "This is how compilers number the first column, usually 1 or 0. If this is buffer-local in the destination buffer, Emacs obeys that value, otherwise it uses the value in the *compilation* -buffer. This enables a major-mode to specify its own value.") +buffer. This enables a major mode to specify its own value.") (defvar compilation-parse-errors-filename-function #'identity "Function to call to post-process filenames while parsing error messages. @@ -752,7 +752,7 @@ program and Emacs agree about the display width of the characters, especially the TAB character. If this is buffer-local in the destination buffer, Emacs obeys that value, otherwise it uses the value in the *compilation* -buffer. This enables a major-mode to specify its own value." +buffer. This enables a major mode to specify its own value." :type 'boolean :version "20.4") @@ -2767,7 +2767,7 @@ Actual value is never used, only the text property.") (set-window-margins w (- (car (window-margins w)) 2)))) (defun compilation--set-up-arrow-spec-in-margins () - "Set up compilation-arrow-overlay to display as an arrow in margins." + "Set up `compilation-arrow-overlay' to display as an arrow in margins." (setq overlay-arrow-string "") (setq compilation-arrow-overlay (make-overlay overlay-arrow-position overlay-arrow-position)) @@ -2780,7 +2780,7 @@ Actual value is never used, only the text property.") #'compilation--tear-down-arrow-spec-in-margins nil t)) (defun compilation--tear-down-arrow-spec-in-margins () - "Restore compilation-arrow-overlay to not using the margins, which are removed." + "Restore `compilation-arrow-overlay' to not using the margins, which are removed." (when (overlayp compilation-arrow-overlay) (overlay-put compilation-arrow-overlay 'before-string nil) (delete-overlay compilation-arrow-overlay) diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el index 165834cc20f..8e32c5a4b79 100644 --- a/lisp/progmodes/cperl-mode.el +++ b/lisp/progmodes/cperl-mode.el @@ -312,8 +312,7 @@ own abbrevs in cperl-mode, but do not want keywords to be electric, you must redefine `cperl-mode-abbrev-table': do \\[edit-abbrevs], search for `cperl-mode-abbrev-table', and, in that paragraph, delete the words that appear at the ends of lines and -that begin with \"cperl-electric\". -" +that begin with \"cperl-electric\"." :type '(choice (const null) boolean) :group 'cperl-affected-by-hairy) @@ -767,8 +766,7 @@ line-breaks/spacing between elements of the construct. 10) Uses a linear-time algorithm for indentation of regions. -11) Syntax-highlight, indentation, sexp-recognition inside regular expressions. -") +11) Syntax-highlight, indentation, sexp-recognition inside regular expressions.") (defvar cperl-speed 'please-ignore-this-line "This is an incomplete compendium of what is available in other parts @@ -865,9 +863,7 @@ In regular expressions (including character classes): backslashes of escape sequences `font-lock-variable-name-face' Interpolated constructs, embedded code, POSIX classes (inside charclasses) - `font-lock-comment-face' Embedded comments - -") + `font-lock-comment-face' Embedded comments") @@ -1452,7 +1448,7 @@ the last)." (defvar cperl-outline-regexp (rx (sequence line-start (0+ blank) (eval cperl--imenu-entries-rx))) - "The regular expression used for outline-minor-mode") + "The regular expression used for `outline-minor-mode'.") (defvar cperl-mode-syntax-table nil "Syntax table in use in CPerl mode buffers.") @@ -4840,7 +4836,7 @@ recursive calls in starting lines of here-documents." ;; Moreover, one takes positive approach (looks for else,grep etc) ;; another negative (looks for bless,tr etc) (defun cperl-after-block-p (lim &optional pre-block) - "Return true if the preceding } (if PRE-BLOCK, following {) delimits a block. + "Return non-nil if the preceding } (if PRE-BLOCK, following {) delimits a block. Would not look before LIM. Assumes that LIM is a good place to begin a statement. The kind of block we treat here is one after which a new statement would start; thus the block in ${func()} does not count." @@ -4876,7 +4872,7 @@ statement would start; thus the block in ${func()} does not count." (error nil)))) (defun cperl-after-expr-p (&optional lim chars test) - "Return true if the position is good for start of expression. + "Return non-nil if the position is good for start of expression. TEST is the expression to evaluate at the found position. If absent, CHARS is a string that contains good characters to have before us (however, `}' is treated \"smartly\" if it is not in the list)." @@ -4972,7 +4968,7 @@ CHARS is a string that contains good characters to have before us (however, (skip-chars-forward " \t")) (defun cperl-after-block-and-statement-beg (lim) - "Return true if the preceding ?} ends the statement." + "Return non-nil if the preceding ?} ends the statement." ;; We assume that we are after ?\} (and (cperl-after-block-p lim) @@ -5620,7 +5616,7 @@ comment, or POD." (defvar cperl-font-lock-keywords nil "Additional expressions to highlight in Perl mode. Default set.") (defvar cperl-font-lock-keywords-2 nil - "Additional expressions to highlight in Perl mode. Maximal set") + "Additional expressions to highlight in Perl mode. Maximal set.") (defun cperl-load-font-lock-keywords () (or cperl-faces-init (cperl-init-faces)) @@ -5635,10 +5631,10 @@ comment, or POD." cperl-font-lock-keywords-2) (defun cperl-font-lock-syntactic-face-function (state) - "Apply faces according to their syntax type. In CPerl mode, this -is used for here-documents which have been marked as c-style -comments. For everything else, delegate to the default -function." + "Apply faces according to their syntax type. +In CPerl mode, this is used for here-documents which have been +marked as c-style comments. For everything else, delegate to the +default function." (cond ;; A c-style comment is a HERE-document. Fontify if requested. ((and (eq 2 (nth 7 state)) @@ -6251,7 +6247,7 @@ side-effect of memorizing only. Examples in `cperl-style-examples'." (filename nodename &optional no-going-back strict-case)) (defun cperl-info-buffer (type) - ;; Returns buffer with documentation. Creates if missing. + ;; Return buffer with documentation. Creates if missing. ;; If TYPE, this vars buffer. ;; Special care is taken to not stomp over an existing info buffer (let* ((bname (if type "*info-perl-var*" "*info-perl*")) @@ -6385,7 +6381,7 @@ Customized by setting variables `cperl-shrink-wrap-info-frame', (declare-function imenu-choose-buffer-index "imenu" (&optional prompt alist)) (defun cperl-imenu-on-info () - "Shows imenu for Perl Info Buffer. + "Show imenu for Perl Info Buffer. Opens Perl Info buffer if needed." (interactive) (require 'imenu) @@ -6733,8 +6729,7 @@ Does not move point." "Add to TAGS data for \"pure\" Perl files in the current directory and kids. Use as emacs -batch -q -no-site-file -l emacs/cperl-mode.el \\ - -f cperl-add-tags-recurse-noxs -" + -f cperl-add-tags-recurse-noxs" (cperl-write-tags nil nil t t nil t)) (defun cperl-add-tags-recurse-noxs-fullpath () @@ -6742,16 +6737,14 @@ Use as Writes down fullpath, so TAGS is relocatable (but if the build directory is relocated, the file TAGS inside it breaks). Use as emacs -batch -q -no-site-file -l emacs/cperl-mode.el \\ - -f cperl-add-tags-recurse-noxs-fullpath -" + -f cperl-add-tags-recurse-noxs-fullpath" (cperl-write-tags nil nil t t nil t "")) (defun cperl-add-tags-recurse () "Add to TAGS file data for Perl files in the current directory and kids. Use as emacs -batch -q -no-site-file -l emacs/cperl-mode.el \\ - -f cperl-add-tags-recurse -" + -f cperl-add-tags-recurse" (cperl-write-tags nil nil t t)) (defvar cperl-tags-file-name "TAGS" @@ -7735,11 +7728,10 @@ prototype \\&SUB Returns prototype of the function given a reference. =begin formatname Start directly formatted region. =end formatname End directly formatted region. =for formatname text Paragraph in special format. -=encoding encodingname Encoding of the document. -") +=encoding encodingname Encoding of the document.") (defun cperl-switch-to-doc-buffer (&optional interactive) - "Go to the perl documentation buffer and insert the documentation." + "Go to the Perl documentation buffer and insert the documentation." (interactive "p") (let ((buf (get-buffer-create cperl-doc-buffer))) (if interactive diff --git a/lisp/progmodes/ebnf2ps.el b/lisp/progmodes/ebnf2ps.el index 6ad55fc1423..052a68547b8 100644 --- a/lisp/progmodes/ebnf2ps.el +++ b/lisp/progmodes/ebnf2ps.el @@ -1165,7 +1165,7 @@ Please send all bug fixes and enhancements to ;;; Interface to the command system (defgroup postscript nil - "Printing with PostScript" + "Printing with PostScript." :tag "PostScript" :version "20" :group 'environment) diff --git a/lisp/progmodes/ebrowse.el b/lisp/progmodes/ebrowse.el index 7524c280f25..ab0329d7eec 100644 --- a/lisp/progmodes/ebrowse.el +++ b/lisp/progmodes/ebrowse.el @@ -3062,7 +3062,7 @@ the first derived class." (easy-menu-define ebrowse-member-name-object-menu ebrowse-member-mode-map - "Object menu for member names" + "Object menu for member names." '("Ebrowse" ["Find Definition" ebrowse-find-member-definition :help "Find this member's definition in the source files" @@ -4200,7 +4200,7 @@ EVENT is the mouse event." (easy-menu-define ebrowse-tree-buffer-class-object-menu ebrowse-tree-mode-map - "Object menu for classes in the tree buffer" + "Object menu for classes in the tree buffer." '("Class" ["Functions" ebrowse-tree-command:show-member-functions :help "Display a list of member functions" @@ -4242,7 +4242,7 @@ EVENT is the mouse event." (easy-menu-define ebrowse-tree-buffer-object-menu ebrowse-tree-mode-map - "Object menu for tree buffers" + "Object menu for tree buffers." '("Ebrowse" ["Filename Display" ebrowse-toggle-file-name-display :help "Toggle display of source files names" diff --git a/lisp/progmodes/flymake.el b/lisp/progmodes/flymake.el index cc12fce04a0..5879bce2a76 100644 --- a/lisp/progmodes/flymake.el +++ b/lisp/progmodes/flymake.el @@ -626,7 +626,7 @@ associated `flymake-category' return DEFAULT." (list bitmap))))))) (defun flymake--highlight-line (diagnostic) - "Highlight buffer with info in DIGNOSTIC." + "Highlight buffer with info in DIAGNOSTIC." (let ((type (or (flymake--diag-type diagnostic) :error)) (ov (make-overlay @@ -973,7 +973,7 @@ Interactively, with a prefix arg, FORCE is t." (defvar flymake-mode-map (let ((map (make-sparse-keymap))) map) - "Keymap for `flymake-mode'") + "Keymap for `flymake-mode'.") ;;;###autoload (define-minor-mode flymake-mode diff --git a/lisp/progmodes/hideif.el b/lisp/progmodes/hideif.el index a2f5d7286ac..7cd49a69d4a 100644 --- a/lisp/progmodes/hideif.el +++ b/lisp/progmodes/hideif.el @@ -531,7 +531,7 @@ that form should be displayed.") ((bound-and-true-p semantic-c-takeover-hideif) (semantic-c-hideif-defined var)) ;; Here we can't use hif-lookup as an empty definition like `#define EMPTY' - ;; is considered defined but is evaluated as `nil'. + ;; is considered defined but is evaluated as nil. ((assq var hide-ifdef-env) 1) ((and (setq def (assq var hif-predefine-alist)) (funcall (cdr def))) 1) diff --git a/lisp/textmodes/css-mode.el b/lisp/textmodes/css-mode.el index d57f2d54936..9f123dc8167 100644 --- a/lisp/textmodes/css-mode.el +++ b/lisp/textmodes/css-mode.el @@ -1156,7 +1156,7 @@ by `css--colors-regexp'. START-POINT is the start of the color, and MATCH is the string matched by the regexp. This function will either return the color, as a hex RGB string; -or `nil' if no color could be recognized. When this function +or nil if no color could be recognized. When this function returns, point will be at the end of the recognized color." (cond ((eq (aref match 0) ?#) @@ -1170,7 +1170,7 @@ returns, point will be at the end of the recognized color." (defcustom css-fontify-colors t "Whether CSS colors should be fontified using the color as the background. -When non-`nil', a text representing CSS color will be fontified +When non-nil, a text representing CSS color will be fontified such that its background is the color itself. E.g., #ff0000 will be fontified with a red background." :version "26.1" diff --git a/lisp/textmodes/enriched.el b/lisp/textmodes/enriched.el index 877658a5a55..c650da43bff 100644 --- a/lisp/textmodes/enriched.el +++ b/lisp/textmodes/enriched.el @@ -34,7 +34,7 @@ ;; A separate file, enriched.txt, contains further documentation and other ;; important information about this code. It also serves as an example ;; file in text/enriched format. It should be in the etc directory of your -;; emacs distribution. +;; Emacs distribution. ;;; Code: diff --git a/lisp/textmodes/flyspell.el b/lisp/textmodes/flyspell.el index 423f37762cf..9b3211df57a 100644 --- a/lisp/textmodes/flyspell.el +++ b/lisp/textmodes/flyspell.el @@ -546,7 +546,7 @@ in your init file. (custom-add-option 'text-mode-hook 'turn-on-flyspell) (defvar flyspell-buffers nil - "For remembering buffers running flyspell") + "For remembering buffers running flyspell.") (make-obsolete-variable 'flyspell-buffers "not used." "28.1") ;;*---------------------------------------------------------------------*/ @@ -702,8 +702,8 @@ has been used, the current word is not checked." ;;* has to be spell checked. */ ;;*---------------------------------------------------------------------*/ (defvar flyspell-pre-buffer nil "Buffer current before `this-command'.") -(defvar flyspell-pre-point nil "Point before running `this-command'") -(defvar flyspell-pre-column nil "Column before running `this-command'") +(defvar flyspell-pre-point nil "Point before running `this-command'.") +(defvar flyspell-pre-column nil "Column before running `this-command'.") (defvar flyspell-pre-pre-buffer nil) (defvar flyspell-pre-pre-point nil) (make-variable-buffer-local 'flyspell-pre-point) ;Why?? --Stef @@ -1746,7 +1746,7 @@ FLYSPELL-BUFFER." ;;* flyspell-overlay-p ... */ ;;*---------------------------------------------------------------------*/ (defun flyspell-overlay-p (o) - "Return true if O is an overlay used by flyspell." + "Return non-nil if O is an overlay used by flyspell." (and (overlayp o) (overlay-get o 'flyspell-overlay))) ;;*---------------------------------------------------------------------*/ diff --git a/lisp/textmodes/ispell.el b/lisp/textmodes/ispell.el index 3b9f1d35129..0d95b4c1151 100644 --- a/lisp/textmodes/ispell.el +++ b/lisp/textmodes/ispell.el @@ -60,7 +60,7 @@ ;; `a': Accept word for this session. ;; `A': Accept word and place in buffer-local dictionary. ;; `r': Replace word with typed-in value. Rechecked. -;; `R': Replace word with typed-in value. Query-replaced in buffer. Rechecked. +;; `R': Replace word with typed-in value. Query-replaced in buffer. Rechecked. ;; `?': Show these commands ;; `x': Exit spelling buffer. Move cursor to original point. ;; `X': Exit spelling buffer. Leaves cursor at the current point, and permits @@ -731,8 +731,7 @@ Otherwise returns the library directory name, if that is defined." result)) (defmacro ispell-with-safe-default-directory (&rest body) - "Execute the forms in BODY with a reasonable -`default-directory'." + "Execute the forms in BODY with a reasonable `default-directory'." (declare (indent 0) (debug t)) `(let ((default-directory default-directory)) (unless (file-accessible-directory-p default-directory) @@ -2530,7 +2529,7 @@ if defined." ;; `grep' returns status 1 and no output when word not found, which ;; is a perfectly normal thing. (if (stringp status) - (error "error: %s exited with signal %s" + (error "Error: %s exited with signal %s" (file-name-nondirectory prog) status) ;; Else collect words into `results' in FIFO order. (goto-char (point-max)) @@ -4090,7 +4089,7 @@ Includes LaTeX/Nroff modes and extended character mode." ;; Can kill the current ispell process (defun ispell-buffer-local-dict (&optional no-reload) - "Initializes local dictionary and local personal dictionary. + "Initialize local dictionary and local personal dictionary. If optional NO-RELOAD is non-nil, do not reload any dictionary. When a dictionary is defined in the buffer (see variable `ispell-dictionary-keyword'), it will override the local setting diff --git a/lisp/textmodes/page-ext.el b/lisp/textmodes/page-ext.el index 87c91e8f1b7..558d6b81d77 100644 --- a/lisp/textmodes/page-ext.el +++ b/lisp/textmodes/page-ext.el @@ -257,7 +257,7 @@ ;;; Addresses related variables (defcustom pages-addresses-file-name "~/addresses" - "Standard name for file of addresses. Entries separated by page-delimiter. + "Standard name for file of addresses. Entries separated by `page-delimiter'. Used by `pages-directory-for-addresses' function." :type 'file) diff --git a/lisp/textmodes/picture.el b/lisp/textmodes/picture.el index 1d5d1caeabc..a9b7b6dc964 100644 --- a/lisp/textmodes/picture.el +++ b/lisp/textmodes/picture.el @@ -514,7 +514,7 @@ Interactively, reads the register using `register-read-with-preview'." (move-to-column column t)))) (defun picture-yank-rectangle (&optional insertp) - "Overlay rectangle saved by \\[picture-clear-rectangle] + "Overlay rectangle saved by \\[picture-clear-rectangle]. The rectangle is positioned with upper left corner at point, overwriting existing text. With prefix argument, the rectangle is inserted instead, shifting existing text. Leaves mark at one corner of rectangle and diff --git a/lisp/textmodes/refbib.el b/lisp/textmodes/refbib.el index 084b17c676b..ce556be00db 100644 --- a/lisp/textmodes/refbib.el +++ b/lisp/textmodes/refbib.el @@ -195,7 +195,7 @@ This is in addition to the `r2b-capitalize-title-stop-words'.") (sit-for 0)))) (defun r2b-match (exp) - "Returns string matched in current buffer." + "Return string matched in current buffer." (buffer-substring (match-beginning exp) (match-end exp))) (defcustom r2b-out-buf-name "*Out*" diff --git a/lisp/textmodes/reftex-cite.el b/lisp/textmodes/reftex-cite.el index 895064b82f3..a2b745b0af1 100644 --- a/lisp/textmodes/reftex-cite.el +++ b/lisp/textmodes/reftex-cite.el @@ -30,11 +30,11 @@ ;;; Variables and constants (defvar reftex-cite-regexp-hist nil - "The history list of regular expressions used for citations") + "The history list of regular expressions used for citations.") (defconst reftex-citation-prompt "Select: [n]ext [p]revious [r]estrict [ ]full_entry [q]uit RET [?]Help+more" - "Prompt and help string for citation selection") + "Prompt and help string for citation selection.") (defconst reftex-citation-help " n / p Go to next/previous entry (Cursor motion works as well). diff --git a/lisp/textmodes/reftex-index.el b/lisp/textmodes/reftex-index.el index 28cc7db2dcd..5674d31c81b 100644 --- a/lisp/textmodes/reftex-index.el +++ b/lisp/textmodes/reftex-index.el @@ -1150,7 +1150,7 @@ When index is restricted, select the previous section as restriction criterion." ;; Some constants and variables (defconst reftex-index-phrases-comment-regexp "^[ \t]*%.*" - "Regular expression to match comment lines in phrases buffer") + "Regular expression to match comment lines in phrases buffer.") (defconst reftex-index-phrases-macrodef-regexp "^\\(>>>INDEX_MACRO_DEFINITION:\\)[ \t]+\\(\\S-\\)\\( *\t[ \t]*\\)\\([^\t]*[^ \t]\\)\\( *\t[ \t]*\\)\\(\\S-+\\)" "Regular expression to match macro definition lines the phrases buffer.") @@ -2068,7 +2068,7 @@ both ends." (defun reftex-index-phrases-replace-space (pos) "If there is a space at POS, replace it with a newline char. -Does not do a save-excursion." +Does not do a `save-excursion'." (when (equal (char-after pos) ?\ ) (goto-char pos) (delete-char 1) diff --git a/lisp/textmodes/reftex-vars.el b/lisp/textmodes/reftex-vars.el index 96065ee69e1..cfdf256f70a 100644 --- a/lisp/textmodes/reftex-vars.el +++ b/lisp/textmodes/reftex-vars.el @@ -433,8 +433,8 @@ This flag can be toggled from within the *toc* buffer with the `f' key." :type 'boolean) (defcustom reftex-revisit-to-follow nil - "Non-nil means, follow-mode will revisit files if necessary. -If nil, follow-mode will be suspended for stuff in unvisited files." + "Non-nil means, `follow-mode' will revisit files if necessary. +If nil, `follow-mode' will be suspended for stuff in unvisited files." :group 'reftex-table-of-contents-browser :group 'reftex-referencing-labels :type 'boolean) @@ -1694,8 +1694,8 @@ entries and for BibTeX database files with live associated buffers." "Non-nil means, echoed information for cite macros is cached. The information displayed in the echo area for cite macros is cached and even saved along with the parsing information. The -cache survives document scans. In order to clear it, use M-x -reftex-reset-mode ." +cache survives document scans. In order to clear it, use +\\[reftex-reset-mode]." :group 'reftex-viewing-cross-references :type 'boolean) diff --git a/lisp/textmodes/reftex.el b/lisp/textmodes/reftex.el index 1cb2cf40c3b..1278e4c403c 100644 --- a/lisp/textmodes/reftex.el +++ b/lisp/textmodes/reftex.el @@ -1,4 +1,5 @@ ;;; reftex.el --- minor mode for doing \label, \ref, \cite, \index in LaTeX -*- lexical-binding: t; -*- + ;; Copyright (C) 1997-2000, 2003-2021 Free Software Foundation, Inc. ;; Author: Carsten Dominik @@ -1930,7 +1931,7 @@ When DIE is non-nil, throw an error if file not found." (defun reftex-convert-string (string split-re invalid-re dot keep-fp nwords maxchar invalid abbrev sep ignore-words &optional downcase) - "Convert a string (a sentence) to something shorter. + "Convert STRING (a sentence) to something shorter. SPLIT-RE is the regular expression used to split the string into words. INVALID-RE matches characters which are invalid in the final string. DOT t means add dots to abbreviated words. diff --git a/lisp/textmodes/sgml-mode.el b/lisp/textmodes/sgml-mode.el index fda00ec367e..5bfcc1a20cc 100644 --- a/lisp/textmodes/sgml-mode.el +++ b/lisp/textmodes/sgml-mode.el @@ -1208,7 +1208,7 @@ and move to the line in the SGML document that caused it." (compilation-start command)) (defsubst sgml-at-indentation-p () - "Return true if point is at the first non-whitespace character on the line." + "Return t if point is at the first non-whitespace character on the line." (save-excursion (skip-chars-backward " \t") (bolp))) @@ -2614,7 +2614,7 @@ HTML Autoview mode is a buffer-local minor mode for use with "") (define-skeleton html-html5-template - "Initial HTML5 template" + "Initial HTML5 template." nil "" \n "" \n diff --git a/lisp/textmodes/table.el b/lisp/textmodes/table.el index 2dd52b87b79..50e44ff6367 100644 --- a/lisp/textmodes/table.el +++ b/lisp/textmodes/table.el @@ -61,7 +61,7 @@ ;; holders. Amazingly there have been no direct support for WYSIWYG ;; table editing tasks in Emacs. Many people must have experienced ;; manipulating existing overwrite-mode and picture-mode for this task -;; and only dreamed of having such a lisp package which supports this +;; and only dreamed of having such a Lisp package which supports this ;; specific task directly. Certainly, I have been one of them. The ;; most difficult part of dealing with table editing in Emacs probably ;; is how to realize localized rectangular editing effect. Emacs has @@ -860,7 +860,7 @@ cell to cache and cache to cell.") This is always set to nil at the entry to `table-with-cache-buffer' before executing body forms.") (defvar-local table-mode-indicator nil - "For mode line indicator") + "For mode line indicator.") ;; This is not a real minor-mode but placed in the minor-mode-alist ;; so that we can show the indicator on the mode line handy. (unless (assq table-mode-indicator minor-mode-alist) @@ -3625,8 +3625,7 @@ independently. By applying `table-release', which does the opposite process, the contents become once again plain text. `table-release' works as -companion command to `table-capture' this way. -" +companion command to `table-capture' this way." (interactive (let ((col-delim-regexp) (row-delim-regexp)) @@ -4535,7 +4534,7 @@ grow into." (defun table--untabify-line (&optional from) "Untabify current line. -Unlike save-excursion this guarantees preserving the cursor location +Unlike `save-excursion' this guarantees preserving the cursor location even when the point is on a tab character which is to be removed. Optional FROM narrows the subject operation from this point to the end of line." @@ -5074,7 +5073,7 @@ signals error if the optional ABORT-ON-ERROR is non-nil." (defun table--insert-rectangle (rectangle) "Insert text of RECTANGLE with upper left corner at point. -Same as insert-rectangle except that mark operation is eliminated." +Same as `insert-rectangle' except that mark operation is eliminated." (let ((lines rectangle) (insertcolumn (current-column)) (first t)) diff --git a/lisp/textmodes/tex-mode.el b/lisp/textmodes/tex-mode.el index d7cd0aceb21..697c0de5984 100644 --- a/lisp/textmodes/tex-mode.el +++ b/lisp/textmodes/tex-mode.el @@ -2353,7 +2353,7 @@ FILE is typically the output DVI or PDF file." collect (cons char (shell-quote-argument file)))) (defun tex-format-cmd (format fspec) - "Like `format-spec' but adds user-specified args to the command. + "Like `format-spec' but add user-specified args to the command. Only applies the FSPEC to the args part of FORMAT." (setq fspec (tex--quote-spec fspec)) (if (not (string-match "\\([^ /\\]+\\) " format)) diff --git a/lisp/textmodes/texinfo.el b/lisp/textmodes/texinfo.el index 11d60e1eb03..135a4047318 100644 --- a/lisp/textmodes/texinfo.el +++ b/lisp/textmodes/texinfo.el @@ -350,7 +350,7 @@ and also to be turned into Info files with \\[makeinfo-buffer] or the `makeinfo' program. These files must be written in a very restricted and modified version of TeX input format. - Editing commands are like text-mode except that the syntax table is + Editing commands are like `text-mode' except that the syntax table is set up so expression commands skip Texinfo bracket groups. To see what the Info version of a region of the Texinfo file will look like, use \\[makeinfo-region], which runs `makeinfo' on the current region. @@ -378,15 +378,15 @@ updating menus and node pointers. These functions Here are the functions: - texinfo-update-node \\[texinfo-update-node] - texinfo-every-node-update \\[texinfo-every-node-update] - texinfo-sequential-node-update + `texinfo-update-node' \\[texinfo-update-node] + `texinfo-every-node-update' \\[texinfo-every-node-update] + `texinfo-sequential-node-update' - texinfo-make-menu \\[texinfo-make-menu] - texinfo-all-menus-update \\[texinfo-all-menus-update] - texinfo-master-menu + `texinfo-make-menu' \\[texinfo-make-menu] + `texinfo-all-menus-update' \\[texinfo-all-menus-update] + `texinfo-master-menu' - texinfo-indent-menu-description (column &optional region-p) + `texinfo-indent-menu-description' (column &optional region-p) The `texinfo-column-for-description' variable specifies the column to which menu descriptions are indented. diff --git a/lisp/vc/vc-hg.el b/lisp/vc/vc-hg.el index 4a64caa36b8..8a9a6b85830 100644 --- a/lisp/vc/vc-hg.el +++ b/lisp/vc/vc-hg.el @@ -291,7 +291,7 @@ and an optional path to which to limit history) and produce a string. The function is called with `default-directory' set to within the repository. -If no list entry produces a useful revision, return `nil'." +If no list entry produces a useful revision, return nil." :type '(repeat (choice (const :tag "Active bookmark" builtin-active-bookmark) (string :tag "Hg template") @@ -301,7 +301,7 @@ If no list entry produces a useful revision, return `nil'." (defcustom vc-hg-use-file-version-for-mode-line-version nil "When enabled, the modeline contains revision information for the visited file. When not, the revision in the modeline is for the repository -working copy. `nil' is the much faster setting for +working copy. nil is the much faster setting for large repositories." :type 'boolean :version "26.1") diff --git a/lisp/windmove.el b/lisp/windmove.el index ef970bb6c96..47a1668ee88 100644 --- a/lisp/windmove.el +++ b/lisp/windmove.el @@ -498,7 +498,7 @@ Default value of MODIFIERS is `shift'." (defcustom windmove-display-no-select nil "Whether the window should be selected after displaying the buffer in it. -If `nil', then the new window where the buffer is displayed will be selected. +If nil, then the new window where the buffer is displayed will be selected. If `ignore', then don't select a window: neither the new nor the old window, thus allowing the next command to decide what window it selects. Other non-nil values will reselect the old window that was selected before. diff --git a/test/lisp/progmodes/flymake-tests.el b/test/lisp/progmodes/flymake-tests.el index 45e0c435984..10111ca06cd 100644 --- a/test/lisp/progmodes/flymake-tests.el +++ b/test/lisp/progmodes/flymake-tests.el @@ -109,7 +109,7 @@ SEVERITY-PREDICATE is used to setup (face-at-point))))) (ert-deftest perl-backend () - "Test the perl backend" + "Test the perl backend." (skip-unless (executable-find "perl")) (flymake-tests--with-flymake ("test.pl") (flymake-goto-next-error) @@ -120,7 +120,7 @@ SEVERITY-PREDICATE is used to setup (defvar ruby-mode-hook) (ert-deftest ruby-backend () - "Test the ruby backend" + "Test the ruby backend." (skip-unless (executable-find "ruby")) ;; Some versions of ruby fail if HOME doesn't exist (bug#29187). (let* ((tempdir (make-temp-file "flymake-tests-ruby" t)) @@ -234,7 +234,7 @@ SEVERITY-PREDICATE is used to setup (lambda (_report-fn) ;; HACK: Shoosh log during tests (setq-local warning-minimum-log-level :emergency) - (error "crashed")))) + (error "Crashed")))) (insert "Lorem ipsum dolor sit amet, consectetur adipiscing elit, sed do eiusmod tempor incididunt ut labore et dolore manha aliqua. Ut enim ad minim veniam, quis nostrud @@ -291,7 +291,7 @@ SEVERITY-PREDICATE is used to setup (should-error (flymake-goto-next-error nil nil t)))))) (ert-deftest recurrent-backend () - "Test a backend that calls REPORT-FN multiple times" + "Test a backend that calls REPORT-FN multiple times." (with-temp-buffer (let (tick) (cl-letf @@ -374,4 +374,4 @@ SEVERITY-PREDICATE is used to setup (provide 'flymake-tests) -;;; flymake.el ends here +;;; flymake-tests.el ends here -- cgit v1.2.3 From 7fe756c014c4150f7c96cd99d490c18c38de51b8 Mon Sep 17 00:00:00 2001 From: Tassilo Horn Date: Mon, 13 Sep 2021 07:11:05 +0200 Subject: bug-reference.el: Adapt default debbugs bug regexp for mail modes * lisp/progmodes/bug-reference.el (bug-reference-setup-from-mail-alist): Adapt regexp so that group 1 defines overlay region. --- lisp/progmodes/bug-reference.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp/progmodes/bug-reference.el') diff --git a/lisp/progmodes/bug-reference.el b/lisp/progmodes/bug-reference.el index 54d4b141656..96dc2044e7e 100644 --- a/lisp/progmodes/bug-reference.el +++ b/lisp/progmodes/bug-reference.el @@ -400,7 +400,7 @@ applicable." ,(regexp-opt '("@debbugs.gnu.org" "-devel@gnu.org" ;; List-Id of Gnus devel mailing list. "ding.gnus.org")) - "\\([Bb]ug ?#?\\)\\([0-9]+\\(?:#[0-9]+\\)?\\)" + "\\([Bb]ug ?#?\\([0-9]+\\(?:#[0-9]+\\)?\\)\\)" "https://debbugs.gnu.org/%s")) "An alist for setting up `bug-reference-mode' in mail modes. -- cgit v1.2.3 From 8454566b765c4012f0039d258bdd172de9f867f9 Mon Sep 17 00:00:00 2001 From: Tassilo Horn Date: Mon, 13 Sep 2021 07:22:50 +0200 Subject: bug-reference.el: Adapt default debbugs bug regexp for IRC modes * lisp/progmodes/bug-reference.el (bug-reference-setup-from-irc-alist): Adapt regexp so that group 1 defines overlay region. --- lisp/progmodes/bug-reference.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp/progmodes/bug-reference.el') diff --git a/lisp/progmodes/bug-reference.el b/lisp/progmodes/bug-reference.el index 96dc2044e7e..b646a47c858 100644 --- a/lisp/progmodes/bug-reference.el +++ b/lisp/progmodes/bug-reference.el @@ -531,7 +531,7 @@ From, and Cc against HEADER-REGEXP in `((,(concat "#" (regexp-opt '("emacs" "gnus" "org-mode" "rcirc" "erc") 'words)) "Libera.Chat" - "\\([Bb]ug ?#?\\)\\([0-9]+\\(?:#[0-9]+\\)?\\)" + "\\([Bb]ug ?#?\\([0-9]+\\(?:#[0-9]+\\)?\\)\\)" "https://debbugs.gnu.org/%s")) "An alist for setting up `bug-reference-mode' in IRC modes. -- cgit v1.2.3 From 7d5930a6f0c7b44c00df403d5fe8a3f40e51902f Mon Sep 17 00:00:00 2001 From: "Basil L. Contovounesios" Date: Sun, 19 Sep 2021 21:13:17 +0100 Subject: Fix VC repo URL detection in bug-reference-mode * lisp/progmodes/bug-reference.el (bug-reference-try-setup-from-vc): Pass file or directory name in question as the first argument to the backend's repository-url implementation (bug#50689). Use when-let and seq-some to flatten nested conditionals. --- lisp/progmodes/bug-reference.el | 31 +++++++++++++------------------ 1 file changed, 13 insertions(+), 18 deletions(-) (limited to 'lisp/progmodes/bug-reference.el') diff --git a/lisp/progmodes/bug-reference.el b/lisp/progmodes/bug-reference.el index b646a47c858..fd014a38d95 100644 --- a/lisp/progmodes/bug-reference.el +++ b/lisp/progmodes/bug-reference.el @@ -376,24 +376,19 @@ URL-REGEXP against the VCS URL and returns the value to be set as Test each configuration in `bug-reference-setup-from-vc-alist' and `bug-reference--setup-from-vc-alist' and apply it if applicable." - (let ((file-or-dir (or buffer-file-name - ;; Catches modes such as vc-dir and Magit. - default-directory))) - (when file-or-dir - (let* ((backend (vc-responsible-backend file-or-dir t)) - (url - (or (ignore-errors - (vc-call-backend backend 'repository-url "upstream")) - (ignore-errors - (vc-call-backend backend 'repository-url))))) - (when url - (catch 'found - (dolist (config (append - bug-reference-setup-from-vc-alist - (bug-reference--setup-from-vc-alist))) - (when (apply #'bug-reference-maybe-setup-from-vc - url config) - (throw 'found t))))))))) + (when-let ((file-or-dir (or buffer-file-name + ;; Catches modes such as vc-dir and Magit. + default-directory)) + (backend (vc-responsible-backend file-or-dir t)) + (url (seq-some (lambda (remote) + (ignore-errors + (vc-call-backend backend 'repository-url + file-or-dir remote))) + '("upstream" nil)))) + (seq-some (lambda (config) + (apply #'bug-reference-maybe-setup-from-vc url config)) + (append bug-reference-setup-from-vc-alist + (bug-reference--setup-from-vc-alist))))) (defvar bug-reference-setup-from-mail-alist `((,(regexp-opt '("emacs" "auctex" "gnus" "tramp" "orgmode") 'words) -- cgit v1.2.3 From fecc4c0f79bbfcae3c6dd0ad8331a8ef6faa4034 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sat, 9 Oct 2021 10:42:49 -0400 Subject: * lisp/progmodes/bug-reference.el: Use new `eql` specializer syntax --- lisp/progmodes/bug-reference.el | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) (limited to 'lisp/progmodes/bug-reference.el') diff --git a/lisp/progmodes/bug-reference.el b/lisp/progmodes/bug-reference.el index fd014a38d95..c6327c1a3f3 100644 --- a/lisp/progmodes/bug-reference.el +++ b/lisp/progmodes/bug-reference.el @@ -269,7 +269,7 @@ via the internet it might also be http.") ;; pull/17 page if 17 is a PR. Explicit user/project#17 links to ;; possibly different projects are also supported. (cl-defmethod bug-reference--build-forge-setup-entry - (host-domain (_forge-type (eql github)) protocol) + (host-domain (_forge-type (eql 'github)) protocol) `(,(concat "[/@]" host-domain "[/:]\\([.A-Za-z0-9_/-]+\\)\\.git") "\\(\\([.A-Za-z0-9_/-]+\\)?\\(?:#\\)\\([0-9]+\\)\\)\\>" ,(lambda (groups) @@ -284,7 +284,7 @@ via the internet it might also be http.") ;; namespace/project#18 or namespace/project!17 references to possibly ;; different projects are also supported. (cl-defmethod bug-reference--build-forge-setup-entry - (host-domain (_forge-type (eql gitlab)) protocol) + (host-domain (_forge-type (eql 'gitlab)) protocol) `(,(concat "[/@]" (regexp-quote host-domain) "[/:]\\([.A-Za-z0-9_/-]+\\)\\.git") "\\(\\([.A-Za-z0-9_/-]+\\)?\\([#!]\\)\\([0-9]+\\)\\)\\>" @@ -301,7 +301,7 @@ via the internet it might also be http.") ;; Gitea: The systematics is exactly as for Github projects. (cl-defmethod bug-reference--build-forge-setup-entry - (host-domain (_forge-type (eql gitea)) protocol) + (host-domain (_forge-type (eql 'gitea)) protocol) `(,(concat "[/@]" (regexp-quote host-domain) "[/:]\\([.A-Za-z0-9_/-]+\\)\\.git") "\\(\\([.A-Za-z0-9_/-]+\\)?\\(?:#\\)\\([0-9]+\\)\\)\\>" @@ -322,7 +322,7 @@ via the internet it might also be http.") ;; repo without tracker, or a repo with a tracker using a different ;; name, etc. So we can only try to make a good guess. (cl-defmethod bug-reference--build-forge-setup-entry - (host-domain (_forge-type (eql sourcehut)) protocol) + (host-domain (_forge-type (eql 'sourcehut)) protocol) `(,(concat "[/@]\\(?:git\\|hg\\)." (regexp-quote host-domain) "[/:]\\(~[.A-Za-z0-9_/-]+\\)") "\\(\\(~[.A-Za-z0-9_/-]+\\)?\\(?:#\\)\\([0-9]+\\)\\)\\>" -- cgit v1.2.3 From 380981ddb5dac675dafd9edb3d636d24e745c91c Mon Sep 17 00:00:00 2001 From: Tassilo Horn Date: Tue, 19 Oct 2021 07:05:18 +0200 Subject: Adjust bug-reference-bug-regexp default values to match only at beg of word Previously, the "bug 1" in "(debug 1)" has also been highlighted. * lisp/progmodes/bug-reference.el (bug-reference-bug-regexp) (bug-reference--setup-from-vc-alist,bug-reference-setup-from-mail-alist) (bug-reference-setup-from-irc-alist): Adjust bug-reference-bug-regexp default values to match only at the beginning of a word. --- lisp/progmodes/bug-reference.el | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) (limited to 'lisp/progmodes/bug-reference.el') diff --git a/lisp/progmodes/bug-reference.el b/lisp/progmodes/bug-reference.el index fd014a38d95..fd435eadfe8 100644 --- a/lisp/progmodes/bug-reference.el +++ b/lisp/progmodes/bug-reference.el @@ -72,7 +72,7 @@ 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]+\\)?\\)\\)" + "\\(\\b\\(?:[Bb]ug ?#?\\|[Pp]atch ?#\\|RFE ?#\\|PR [a-z+-]+/\\)\\([0-9]+\\(?:#[0-9]+\\)?\\)\\)" "Regular expression matching bug references. The first subexpression defines the region of the bug-reference overlay, i.e., the region being fontified and made clickable in @@ -350,7 +350,7 @@ generated from `bug-reference-forge-alist'." ;; `bug-reference-url-format' and ;; `bug-reference-bug-regexp' aren't set already. ("git\\.\\(?:sv\\|savannah\\)\\.gnu\\.org:" - "\\<\\(\\(?:[Bb]ug ?#?\\)\\([0-9]+\\(?:#[0-9]+\\)?\\)\\)\\>" + "\\(\\b\\(?:[Bb]ug ?#?\\)\\([0-9]+\\(?:#[0-9]+\\)?\\)\\)\\>" ,(lambda (_) "https://debbugs.gnu.org/%s")) ;; Entries for the software forges of @@ -395,7 +395,7 @@ applicable." ,(regexp-opt '("@debbugs.gnu.org" "-devel@gnu.org" ;; List-Id of Gnus devel mailing list. "ding.gnus.org")) - "\\([Bb]ug ?#?\\([0-9]+\\(?:#[0-9]+\\)?\\)\\)" + "\\(\\b[Bb]ug ?#?\\([0-9]+\\(?:#[0-9]+\\)?\\)\\)" "https://debbugs.gnu.org/%s")) "An alist for setting up `bug-reference-mode' in mail modes. @@ -526,7 +526,7 @@ From, and Cc against HEADER-REGEXP in `((,(concat "#" (regexp-opt '("emacs" "gnus" "org-mode" "rcirc" "erc") 'words)) "Libera.Chat" - "\\([Bb]ug ?#?\\([0-9]+\\(?:#[0-9]+\\)?\\)\\)" + "\\(\\b[Bb]ug ?#?\\([0-9]+\\(?:#[0-9]+\\)?\\)\\)" "https://debbugs.gnu.org/%s")) "An alist for setting up `bug-reference-mode' in IRC modes. -- cgit v1.2.3 From 9b6b5e37ef9106d9d77cf4785dc61feef531b8cf Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Fri, 22 Oct 2021 16:57:04 +0200 Subject: Regexp-quote github domains in bug-reference * lisp/progmodes/bug-reference.el (bug-reference--build-forge-setup-entry): Regexp-quote the domain (bug#51316). --- lisp/progmodes/bug-reference.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'lisp/progmodes/bug-reference.el') diff --git a/lisp/progmodes/bug-reference.el b/lisp/progmodes/bug-reference.el index fd435eadfe8..d7b12db2211 100644 --- a/lisp/progmodes/bug-reference.el +++ b/lisp/progmodes/bug-reference.el @@ -270,7 +270,8 @@ via the internet it might also be http.") ;; possibly different projects are also supported. (cl-defmethod bug-reference--build-forge-setup-entry (host-domain (_forge-type (eql github)) protocol) - `(,(concat "[/@]" host-domain "[/:]\\([.A-Za-z0-9_/-]+\\)\\.git") + `(,(concat "[/@]" (regexp-quote host-domain) + "[/:]\\([.A-Za-z0-9_/-]+\\)\\.git") "\\(\\([.A-Za-z0-9_/-]+\\)?\\(?:#\\)\\([0-9]+\\)\\)\\>" ,(lambda (groups) (let ((ns-project (nth 1 groups))) -- cgit v1.2.3 From 559fb593d777c4e24012b918bbab9f430006be3e Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Sun, 24 Oct 2021 14:14:42 +0200 Subject: Allow matching non-.git URLs in bug-reference * lisp/progmodes/bug-reference.el (bug-reference--build-forge-setup-entry): Allow matching non-.git URLs, with and without slashes (bug#51316). --- lisp/progmodes/bug-reference.el | 2 +- test/lisp/progmodes/bug-reference-tests.el | 62 ++++++++++++++++++++++++++++++ 2 files changed, 63 insertions(+), 1 deletion(-) create mode 100644 test/lisp/progmodes/bug-reference-tests.el (limited to 'lisp/progmodes/bug-reference.el') diff --git a/lisp/progmodes/bug-reference.el b/lisp/progmodes/bug-reference.el index 150dfac0d2d..993d670917b 100644 --- a/lisp/progmodes/bug-reference.el +++ b/lisp/progmodes/bug-reference.el @@ -271,7 +271,7 @@ via the internet it might also be http.") (cl-defmethod bug-reference--build-forge-setup-entry (host-domain (_forge-type (eql 'github)) protocol) `(,(concat "[/@]" (regexp-quote host-domain) - "[/:]\\([.A-Za-z0-9_/-]+\\)\\.git") + "[/:]\\([.A-Za-z0-9_/-]+?\\)\\(?:\\.git\\)?/?\\'") "\\(\\([.A-Za-z0-9_/-]+\\)?\\(?:#\\)\\([0-9]+\\)\\)\\>" ,(lambda (groups) (let ((ns-project (nth 1 groups))) diff --git a/test/lisp/progmodes/bug-reference-tests.el b/test/lisp/progmodes/bug-reference-tests.el new file mode 100644 index 00000000000..803a1dd75a8 --- /dev/null +++ b/test/lisp/progmodes/bug-reference-tests.el @@ -0,0 +1,62 @@ +;;; bug-reference-tests.el --- Tests for bug-reference.el -*- lexical-binding: t; -*- + +;; Copyright (C) 2021 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Commentary: + +;; + +;;; Code: + +(require 'bug-reference) +(require 'ert) + +(defun test--get-github-entry (protocol) + (and (string-match + (car (bug-reference--build-forge-setup-entry + "github.com" 'github protocol)) + protocol) + (match-string 1 protocol))) + +(ert-deftest test-github-entry () + (should + (equal + (test--get-github-entry "git@github.com:larsmagne/csid.git") + "larsmagne/csid")) + (should + (equal + (test--get-github-entry "git@github.com:larsmagne/csid") + "larsmagne/csid")) + (should + (equal + (test--get-github-entry "https://github.com/emacs-mirror/emacs.git") + "emacs-mirror/emacs")) + (should + (equal + (test--get-github-entry "https://github.com/emacs-mirror/emacs.git/") + "emacs-mirror/emacs")) + (should + (equal + (test--get-github-entry "https://github.com/emacs-mirror/emacs") + "emacs-mirror/emacs")) + (should + (equal + (test--get-github-entry "https://github.com/emacs-mirror/emacs/") + "emacs-mirror/emacs"))) + +;;; bug-reference-tests.el ends here -- cgit v1.2.3 From 3fac3120f8ba7941bac89fa90f30140492fdf0eb Mon Sep 17 00:00:00 2001 From: Miha Rihtaršič Date: Tue, 26 Oct 2021 10:54:54 +0200 Subject: Allow matching non-.git gitlab and gitea URLs in bug-reference * lisp/progmodes/bug-reference.el (bug-reference--build-forge-setup-entry): Allow matching non-.git gitlab and gitea URLs, with and without slashes (bug#51316). --- lisp/progmodes/bug-reference.el | 4 +- test/lisp/progmodes/bug-reference-tests.el | 74 ++++++++++++++++++++++++++++-- 2 files changed, 72 insertions(+), 6 deletions(-) (limited to 'lisp/progmodes/bug-reference.el') diff --git a/lisp/progmodes/bug-reference.el b/lisp/progmodes/bug-reference.el index 993d670917b..d7092a37d44 100644 --- a/lisp/progmodes/bug-reference.el +++ b/lisp/progmodes/bug-reference.el @@ -287,7 +287,7 @@ via the internet it might also be http.") (cl-defmethod bug-reference--build-forge-setup-entry (host-domain (_forge-type (eql 'gitlab)) protocol) `(,(concat "[/@]" (regexp-quote host-domain) - "[/:]\\([.A-Za-z0-9_/-]+\\)\\.git") + "[/:]\\([.A-Za-z0-9_/-]+?\\)\\(?:\\.git\\)?/?\\'") "\\(\\([.A-Za-z0-9_/-]+\\)?\\([#!]\\)\\([0-9]+\\)\\)\\>" ,(lambda (groups) (let ((ns-project (nth 1 groups))) @@ -304,7 +304,7 @@ via the internet it might also be http.") (cl-defmethod bug-reference--build-forge-setup-entry (host-domain (_forge-type (eql 'gitea)) protocol) `(,(concat "[/@]" (regexp-quote host-domain) - "[/:]\\([.A-Za-z0-9_/-]+\\)\\.git") + "[/:]\\([.A-Za-z0-9_/-]+?\\)\\(?:\\.git\\)?/?\\'") "\\(\\([.A-Za-z0-9_/-]+\\)?\\(?:#\\)\\([0-9]+\\)\\)\\>" ,(lambda (groups) (let ((ns-project (nth 1 groups))) diff --git a/test/lisp/progmodes/bug-reference-tests.el b/test/lisp/progmodes/bug-reference-tests.el index 7a355509a1d..7a3ab5fbda0 100644 --- a/test/lisp/progmodes/bug-reference-tests.el +++ b/test/lisp/progmodes/bug-reference-tests.el @@ -26,12 +26,26 @@ (require 'bug-reference) (require 'ert) -(defun test--get-github-entry (protocol) +(defun test--get-github-entry (url) (and (string-match (car (bug-reference--build-forge-setup-entry - "github.com" 'github protocol)) - protocol) - (match-string 1 protocol))) + "github.com" 'github "https")) + url) + (match-string 1 url))) + +(defun test--get-gitlab-entry (url) + (and (string-match + (car (bug-reference--build-forge-setup-entry + "gitlab.com" 'gitlab "https")) + url) + (match-string 1 url))) + +(defun test--get-gitea-entry (url) + (and (string-match + (car (bug-reference--build-forge-setup-entry + "gitea.com" 'gitea "https")) + url) + (match-string 1 url))) (ert-deftest test-github-entry () (should @@ -59,4 +73,56 @@ (test--get-github-entry "https://github.com/magit/magit/") "magit/magit"))) +(ert-deftest test-gitlab-entry () + (should + (equal + (test--get-gitlab-entry "git@gitlab.com:larsmagne/csid.git") + "larsmagne/csid")) + (should + (equal + (test--get-gitlab-entry "git@gitlab.com:larsmagne/csid") + "larsmagne/csid")) + (should + (equal + (test--get-gitlab-entry "https://gitlab.com/magit/magit.git") + "magit/magit")) + (should + (equal + (test--get-gitlab-entry "https://gitlab.com/magit/magit.git/") + "magit/magit")) + (should + (equal + (test--get-gitlab-entry "https://gitlab.com/magit/magit") + "magit/magit")) + (should + (equal + (test--get-gitlab-entry "https://gitlab.com/magit/magit/") + "magit/magit"))) + +(ert-deftest test-gitea-entry () + (should + (equal + (test--get-gitea-entry "git@gitea.com:larsmagne/csid.git") + "larsmagne/csid")) + (should + (equal + (test--get-gitea-entry "git@gitea.com:larsmagne/csid") + "larsmagne/csid")) + (should + (equal + (test--get-gitea-entry "https://gitea.com/magit/magit.git") + "magit/magit")) + (should + (equal + (test--get-gitea-entry "https://gitea.com/magit/magit.git/") + "magit/magit")) + (should + (equal + (test--get-gitea-entry "https://gitea.com/magit/magit") + "magit/magit")) + (should + (equal + (test--get-gitea-entry "https://gitea.com/magit/magit/") + "magit/magit"))) + ;;; bug-reference-tests.el ends here -- cgit v1.2.3