]> code.delx.au - gnu-emacs-elpa/blobdiff - packages/debbugs/debbugs-gnu.el
delx.au / code / gnu-emacs-elpa / blobdiff
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
Fix some quoting problems in doc strings
[gnu-emacs-elpa] / packages / debbugs / debbugs-gnu.el
diff --git a/packages/debbugs/debbugs-gnu.el b/packages/debbugs/debbugs-gnu.el
index d0ccf297988597b23fefdf4ae7c9f582031c12fa..55841fdf0384e4b6514801b97adc1c20bd7880be 100644 (file)
--- 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
+;;; debbugs-gnu.el --- interface for the GNU bug tracker  -*- lexical-binding:t -*-
 
 
-;; Copyright (C) 2011-2015 Free Software Foundation, Inc.
+;; Copyright (C) 2011-2016 Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;;         Michael Albinus <michael.albinus@gmx.org>
 ;; Keywords: comm, hypermedia, maint
 ;; Package: debbugs
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;;         Michael Albinus <michael.albinus@gmx.org>
 ;; Keywords: comm, hypermedia, maint
 ;; Package: debbugs
-;; Version: 0.8
 
 ;; This file is not part of GNU Emacs.
 
 
 ;; 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
 ;; 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
 ;;
 
 ;; 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
 
 ;; 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
 
 ;; 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
 
 ;;   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
 
 ;;   "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
 
 ;; 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
 
 ;; 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
 
 ;; Unfortunately, it is not possible with the SOAP interface to show
 ;; all users who have tagged bugs.  This list can be retrieved via
