Improve debbugs menu and buffer name

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

diff --git a/packages/debbugs/debbugs-gnu.el b/packages/debbugs/debbugs-gnu.el
index 392934800774838b10ed1e5aa4476afea93161ab..510a58ed3f43ff616dd88a133c4f53196e1c5e57 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.
 


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


@@ -186,9 +187,6 @@
   :group 'debbugs
   :version "24.1")
 
   :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."


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


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


@@ -256,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))


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


@@ -317,6 +322,22 @@ a date, value is the cons cell \(BEFORE . AFTER\).")
 The specification which bugs shall be suppressed is taken from
   `debbugs-gnu-default-suppress-bugs'.")
 
 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'."


@@ -355,7 +376,10 @@ marked as \"client-side filter\"."
            (setq phrase nil)
          (add-to-list 'debbugs-gnu-current-query (cons 'phrase phrase)))
        ;; We suppress closed bugs if there is no phrase.
            (setq phrase nil)
          (add-to-list 'debbugs-gnu-current-query (cons 'phrase phrase)))
        ;; We suppress closed bugs if there is no phrase.

-       (setq debbugs-gnu-current-suppress (null phrase))
+       (setq debbugs-gnu-current-suppress
+             (if (not debbugs-gnu-suppress-closed)
+                 nil
+               (null phrase)))

 
        ;; The other queries.
        (catch :finished
 
        ;; The other queries.
        (catch :finished


@@ -363,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.


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


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


@@ -468,6 +516,12 @@ marked as \"client-side filter\"."
        ;; Do the search.
        (debbugs-gnu severities packages archivedp))))
 
        ;; Do the search.
        (debbugs-gnu severities packages archivedp))))
 

+;;;###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)
   "List all outstanding bugs."
 ;;;###autoload
 (defun debbugs-gnu (severities &optional packages archivedp suppress tags)
   "List all outstanding bugs."


@@ -492,49 +546,52 @@ marked as \"client-side filter\"."
       (when (member "tagged" severities)
        (split-string (read-string "User tag(s): ") "," t)))))
 
       (when (member "tagged" severities)
        (split-string (read-string "User tag(s): ") "," t)))))
 

-  ;; Initialize variables.
-  (when (and (file-exists-p debbugs-gnu-persistency-file)
-            (not debbugs-gnu-local-tags))
-    (with-temp-buffer
-      (insert-file-contents debbugs-gnu-persistency-file)
-      (eval (read (current-buffer)))))
-  ;; Per default, we suppress retrieved unwanted bugs.
-  (when (called-interactively-p 'any)
-    (setq debbugs-gnu-current-suppress t))
-
-  ;; Add queries.
-  (dolist (severity (if (consp severities) severities (list severities)))
-    (when (not (zerop (length severity)))
-      (when (string-equal severity "tagged")
-       (setq debbugs-gnu-current-suppress nil))
-      (add-to-list 'debbugs-gnu-current-query (cons 'severity severity))))
-  (dolist (package (if (consp packages) packages (list packages)))
-    (when (not (zerop (length package)))
-      (add-to-list 'debbugs-gnu-current-query (cons 'package package))))
-  (when archivedp
-    (setq debbugs-gnu-current-suppress nil)
-    (add-to-list 'debbugs-gnu-current-query '(archive . "1")))
-  (when suppress
-    (setq debbugs-gnu-current-suppress t)
-    (add-to-list 'debbugs-gnu-current-query '(status . "open"))
-    (add-to-list 'debbugs-gnu-current-query '(status . "forwarded")))
-  (dolist (tag (if (consp tags) tags (list tags)))
-    (when (not (zerop (length tag)))
-      (add-to-list 'debbugs-gnu-current-query (cons 'tag tag))))
-
-  ;; Show result.
-  (debbugs-gnu-show-reports)
-
-  ;; Reset query, filter and suppress.
-  (setq debbugs-gnu-current-query nil
-       debbugs-gnu-current-filter nil
-       debbugs-gnu-current-suppress nil))
+  (unwind-protect
+      (progn
+       ;; Initialize variables.
+       (when (and (file-exists-p debbugs-gnu-persistency-file)
+                  (not debbugs-gnu-local-tags))
+         (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)))
+           (when (string-equal severity "tagged")
+             (setq debbugs-gnu-current-suppress nil))
+           (add-to-list 'debbugs-gnu-current-query (cons 'severity severity))))
+       (dolist (package (if (consp packages) packages (list packages)))
+         (when (not (zerop (length package)))
+           (add-to-list 'debbugs-gnu-current-query (cons 'package package))))
+       (when archivedp
+         (setq debbugs-gnu-current-suppress nil)
+         (add-to-list 'debbugs-gnu-current-query '(archive . "1")))
+       (when suppress
+         (setq debbugs-gnu-current-suppress t)
+         (add-to-list 'debbugs-gnu-current-query '(status . "open"))
+         (add-to-list 'debbugs-gnu-current-query '(status . "forwarded")))
+       (dolist (tag (if (consp tags) tags (list tags)))
+         (when (not (zerop (length tag)))
+           (add-to-list 'debbugs-gnu-current-query (cons 'tag tag))))
+
+       ;; Show result.
+       (debbugs-gnu-show-reports))
+
+    ;; Reset query, filter and suppress.
+    (setq debbugs-gnu-current-query nil
+         debbugs-gnu-current-filter nil
+         debbugs-gnu-current-suppress nil)))

 
 (defun debbugs-gnu-get-bugs (query)
   "Retrieve bug numbers from debbugs.gnu.org according search criteria."
   (let* ((debbugs-port "gnu.org")
         (bugs (assoc 'bugs query))
 
 (defun debbugs-gnu-get-bugs (query)
   "Retrieve bug numbers from debbugs.gnu.org according search criteria."
   (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)


@@ -578,10 +635,19 @@ marked as \"client-side filter\"."
      ;; 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."
-  (let ((inhibit-read-only t)
-       (buffer-name "*Emacs Bugs*"))
+(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)
+        string
+        (buffer-name
+         (cond
+          ((setq string (cdr (assq 'phrase debbugs-gnu-current-query)))
+           (format "*%S Bugs*" string))
+          ((setq string (cdr (assq 'package debbugs-gnu-current-query)))
+           (format "*%s Bugs*" (capitalize string)))
+          (t "*Bugs*"))))

     ;; The tabulated mode sets several local variables.  We must get
     ;; rid of them.
     (when (get-buffer buffer-name)
     ;; The tabulated mode sets several local variables.  We must get
     ;; rid of them.
     (when (get-buffer buffer-name)


@@ -591,8 +657,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-local-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


@@ -614,7 +688,10 @@ marked as \"client-side filter\"."
             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)))))

-       (let ((packages (delete "emacs" (cdr (assq 'package status)))))
+       (let ((packages (cdr (assq 'package status))))
+         (dolist (elt packages)
+           (when (member elt debbugs-gnu-default-packages)
+             (setq packages (delete elt packages))))

          (when packages
            (setq words (concat words "," (mapconcat 'identity packages ",")))))
        (when (setq merged (cdr (assq 'mergedwith status)))
          (when packages
            (setq words (concat words "," (mapconcat 'identity packages ",")))))
        (when (setq merged (cdr (assq 'mergedwith status)))


@@ -655,8 +732,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)))


@@ -704,7 +784,8 @@ 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.
           (or (not debbugs-gnu-limit)
     (when (and
           ;; We may have a narrowing in effect.
           (or (not debbugs-gnu-limit)


@@ -766,6 +847,11 @@ Used instead of `tabulated-list-print-entry'."
       ;; Package "emacs" has been selected.
       (member '(package . "emacs") debbugs-gnu-local-query)))
 
       ;; Package "emacs" has been selected.
       (member '(package . "emacs") debbugs-gnu-local-query)))
 

+(defun debbugs-gnu-manual ()
+  "Display the Debbugs manual in Info mode."
+  (interactive)
+  (info "debbugs-ug"))
+

 (defconst debbugs-gnu-bug-triage-file
   (expand-file-name "../admin/notes/bug-triage" data-directory)
   "The \"bug-triage\" file.")
 (defconst debbugs-gnu-bug-triage-file
   (expand-file-name "../admin/notes/bug-triage" data-directory)
   "The \"bug-triage\" file.")


@@ -839,12 +925,16 @@ Used instead of `tabulated-list-print-entry'."
 
     (define-key-after menu-map [debbugs-gnu-separator2]
       '(menu-item "--") 'debbugs-gnu-bugs)
 
     (define-key-after menu-map [debbugs-gnu-separator2]
       '(menu-item "--") 'debbugs-gnu-bugs)

+    (define-key-after menu-map [debbugs-gnu-manual]
+      '(menu-item "Debbugs Manual" debbugs-gnu-manual
+                 :help "Show Debbugs Manual")
+      'debbugs-gnu-separator2)

     (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")
     (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)
+      'debbugs-gnu-manual)

     map))
 
 (defun debbugs-gnu-rescan ()
     map))
 
 (defun debbugs-gnu-rescan ()


@@ -938,7 +1028,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)))


@@ -990,9 +1080,16 @@ 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)


@@ -1224,6 +1321,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


@@ -1243,14 +1343,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


@@ -1274,6 +1375,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"))


@@ -1295,6 +1397,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")


@@ -1322,7 +1426,7 @@ 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"
       (remhash id debbugs-cache-data)
       (message-goto-body)
       (message "Control message sent:\n%s"


@@ -1458,7 +1562,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))))


@@ -1467,11 +1571,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)


@@ -1556,18 +1660,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) ")."))


@@ -1583,7 +1717,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


@@ -1626,28 +1762,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)