X-Git-Url: https://code.delx.au/gnu-emacs-elpa/blobdiff_plain/aea4c6ae3a0b470ca16b2b209f8ee344c7b21a94..8a2f21f780c915faae42b5ba79b4e682856bdd95:/packages/debbugs/debbugs-gnu.el diff --git a/packages/debbugs/debbugs-gnu.el b/packages/debbugs/debbugs-gnu.el index c5c4ca921..fd0b50196 100644 --- a/packages/debbugs/debbugs-gnu.el +++ b/packages/debbugs/debbugs-gnu.el @@ -187,9 +187,6 @@ :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." @@ -236,6 +233,7 @@ (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))