From: Stefan Monnier <monnier@iro.umontreal.ca>
To: Stefan Kangas <stefan@marxist.se>
Cc: Eli Zaretskii <eliz@gnu.org>, emacs-devel@gnu.org
Subject: Re: Our use of the "fixed" tag in debbugs
Date: Tue, 05 Oct 2021 17:48:38 -0400 [thread overview]
Message-ID: <jwv1r4zdu1f.fsf-monnier+emacs@gnu.org> (raw)
In-Reply-To: <CADwFkmkVEftqLBX7s9FY5SpsGn+j7RPz6oLbbmy8zv3xRwt=ug@mail.gmail.com> (Stefan Kangas's message of "Tue, 5 Oct 2021 15:44:08 -0400")
> Indeed, it's a hassle. Perhaps it would help to have a command for this
> in `message-mode' much like `debbugs-gnu-make-control-message'? Or
> perhaps such a thing already exist?
FWIW, I use a hackish completion table for that.
Stefan
diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el
index b08d8c26c9a..7cb6842f783 100644
--- a/lisp/gnus/message.el
+++ b/lisp/gnus/message.el
@@ -3174,7 +3181,8 @@ message-mode
((message-mail-alias-type-p 'ecomplete)
(ecomplete-setup)))
;; FIXME: merge the completion tables from ecomplete/bbdb/...?
- ;;(add-hook 'completion-at-point-functions #'message-ecomplete-capf nil t)
+ (add-hook 'completion-at-point-functions #'message-ecomplete-capf nil t)
+ (add-hook 'completion-at-point-functions #'message-debbugs-completion nil t)
(add-hook 'completion-at-point-functions #'message-completion-function nil t)
(unless buffer-file-name
(message-set-auto-save-file-name))
@@ -8285,6 +8293,104 @@ message-completion-function
;; function that prevents trying any further.
(lambda () 'completion-attempted))))))))
+(defun message-debbugs-completion ()
+ (save-excursion
+ (let* ((severities '("critical" "grave" "serious" "important" "normal"
+ "minor" "wishlist"))
+ (tags '("patch" "wontfix" "moreinfo" "unreproducible"
+ "notabug" "fixed"))
+ (start (prog1 (point-marker)
+ (rfc822-goto-eoh)
+ (forward-line 1)))
+ ;; Check whether we're sending to the control address as well.
+ (control (save-excursion
+ (re-search-backward "\\<control@" nil t)))
+ ;; Fetch current bug number, if any.
+ (bugnb (save-excursion
+ (when (re-search-backward "^\\(?:[Ss]ubject:.*bug#\\([1-9][0-9]+\\)\\|\\(?:to\\|cc\\):\\(.*,\\)? *\\(?1:[1-9][0-9]+\\)@\\)"
+ nil t)
+ (match-string 1)))))
+ ;; Add the control header as a side-effect.
+ ;; This is very handy when you want it, but it's a pain when you did not
+ ;; intend it at all, so only do it in very few circumstances to reduce
+ ;; the false positives.
+ (when (and (not control)
+ bugnb
+ (= (point) start))
+ (save-excursion
+ (let ((host (and (re-search-backward "^\\(?:to\\|cc\\):\\(?:.*,\\)? *<?[1-9][0-9]+@\\([a-z.]+\\)"
+ nil t)
+ (match-string 1))))
+ (when host
+ (if (not (re-search-backward "^[Bb]cc:.*\\(\n[ \t].*\\)*" nil t))
+ (progn
+ (goto-char (point-min))
+ (insert "Bcc: control@" host "\n"))
+ (goto-char (match-end 0))
+ (insert ", control@" host))
+ (setq control t)))))
+ ;; Check whether we're inside the "pseudo header".
+ (when (and (<= (point) start) ;Not in the header.
+ (save-excursion
+ (if control
+ (re-search-forward "^thanks\\|^[ \t]*$" nil 'move)
+ (save-restriction
+ (narrow-to-region (point) (point-max))
+ (rfc822-goto-eoh)))
+ (>= (line-end-position) start)))
+ (goto-char start)
+ (skip-chars-backward "^ \t\n:")
+ (cond
+ ((and (bolp) control) ; Completing control commands.
+ (let ((commands '("reassign" "reopen" "found" "notfound" "submitter"
+ "forwarded" "notforwarded" "retitle" "severity"
+ "clone" "merge" "forcemerge" "unmerge" "tags"
+ "block" "unblock" "owner" "noowner" "archive"
+ "unarchive" "close")))
+ (list (point)
+ (progn (skip-chars-forward "^ \t\n") (point))
+ `("thanks" "package "
+ ,@(mapcar (if bugnb
+ (lambda (s) (concat s " " bugnb " "))
+ (lambda (s) (concat s " ")))
+ commands)))))
+
+ (control ; Completing control command arguments.
+ (let* ((command (save-excursion
+ (beginning-of-line)
+ (looking-at "[^ \n\t]*")
+ (match-string 0)))
+ (table
+ (cond
+ ((equal command "severity") severities)
+ ((equal command "tags")
+ (let ((p (if (looking-at "-")
+ (match-string 0))))
+ (mapcar (lambda (tag) (concat p tag)) tags))))))
+ (when table
+ (list (point)
+ (progn (skip-chars-forward "^ \t\n") (point))
+ table))))
+
+ ((bolp) ; Completing special pseudo-header names.
+ (list (point)
+ (progn (skip-chars-forward "^: \t\n")
+ (if (eq (char-after) ?:)
+ (1+ (point)) (point)))
+ '("Package:" "Version:" "Severity:")))
+ (t ; Completing a pseudo-header.
+ (let* ((header (save-excursion
+ (beginning-of-line)
+ (looking-at "[^ \t\n:]*:?")
+ (match-string 0)))
+ (table
+ (cond
+ ((equal header "Severity:") severities))))
+ (when table
+ (list (point)
+ (progn (skip-chars-forward "^ \t\n") (point))
+ table)))))))))
+
(defun message-expand-group ()
"Expand the group name under point."
(let ((b (save-excursion
next prev parent reply other threads:[~2021-10-05 21:48 UTC|newest]
Thread overview: 14+ messages / expand[flat|nested] mbox.gz Atom feed top
2021-10-05 17:27 Our use of the "fixed" tag in debbugs Stefan Kangas
2021-10-05 17:52 ` Lars Ingebrigtsen
2021-10-05 17:56 ` Stefan Kangas
2021-10-05 17:57 ` Glenn Morris
2021-10-05 18:12 ` Basil L. Contovounesios
2021-10-05 19:08 ` Eli Zaretskii
2021-10-05 19:44 ` Stefan Kangas
2021-10-05 21:48 ` Stefan Monnier [this message]
2021-10-06 7:44 ` Robert Pluim
2021-10-08 11:21 ` Eli Zaretskii
2021-10-08 11:44 ` Basil L. Contovounesios
2021-10-08 15:41 ` Glenn Morris
2021-10-08 16:00 ` Basil L. Contovounesios
2021-10-08 17:16 ` Stefan Kangas
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://www.gnu.org/software/emacs/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=jwv1r4zdu1f.fsf-monnier+emacs@gnu.org \
--to=monnier@iro.umontreal.ca \
--cc=eliz@gnu.org \
--cc=emacs-devel@gnu.org \
--cc=stefan@marxist.se \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/emacs.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).