* packages/debbugs/debbugs-gnu.el (debbugs-gnu-default-packages): Add "hyperbole".

[gnu-emacs-elpa] / packages / debbugs / debbugs-gnu.el

diff --git a/packages/debbugs/debbugs-gnu.el b/packages/debbugs/debbugs-gnu.el
index 51f5bf15501e768a8c6d071620487fe9f9648189..ce694cbb6b1844326538a886d0c44bd7aa3d3724 100644 (file)
--- a/packages/debbugs/debbugs-gnu.el
+++ b/packages/debbugs/debbugs-gnu.el
@@ -1,4 +1,4 @@
-;;; debbugs-gnu.el --- interface for the GNU bug tracker
+;;; debbugs-gnu.el --- interface for the GNU bug tracker  -*- lexical-binding:t -*-

 
 ;; Copyright (C) 2011-2016 Free Software Foundation, Inc.
 
 
 ;; Copyright (C) 2011-2016 Free Software Foundation, Inc.
 


@@ -58,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
 ;;


@@ -75,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


@@ -105,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


@@ -119,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


@@ -141,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")


@@ -174,6 +175,13 @@
 (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
 (defgroup debbugs-gnu ()
   "UI for the debbugs.gnu.org bug tracker."
   :group 'debbugs


@@ -197,6 +205,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 +236,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")


@@ -269,7 +284,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.")


@@ -305,6 +320,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\).")
 
 `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'."
 (defun debbugs-gnu-calendar-read (prompt acceptable &optional initial-contents)
   "Return a string read from the minibuffer.
 Derived from `calendar-read'."


@@ -342,8 +362,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 the bugs if there is no phrase.
-       (setq-default debbugs-gnu-current-suppress (null 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


@@ -351,13 +374,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.


@@ -385,21 +423,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)"))
+               '("pending" "forwarded" "fixed" "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


@@ -438,12 +484,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


@@ -454,19 +501,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))
-
-    ;; Reset query and filter.
-    (setq debbugs-gnu-current-query nil
-         debbugs-gnu-current-filter nil)))
+       (debbugs-gnu severities packages archivedp))))

 
 

-(defvar debbugs-gnu-current-limit nil
-  "List of bug ids to be shown, if non-nil")
-
-(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'.")
+;;;###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)


@@ -499,23 +540,24 @@ The specification which bugs shall be suppressed is taken from
       (insert-file-contents debbugs-gnu-persistency-file)
       (eval (read (current-buffer)))))
   ;; Per default, we suppress retrieved unwanted bugs.
       (insert-file-contents debbugs-gnu-persistency-file)
       (eval (read (current-buffer)))))
   ;; Per default, we suppress retrieved unwanted bugs.

