>From 2c01285eff8b098f3753d66ad6c18d526508e15c Mon Sep 17 00:00:00 2001 From: Noam Postavsky Date: Thu, 1 Nov 2018 08:03:57 -0400 Subject: [PATCH v1] New command debbugs-control-make-message * packages/debbugs/debbugs-gnu.el (debbugs-control-message-keywords): (debbugs-control-message-commands-regexp) (debbugs-control-message-end-regexp): New constants. (debbugs-gnus-implicit-ids): New function. (debbugs-control-make-message): New command. --- packages/debbugs/debbugs-gnu.el | 168 ++++++++++++++++++++++++++++++++++++++++ 1 file changed, 168 insertions(+) diff --git a/packages/debbugs/debbugs-gnu.el b/packages/debbugs/debbugs-gnu.el index 5466d6518..2f9967281 100644 --- a/packages/debbugs/debbugs-gnu.el +++ b/packages/debbugs/debbugs-gnu.el @@ -1591,6 +1591,174 @@ (defun debbugs-gnu-send-control-message (message &optional reverse) (message "Control message sent:\n%s" (buffer-substring-no-properties (point) (1- (point-max))))))) +(defconst debbugs-control-message-keywords + '("serious" "important" "normal" "minor" "wishlist" + "done" "donenotabug" "donewontfix" "doneunreproducible" + "invalid" ; done+notabug+wontfix + "unarchive" "unmerge" "reopen" "close" + "merge" "forcemerge" + "block" "unblock" + "owner" "noowner" + "reassign" + "retitle" + "forwarded" + ;; 'notfixed ' works, even though it's + ;; undocumented at debbugs.gnu.org. + "fixed" "found" "notfound" "notfixed" + "patch" "wontfix" "moreinfo" "unreproducible" "notabug" + "pending" "help" "security" "confirmed" "easy" + "usertag" "user" + "documentation" ;; usertag:emacs.documentation + )) +(defconst debbugs-control-message-commands-regexp + (concat "^" (regexp-opt (cl-list* "#" "tags" "severity" + debbugs-control-message-keywords)) + " .*$")) +(defconst debbugs-control-message-end-regexp + (concat "^" (regexp-opt '("--" "quit" "stop" + "thank" "thanks" "thankyou" "thank you")) + "$")) + +(defun debbugs-gnus-implicit-ids () + "Return a list of bug IDs guessed from the current buffer." + (delq nil (list (debbugs-gnu-current-id t) + debbugs-gnu-bug-number ; Set on group entry. + (debbugs-gnu-guess-current-id) + (let ((bugnum-re "\\([0-9]+\\)\\(?:-done\\)?@debbugs.gnu.org") + (addr nil)) + (and (eq major-mode 'message-mode) + (save-restriction + (message-narrow-to-headers) + (or (let ((addr (message-fetch-field "to"))) + (and addr (string-match bugnum-re addr) + (match-string 1 addr))) + (let ((addr (message-fetch-field "cc"))) + (and addr (string-match bugnum-re addr) + (match-string 1 addr)))))))))) + +(defun debbugs-control-make-message (message bugid &optional reverse) + "Make a control message for the current bug report. +If called from a `message-mode' buffer, add the control command +to the current buffer, and adjust Bcc as needed. + +You can set the severity or add a tag, or close the report. If +you use the special \"done\" MESSAGE, the report will be marked as +fixed, and then closed. + +If given a prefix, and given a tag to set, the tag will be +removed instead." + (interactive + (save-excursion ; Point can change while prompting! + (list (completing-read + "Control message: " debbugs-control-message-keywords nil t) + (let ((implicit-ids (debbugs-gnus-implicit-ids))) + (string-to-number + (completing-read "Bug #ID: " (mapcar #'prin1-to-string implicit-ids) + (lambda (s) (string-match-p "\\`[0-9]+\\'" s)) + nil nil nil (car implicit-ids)))) + current-prefix-arg))) + (let* ((version + (when (member message '("done" "fixed" "found")) + (save-excursion + (read-string + "Version: " + (pcase (version-to-list emacs-version) + ;; Emacs development versions. + ((and `(,major ,minor ,micro . ,_)) + (format "%d.%d" major (+ (if (> micro 1) 1 0) minor))) + (_ emacs-version)))))) + (status (debbugs-gnu-current-status)) + (subject (format "Subject: control message for bug #%d" bugid))) + (unless (derived-mode-p 'message-mode) + (set-buffer (pop-to-buffer "*Debbugs Control Message for #%d*" bugid)) + (insert "To: control@debbugs.gnu.org\n" + "From: " (message-make-from) "\n" + (format "Subject: control message for bug #%d\n" bugid) + mail-header-separator + "\n") + (message-mode)) + (let ((ctrl-addr "control@debbugs.gnu.org") + (id bugid) + to-addr bcc-addr) + (save-restriction + (message-narrow-to-head) + (setq to-addr (message-fetch-field "to") + bcc-addr (message-fetch-field "bcc")) + (let* ((ctrl-re (regexp-quote ctrl-addr))) + (unless (or (and to-addr (string-match-p ctrl-re to-addr)) + (and bcc-addr (string-match-p ctrl-re bcc-addr))) + (message-add-header + (format "%s: %s" (if to-addr "Bcc" "To") ctrl-addr))))) + (message-goto-body) + (while (looking-at-p debbugs-control-message-commands-regexp) + (forward-line)) + (insert + (save-excursion ; Point can change while prompting! + (cond + ((member message '("unarchive" "unmerge" "noowner")) + (format "%s %d\n" message id)) + ((equal message "reopen") + (format "reopen %d\ntag %d - fixed patch\n" id id)) + ((member message '("merge" "forcemerge")) + (format "%s %d %s\n" message id + (read-string "Merge with bug #: "))) + ((member message '("block" "unblock")) + (format + "%s %d by %s\n" message id + (mapconcat + 'identity + (completing-read-multiple + (format "%s with bug(s) #: " (capitalize message)) + (if (equal message "unblock") + (mapcar 'number-to-string + (cdr (assq 'blockedby status)))) + nil (and (equal message "unblock") status)) + " "))) + ((equal message "owner") + (format "owner %d !\n" id)) + ((equal message "retitle") + (format "retitle %d %s\n" id (read-string "New title: "))) + ((equal message "forwarded") + (format "forwarded %d %s\n" id (read-string "Forward to: "))) + ((equal message "reassign") + (format "reassign %d %s\n" id (read-string "Package(s): "))) + ((equal message "close") + (format "close %d\n" id)) + ((equal message "done") + (format "tags %d fixed\nclose %d %s\n" id id version)) + ((member message '("found" "notfound" "fixed" "notfixed")) + (format "%s %d %s\n" message id version)) + ((member message '("donenotabug" "donewontfix" + "doneunreproducible")) + (format "tags %d %s\nclose %d\n" id (substring message 4) id)) + ((member message '("serious" "important" "normal" + "minor" "wishlist")) + (format "severity %d %s\n" id message)) + ((equal message "invalid") + (format "tags %d notabug wontfix\nclose %d\n" + id id)) + ((equal message "documentation") + (concat (unless (save-excursion + (message-goto-body) + (re-search-forward "^user emacs$")) + "user emacs\n") + (format "usertag %d %s\n" id "documentation"))) + ((equal message "usertag") + (format "user %s\nusertag %d %s\n" + (completing-read + "Package name or email address: " + (append + debbugs-gnu-all-packages (list user-mail-address)) + nil nil (car debbugs-gnu-default-packages)) + id (read-string "User tag: "))) + (t + (format "tags %d %c %s\n" + id (if reverse ?- ?+) + message))))) + (unless (looking-at-p debbugs-control-message-end-regexp) + (insert "quit\n\n"))))) + + (defvar debbugs-gnu-usertags-mode-map (let ((map (make-sparse-keymap))) (set-keymap-parent map tabulated-list-mode-map) -- 2.11.0