X-Git-Url: https://code.delx.au/gnu-emacs-elpa/blobdiff_plain/43a0618423817ea2add5d428cb3449be8aac009c..8f6fe36e1ad23834e9b772e8fcdfe85d5eb47356:/packages/debbugs/debbugs-gnu.el diff --git a/packages/debbugs/debbugs-gnu.el b/packages/debbugs/debbugs-gnu.el index eba1f7581..392934800 100644 --- a/packages/debbugs/debbugs-gnu.el +++ b/packages/debbugs/debbugs-gnu.el @@ -1,12 +1,11 @@ ;;; debbugs-gnu.el --- interface for the GNU bug tracker -;; Copyright (C) 2011-2015 Free Software Foundation, Inc. +;; Copyright (C) 2011-2016 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Michael Albinus ;; Keywords: comm, hypermedia, maint ;; Package: debbugs -;; Version: 0.8 ;; This file is not part of GNU Emacs. @@ -59,7 +58,7 @@ ;; If a prefix is given to the command, more search parameters are ;; asked for, like packages (also a comma separated list, "emacs" is ;; the default), whether archived bugs shall be shown, and whether -;; closed bugs shall be shown. +;; closed bugs shall be suppressed from being retrieved. ;; Another command is ;; @@ -76,18 +75,18 @@ ;; 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. +;; downloaded at once. If there are more hits, several downloads will +;; be performed, until all bugs are retrieved. ;; These default values could be changed also by customer options -;; `debbugs-gnu-default-severities', `debbugs-gnu-default-packages', -;; `debbugs-gnu-default-hits-per-page' and `debbugs-gnu-default-suppress-bugs'. +;; `debbugs-gnu-default-severities', `debbugs-gnu-default-packages' +;; and `debbugs-gnu-default-suppress-bugs'. -;; The commands create one or more pages of bug lists. Every bug is -;; shown in one line, including the bug number, the status (combining -;; merged bug numbers, keywords and severities), the name of the -;; submitter, and the title of the bug. On every bug line you could -;; apply the following actions by the following keystrokes: +;; The commands create a page of bug lists. Every bug is shown in one +;; line, including the bug number, the status (combining merged bug +;; numbers, keywords and severities), the name of the submitter, and +;; the title of the bug. On every bug line you could apply the +;; following actions by the following keystrokes: ;; RET: Show corresponding messages in Gnus/Rmail ;; "C": Send a control message @@ -106,8 +105,8 @@ ;; "R": Display only bugs blocking the current release ;; "w": Display all the currently selected bug reports -;; When you visit the related bug messages in Gnus, you could also -;; send control messages by keystroke "C". +;; When you visit the related bug messages in Gnus or Rmail, you could +;; also send control messages by keystroke "C". ;; In the header line of every bug list page, you can toggle sorting ;; per column by selecting a column with the mouse. The sorting @@ -120,11 +119,11 @@ ;; This command shows you all existing user tags for the packages ;; defined in `debbugs-gnu-default-packages'. A prefix for the -;; command allows you to use other packe names, or an arbitrary string -;; for a user who has tagged bugs. The command returns the list of -;; existing user tags for the given user(s) or package name(s), -;; respectively. Applying RET on a user tag, all bugs tagged with -;; this user tag are shown. +;; command allows you to use other package names, or an arbitrary +;; string for a user who has tagged bugs. The command returns the +;; list of existing user tags for the given user(s) or package +;; name(s), respectively. Applying RET on a user tag, all bugs tagged +;; with this user tag are shown. ;; Unfortunately, it is not possible with the SOAP interface to show ;; all users who have tagged bugs. This list can be retrieved via @@ -156,6 +155,7 @@ (autoload 'gnus-with-article-buffer "gnus-art") (autoload 'log-edit-insert-changelog "log-edit") (autoload 'mail-header-subject "nnheader") +(autoload 'message-goto-body "message") (autoload 'message-make-from "message") (autoload 'rmail-get-new-mail "rmail") (autoload 'rmail-show-message "rmail") @@ -174,6 +174,13 @@ (defvar rmail-summary-mode-map) (defvar rmail-total-messages) +;; Buffer-local variables. +(defvar debbugs-gnu-local-query) +(defvar debbugs-gnu-local-filter) +(defvar debbugs-gnu-local-suppress) +(defvar debbugs-gnu-sort-state) +(defvar debbugs-gnu-limit) + (defgroup debbugs-gnu () "UI for the debbugs.gnu.org bug tracker." :group 'debbugs @@ -186,6 +193,8 @@ "*The list severities bugs are searched for. \"tagged\" is not a severity but marks locally tagged bugs." ;; + ;; /ssh:debbugs:/etc/debbugs/config @gSeverityList + ;; We don't use "critical" and "grave". :group 'debbugs-gnu :type '(set (const "serious") (const "important") @@ -234,16 +243,11 @@ (mapcar 'cadr (cdr (get 'debbugs-gnu-default-packages 'custom-type))) "*List of all possible package names.") -;; Please do not increase this value, otherwise we would run into -;; performance problems on the server. -(defconst debbugs-gnu-default-hits-per-page 500 - "The number of bugs shown per page.") - (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 +being returned by `debbugs-get-status', and REGEXP a regular expression matching the corresponding value, a string. Showing suppressed bugs is toggled by `debbugs-gnu-toggle-suppress'." :group 'debbugs-gnu @@ -294,7 +298,7 @@ If this is 'rmail, use Rmail instead." ";; -*- emacs-lisp -*-\n" ";; Debbugs tags connection history. Don't change this file.\n\n" (format "(setq debbugs-gnu-local-tags '%S)" - (sort (copy-sequence debbugs-gnu-local-tags) '<))))) + (sort (copy-sequence debbugs-gnu-local-tags) '>))))) (defvar debbugs-gnu-current-query nil "The query object of the current search. @@ -308,6 +312,11 @@ It will be applied client-side, when parsing the results of `debbugs-gnu-default-suppress-bugs'. In case of keys representing a date, value is the cons cell \(BEFORE . AFTER\).") +(defvar debbugs-gnu-current-suppress nil + "Whether bugs shall be suppressed. +The specification which bugs shall be suppressed is taken from + `debbugs-gnu-default-suppress-bugs'.") + (defun debbugs-gnu-calendar-read (prompt acceptable &optional initial-contents) "Return a string read from the minibuffer. Derived from `calendar-read'." @@ -345,6 +354,8 @@ marked as \"client-side filter\"." (if (zerop (length phrase)) (setq phrase nil) (add-to-list 'debbugs-gnu-current-query (cons 'phrase phrase))) + ;; We suppress closed bugs if there is no phrase. + (setq debbugs-gnu-current-suppress (null phrase)) ;; The other queries. (catch :finished @@ -455,14 +466,7 @@ marked as \"client-side filter\"." (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))) - -(defvar debbugs-gnu-current-limit nil) -(defvar debbugs-gnu-current-suppress nil) + (debbugs-gnu severities packages archivedp)))) ;;;###autoload (defun debbugs-gnu (severities &optional packages archivedp suppress tags) @@ -494,20 +498,26 @@ marked as \"client-side filter\"." (with-temp-buffer (insert-file-contents debbugs-gnu-persistency-file) (eval (read (current-buffer))))) + ;; Per default, we suppress retrieved unwanted bugs. + (when (called-interactively-p 'any) + (setq debbugs-gnu-current-suppress t)) ;; Add queries. (dolist (severity (if (consp severities) severities (list severities))) (when (not (zerop (length severity))) + (when (string-equal severity "tagged") + (setq debbugs-gnu-current-suppress nil)) (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 + (setq debbugs-gnu-current-suppress nil) (add-to-list 'debbugs-gnu-current-query '(archive . "1"))) (when suppress + (setq debbugs-gnu-current-suppress t) (add-to-list 'debbugs-gnu-current-query '(status . "open")) - (add-to-list 'debbugs-gnu-current-query '(status . "forwarded")) - (setq debbugs-gnu-current-suppress suppress)) + (add-to-list 'debbugs-gnu-current-query '(status . "forwarded"))) (dolist (tag (if (consp tags) tags (list tags))) (when (not (zerop (length tag))) (add-to-list 'debbugs-gnu-current-query (cons 'tag tag)))) @@ -515,12 +525,13 @@ marked as \"client-side filter\"." ;; Show result. (debbugs-gnu-show-reports) - ;; Reset query and filter. + ;; Reset query, filter and suppress. (setq debbugs-gnu-current-query nil - debbugs-gnu-current-filter nil)) + debbugs-gnu-current-filter nil + debbugs-gnu-current-suppress nil)) (defun debbugs-gnu-get-bugs (query) - "Retrieve bugs numbers from debbugs.gnu.org according search criteria." + "Retrieve bug numbers from debbugs.gnu.org according search criteria." (let* ((debbugs-port "gnu.org") (bugs (assoc 'bugs query)) (tags (assoc 'tag query)) @@ -539,7 +550,7 @@ marked as \"client-side filter\"." (if phrase (cond ((eq (car elt) 'phrase) - (list (list :phrase (cdr elt) :max 500))) + (list (list :phrase (cdr elt)))) ((eq (car elt) 'date) (list (list :date (cddr elt) (cadr elt) :operator "NUMBT"))) @@ -549,33 +560,28 @@ marked as \"client-side filter\"." (list (intern (concat ":" (symbol-name (car elt)))) (cdr elt))))))) - (sort - (cond - ;; If the query is just a list of bug numbers, we return them. - (bugs (cdr bugs)) - ;; If the query contains the pseudo-severity "tagged", we return - ;; just the local tagged bugs. - (local-tags (copy-sequence debbugs-gnu-local-tags)) - ;; A full text query. - (phrase - (mapcar - (lambda (x) (cdr (assoc "id" x))) - (apply 'debbugs-search-est args))) - ;; User tags. - (tags - (setq args (mapcar (lambda (x) (if (eq x :package) :user x)) args)) - (apply 'debbugs-get-usertag args)) - ;; Otherwise, we retrieve the bugs from the server. - (t (apply 'debbugs-get-bugs args))) - ;; Sort function. - '<))) + (cond + ;; If the query is just a list of bug numbers, we return them. + (bugs (cdr bugs)) + ;; If the query contains the pseudo-severity "tagged", we return + ;; just the local tagged bugs. + (local-tags (copy-sequence debbugs-gnu-local-tags)) + ;; A full text query. + (phrase + (mapcar + (lambda (x) (cdr (assoc "id" x))) + (apply 'debbugs-search-est args))) + ;; User tags. + (tags + (setq args (mapcar (lambda (x) (if (eq x :package) :user x)) args)) + (apply 'debbugs-get-usertag args)) + ;; Otherwise, we retrieve the bugs from the server. + (t (apply 'debbugs-get-bugs args))))) (defun debbugs-gnu-show-reports () "Show bug reports." (let ((inhibit-read-only t) - (debbugs-port "gnu.org") - (buffer-name "*Emacs Bugs*") - all-status) + (buffer-name "*Emacs Bugs*")) ;; The tabulated mode sets several local variables. We must get ;; rid of them. (when (get-buffer buffer-name) @@ -583,20 +589,10 @@ marked as \"client-side filter\"." (switch-to-buffer (get-buffer-create buffer-name)) (debbugs-gnu-mode) - ;; Retrieve all bugs in chunks of `debbugs-gnu-default-hits-per-page'. - (let ((bug-ids (debbugs-gnu-get-bugs debbugs-gnu-current-query)) - (hits debbugs-gnu-default-hits-per-page) - curr-ids) - (while bug-ids - (setq curr-ids (butlast bug-ids (- (length bug-ids) hits)) - bug-ids (last bug-ids (- (length bug-ids) hits)) - all-status - (append all-status (apply 'debbugs-get-status curr-ids))))) - ;; Print bug reports. - ;; TODO: Do it asynchronously, in parallel to retrieving next chunk - ;; of bug statuses. - (dolist (status all-status) + (dolist (status + (apply 'debbugs-get-status + (debbugs-gnu-get-bugs debbugs-gnu-local-query))) (let* ((id (cdr (assq 'id status))) (words (mapconcat @@ -604,19 +600,20 @@ marked as \"client-side filter\"." (cons (cdr (assq 'severity status)) (cdr (assq 'keywords status))) ",")) - (address (mail-header-parse-address - (decode-coding-string (cdr (assq 'originator status)) - 'utf-8))) + (address (if (cdr (assq 'originator status)) + (mail-header-parse-address + (decode-coding-string (cdr (assq 'originator status)) + 'utf-8)))) (owner (if (cdr (assq 'owner status)) (car (mail-header-parse-address (decode-coding-string (cdr (assq 'owner status)) 'utf-8))))) - (subject (decode-coding-string (cdr (assq 'subject status)) - 'utf-8)) + (subject (if (cdr (assq 'subject status)) + (decode-coding-string (cdr (assq 'subject status)) + 'utf-8))) merged) (unless (equal (cdr (assq 'pending status)) "pending") - (setq words - (concat words "," (cdr (assq 'pending status))))) + (setq words (concat words "," (cdr (assq 'pending status))))) (let ((packages (delete "emacs" (cdr (assq 'package status))))) (when packages (setq words (concat words "," (mapconcat 'identity packages ","))))) @@ -649,7 +646,7 @@ marked as \"client-side filter\"." 'default)) (propertize ;; Mark status and age. - words + (or words "") 'face (cond ((cdr (assq 'archived status)) @@ -670,7 +667,8 @@ marked as \"client-side filter\"." (propertize ;; Prefer the name over the address. (or (cdr address) - (car address)) + (car address) + "") 'face ;; Mark own submitted bugs. (if (and (stringp (car address)) @@ -678,7 +676,7 @@ marked as \"client-side filter\"." 'debbugs-gnu-tagged 'default)) (propertize - subject + (or subject "") 'face ;; Mark owned bugs. (if (and (stringp owner) @@ -686,6 +684,7 @@ marked as \"client-side filter\"." 'debbugs-gnu-tagged 'default)))) 'append)))) + (tabulated-list-init-header) (tabulated-list-print) @@ -708,21 +707,20 @@ Used instead of `tabulated-list-print-entry'." (title-length (nth 1 (aref tabulated-list-format 3)))) (when (and ;; We may have a narrowing in effect. - (or (not debbugs-gnu-current-limit) - (memq (cdr (assq 'id list-id)) debbugs-gnu-current-limit)) + (or (not debbugs-gnu-limit) + (memq (cdr (assq 'id list-id)) debbugs-gnu-limit)) ;; Filter suppressed bugs. - (or (not debbugs-gnu-current-suppress) - (and (not (memq (cdr (assq 'id list-id)) debbugs-gnu-local-tags)) - (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))))))) + (or (not debbugs-gnu-local-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 debbugs-gnu-current-filter) + (dolist (check debbugs-gnu-local-filter) (let ((val (cdr (assq (car check) list-id)))) (if (stringp (cdr check)) ;; Regular expression. @@ -761,36 +759,105 @@ Used instead of `tabulated-list-print-entry'." `(tabulated-list-id ,list-id mouse-face highlight)) (insert ?\n)))) +(defun debbugs-gnu-menu-map-emacs-enabled () + "Whether \"Show Release Blocking Bugs\" is enabled in the menu." + (or ;; No package discriminator has been used. + (not (assq 'package debbugs-gnu-local-query)) + ;; Package "emacs" has been selected. + (member '(package . "emacs") debbugs-gnu-local-query))) + +(defconst debbugs-gnu-bug-triage-file + (expand-file-name "../admin/notes/bug-triage" data-directory) + "The \"bug-triage\" file.") + +(defun debbugs-gnu-menu-map-bug-triage-enabled () + "Whether \"Describe Bug Triage Procedure\" is enabled in the menu." + (and (debbugs-gnu-menu-map-emacs-enabled) + (stringp debbugs-gnu-bug-triage-file) + (file-readable-p debbugs-gnu-bug-triage-file))) + +(defun debbugs-gnu-view-bug-triage () + "Show \"bug-triage\" file." + (interactive) + (view-file debbugs-gnu-bug-triage-file)) + (defvar debbugs-gnu-mode-map - (let ((map (make-sparse-keymap))) + (let ((map (make-sparse-keymap)) + (menu-map (make-sparse-keymap))) (set-keymap-parent map tabulated-list-mode-map) (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 "g" 'debbugs-gnu-rescan) + (define-key map "R" 'debbugs-gnu-show-all-blocking-reports) + (define-key map "C" 'debbugs-gnu-send-control-message) + (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) (define-key map "/" 'debbugs-gnu-narrow-to-status) (define-key map "w" 'debbugs-gnu-widen) + (define-key map "b" 'debbugs-gnu-show-blocked-by-reports) (define-key map "B" 'debbugs-gnu-show-blocking-reports) - (define-key map "C" 'debbugs-gnu-send-control-message) - (define-key map "R" 'debbugs-gnu-show-all-blocking-reports) + (define-key map "d" 'debbugs-gnu-display-status) + + (define-key map [menu-bar debbugs] (cons "Debbugs" menu-map)) + (define-key menu-map [debbugs-gnu-select-report] + '(menu-item "Show Reports" debbugs-gnu-select-report + :help "Show all reports belonging to this bug")) + (define-key-after menu-map [debbugs-gnu-rescan] + '(menu-item "Refresh Bugs" debbugs-gnu-rescan + :help "Refresh bug list") + 'debbugs-gnu-select-report) + (define-key-after menu-map [debbugs-gnu-show-all-blocking-reports] + '(menu-item "Show Release Blocking Bugs" + debbugs-gnu-show-all-blocking-reports + :enable (debbugs-gnu-menu-map-emacs-enabled) + :help "Show all bugs blocking next Emacs release") + 'debbugs-gnu-rescan) + (define-key-after menu-map [debbugs-gnu-send-control-message] + '(menu-item "Send Control Message" + debbugs-gnu-send-control-message + :help "Send control message to debbugs.gnu.org") + 'debbugs-gnu-show-all-blocking-reports) + + (define-key-after menu-map [debbugs-gnu-separator1] + '(menu-item "--") 'debbugs-gnu-send-control-message) + (define-key-after menu-map [debbugs-gnu-search] + '(menu-item "Search Bugs" debbugs-gnu-search + :help "Search bugs on debbugs.gnu.org") + 'debbugs-gnu-separator1) + (define-key-after menu-map [debbugs-gnu] + '(menu-item "Retrieve Bugs" debbugs-gnu + :help "Retrieve bugs from debbugs.gnu.org") + 'debbugs-gnu-search) + (define-key-after menu-map [debbugs-gnu-bugs] + '(menu-item "Retrieve Bugs by Number" debbugs-gnu-bugs + :help "Retrieve selected bugs from debbugs.gnu.org") + 'debbugs-gnu) + + (define-key-after menu-map [debbugs-gnu-separator2] + '(menu-item "--") 'debbugs-gnu-bugs) + (define-key-after menu-map [debbugs-gnu-view-bug-triage] + '(menu-item "Describe Bug Triage Procedure" + debbugs-gnu-view-bug-triage + :enable (debbugs-gnu-menu-map-bug-triage-enabled) + :help "Show procedure of triaging bugs") + 'debbugs-gnu-separator2) map)) (defun debbugs-gnu-rescan () "Rescan the current set of bug reports." (interactive) - - ;; Refresh the buffer. `save-excursion' does not work, so we - ;; remember the position. - (let ((pos (point))) + (let ((id (debbugs-gnu-current-id)) + (debbugs-gnu-current-query debbugs-gnu-local-query) + (debbugs-gnu-current-filter debbugs-gnu-local-filter) + (debbugs-gnu-current-suppress debbugs-gnu-local-suppress) + (debbugs-cache-expiry (if current-prefix-arg t debbugs-cache-expiry))) (debbugs-gnu-show-reports) - (goto-char pos))) - -(defvar debbugs-gnu-sort-state 'number) + (when id + (debbugs-gnu-goto id)))) (define-derived-mode debbugs-gnu-mode tabulated-list-mode "Debbugs" "Major mode for listing bug reports. @@ -802,8 +869,13 @@ The following commands are available: \\{debbugs-gnu-mode-map}" (set (make-local-variable 'debbugs-gnu-sort-state) 'number) - (set (make-local-variable 'debbugs-gnu-current-limit) nil) - (set (make-local-variable 'debbugs-gnu-current-suppress) nil) + (set (make-local-variable 'debbugs-gnu-limit) nil) + (set (make-local-variable 'debbugs-gnu-local-query) + debbugs-gnu-current-query) + (set (make-local-variable 'debbugs-gnu-local-filter) + debbugs-gnu-current-filter) + (set (make-local-variable 'debbugs-gnu-local-suppress) + debbugs-gnu-current-suppress) (setq tabulated-list-format [("Id" 5 debbugs-gnu-sort-id) ("State" 20 debbugs-gnu-sort-state) ("Submitter" 25 t) @@ -815,7 +887,7 @@ The following commands are available: (setq buffer-read-only t)) (defun debbugs-gnu-sort-id (s1 s2) - (< (cdr (assq 'id (car s1))) + (> (cdr (assq 'id (car s1))) (cdr (assq 'id (car s2))))) (defconst debbugs-gnu-state-preference @@ -891,7 +963,7 @@ The following commands are available: (interactive) (let ((id (debbugs-gnu-current-id t)) (inhibit-read-only t)) - (setq debbugs-gnu-current-limit nil) + (setq debbugs-gnu-limit nil) (tabulated-list-init-header) (tabulated-list-print) (when id @@ -924,13 +996,13 @@ The following commands are available: (id (debbugs-gnu-current-id t)) (inhibit-read-only t) status) - (setq debbugs-gnu-current-limit nil) + (setq debbugs-gnu-limit nil) (goto-char (point-min)) (while (not (eobp)) (setq status (debbugs-gnu-current-status)) (if (not (memq (cdr (assq 'id status)) blockers)) (delete-region (point) (progn (forward-line 1) (point))) - (push (cdr (assq 'id status)) debbugs-gnu-current-limit) + (push (cdr (assq 'id status)) debbugs-gnu-limit) (forward-line 1))) (when id (debbugs-gnu-goto id)))) @@ -943,7 +1015,7 @@ Subject fields." (let ((id (debbugs-gnu-current-id t)) (inhibit-read-only t) status) - (setq debbugs-gnu-current-limit nil) + (setq debbugs-gnu-limit nil) (if (equal string "") (debbugs-gnu-toggle-suppress) (goto-char (point-min)) @@ -957,7 +1029,7 @@ Subject fields." (or status-only (not (string-match string (cdr (assq 'subject status)))))) (delete-region (point) (progn (forward-line 1) (point))) - (push (cdr (assq 'id status)) debbugs-gnu-current-limit) + (push (cdr (assq 'id status)) debbugs-gnu-limit) (forward-line 1))) (when id (debbugs-gnu-goto id))))) @@ -1004,7 +1076,7 @@ interest to you." (defun debbugs-gnu-toggle-suppress () "Suppress bugs marked in `debbugs-gnu-suppress-bugs'." (interactive) - (setq debbugs-gnu-current-suppress (not debbugs-gnu-current-suppress)) + (setq debbugs-gnu-local-suppress (not debbugs-gnu-local-suppress)) (tabulated-list-init-header) (tabulated-list-print)) @@ -1019,18 +1091,25 @@ interest to you." (defun debbugs-gnu-current-status () (get-text-property (line-beginning-position) 'tabulated-list-id)) -(defun debbugs-gnu-current-query () - debbugs-gnu-current-query) - -(defun debbugs-gnu-display-status (query status) - "Display the query and status of the report on the current line." - (interactive (list (debbugs-gnu-current-query) +(defun debbugs-gnu-display-status (query filter status) + "Display the query, filter and status of the report on the current line." + (interactive (list debbugs-gnu-local-query + debbugs-gnu-local-filter (debbugs-gnu-current-status))) (switch-to-buffer "*Bug Status*") (let ((inhibit-read-only t)) (erase-buffer) - (when query (pp query (current-buffer))) - (when status (pp status (current-buffer))) + (when query + (insert ";; Query\n") + (pp query (current-buffer)) + (insert "\n")) + (when filter + (insert ";; Filter\n") + (pp filter (current-buffer)) + (insert "\n")) + (when status + (insert ";; Status\n") + (pp status (current-buffer))) (goto-char (point-min))) (set-buffer-modified-p nil) (special-mode)) @@ -1243,7 +1322,11 @@ removed instead." (format "tags %d%s %s\n" id (if reverse " -" "") message)))) - (funcall send-mail-function)))) + (funcall send-mail-function) + (remhash id debbugs-cache-data) + (message-goto-body) + (message "Control message sent:\n%s" + (buffer-substring-no-properties (point) (1- (point-max))))))) (defvar debbugs-gnu-usertags-mode-map (let ((map (make-sparse-keymap))) @@ -1343,6 +1426,8 @@ The following commands are available: (dolist (elt bugs) (unless (natnump elt) (signal 'wrong-type-argument (list 'natnump elt)))) (add-to-list 'debbugs-gnu-current-query (cons 'bugs bugs)) + ;; We do not suppress bugs requested explicitely. + (setq debbugs-gnu-current-suppress nil) (debbugs-gnu nil)) (defvar debbugs-gnu-trunk-directory "~/src/emacs/trunk/" @@ -1568,4 +1653,7 @@ If given a prefix, patch in the branch directory instead." ;;; TODO: +;; * Another random thought - is it possible to implement some local +;; cache, so only changed bugs are fetched? Glenn Morris. + ;;; debbugs-gnu.el ends here