unofficial mirror of emacs-devel@gnu.org 
 help / color / mirror / code / Atom feed
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




  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).