@@ -142,13 +141,14 @@
 (require 'debbugs)
 (require 'tabulated-list)
 (require 'add-log)
 (require 'debbugs)
 (require 'tabulated-list)
 (require 'add-log)
-(require 'subr-x)
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'subr-x))
+(eval-when-compile (require 'cl-lib))
 
 (autoload 'article-decode-charset "gnus-art")
 (autoload 'diff-goto-source "diff-mode")
 (autoload 'diff-hunk-file-names "diff-mode")
 (autoload 'gnus-article-mime-handles "gnus-art")
 
 (autoload 'article-decode-charset "gnus-art")
 (autoload 'diff-goto-source "diff-mode")
 (autoload 'diff-hunk-file-names "diff-mode")
 (autoload 'gnus-article-mime-handles "gnus-art")
+(autoload 'gnus-fetch-field "gnus-util")
 (autoload 'gnus-read-ephemeral-emacs-bug-group "gnus-group")
 (autoload 'gnus-summary-article-header "gnus-sum")
 (autoload 'gnus-summary-select-article "gnus-sum")
 (autoload 'gnus-read-ephemeral-emacs-bug-group "gnus-group")
 (autoload 'gnus-summary-article-header "gnus-sum")
 (autoload 'gnus-summary-select-article "gnus-sum")
@@ -156,6 +156,7 @@
 (autoload 'gnus-with-article-buffer "gnus-art")
 (autoload 'log-edit-insert-changelog "log-edit")
 (autoload 'mail-header-subject "nnheader")
 (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")
 (autoload 'message-make-from "message")
 (autoload 'rmail-get-new-mail "rmail")
 (autoload 'rmail-show-message "rmail")
@@ -174,14 +175,18 @@
 (defvar rmail-summary-mode-map)
 (defvar rmail-total-messages)
 
 (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
   :version "24.1")
 
 (defgroup debbugs-gnu ()
   "UI for the debbugs.gnu.org bug tracker."
   :group 'debbugs
   :version "24.1")
 
-(defvar debbugs-gnu-blocking-report 19759
-  "The ID of the current release report used to track blocking bug reports.")
-
 (defcustom debbugs-gnu-default-severities '("serious" "important" "normal")
   "*The list severities bugs are searched for.
 \"tagged\" is not a severity but marks locally tagged bugs."
 (defcustom debbugs-gnu-default-severities '("serious" "important" "normal")
   "*The list severities bugs are searched for.
 \"tagged\" is not a severity but marks locally tagged bugs."
@@ -197,6 +202,12 @@
              (const "tagged"))
   :version "24.1")
 
              (const "tagged"))
   :version "24.1")
 
+(defcustom debbugs-gnu-suppress-closed t
+  "If non-nil, don't show closed bugs."
+  :group 'debbugs-gnu
+  :type 'boolean
+  :version "25.1")
+
 (defconst debbugs-gnu-all-severities
   (mapcar 'cadr (cdr (get 'debbugs-gnu-default-severities 'custom-type)))
   "*List of all possible severities.")
 (defconst debbugs-gnu-all-severities
   (mapcar 'cadr (cdr (get 'debbugs-gnu-default-severities 'custom-type)))
   "*List of all possible severities.")
@@ -222,6 +233,7 @@
              (const "guile")
              (const "guix")
              (const "gzip")
              (const "guile")
              (const "guix")
              (const "gzip")
+             (const "hyperbole")
              (const "idutils")
              (const "libtool")
              (const "mh-e")
              (const "idutils")
              (const "libtool")
              (const "mh-e")
@@ -240,7 +252,7 @@
   '((pending . "done"))
   "*A list of specs for bugs to be suppressed.
 An element of this list is a cons cell \(KEY . REGEXP\), with key
   '((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
 expression matching the corresponding value, a string.  Showing
 suppressed bugs is toggled by `debbugs-gnu-toggle-suppress'."
   :group 'debbugs-gnu
@@ -249,8 +261,8 @@ suppressed bugs is toggled by `debbugs-gnu-toggle-suppress'."
 
 (defcustom debbugs-gnu-mail-backend 'gnus
   "*The email backend to use for reading bug report email exchange.
 
 (defcustom debbugs-gnu-mail-backend 'gnus
   "*The email backend to use for reading bug report email exchange.
-If this is 'gnus, the default, use Gnus.
-If this is 'rmail, use Rmail instead."
+If this is `gnus', the default, use Gnus.
+If this is `rmail', use Rmail instead."
   :group 'debbugs-gnu
   :type '(choice (const :tag "Use Gnus" 'gnus)
                 (const :tag "Use Rmail" 'rmail))
   :group 'debbugs-gnu
   :type '(choice (const :tag "Use Gnus" 'gnus)
                 (const :tag "Use Rmail" 'rmail))
@@ -269,7 +281,7 @@ If this is 'rmail, use Rmail instead."
   "Face for reports that are pending.")
 
 (defface debbugs-gnu-stale '((t (:foreground "orange")))
   "Face for reports that are pending.")
 
 (defface debbugs-gnu-stale '((t (:foreground "orange")))
-  "Face for reports that have not been touched for a week.")
+  "Face for reports that have not been touched for two weeks.")
 
 (defface debbugs-gnu-done '((t (:foreground "DarkGrey")))
   "Face for closed bug reports.")
 
 (defface debbugs-gnu-done '((t (:foreground "DarkGrey")))
   "Face for closed bug reports.")
@@ -291,7 +303,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)"
      ";; -*- 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.
 
 (defvar debbugs-gnu-current-query nil
   "The query object of the current search.
@@ -305,6 +317,27 @@ 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\).")
 
 `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'.")
+
+(defcustom debbugs-gnu-emacs-current-release "25.1"
+  "The current Emacs relase developped for."
+  :group 'debbugs-gnu
+  :type '(set (const "24.5")
+             (const "25.1")
+             (const "25.2"))
+  :version "25.1")
+
+(defconst debbugs-gnu-blocking-reports
+  '(("24.5" . 19758)
+    ("25.1" . 19759)
+    ("25.2" . 21966))
+  "The IDs of the Emacs report used to track blocking bug reports.
+It is a list of cons cells, each one containing the Emacs
+version (a string) and the bug report number (a number).")
+
 (defun debbugs-gnu-calendar-read (prompt acceptable &optional initial-contents)
   "Return a string read from the minibuffer.
 Derived from `calendar-read'."
 (defun debbugs-gnu-calendar-read (prompt acceptable &optional initial-contents)
   "Return a string read from the minibuffer.
 Derived from `calendar-read'."
@@ -342,6 +375,11 @@ marked as \"client-side filter\"."
        (if (zerop (length phrase))
            (setq phrase nil)
          (add-to-list 'debbugs-gnu-current-query (cons 'phrase phrase)))
        (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
+             (if (not debbugs-gnu-suppress-closed)
+                 nil
+               (null phrase)))
 
        ;; The other queries.
        (catch :finished
 
        ;; The other queries.
        (catch :finished
@@ -349,13 +387,28 @@ marked as \"client-side filter\"."
            (setq key (completing-read
                       "Enter attribute: "
                       (if phrase
            (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"))
+                          (append
+                           '("severity" "package" "tags"
+                             "author" "date" "subject")
+                            ;; Client-side filters.
+                           (mapcar
+                            (lambda (key)
+                              (propertize
+                               key 'face 'debbugs-gnu-done
+                               'help-echo "Client-side filter"))
+                            '("status")))
+                        (append
+                         '("severity" "package" "archive" "src" "status" "tag"
+                           "owner" "submitter" "maint" "correspondent")
+                         ;; Client-side filters.
+                         (mapcar
+                          (lambda (key)
+                            (propertize
+                             key 'face 'debbugs-gnu-done
+                             'help-echo "Client-side filter"))
+                          '("date" "log_modified" "last_modified"
+                            "found_date" "fixed_date" "unarchived"
+                            "subject" "done" "forwarded" "msgid" "summary"))))
                       nil t))
            (cond
             ;; Server-side queries.
                       nil t))
            (cond
             ;; Server-side queries.
@@ -383,21 +436,29 @@ marked as \"client-side filter\"."
                (add-to-list
                 'debbugs-gnu-current-query (cons (intern key) val1))))
 
                (add-to-list
                 'debbugs-gnu-current-query (cons (intern key) val1))))
 
-            ((member key '("owner" "submitter" "maint" "correspondent"))
+            ((member
+              key '("author" "owner" "submitter" "maint" "correspondent"))
              (setq val1 (read-string "Enter email address: "))
              (when (not (zerop (length val1)))
                (add-to-list
              (setq val1 (read-string "Enter email address: "))
              (when (not (zerop (length val1)))
                (add-to-list
-                'debbugs-gnu-current-query (cons (intern key) val1))))
+                'debbugs-gnu-current-query
+                (cons (intern (if (equal key "author") "@author" key)) val1))))
 
 
+            ;; Client-side filters.
             ((equal key "status")
              (setq
               val1
             ((equal key "status")
              (setq
               val1
-              (completing-read "Enter status: " '("done" "forwarded" "open")))
+              (completing-read
+               (format "Enter status%s: "
+                       (if (null phrase) "" " (client-side filter)"))
+               '("open" "forwarded" "done")))
              (when (not (zerop (length val1)))
              (when (not (zerop (length val1)))
-               (add-to-list
-                'debbugs-gnu-current-query (cons (intern key) val1))))
+                (if (null phrase)
+                    (add-to-list
+                     'debbugs-gnu-current-query (cons (intern key) val1))
+                  (add-to-list
+                   'debbugs-gnu-current-filter (cons 'pending val1)))))
 
 
-            ;; Client-side filters.
             ((member key '("date" "log_modified" "last_modified"
                            "found_date" "fixed_date" "unarchived"))
              (setq val1
             ((member key '("date" "log_modified" "last_modified"
                            "found_date" "fixed_date" "unarchived"))
              (setq val1
@@ -436,12 +497,13 @@ marked as \"client-side filter\"."
                     'debbugs-gnu-current-query 'debbugs-gnu-current-filter)
                 (cons (intern key) (cons val1 val2)))))
 
                     'debbugs-gnu-current-query 'debbugs-gnu-current-filter)
                 (cons (intern key) (cons val1 val2)))))
 
+            ;; "subject", "done", "forwarded", "msgid", "summary".
             ((not (zerop (length key)))
              (setq val1
                    (funcall
                     (if phrase 'read-string 'read-regexp)
             ((not (zerop (length key)))
              (setq val1
                    (funcall
                     (if phrase 'read-string 'read-regexp)
-                    (format "Enter %s%s"
-                            key (if phrase ": " " (client-side filter)"))))
+                    (format "Enter %s%s: "
+                            key (if phrase "" " (client-side filter)"))))
              (when (not (zerop (length val1)))
                (add-to-list
                 (if phrase
              (when (not (zerop (length val1)))
                (add-to-list
                 (if phrase
@@ -452,14 +514,13 @@ marked as \"client-side filter\"."
             (t (throw :finished nil)))))
 
        ;; Do the search.
             (t (throw :finished nil)))))
 
        ;; Do the search.
-       (debbugs-gnu severities packages archivedp))
+       (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)
+;;;###autoload
+(defun debbugs-gnu-patches ()
+  "List the bug reports that have been marked as containing a patch."
+  (interactive)
+  (debbugs-gnu nil debbugs-gnu-default-packages nil nil "patch"))
 
 ;;;###autoload
 (defun debbugs-gnu (severities &optional packages archivedp suppress tags)
 
 ;;;###autoload
 (defun debbugs-gnu (severities &optional packages archivedp suppress tags)
@@ -491,20 +552,27 @@ marked as \"client-side filter\"."
     (with-temp-buffer
       (insert-file-contents debbugs-gnu-persistency-file)
       (eval (read (current-buffer)))))
     (with-temp-buffer
       (insert-file-contents debbugs-gnu-persistency-file)
       (eval (read (current-buffer)))))
+  ;; Per default, we suppress retrieved unwanted bugs.
+  (when (and (called-interactively-p 'any)
+            debbugs-gnu-suppress-closed)
+    (setq debbugs-gnu-current-suppress t))
 
   ;; Add queries.
   (dolist (severity (if (consp severities) severities (list severities)))
     (when (not (zerop (length severity)))
 
   ;; 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
       (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
     (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 . "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))))
   (dolist (tag (if (consp tags) tags (list tags)))
     (when (not (zerop (length tag)))
       (add-to-list 'debbugs-gnu-current-query (cons 'tag tag))))
@@ -512,15 +580,16 @@ marked as \"client-side filter\"."
   ;; Show result.
   (debbugs-gnu-show-reports)
 
   ;; Show result.
   (debbugs-gnu-show-reports)
 
-  ;; Reset query and filter.
+  ;; Reset query, filter and suppress.
   (setq debbugs-gnu-current-query nil
   (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)
 
 (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))
   (let* ((debbugs-port "gnu.org")
         (bugs (assoc 'bugs query))
-        (tags (assoc 'tag query))
+        (tags (and (member '(severity . "tagged") query) (assoc 'tag query)))
         (local-tags (and (member '(severity . "tagged") query) (not tags)))
         (phrase (assoc 'phrase query))
         args)
         (local-tags (and (member '(severity . "tagged") query) (not tags)))
         (phrase (assoc 'phrase query))
         args)
@@ -536,7 +605,7 @@ marked as \"client-side filter\"."
               (if phrase
                   (cond
                    ((eq (car elt) 'phrase)
               (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")))
                    ((eq (car elt) 'date)
                     (list (list :date (cddr elt) (cadr elt)
                                 :operator "NUMBT")))
@@ -546,31 +615,29 @@ marked as \"client-side filter\"."
                 (list (intern (concat ":" (symbol-name (car elt))))
                       (cdr elt)))))))
 
                 (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.
-     '<)))
-
-(defun debbugs-gnu-show-reports ()
-  "Show bug reports."
+    (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 (&optional offline)
+  "Show bug reports.
+If OFFLINE is non-nil, the query is not sent to the server.  Bugs
+are taken from the cache instead."
   (let ((inhibit-read-only t)
   (let ((inhibit-read-only t)
-       (debbugs-port "gnu.org")
        (buffer-name "*Emacs Bugs*"))
     ;; The tabulated mode sets several local variables.  We must get
     ;; rid of them.
        (buffer-name "*Emacs Bugs*"))
     ;; The tabulated mode sets several local variables.  We must get
     ;; rid of them.
@@ -581,8 +648,16 @@ marked as \"client-side filter\"."
 
     ;; Print bug reports.
     (dolist (status
 
     ;; Print bug reports.
     (dolist (status
-            (apply 'debbugs-get-status
-                   (debbugs-gnu-get-bugs debbugs-gnu-current-query)))
+            (let ((debbugs-cache-expiry (if offline nil debbugs-cache-expiry))
+                  ids)
+              (apply 'debbugs-get-status
+                     (if offline
+                         (progn
+                           (maphash (lambda (key _elem)
+                                      (push key ids))
+                                    debbugs-cache-data)
+                           (sort ids '<))
+                       (debbugs-gnu-get-bugs debbugs-gnu-local-query)))))
       (let* ((id (cdr (assq 'id status)))
             (words
              (mapconcat
       (let* ((id (cdr (assq 'id status)))
             (words
              (mapconcat
@@ -590,15 +665,17 @@ marked as \"client-side filter\"."
               (cons (cdr (assq 'severity status))
                     (cdr (assq 'keywords status)))
               ","))
               (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)))))
             (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)))))
             merged)
        (unless (equal (cdr (assq 'pending status)) "pending")
          (setq words (concat words "," (cdr (assq 'pending status)))))
@@ -634,7 +711,7 @@ marked as \"client-side filter\"."
                'default))
             (propertize
              ;; Mark status and age.
                'default))
             (propertize
              ;; Mark status and age.
-             words
+             (or words "")
              'face
              (cond
               ((cdr (assq 'archived status))
              'face
              (cond
               ((cdr (assq 'archived status))
@@ -643,8 +720,11 @@ marked as \"client-side filter\"."
                'debbugs-gnu-done)
               ((member "pending" (cdr (assq 'keywords status)))
                'debbugs-gnu-pending)
                'debbugs-gnu-done)
               ((member "pending" (cdr (assq 'keywords status)))
                'debbugs-gnu-pending)
-              ((= (cdr (assq 'date status))
-                  (cdr (assq 'log_modified status)))
+              ;; For some new bugs `date' and `log_modified' may
+              ;; differ in 1 second.
+              ((< (abs (- (cdr (assq 'date status))
+                          (cdr (assq 'log_modified status))))
+                  3)
                'debbugs-gnu-new)
               ((< (- (float-time)
                      (cdr (assq 'log_modified status)))
                'debbugs-gnu-new)
               ((< (- (float-time)
                      (cdr (assq 'log_modified status)))
@@ -655,7 +735,8 @@ marked as \"client-side filter\"."
             (propertize
              ;; Prefer the name over the address.
              (or (cdr address)
             (propertize
              ;; Prefer the name over the address.
              (or (cdr address)
-                 (car address))
+                 (car address)
+                 "")
              'face
              ;; Mark own submitted bugs.
              (if (and (stringp (car address))
              'face
              ;; Mark own submitted bugs.
              (if (and (stringp (car address))
@@ -663,7 +744,7 @@ marked as \"client-side filter\"."
                  'debbugs-gnu-tagged
                'default))
             (propertize
                  'debbugs-gnu-tagged
                'default))
             (propertize
-             subject
+             (or subject "")
              'face
              ;; Mark owned bugs.
              (if (and (stringp owner)
              'face
              ;; Mark owned bugs.
              (if (and (stringp owner)
@@ -691,24 +772,24 @@ Used instead of `tabulated-list-print-entry'."
        (submitter        (aref cols 2))
        (submitter-length (nth 1 (aref tabulated-list-format 2)))
        (title            (aref cols 3))
        (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))))
+       ;; (title-length     (nth 1 (aref tabulated-list-format 3)))
+        )
     (when (and
           ;; We may have a narrowing in effect.
     (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.
           ;; 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
           ;; 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.
                    (let ((val (cdr (assq (car check) list-id))))
                      (if (stringp (cdr check))
                          ;; Regular expression.
@@ -747,35 +828,105 @@ Used instead of `tabulated-list-print-entry'."
        `(tabulated-list-id ,list-id mouse-face highlight))
       (insert ?\n))))
 
        `(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
 (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)
     (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 "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 "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 "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)
     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)
     (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.
 
 (define-derived-mode debbugs-gnu-mode tabulated-list-mode "Debbugs"
   "Major mode for listing bug reports.
@@ -787,8 +938,13 @@ The following commands are available:
 
 \\{debbugs-gnu-mode-map}"
   (set (make-local-variable 'debbugs-gnu-sort-state) 'number)
 
 \\{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)
   (setq tabulated-list-format [("Id"         5 debbugs-gnu-sort-id)
                               ("State"     20 debbugs-gnu-sort-state)
                               ("Submitter" 25 t)
@@ -800,7 +956,7 @@ The following commands are available:
   (setq buffer-read-only t))
 
 (defun debbugs-gnu-sort-id (s1 s2)
   (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
      (cdr (assq 'id (car s2)))))
 
 (defconst debbugs-gnu-state-preference
@@ -851,7 +1007,7 @@ The following commands are available:
       t)
      (t nil))))
 
       t)
      (t nil))))
 
-(defun debbugs-gnu-sort-title (s1 s2)
+(defun debbugs-gnu-sort-title (s1 _s2)
   (let ((owner (if (cdr (assq 'owner (car s1)))
                   (car (mail-header-parse-address
                         (decode-coding-string (cdr (assq 'owner (car s1)))
   (let ((owner (if (cdr (assq 'owner (car s1)))
                   (car (mail-header-parse-address
                         (decode-coding-string (cdr (assq 'owner (car s1)))
@@ -876,7 +1032,7 @@ The following commands are available:
   (interactive)
   (let ((id (debbugs-gnu-current-id t))
        (inhibit-read-only t))
   (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
     (tabulated-list-init-header)
     (tabulated-list-print)
     (when id
@@ -903,19 +1059,26 @@ The following commands are available:
 (defun debbugs-gnu-show-all-blocking-reports ()
   "Narrow the display to just the reports that are blocking a release."
   (interactive)
 (defun debbugs-gnu-show-all-blocking-reports ()
   "Narrow the display to just the reports that are blocking a release."
   (interactive)
-  (let ((blockers (cdr (assq 'blockedby
-                            (car (debbugs-get-status
-                                  debbugs-gnu-blocking-report)))))
+  (let ((blockers
+        (cdr
+         (assq
+          'blockedby
+          (car
+           (debbugs-get-status
+            (cdr
+             (assoc
+              debbugs-gnu-emacs-current-release
+              debbugs-gnu-blocking-reports)))))))
        (id (debbugs-gnu-current-id t))
        (inhibit-read-only t)
        status)
        (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)))
     (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))))
        (forward-line 1)))
     (when id
       (debbugs-gnu-goto id))))
@@ -928,7 +1091,7 @@ Subject fields."
   (let ((id (debbugs-gnu-current-id t))
        (inhibit-read-only t)
        status)
   (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))
     (if (equal string "")
        (debbugs-gnu-toggle-suppress)
       (goto-char (point-min))
@@ -942,7 +1105,7 @@ Subject fields."
                 (or status-only
                     (not (string-match string (cdr (assq 'subject status))))))
            (delete-region (point) (progn (forward-line 1) (point)))
                 (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)))))
          (forward-line 1)))
       (when id
        (debbugs-gnu-goto id)))))
@@ -989,7 +1152,7 @@ interest to you."
 (defun debbugs-gnu-toggle-suppress ()
   "Suppress bugs marked in `debbugs-gnu-suppress-bugs'."
   (interactive)
 (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))
 
   (tabulated-list-init-header)
   (tabulated-list-print))
 
@@ -1004,18 +1167,25 @@ interest to you."
 (defun debbugs-gnu-current-status ()
   (get-text-property (line-beginning-position) 'tabulated-list-id))
 
 (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)
                     (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))
     (goto-char (point-min)))
   (set-buffer-modified-p nil)
   (special-mode))
@@ -1130,6 +1300,9 @@ MERGED is the list of bugs merged with this one."
           (re-search-forward "#\\([0-9]+\\)" nil t)))
      (string-to-number (match-string 1)))))
 
           (re-search-forward "#\\([0-9]+\\)" nil t)))
      (string-to-number (match-string 1)))))
 
+(defvar debbugs-gnu-send-mail-function nil
+  "A function to send control messages from debbugs.")
+
 (defun debbugs-gnu-send-control-message (message &optional reverse)
   "Send a control message for the current bug report.
 You can set the severity or add a tag, or close the report.  If
 (defun debbugs-gnu-send-control-message (message &optional reverse)
   "Send a control message for the current bug report.
 You can set the severity or add a tag, or close the report.  If
@@ -1149,14 +1322,15 @@ removed instead."
            "owner" "noowner"
            "invalid"
            "reassign"
            "owner" "noowner"
            "invalid"
            "reassign"
+           "retitle"
            "patch" "wontfix" "moreinfo" "unreproducible" "fixed" "notabug"
            "pending" "help" "security" "confirmed"
            "usertag")
          nil t)
         current-prefix-arg))
            "patch" "wontfix" "moreinfo" "unreproducible" "fixed" "notabug"
            "pending" "help" "security" "confirmed"
            "usertag")
          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)))
+  (let* ((id (or (debbugs-gnu-current-id t)
+                debbugs-gnu-bug-number ; Set on group entry.
+                (debbugs-gnu-guess-current-id)))
         (version
          (when (member message '("close" "done"))
            (read-string
         (version
          (when (member message '("close" "done"))
            (read-string
@@ -1180,6 +1354,7 @@ removed instead."
       (insert "To: control@debbugs.gnu.org\n"
              "From: " (message-make-from) "\n"
              (format "Subject: control message for bug #%d\n" id)
       (insert "To: control@debbugs.gnu.org\n"
              "From: " (message-make-from) "\n"
              (format "Subject: control message for bug #%d\n" id)
+             mail-header-separator
              "\n"
              (cond
               ((member message '("unarchive" "unmerge" "reopen" "noowner"))
              "\n"
              (cond
               ((member message '("unarchive" "unmerge" "reopen" "noowner"))
@@ -1201,6 +1376,8 @@ removed instead."
                  " ")))
               ((equal message "owner")
                (format "owner %d !\n" id))
                  " ")))
               ((equal message "owner")
                (format "owner %d !\n" id))
+              ((equal message "retitle")
+               (format "retitle %d %s\n" id (read-string "New title: ")))
               ((equal message "reassign")
                (format "reassign %d %s\n" id (read-string "Package(s): ")))
               ((equal message "close")
               ((equal message "reassign")
                (format "reassign %d %s\n" id (read-string "Package(s): ")))
               ((equal message "close")
@@ -1228,7 +1405,11 @@ removed instead."
                (format "tags %d%s %s\n"
                        id (if reverse " -" "")
                        message))))
                (format "tags %d%s %s\n"
                        id (if reverse " -" "")
                        message))))
-      (funcall send-mail-function))))
+      (funcall (or debbugs-gnu-send-mail-function 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)))
 
 (defvar debbugs-gnu-usertags-mode-map
   (let ((map (make-sparse-keymap)))
@@ -1328,6 +1509,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))
   (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/"
   (debbugs-gnu nil))
 
 (defvar debbugs-gnu-trunk-directory "~/src/emacs/trunk/"
@@ -1358,7 +1541,7 @@ If given a prefix, patch in the branch directory instead."
     ;; buffer.  Determine which.
     (gnus-with-article-buffer
       (dolist (handle (mapcar 'cdr (gnus-article-mime-handles)))
     ;; buffer.  Determine which.
     (gnus-with-article-buffer
       (dolist (handle (mapcar 'cdr (gnus-article-mime-handles)))
-       (when (string-match "diff\\|patch" (mm-handle-media-type handle))
+       (when (string-match "diff\\|patch\\|plain" (mm-handle-media-type handle))
          (push (cons (mm-handle-encoding handle)
                      (mm-handle-buffer handle))
                patch-buffers))))
          (push (cons (mm-handle-encoding handle)
                      (mm-handle-buffer handle))
                patch-buffers))))
@@ -1367,11 +1550,11 @@ If given a prefix, patch in the branch directory instead."
       (article-decode-charset)
       (push (cons nil gnus-article-buffer) patch-buffers))
     (dolist (elem patch-buffers)
       (article-decode-charset)
       (push (cons nil gnus-article-buffer) patch-buffers))
     (dolist (elem patch-buffers)
-      (with-temp-buffer
+      (with-current-buffer (generate-new-buffer "*debbugs input patch*")
        (insert-buffer-substring (cdr elem))
        (cond ((eq (car elem) 'base64)
               (base64-decode-region (point-min) (point-max)))
        (insert-buffer-substring (cdr elem))
        (cond ((eq (car elem) 'base64)
               (base64-decode-region (point-min) (point-max)))
-             ((eq (car elem) 'qp)
+             ((eq (car elem) 'quoted-printable)
               (quoted-printable-decode-region (point-min) (point-max))))
        (debbugs-gnu-fix-patch dir)
        (call-process-region (point-min) (point-max)
               (quoted-printable-decode-region (point-min) (point-max))))
        (debbugs-gnu-fix-patch dir)
        (call-process-region (point-min) (point-max)
@@ -1456,18 +1639,48 @@ If given a prefix, patch in the branch directory instead."
     (message "%s is a contributor %d times" string found)
     found))
 
     (message "%s is a contributor %d times" string found)
     found))
 
+(defvar debbugs-gnu-patch-subject nil)
+
 (defun debbugs-gnu-insert-changelog ()
   "Add a ChangeLog from a recently applied patch from a third party."
   (interactive)
 (defun debbugs-gnu-insert-changelog ()
   "Add a ChangeLog from a recently applied patch from a third party."
   (interactive)
-  (let (from subject)
+  (let (from subject patch-subject changelog)
     (gnus-with-article-buffer
       (widen)
       (goto-char (point-min))
       (setq from (mail-extract-address-components (gnus-fetch-field "from"))
     (gnus-with-article-buffer
       (widen)
       (goto-char (point-min))
       (setq from (mail-extract-address-components (gnus-fetch-field "from"))
-           subject (gnus-fetch-field "subject")))
+           subject (gnus-fetch-field "subject"))
+      ;; If it's a patch formatted the right way, extract that data.
+      (dolist (handle (mapcar 'cdr (gnus-article-mime-handles)))
+       (when (string-match "diff\\|patch\\|plain"
+                           (mm-handle-media-type handle))
+         (with-temp-buffer
+           (insert-buffer-substring (mm-handle-buffer handle))
+           (cond ((eq (mm-handle-encoding handle) 'base64)
+                  (base64-decode-region (point-min) (point-max)))
+                 ((eq (mm-handle-encoding handle) 'quoted-printable)
+                  (quoted-printable-decode-region (point-min) (point-max))))
+           (setq patch-subject
+                 (or (gnus-fetch-field "subject") patch-subject))
+           (goto-char (point-min))
+           (when (re-search-forward "^[*] " nil t)
+             (let ((start (match-beginning 0)))
+               (while (and (not (eobp))
+                           (not (looking-at "---")))
+                 (forward-line 1))
+               (setq changelog (buffer-substring
+                                start (line-end-position 0)))))))))
     (let ((add-log-full-name (car from))
          (add-log-mailing-address (cadr from)))
       (add-change-log-entry-other-window)
     (let ((add-log-full-name (car from))
          (add-log-mailing-address (cadr from)))
       (add-change-log-entry-other-window)
+      (when patch-subject
+       (setq-local debbugs-gnu-patch-subject patch-subject))
+      (when changelog
+       (delete-region (line-beginning-position) (point-max))
+       (save-restriction
+         (narrow-to-region (point) (point))
+         (insert changelog)
+         (indent-region (point-min) (point-max))))
       (let ((point (point)))
        (when (string-match "\\(bug#[0-9]+\\)" subject)
          (insert " (" (match-string 1 subject) ")."))
       (let ((point (point)))
        (when (string-match "\\(bug#[0-9]+\\)" subject)
          (insert " (" (match-string 1 subject) ")."))
@@ -1483,7 +1696,9 @@ If given a prefix, patch in the branch directory instead."
                          (cadr from))))))
          (goto-char (point-max))
          (end-of-line)
                          (cadr from))))))
          (goto-char (point-max))
          (end-of-line)
-         (insert "  (tiny change"))
+         (when changelog
+           (insert "\n\n"))
+         (insert "  Copyright-paperwork-exempt: yes"))
        (goto-char point)))))
 
 (defvar debbugs-gnu-lisp-mode-map
        (goto-char point)))))
 
 (defvar debbugs-gnu-lisp-mode-map
@@ -1526,28 +1741,45 @@ If given a prefix, patch in the branch directory instead."
   "Prepare checking in the current changes."
   (interactive)
   (save-some-buffers t)
   "Prepare checking in the current changes."
   (interactive)
   (save-some-buffers t)
-   (when (get-buffer "*vc-dir*")
-     (kill-buffer (get-buffer "*vc-dir*")))
-   (let ((trunk (expand-file-name debbugs-gnu-trunk-directory)))
-     (if (equal (cl-subseq default-directory 0 (length trunk))
-               trunk)
-        (vc-dir debbugs-gnu-trunk-directory)
-       (vc-dir debbugs-gnu-branch-directory)))
-   (goto-char (point-min))
-   (while (not (search-forward "edited" nil t))
-     (sit-for 0.01))
-   (beginning-of-line)
-   (while (search-forward "edited" nil t)
-     (vc-dir-mark)
-     (beginning-of-line))
-   (vc-diff nil)
-   (vc-next-action nil)
-   (log-edit-insert-changelog t)
-   (delete-other-windows)
-   (split-window)
-   (other-window 1)
-   (switch-to-buffer "*vc-diff*")
-   (other-window 1))
+  (when (get-buffer "*vc-dir*")
+    (kill-buffer (get-buffer "*vc-dir*")))
+  (let ((patch-subject debbugs-gnu-patch-subject))
+    (let ((trunk (expand-file-name debbugs-gnu-trunk-directory)))
+      (if (equal (cl-subseq default-directory 0 (length trunk))
+                trunk)
+         (vc-dir debbugs-gnu-trunk-directory)
+       (vc-dir debbugs-gnu-branch-directory)))
+    (goto-char (point-min))
+    (while (not (search-forward "edited" nil t))
+      (sit-for 0.01))
+    (beginning-of-line)
+    (while (search-forward "edited" nil t)
+      (vc-dir-mark)
+      (beginning-of-line))
+    (vc-diff nil)
+    (vc-next-action nil)
+    (delete-region (point-min) (point-max))
+    (log-edit-insert-changelog t)
+    (delete-other-windows)
+    (split-window)
+    (other-window 1)
+    (switch-to-buffer "*vc-diff*")
+    (other-window 1)
+    (when patch-subject
+      (insert "Summary: "
+             (replace-regexp-in-string "^ *\\[PATCH\\] *" "" patch-subject)
+             "\n"))))
+
+(defun debbugs-gnu-save-cache ()
+  "Save the bugs cache to a file."
+  (interactive)
+  (unless debbugs-cache-data
+    (error "No data to cache"))
+  (unless (file-exists-p "~/.emacs.d/debbugs-cache")
+    (make-directory "~/.emacs.d/debbugs-cache" t))
+  (let ((coding-system-for-write 'utf-8))
+    (with-temp-file "~/.emacs.d/debbugs-cache/list"
+      (prin1 debbugs-cache-data (current-buffer)))))
 
 (provide 'debbugs-gnu)
 
 
 (provide 'debbugs-gnu)