]> code.delx.au - gnu-emacs-elpa/blobdiff - packages/debbugs/debbugs-gnu.el
Improve debbugs menu and buffer name
[gnu-emacs-elpa] / packages / debbugs / debbugs-gnu.el
index 4c108cc46a6ab35d465b1ab007c6043f14bea53c..510a58ed3f43ff616dd88a133c4f53196e1c5e57 100644 (file)
   :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."
   "If non-nil, don't show closed bugs."
   :group 'debbugs-gnu
   :type 'boolean
-  :version "25.2")
+  :version "25.1")
 
 (defconst debbugs-gnu-all-severities
   (mapcar 'cadr (cdr (get 'debbugs-gnu-default-severities 'custom-type)))
              (const "guile")
              (const "guix")
              (const "gzip")
+             (const "hyperbole")
              (const "idutils")
              (const "libtool")
              (const "mh-e")
@@ -263,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.
-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))
@@ -324,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'.")
 
+(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'."
@@ -342,12 +356,6 @@ between the words, AND is used by default.  The phrase can also
 be empty, in this case only the following attributes are used for
 search."))
 
-;;;###autoload
-(defun debbugs-gnu-patches ()
-  "List the bug reports that have been marked as containing a patch."
-  (interactive)
-  (debbugs-gnu nil '("emacs") nil nil "patch"))
-
 ;;;###autoload
 (defun debbugs-gnu-search ()
   "Search for Emacs bugs interactively.
@@ -379,13 +387,28 @@ marked as \"client-side filter\"."
            (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.
@@ -413,21 +436,29 @@ marked as \"client-side filter\"."
                (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
-                '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
-              (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)))
-               (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
@@ -466,12 +497,13 @@ marked as \"client-side filter\"."
                     '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)
-                    (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
@@ -484,6 +516,12 @@ marked as \"client-side filter\"."
        ;; 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."
@@ -508,50 +546,52 @@ marked as \"client-side filter\"."
       (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 (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))
+  (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))
-        (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)
@@ -588,6 +628,10 @@ marked as \"client-side filter\"."
       (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)))))
 
@@ -595,8 +639,15 @@ marked as \"client-side filter\"."
   "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)
-       (buffer-name "*Emacs Bugs*"))
+  (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)
@@ -637,7 +688,10 @@ are taken from the cache instead."
             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)))
@@ -678,8 +732,11 @@ are taken from the cache instead."
                '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)))
@@ -790,6 +847,11 @@ Used instead of `tabulated-list-print-entry'."
       ;; 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.")
@@ -863,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-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")
-      'debbugs-gnu-separator2)
+      'debbugs-gnu-manual)
     map))
 
 (defun debbugs-gnu-rescan ()
@@ -1014,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)
-  (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)