X-Git-Url: https://code.delx.au/gnu-emacs-elpa/blobdiff_plain/42ffcecf8da9828eb58685649c7340c952eba7c8..c860062c7be598c8ba40e47fed4e3272945329dd:/packages/debbugs/debbugs-gnu.el diff --git a/packages/debbugs/debbugs-gnu.el b/packages/debbugs/debbugs-gnu.el index 54922c035..1115db819 100644 --- a/packages/debbugs/debbugs-gnu.el +++ b/packages/debbugs/debbugs-gnu.el @@ -5,7 +5,7 @@ ;; Author: Lars Magne Ingebrigtsen ;; Keywords: comm, hypermedia, maint ;; Package: debbugs -;; Version: 0.1 +;; Version: 0.3 ;; This file is part of GNU Emacs. @@ -25,14 +25,15 @@ ;;; Commentary: ;; This package provides an interface to bug reports which are located -;; on the GNU bug tracker debbugs.gnu.org. It's main purpose is to +;; on the GNU bug tracker debbugs.gnu.org. Its main purpose is to ;; show and manipulate bug reports from Emacs, but it could be used ;; also for other GNU projects which use the same bug tracker. ;; If you have `debbugs-gnu.el' in your load-path, you could enable -;; the bug tracker command by the following line in your ~/.emacs +;; the bug tracker command by the following lines in your ~/.emacs ;; ;; (autoload 'debbugs-gnu "debbugs-gnu" "" 'interactive) +;; (autoload 'debbugs-gnu-search "debbugs-gnu" "" 'interactive) ;; The bug tracker is called interactively by ;; @@ -53,14 +54,27 @@ ;; the default), whether archived bugs shall be shown, and whether ;; closed bugs shall be shown. +;; Another command is +;; +;; M-x debbugs-gnu-search + +;; It behaves like `debbugs-gnu', but asks at the beginning for a +;; search phrase to be used for full text search. Additionally, it +;; asks for key-value pairs to filter bugs. Keys are as described in +;; `debbugs-get-status', the corresponding value must be a regular +;; expression to match for. The other parameters are as described in +;; `debbugs-gnu'. Usually, there is just one value except for the +;; attribute "date", which needs two arguments specifying a period in +;; which the bug has been submitted or modified. + ;; The bug reports are downloaded from the bug tracker. In order to ;; not generate too much load of the server, up to 500 bugs will be ;; downloaded at once. If there are more hits, you will be asked to ;; change this limit, but please don't increase this number too much. ;; These default values could be changed also by customer options -;; `debbugs-gnu-default-severities', `debbugs-gnu-default-packages' -;; and `debbugs-gnu-default-hits-per-page'. +;; `debbugs-gnu-default-severities', `debbugs-gnu-default-packages', +;; `debbugs-gnu-default-hits-per-page' and `debbugs-gnu-default-suppress-bugs'. ;; The command creates one or more pages of bug lists. Every bug is ;; shown in one line, including the bug number, the status (combining @@ -78,7 +92,7 @@ ;; "g": Rescan bugs ;; "q": Quit the buffer ;; "s": Toggle bug sorting for age or for state -;; "x": Toggle suppressing of closed bugs +;; "x": Toggle suppressing of bugs ;; When you visit the related bug messages in Gnus, you could also ;; send control messages by keystroke "C". @@ -134,6 +148,17 @@ :type 'integer :version "24.1") +(defcustom debbugs-gnu-default-suppress-bugs + '((pending . "done")) + "*A list of specs for bugs to be suppressed. +An element of this list is a cons cell \(KEY . REGEXP\), with key +being returned by `debbugs-get-status', and VAL a regular +expression matching the corresponding value, a string. Showing +suppressed bugs is toggled by `debbugs-gnu-toggle-suppress'." + :group 'debbugs-gnu + :type '(alist :key-type symbol :value-type regexp) + :version "24.1") + (defface debbugs-gnu-new '((t (:foreground "red"))) "Face for new reports that nobody has answered.") @@ -141,7 +166,7 @@ "Face for reports that have been modified recently.") (defface debbugs-gnu-pending '((t (:foreground "MidnightBlue"))) - "Face for reports that have been modified recently.") + "Face for reports that are pending.") (defface debbugs-gnu-stale '((t (:foreground "orange"))) "Face for reports that have not been touched for a week.") @@ -177,22 +202,184 @@ (format "(setq debbugs-gnu-local-tags '%S)" (sort (copy-sequence debbugs-gnu-local-tags) '<))))) -(defvar debbugs-gnu-current-severities nil - "The severities strings to be searched for.") - -(defvar debbugs-gnu-current-packages nil - "The package names to be searched for.") - -(defvar debbugs-gnu-current-archive nil - "Whether to search in the archive.") +(defvar debbugs-gnu-current-query nil + "The query object of the current search. +It will be applied server-side, when calling `debbugs-get-bugs'. +It has the same format as `debbugs-gnu-default-suppress-bugs'.") + +(defvar debbugs-gnu-current-filter nil + "The filter object for the current search. +It will be applied client-side, when parsing the results of +`debbugs-get-status'. It has a similar format as +`debbugs-gnu-default-suppress-bugs'. In case of keys representing +a date, value is the cons cell \(BEFORE . AFTER\).") + +(defun debbugs-gnu-calendar-read (prompt acceptable &optional initial-contents) + "Return a string read from the minibuffer. +Derived from `calendar-read'." + (let ((value (read-string prompt initial-contents))) + (while (not (funcall acceptable value)) + (setq value (read-string prompt initial-contents))) + value)) + +(defconst debbugs-gnu-phrase-prompt + (propertize + "Enter search phrase: " + 'help-echo "\ +The search phrase contains words to be searched for, combined by +operators like AND, ANDNOT and OR. If there is no operator +between the words, AND is used by default. The phrase can also +be empty, in this case only the following attributes are used for +search.")) + +;;;###autoload +(defun debbugs-gnu-search () + "Search for Emacs bugs interactively. +Search arguments are requested interactively. The \"search +phrase\" is used for full text search in the bugs database. +Further key-value pairs are requested until an empty key is +returned. If a key cannot be queried by a SOAP request, it is +marked as \"client-side filter\"." + (interactive) -(defun debbugs-gnu (severities &optional packages archivedp suppress-done) + (unwind-protect + (let ((date-format "\\([[:digit:]]\\{4\\}\\)-\\([[:digit:]]\\{1,2\\}\\)-\\([[:digit:]]\\{1,2\\}\\)") + key val1 val2 phrase severities packages archivedp) + + ;; Check for the phrase. + (setq phrase (read-string debbugs-gnu-phrase-prompt)) + (if (zerop (length phrase)) + (setq phrase nil) + (add-to-list 'debbugs-gnu-current-query (cons 'phrase phrase))) + + ;; The other queries. + (catch :finished + (while t + (setq key (completing-read + "Enter attribute: " + (if phrase + '("severity" "package" "tags" "submitter" "date" + "subject" "status") + '("severity" "package" "archive" "src" "tag" + "owner" "submitter" "maint" "correspondent" + "date" "log_modified" "last_modified" + "found_date" "fixed_date" "unarchived" + "subject" "done" "forwarded" "msgid" "summary")) + nil t)) + (cond + ;; Server-side queries. + ((equal key "severity") + (setq + severities + (completing-read-multiple + "Enter severities: " + (mapcar + 'cadr (cdr (get 'debbugs-gnu-default-severities 'custom-type))) + nil t + (mapconcat 'identity debbugs-gnu-default-severities ",")))) + + ((equal key "package") + (setq + packages + (completing-read-multiple + "Enter packages: " + (mapcar + 'cadr (cdr (get 'debbugs-gnu-default-packages 'custom-type))) + nil t (mapconcat 'identity debbugs-gnu-default-packages ",")))) + + ((equal key "archive") + ;; We simplify, by assuming just archived bugs are requested. + (setq archivedp t)) + + ((member key '("src" "tag" "tags")) + (setq val1 (read-string (format "Enter %s: " key))) + (when (not (zerop (length val1))) + (add-to-list + 'debbugs-gnu-current-query (cons (intern key) val1)))) + + ((member key '("owner" "submitter" "maint" "correspondent")) + (setq val1 (read-string "Enter email address: ")) + (when (not (zerop (length val1))) + (add-to-list + 'debbugs-gnu-current-query (cons (intern key) val1)))) + + ((equal key "status") + (setq + val1 + (completing-read "Enter status: " '("done" "forwarded" "open"))) + (when (not (zerop (length val1))) + (add-to-list + 'debbugs-gnu-current-query (cons (intern key) val1)))) + + ;; Client-side filters. + ((member key '("date" "log_modified" "last_modified" + "found_date" "fixed_date" "unarchived")) + (setq val1 + (debbugs-gnu-calendar-read + (format "Enter %s before YYYY-MM-DD%s: " + key (if phrase "" " (client-side filter)")) + (lambda (x) + (string-match (concat "^\\(" date-format "\\|\\)$") x)))) + (if (string-match date-format val1) + (setq val1 (floor + (float-time + (encode-time + 0 0 0 + (string-to-number (match-string 3 val1)) + (string-to-number (match-string 2 val1)) + (string-to-number (match-string 1 val1)))))) + (setq val1 nil)) + (setq val2 + (debbugs-gnu-calendar-read + (format "Enter %s after YYYY-MM-DD%s: " + key (if phrase "" " (client-side filter)")) + (lambda (x) + (string-match (concat "^\\(" date-format "\\|\\)$") x)))) + (if (string-match date-format val2) + (setq val2 (floor + (float-time + (encode-time + 0 0 0 + (string-to-number (match-string 3 val2)) + (string-to-number (match-string 2 val2)) + (string-to-number (match-string 1 val2)))))) + (setq val2 nil)) + (when (or val1 val2) + (add-to-list + (if phrase + 'debbugs-gnu-current-query 'debbugs-gnu-current-filter) + (cons (intern key) (cons val1 val2))))) + + ((not (zerop (length key))) + (setq val1 + (funcall + (if phrase 'read-string 'read-regexp) + (format "Enter %s%s" + key (if phrase ": " " (client-side filter)")))) + (when (not (zerop (length val1))) + (add-to-list + (if phrase + 'debbugs-gnu-current-query 'debbugs-gnu-current-filter) + (cons (intern key) val1)))) + + ;; The End. + (t (throw :finished nil))))) + + ;; Do the search. + (debbugs-gnu severities packages archivedp)) + + ;; Reset query and filter. + (setq debbugs-gnu-current-query nil + debbugs-gnu-current-filter nil))) + +;;;###autoload +(defun debbugs-gnu (severities &optional packages archivedp suppress) "List all outstanding Emacs bugs." (interactive (let (archivedp) (list (completing-read-multiple - "Severity: " + "Severities: " (mapcar 'cadr (cdr (get 'debbugs-gnu-default-severities 'custom-type))) nil t (mapconcat 'identity debbugs-gnu-default-severities ",")) ;; The optional parameters are asked only when there is a prefix. @@ -205,7 +392,7 @@ (when current-prefix-arg (setq archivedp (y-or-n-p "Show archived bugs?"))) (when (and current-prefix-arg (not archivedp)) - (y-or-n-p "Suppress closed bugs?"))))) + (y-or-n-p "Suppress unwanted bugs?"))))) ;; Initialize variables. (when (and (file-exists-p debbugs-gnu-persistency-file) @@ -213,77 +400,116 @@ (with-temp-buffer (insert-file-contents debbugs-gnu-persistency-file) (eval (read (current-buffer))))) - ;; Set lists. - (unless (consp severities) - (setq severities (list severities))) - (unless (consp packages) - (setq packages (list packages))) - - (setq debbugs-gnu-current-severities severities - debbugs-gnu-current-packages packages - debbugs-gnu-current-archive (if archivedp "1" "0") - debbugs-gnu-widgets nil) - - (let ((hits debbugs-gnu-default-hits-per-page) - (ids (debbugs-gnu-get-bugs))) - - (if (> (length ids) hits) - (let ((cursor-in-echo-area nil)) - (setq hits - (string-to-number - (read-string - (format - "How many reports (available %d, default %d): " - (length ids) hits) - nil - nil - (number-to-string hits)))))) - - (if (> (length ids) hits) - (let ((i 0) - curr-ids) - (while ids - (setq i (1+ i) - curr-ids (butlast ids (- (length ids) hits))) - (add-to-list - 'debbugs-gnu-widgets - (widget-convert - 'push-button - :follow-link 'mouse-face - :notify (lambda (widget &rest ignore) - (debbugs-gnu-show-reports widget)) - :keymap debbugs-gnu-widget-map - :suppress-done suppress-done - :buffer-name (format "*Emacs Bugs*<%d>" i) - :bug-ids curr-ids - :help-echo (format "%d-%d" (car ids) (car (last curr-ids))) - :format " %[%v%]" - (number-to-string i)) - 'append) - (setq ids (last ids (- (length ids) hits)))) - (debbugs-gnu-show-reports (car debbugs-gnu-widgets))) - - (debbugs-gnu-show-reports - (widget-convert - 'const - :suppress-done suppress-done - :buffer-name "*Emacs Bugs*" - :bug-ids ids))))) - -(defun debbugs-gnu-get-bugs () + (setq debbugs-gnu-widgets nil) + + ;; Add queries. + (dolist (severity (if (consp severities) severities (list severities))) + (when (not (zerop (length severity))) + (add-to-list 'debbugs-gnu-current-query (cons 'severity severity)))) + (dolist (package (if (consp packages) packages (list packages))) + (when (not (zerop (length package))) + (add-to-list 'debbugs-gnu-current-query (cons 'package package)))) + (when archivedp + (add-to-list 'debbugs-gnu-current-query '(archive . "1"))) + + (unwind-protect + (let ((hits debbugs-gnu-default-hits-per-page) + (ids (debbugs-gnu-get-bugs debbugs-gnu-current-query))) + + (if (> (length ids) hits) + (let ((cursor-in-echo-area nil)) + (setq hits + (string-to-number + (read-string + (format + "How many reports (available %d, default %d): " + (length ids) hits) + nil + nil + (number-to-string hits)))))) + + (if (> (length ids) hits) + (let ((i 0) + curr-ids) + (while ids + (setq i (1+ i) + curr-ids (butlast ids (- (length ids) hits))) + (add-to-list + 'debbugs-gnu-widgets + (widget-convert + 'push-button + :follow-link 'mouse-face + :notify (lambda (widget &rest ignore) + (debbugs-gnu-show-reports widget)) + :keymap debbugs-gnu-widget-map + :suppress suppress + :buffer-name (format "*Emacs Bugs*<%d>" i) + :bug-ids curr-ids + :query debbugs-gnu-current-query + :filter debbugs-gnu-current-filter + :help-echo (format "%d-%d" (car ids) (car (last curr-ids))) + :format " %[%v%]" + (number-to-string i)) + 'append) + (setq ids (last ids (- (length ids) hits)))) + (debbugs-gnu-show-reports (car debbugs-gnu-widgets))) + + (debbugs-gnu-show-reports + (widget-convert + 'const + :suppress suppress + :buffer-name "*Emacs Bugs*" + :bug-ids ids + :query debbugs-gnu-current-query + :filter debbugs-gnu-current-filter)))) + + ;; Reset query and filter. + (setq debbugs-gnu-current-query nil + debbugs-gnu-current-filter nil))) + +(defun debbugs-gnu-get-bugs (query) "Retrieve bugs numbers from debbugs.gnu.org according search criteria." (let ((debbugs-port "gnu.org") - args ids) - (dolist (severity debbugs-gnu-current-severities (sort ids '<)) - (if (string-equal severity "tagged") - (setq ids (nconc ids (copy-sequence debbugs-gnu-local-tags))) - (dolist (package debbugs-gnu-current-packages) - (setq args `(:archive ,debbugs-gnu-current-archive)) - (when (not (zerop (length severity))) - (setq args (append args `(:severity ,severity)))) - (when (not (zerop (length package))) - (setq args (append args `(:package ,package)))) - (setq ids (nconc ids (apply 'debbugs-get-bugs args)))))))) + (tagged (when (member '(severity . "tagged") query) + (copy-sequence debbugs-gnu-local-tags))) + (phrase (assoc 'phrase query)) + args) + ;; Compile query arguments. + (unless query + (dolist (elt debbugs-gnu-default-packages) + (setq args (append args (list :package elt))))) + (dolist (elt query) + (unless (equal elt '(severity . "tagged")) + (setq args + (append + args + (if phrase + (cond + ((eq (car elt) 'phrase) + (list (list :phrase (cdr elt) :max 500))) + ((eq (car elt) 'date) + (list (list :date (cddr elt) (cadr elt) + :operator "NUMBT"))) + (t + (list (list (intern (concat ":" (symbol-name (car elt)))) + (cdr elt) :operator "ISTRINC")))) + (list (intern (concat ":" (symbol-name (car elt)))) + (cdr elt))))))) + + (cond + ;; If the query contains only the pseudo-severity "tagged", we + ;; return just the local tagged bugs. + ((and tagged (not (memq :severity args))) + (sort tagged '<)) + ;; A full text query. + (phrase + (append + (mapcar + (lambda (x) (cdr (assoc "id" x))) + (apply 'debbugs-search-est args)) + tagged)) + ;; Otherwise, we retrieve the bugs from the server. + (t (sort (append (apply 'debbugs-get-bugs args) tagged) '<))))) (defvar debbugs-gnu-current-widget nil) @@ -295,7 +521,6 @@ (debbugs-gnu-mode) (let ((inhibit-read-only t) (debbugs-port "gnu.org")) - (erase-buffer) (set (make-local-variable 'debbugs-gnu-current-widget) widget) @@ -330,55 +555,64 @@ merged (mapconcat 'number-to-string merged ",")) words))) - (add-to-list - 'tabulated-list-entries - (list - status - (vector - (propertize - (format "%5d" id) - 'face - ;; Mark tagged bugs. - (if (memq id debbugs-gnu-local-tags) - 'debbugs-gnu-tagged - 'default)) - (propertize - ;; Mark status and age. - words - 'face - (cond - ((equal (cdr (assq 'pending status)) "done") - 'debbugs-gnu-done) - ((member "pending" (cdr (assq 'keywords status))) - 'debbugs-gnu-pending) - ((= (cdr (assq 'date status)) - (cdr (assq 'log_modified status))) - 'debbugs-gnu-new) - ((< (- (float-time) - (cdr (assq 'log_modified status))) - (* 60 60 24 7)) - 'debbugs-gnu-handled) - (t - 'debbugs-gnu-stale))) - (propertize - ;; Prefer the name over the address. - (or (cdr address) - (car address)) - 'face - ;; Mark own submitted bugs. - (if (and (stringp (car address)) - (string-equal (car address) user-mail-address)) - 'debbugs-gnu-tagged - 'default)) - (propertize - subject - 'face - ;; Mark owned bugs. - (if (and (stringp owner) - (string-equal owner user-mail-address)) - 'debbugs-gnu-tagged - 'default)))) - 'append))) + (when (or (not merged) + (not (let ((found nil)) + (dolist (id (if (listp merged) + merged + (list merged))) + (dolist (entry tabulated-list-entries) + (when (equal id (cdr (assq 'id (car entry)))) + (setq found t)))) + found))) + (add-to-list + 'tabulated-list-entries + (list + status + (vector + (propertize + (format "%5d" id) + 'face + ;; Mark tagged bugs. + (if (memq id debbugs-gnu-local-tags) + 'debbugs-gnu-tagged + 'default)) + (propertize + ;; Mark status and age. + words + 'face + (cond + ((equal (cdr (assq 'pending status)) "done") + 'debbugs-gnu-done) + ((member "pending" (cdr (assq 'keywords status))) + 'debbugs-gnu-pending) + ((= (cdr (assq 'date status)) + (cdr (assq 'log_modified status))) + 'debbugs-gnu-new) + ((< (- (float-time) + (cdr (assq 'log_modified status))) + (* 60 60 24 7 2)) + 'debbugs-gnu-handled) + (t + 'debbugs-gnu-stale))) + (propertize + ;; Prefer the name over the address. + (or (cdr address) + (car address)) + 'face + ;; Mark own submitted bugs. + (if (and (stringp (car address)) + (string-equal (car address) user-mail-address)) + 'debbugs-gnu-tagged + 'default)) + (propertize + subject + 'face + ;; Mark owned bugs. + (if (and (stringp owner) + (string-equal owner user-mail-address)) + 'debbugs-gnu-tagged + 'default)))) + 'append)))) (tabulated-list-init-header) (tabulated-list-print) @@ -406,18 +640,43 @@ Used instead of `tabulated-list-print-entry'." (mapc (lambda (obj) (widget-apply obj :create)) debbugs-gnu-widgets) (widget-setup))) - (when (or (not (widget-get debbugs-gnu-current-widget :suppress-done)) - (not (equal (cdr (assq 'pending list-id)) "done"))) - (let ((beg (point)) - (pos 0) - (id (aref cols 0)) - (id-length (nth 1 (aref tabulated-list-format 0))) - (state (aref cols 1)) - (state-length (nth 1 (aref tabulated-list-format 1))) - (submitter (aref cols 2)) - (submitter-length (nth 1 (aref tabulated-list-format 2))) - (title (aref cols 3)) - (title-length (nth 1 (aref tabulated-list-format 3)))) + (let ((beg (point)) + (pos 0) + (case-fold-search t) + (id (aref cols 0)) + (id-length (nth 1 (aref tabulated-list-format 0))) + (state (aref cols 1)) + (state-length (nth 1 (aref tabulated-list-format 1))) + (submitter (aref cols 2)) + (submitter-length (nth 1 (aref tabulated-list-format 2))) + (title (aref cols 3)) + (title-length (nth 1 (aref tabulated-list-format 3)))) + (when (and + ;; Filter suppressed bugs. + (or (not (widget-get debbugs-gnu-current-widget :suppress)) + (not (catch :suppress + (dolist (check debbugs-gnu-default-suppress-bugs) + (when + (string-match + (cdr check) + (or (cdr (assq (car check) list-id)) "")) + (throw :suppress t)))))) + ;; Filter search list. + (not (catch :suppress + (dolist (check + (widget-get debbugs-gnu-current-widget :filter)) + (let ((val (cdr (assq (car check) list-id)))) + (if (stringp (cdr check)) + ;; Regular expression. + (when (not (string-match (cdr check) (or val ""))) + (throw :suppress t)) + ;; Time value. + (when (or (and (numberp (cadr check)) + (< (cadr check) val)) + (and (numberp (cddr check)) + (> (cddr check) val))) + (throw :suppress t)))))))) + ;; Insert id. (indent-to (- id-length (length id))) (insert id) @@ -449,12 +708,11 @@ Used instead of `tabulated-list-print-entry'." (define-key map "\r" 'debbugs-gnu-select-report) (define-key map [mouse-1] 'debbugs-gnu-select-report) (define-key map [mouse-2] 'debbugs-gnu-select-report) - (define-key map "q" 'bury-buffer) (define-key map "s" 'debbugs-gnu-toggle-sort) (define-key map "t" 'debbugs-gnu-toggle-tag) (define-key map "d" 'debbugs-gnu-display-status) (define-key map "g" 'debbugs-gnu-rescan) - (define-key map "x" 'debbugs-gnu-toggle-suppress-done) + (define-key map "x" 'debbugs-gnu-toggle-suppress) (define-key map "C" 'debbugs-gnu-send-control-message) map)) @@ -469,7 +727,8 @@ Used instead of `tabulated-list-print-entry'." (let ((first-id (car (widget-get debbugs-gnu-current-widget :bug-ids))) (last-id (car (last (widget-get debbugs-gnu-current-widget :bug-ids)))) - (ids (debbugs-gnu-get-bugs))) + (ids (debbugs-gnu-get-bugs + (widget-get debbugs-gnu-current-widget :query)))) (while (and (<= first-id last-id) (not (memq first-id ids))) (setq first-id (1+ first-id))) @@ -595,11 +854,11 @@ The following commands are available: 'face 'debbugs-gnu-tagged)))) (debbugs-gnu-dump-persistency-file)) -(defun debbugs-gnu-toggle-suppress-done () - "Suppress bugs marked as done." +(defun debbugs-gnu-toggle-suppress () + "Suppress bugs marked in `debbugs-gnu-suppress-bugs'." (interactive) - (widget-put debbugs-gnu-current-widget :suppress-done - (not (widget-get debbugs-gnu-current-widget :suppress-done))) + (widget-put debbugs-gnu-current-widget :suppress + (not (widget-get debbugs-gnu-current-widget :suppress))) (tabulated-list-init-header) (tabulated-list-print)) @@ -656,22 +915,35 @@ The following commands are available: (set (make-local-variable 'gnus-posting-styles) `((".*" (eval - (with-current-buffer gnus-article-copy - (set (make-local-variable 'message-prune-recipient-rules) - '((".*@debbugs.*" "emacs-pretest-bug") - (".*@debbugs.*" "bug-gnu-emacs") - ("[0-9]+@debbugs.*" "submit@debbugs.gnu.org") - ("[0-9]+@debbugs.*" "quiet@debbugs.gnu.org"))) - (set (make-local-variable 'message-alter-recipients-function) - (lambda (address) - (if (string-match "\\([0-9]+\\)@donarmstrong" (car address)) - (let ((new (format "%s@debbugs.gnu.org" - (match-string 1 (car address))))) - (cons new new)) - address))) - ;; `gnus-posting-styles' is eval'ed after - ;; `message-simplify-subject'. So we cannot use m-s-s. - (setq subject ,debbugs-gnu-subject))))))) + (when (buffer-live-p gnus-article-copy) + (with-current-buffer gnus-article-copy + (set (make-local-variable 'message-prune-recipient-rules) + '((".*@debbugs.*" "emacs-pretest-bug") + (".*@debbugs.*" "bug-gnu-emacs") + ("[0-9]+@debbugs.*" "submit@debbugs.gnu.org") + ("[0-9]+@debbugs.*" "quiet@debbugs.gnu.org"))) + (set (make-local-variable 'message-alter-recipients-function) + (lambda (address) + (if (string-match "\\([0-9]+\\)@donarmstrong" + (car address)) + (let ((new (format "%s@debbugs.gnu.org" + (match-string 1 (car address))))) + (cons new new)) + address))) + ;; `gnus-posting-styles' is eval'ed after + ;; `message-simplify-subject'. So we cannot use m-s-s. + (setq subject ,debbugs-gnu-subject)))))))) + +(defun debbugs-gnu-guess-current-id () + "Guess the ID based on \"#23\"." + (save-excursion + (beginning-of-line) + (and + (or (re-search-forward "#\\([0-9]+\\)" (line-end-position) t) + (progn + (goto-char (point-min)) + (re-search-forward "#\\([0-9]+\\)" nil t))) + (string-to-number (match-string 1))))) (defun debbugs-gnu-send-control-message (message &optional reverse) "Send a control message for the current bug report. @@ -690,11 +962,13 @@ removed instead." "merge" "forcemerge" "owner" "noowner" "invalid" + "reassign" "patch" "wontfix" "moreinfo" "unreproducible" "fixed" "notabug" "pending" "help" "security" "confirmed") nil t) current-prefix-arg)) (let* ((id (or debbugs-gnu-bug-number ; Set on group entry. + (debbugs-gnu-guess-current-id) (debbugs-gnu-current-id))) (version (when (member message '("close" "done")) @@ -727,6 +1001,8 @@ removed instead." (read-string "Merge with bug #: "))) ((equal message "owner") (format "owner %d !\n" id)) + ((equal message "reassign") + (format "reassign %d %s\n" id (read-string "Package: "))) ((equal message "close") (format "close %d %s\n" id version)) ((equal message "done") @@ -750,4 +1026,6 @@ removed instead." ;;; TODO: +;; * Reorganize pages after client-side filtering. + ;;; debbugs-gnu.el ends here