]> code.delx.au - gnu-emacs-elpa/blobdiff - packages/debbugs/debbugs-gnu.el
Use dynamic completion for bug numbers in debbugs
[gnu-emacs-elpa] / packages / debbugs / debbugs-gnu.el
index c5c4ca92139f79c91c4bb369897528793c5a0c60..fd0b50196a14a95df19c49fd89dcabd336872a63 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."
              (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'."
@@ -437,7 +451,7 @@ marked as \"client-side filter\"."
               (completing-read
                (format "Enter status%s: "
                        (if (null phrase) "" " (client-side filter)"))
-               '("pending" "forwarded" "fixed" "done")))
+               '("open" "forwarded" "done") nil t))
              (when (not (zerop (length val1)))
                 (if (null phrase)
                     (add-to-list
@@ -532,44 +546,46 @@ 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."
@@ -623,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)
@@ -665,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)))
@@ -821,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.")
@@ -894,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 ()
@@ -1045,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)
@@ -1282,6 +1324,27 @@ MERGED is the list of bugs merged with this one."
 (defvar debbugs-gnu-send-mail-function nil
   "A function to send control messages from debbugs.")
 
+(defvar debbugs-gnu-completion-table
+  (completion-table-dynamic
+   (lambda (string)
+     (if (string-equal string "")
+        (mapcar
+         (lambda (x)
+           (list (format "%d" x) x))
+         '(1 2 3 4 5 6 7 8 9))
+       (let ((newest-bug (car (debbugs-newest-bugs 1))))
+        (and (string-match "^[1-9][0-9]*$" string)
+             (<= (string-to-number string) newest-bug)
+             (append
+              `(,string)
+              (mapcar
+               (lambda (x)
+                 (let ((y (format "%s%d" string x)))
+                   (and (<= (string-to-number y) newest-bug)
+                        (list y x))))
+               '(0 1 2 3 4 5 6 7 8 9))))))))
+  "Dynamic completion table for reading bug numbers.")
+
 (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
@@ -1310,8 +1373,11 @@ removed instead."
   (let* ((id (or (debbugs-gnu-current-id t)
                 debbugs-gnu-bug-number ; Set on group entry.
                 (debbugs-gnu-guess-current-id)))
+        (status (debbugs-gnu-current-status))
         (version
-         (when (member message '("close" "done"))
+         (when (and
+                (member message '("close" "done"))
+                (member "emacs" (cdr (assq 'package status))))
            (read-string
             "Version: "
             (cond
@@ -1327,8 +1393,7 @@ removed instead."
               (format "%s.%s"
                       (match-string 1 emacs-version)
                       (match-string 2 emacs-version)))
-             (t emacs-version)))))
-        (status (debbugs-gnu-current-status)))
+             (t emacs-version))))))
     (with-temp-buffer
       (insert "To: control@debbugs.gnu.org\n"
              "From: " (message-make-from) "\n"
@@ -1339,8 +1404,14 @@ removed instead."
               ((member message '("unarchive" "unmerge" "reopen" "noowner"))
                (format "%s %d\n" message id))
               ((member message '("merge" "forcemerge"))
-               (format "%s %d %s\n" message id
-                       (read-string "Merge with bug #: ")))
+               (format
+                "%s %d %s\n" message id
+                (mapconcat
+                 'identity
+                 (completing-read-multiple
+                  (format "%s with bug(s) #: " (capitalize message))
+                  debbugs-gnu-completion-table)
+                 " ")))
               ((member message '("block" "unblock"))
                (format
                 "%s %d by %s\n" message id
@@ -1350,7 +1421,8 @@ removed instead."
                   (format "%s with bug(s) #: " (capitalize message))
                   (if (equal message "unblock")
                       (mapcar 'number-to-string
-                              (cdr (assq 'blockedby status))))
+                              (cdr (assq 'blockedby status)))
+                    debbugs-gnu-completion-table)
                   nil (and (equal message "unblock") status))
                  " ")))
               ((equal message "owner")
@@ -1360,9 +1432,9 @@ removed instead."
               ((equal message "reassign")
                (format "reassign %d %s\n" id (read-string "Package(s): ")))
               ((equal message "close")
-               (format "close %d %s\n" id version))
+               (format "close %d %s\n" id (or version "")))
               ((equal message "done")
-               (format "tags %d fixed\nclose %d %s\n" id id version))
+               (format "tags %d fixed\nclose %d %s\n" id id (or version "")))
               ((member message '("donenotabug" "donewontfix"
                                  "doneunreproducible"))
                (format "tags %d %s\nclose %d\n" id (substring message 4) id))
@@ -1483,8 +1555,9 @@ The following commands are available:
 (defun debbugs-gnu-bugs (&rest bugs)
   "List all BUGS, a list of bug numbers."
   (interactive
-   (mapcar 'string-to-number
-          (completing-read-multiple "Bug numbers: " nil 'natnump)))
+   (mapcar
+    'string-to-number
+    (completing-read-multiple "Bug numbers: " debbugs-gnu-completion-table)))
   (dolist (elt bugs)
     (unless (natnump elt) (signal 'wrong-type-argument (list 'natnump elt))))
   (add-to-list 'debbugs-gnu-current-query (cons 'bugs bugs))