Re: Our use of the "fixed" tag in debbugs

[Stefan Monnier <monnier@iro.umontreal.ca>]

> 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