X-Git-Url: https://code.delx.au/gnu-emacs-elpa/blobdiff_plain/e2fb73d2f8fff2e604e9d59f55f7275e8999b04b..f10533854f4c7bb54247a11981191bf37b70cb36:/packages/debbugs/debbugs-gnu.el diff --git a/packages/debbugs/debbugs-gnu.el b/packages/debbugs/debbugs-gnu.el index 4c108cc46..55841fdf0 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." @@ -209,7 +206,7 @@ "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))) @@ -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'." @@ -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." @@ -551,7 +589,7 @@ marked as \"client-side filter\"." "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 +626,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))))) @@ -678,8 +720,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))) @@ -1014,9 +1059,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)