-  (when (called-interactively-p 'any)
-    (setq-default debbugs-gnu-current-suppress t))
+  (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)))
       (when (string-equal severity "tagged")
 
   ;; Add queries.
   (dolist (severity (if (consp severities) severities (list severities)))
     (when (not (zerop (length severity)))
       (when (string-equal severity "tagged")

-       (setq-default debbugs-gnu-current-suppress nil))
+       (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-default debbugs-gnu-current-suppress nil)
+    (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-default debbugs-gnu-current-suppress t)
+    (setq debbugs-gnu-current-suppress t)

     (add-to-list 'debbugs-gnu-current-query '(status . "open"))
     (add-to-list 'debbugs-gnu-current-query '(status . "forwarded")))
   (dolist (tag (if (consp tags) tags (list tags)))
     (add-to-list 'debbugs-gnu-current-query '(status . "open"))
     (add-to-list 'debbugs-gnu-current-query '(status . "forwarded")))
   (dolist (tag (if (consp tags) tags (list tags)))


@@ -525,15 +567,16 @@ The specification which bugs shall be suppressed is taken from
   ;; 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)


@@ -549,7 +592,7 @@ The specification which bugs shall be suppressed is taken from
               (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")))


@@ -577,10 +620,11 @@ The specification which bugs shall be suppressed is taken from
      ;; Otherwise, we retrieve the bugs from the server.
      (t (apply 'debbugs-get-bugs args)))))
 
      ;; Otherwise, we retrieve the bugs from the server.
      (t (apply 'debbugs-get-bugs args)))))
 

-(defun debbugs-gnu-show-reports ()
-  "Show bug reports."
+(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.


@@ -591,8 +635,16 @@ The specification which bugs shall be suppressed is taken from
 
     ;; 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


@@ -600,15 +652,17 @@ The specification which bugs shall be suppressed is taken from
               (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)))))


@@ -644,7 +698,7 @@ The specification which bugs shall be suppressed is taken from
                '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))


@@ -653,8 +707,11 @@ The specification which bugs shall be suppressed is taken from
                '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)))


@@ -665,7 +722,8 @@ The specification which bugs shall be suppressed is taken from
             (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))


@@ -673,7 +731,7 @@ The specification which bugs shall be suppressed is taken from
                  '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)


@@ -701,13 +759,14 @@ 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)
+          (or (not debbugs-gnu-local-suppress)

               (not (catch :suppress
                      (dolist (check debbugs-gnu-default-suppress-bugs)
                        (when
               (not (catch :suppress
                      (dolist (check debbugs-gnu-default-suppress-bugs)
                        (when


@@ -717,7 +776,7 @@ Used instead of `tabulated-list-print-entry'."
                          (throw :suppress t))))))
           ;; Filter search list.
           (not (catch :suppress
                          (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.
                    (let ((val (cdr (assq (car check) list-id))))
                      (if (stringp (cdr check))
                          ;; Regular expression.


@@ -756,6 +815,28 @@ 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
   (let ((map (make-sparse-keymap))
        (menu-map (make-sparse-keymap)))
 (defvar debbugs-gnu-mode-map
   (let ((map (make-sparse-keymap))
        (menu-map (make-sparse-keymap)))


@@ -763,17 +844,19 @@ 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 "\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]
 
     (define-key map [menu-bar debbugs] (cons "Debbugs" menu-map))
     (define-key menu-map [debbugs-gnu-select-report]


@@ -786,15 +869,21 @@ Used instead of `tabulated-list-print-entry'."
     (define-key-after menu-map [debbugs-gnu-show-all-blocking-reports]
       '(menu-item "Show Release Blocking Bugs"
                  debbugs-gnu-show-all-blocking-reports
     (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")
                  :help "Show all bugs blocking next Emacs release")

-                 ;:enable '(assq 'phrase debbugs-gnu-current-query))

       'debbugs-gnu-rescan)
       'debbugs-gnu-rescan)

-    (define-key-after menu-map [debbugs-gnu-separator]
-      '(menu-item "--") 'debbugs-gnu-show-all-blocking-reports)
+    (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")
     (define-key-after menu-map [debbugs-gnu-search]
       '(menu-item "Search Bugs" debbugs-gnu-search
                  :help "Search bugs on debbugs.gnu.org")

-      'debbugs-gnu-separator)
+      'debbugs-gnu-separator1)

     (define-key-after menu-map [debbugs-gnu]
       '(menu-item "Retrieve Bugs" debbugs-gnu
                  :help "Retrieve bugs from debbugs.gnu.org")
     (define-key-after menu-map [debbugs-gnu]
       '(menu-item "Retrieve Bugs" debbugs-gnu
                  :help "Retrieve bugs from debbugs.gnu.org")


@@ -803,19 +892,28 @@ Used instead of `tabulated-list-print-entry'."
       '(menu-item "Retrieve Bugs by Number" debbugs-gnu-bugs
                  :help "Retrieve selected bugs from debbugs.gnu.org")
       'debbugs-gnu)
       '(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.
-  (setq-default debbugs-gnu-current-suppress debbugs-gnu-current-suppress)
-  (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.


@@ -827,8 +925,12 @@ 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)
+  (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)
        debbugs-gnu-current-suppress)
   (setq tabulated-list-format [("Id"         5 debbugs-gnu-sort-id)
                               ("State"     20 debbugs-gnu-sort-state)


@@ -892,7 +994,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)))


@@ -917,7 +1019,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


@@ -950,13 +1052,13 @@ The following commands are available:
        (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))))


@@ -969,7 +1071,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))


@@ -983,7 +1085,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)))))


@@ -1030,7 +1132,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))
 


@@ -1045,18 +1147,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))


@@ -1171,6 +1280,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


@@ -1190,14 +1302,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


@@ -1221,6 +1334,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"))


@@ -1242,6 +1356,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")


@@ -1269,7 +1385,8 @@ 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)))))))
       (message-goto-body)
       (message "Control message sent:\n%s"
               (buffer-substring-no-properties (point) (1- (point-max)))))))


@@ -1373,7 +1490,7 @@ The following commands are available:
     (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.
     (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-default debbugs-gnu-current-suppress nil)
+  (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/"


@@ -1404,7 +1521,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))))


@@ -1413,11 +1530,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)


@@ -1502,18 +1619,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) ")."))


@@ -1529,7 +1676,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


@@ -1572,28 +1721,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)