;; "s": Toggle bug sorting for age or for state
;; "x": Toggle suppressing of bugs
;; "/": Display only bugs matching a string
+;; "R": Display only bugs blocking the current release
;; "w": Display all the currently selected bug reports
;; When you visit the related bug messages in Gnus, you could also
;;; Code:
(require 'debbugs)
-(require 'widget)
-(require 'wid-edit)
(require 'tabulated-list)
(require 'add-log)
(eval-when-compile (require 'cl))
: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."
(mapcar 'cadr (cdr (get 'debbugs-gnu-default-packages 'custom-type)))
"*List of all possible package names.")
-(defcustom debbugs-gnu-default-hits-per-page 3000
- "*The number of bugs shown per page."
- :group 'debbugs-gnu
- :type 'integer
- :version "24.1")
+;; Please do not increase this value, otherwise we would run into
+;; performance problems on the server.
+(defconst debbugs-gnu-default-hits-per-page 500
+ "The number of bugs shown per page.")
(defcustom debbugs-gnu-default-suppress-bugs
'((pending . "done"))
:type '(alist :key-type symbol :value-type regexp)
:version "24.1")
-(defface debbugs-gnu-archived '((t (:inverse-video t)))
- "Face for archived bug reports.")
-
(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.
(const :tag "Use Rmail" 'rmail))
:version "25.1")
+(defface debbugs-gnu-archived '((t (:inverse-video t)))
+ "Face for archived bug reports.")
+
(defface debbugs-gnu-new '((t (:foreground "red")))
"Face for new reports that nobody has answered.")
(defface debbugs-gnu-tagged '((t (:foreground "red")))
"Face for reports that have been tagged locally.")
-(defvar debbugs-gnu-widgets nil)
-
-(defvar debbugs-gnu-widget-map
- (let ((map (make-sparse-keymap)))
- (define-key map "\r" 'widget-button-press)
- (define-key map [mouse-2] 'widget-button-press)
- map))
-
(defvar debbugs-gnu-local-tags nil
"List of bug numbers tagged locally, and kept persistent.")
(setq debbugs-gnu-current-query nil
debbugs-gnu-current-filter nil)))
+(defvar debbugs-gnu-current-limit nil)
+(defvar debbugs-gnu-current-suppress nil)
+
;;;###autoload
(defun debbugs-gnu (severities &optional packages archivedp suppress tags)
"List all outstanding bugs."
(with-temp-buffer
(insert-file-contents debbugs-gnu-persistency-file)
(eval (read (current-buffer)))))
- (setq debbugs-gnu-widgets nil)
;; Add queries.
(dolist (severity (if (consp severities) severities (list severities)))
(add-to-list 'debbugs-gnu-current-query '(archive . "1")))
(when suppress
(add-to-list 'debbugs-gnu-current-query '(status . "open"))
- (add-to-list 'debbugs-gnu-current-query '(status . "forwarded")))
+ (add-to-list 'debbugs-gnu-current-query '(status . "forwarded"))
+ (setq debbugs-gnu-current-suppress suppress))
(dolist (tag (if (consp tags) tags (list tags)))
(when (not (zerop (length tag)))
(add-to-list 'debbugs-gnu-current-query (cons 'tag tag))))
- (unwind-protect
- (let ((hits debbugs-gnu-default-hits-per-page)
- (ids (debbugs-gnu-get-bugs debbugs-gnu-current-query)))
-
- (if (> (length ids) hits)
- (let ((cursor-in-echo-area nil))
- (setq hits
- (string-to-number
- (read-string
- (format
- "How many reports (available %d, default %d): "
- (length ids) hits)
- nil
- nil
- (number-to-string hits))))))
-
- (if (> (length ids) hits)
- (let ((i 0)
- curr-ids)
- (while ids
- (setq i (1+ i)
- curr-ids (butlast ids (- (length ids) hits)))
- (add-to-list
- 'debbugs-gnu-widgets
- (widget-convert
- 'push-button
- :follow-link 'mouse-face
- :notify (lambda (widget &rest ignore)
- (debbugs-gnu-show-reports widget))
- :keymap debbugs-gnu-widget-map
- :suppress suppress
- :buffer-name (format "*Emacs Bugs*<%d>" i)
- :bug-ids curr-ids
- :query debbugs-gnu-current-query
- :filter debbugs-gnu-current-filter
- :help-echo (format "%d-%d" (car ids) (car (last curr-ids)))
- :format " %[%v%]"
- (number-to-string i))
- 'append)
- (setq ids (last ids (- (length ids) hits))))
- (debbugs-gnu-show-reports (car debbugs-gnu-widgets)))
-
- (debbugs-gnu-show-reports
- (widget-convert
- 'const
- :suppress suppress
- :buffer-name "*Emacs Bugs*"
- :bug-ids ids
- :query debbugs-gnu-current-query
- :filter debbugs-gnu-current-filter))))
+ ;; Show result.
+ (debbugs-gnu-show-reports)
- ;; Reset query and filter.
- (setq debbugs-gnu-current-query nil
- debbugs-gnu-current-filter nil)))
+ ;; Reset query and filter.
+ (setq debbugs-gnu-current-query nil
+ debbugs-gnu-current-filter nil))
(defun debbugs-gnu-get-bugs (query)
"Retrieve bugs numbers from debbugs.gnu.org according search criteria."
;; Sort function.
'<)))
-(defvar debbugs-gnu-current-widget nil)
-(defvar debbugs-gnu-current-limit nil)
-
-(defun debbugs-gnu-show-reports (widget)
- "Show bug reports as given in WIDGET property :bug-ids."
- ;; The tabulated mode sets several local variables. We must get rid
- ;; of them.
- (when (get-buffer (widget-get widget :buffer-name))
- (kill-buffer (widget-get widget :buffer-name)))
- (pop-to-buffer (get-buffer-create (widget-get widget :buffer-name)))
- (debbugs-gnu-mode)
+(defun debbugs-gnu-show-reports ()
+ "Show bug reports."
(let ((inhibit-read-only t)
- (debbugs-port "gnu.org"))
- (erase-buffer)
- (set (make-local-variable 'debbugs-gnu-current-widget) widget)
-
- (dolist (status (apply 'debbugs-get-status (widget-get widget :bug-ids)))
+ (debbugs-port "gnu.org")
+ (buffer-name "*Emacs Bugs*")
+ all-status)
+ ;; The tabulated mode sets several local variables. We must get
+ ;; rid of them.
+ (when (get-buffer buffer-name)
+ (kill-buffer buffer-name))
+ (switch-to-buffer (get-buffer-create buffer-name))
+ (debbugs-gnu-mode)
+
+ ;; Retrieve all bugs in chunks of `debbugs-gnu-default-hits-per-page'.
+ (let ((bug-ids (debbugs-gnu-get-bugs debbugs-gnu-current-query))
+ (hits debbugs-gnu-default-hits-per-page)
+ curr-ids)
+ (while bug-ids
+ (setq curr-ids (butlast bug-ids (- (length bug-ids) hits))
+ bug-ids (last bug-ids (- (length bug-ids) hits))
+ all-status
+ (append all-status (apply 'debbugs-get-status curr-ids)))))
+
+ ;; Print bug reports.
+ ;; TODO: Do it asynchronously, in parallel to retrieving next chunk
+ ;; of bug statuses.
+ (dolist (status all-status)
(let* ((id (cdr (assq 'id status)))
(words
(mapconcat
(defun debbugs-gnu-print-entry (list-id cols)
"Insert a debbugs entry at point.
Used instead of `tabulated-list-print-entry'."
- ;; This shall be in `debbugs-gnu-show-reports'. But
- ;; `tabulated-list-print' erases the buffer, therefore we do it
- ;; here. (bug#9047)
- (when (and debbugs-gnu-widgets (= (point) (point-min)))
- (widget-insert "Page:")
- (mapc
- (lambda (obj)
- (if (eq obj debbugs-gnu-current-widget)
- (widget-put obj :button-face 'widget-button-pressed)
- (widget-put obj :button-face 'widget-button-face))
- (widget-apply obj :create))
- debbugs-gnu-widgets)
- (widget-insert "\n\n")
- (save-excursion
- (widget-insert "\nPage:")
- (mapc (lambda (obj) (widget-apply obj :create)) debbugs-gnu-widgets)
- (widget-setup)))
-
(let ((beg (point))
(pos 0)
(case-fold-search t)
(or (not debbugs-gnu-current-limit)
(memq (cdr (assq 'id list-id)) debbugs-gnu-current-limit))
;; Filter suppressed bugs.
- (or (not (widget-get debbugs-gnu-current-widget :suppress))
+ (or (not debbugs-gnu-current-suppress)
(and (not (memq (cdr (assq 'id list-id)) debbugs-gnu-local-tags))
(not (catch :suppress
(dolist (check debbugs-gnu-default-suppress-bugs)
(throw :suppress t)))))))
;; Filter search list.
(not (catch :suppress
- (dolist (check
- (widget-get debbugs-gnu-current-widget :filter))
+ (dolist (check debbugs-gnu-current-filter)
(let ((val (cdr (assq (car check) list-id))))
(if (stringp (cdr check))
;; Regular expression.
(insert (propertize title 'help-echo title))
;; Add properties.
(add-text-properties
- beg (point) `(tabulated-list-id ,list-id mouse-face ,widget-mouse-face))
+ beg (point)
+ `(tabulated-list-id ,list-id mouse-face highlight))
(insert ?\n))))
(defvar debbugs-gnu-mode-map
(define-key map "b" 'debbugs-gnu-show-blocked-by-reports)
(define-key map "B" 'debbugs-gnu-show-blocking-reports)
(define-key map "C" 'debbugs-gnu-send-control-message)
+ (define-key map "R" 'debbugs-gnu-show-all-blocking-reports)
map))
(defun debbugs-gnu-rescan ()
"Rescan the current set of bug reports."
(interactive)
- ;; The last page will be provided with new bug ids.
- ;; TODO: Do it also for the other pages.
- (when (and debbugs-gnu-widgets
- (eq debbugs-gnu-current-widget (car (last debbugs-gnu-widgets))))
- (let ((first-id (car (widget-get debbugs-gnu-current-widget :bug-ids)))
- (last-id (car
- (last (widget-get debbugs-gnu-current-widget :bug-ids))))
- (ids (debbugs-gnu-get-bugs
- (widget-get debbugs-gnu-current-widget :query))))
-
- (while (and (<= first-id last-id) (not (memq first-id ids)))
- (setq first-id (1+ first-id)))
-
- (when (<= first-id last-id)
- (widget-put debbugs-gnu-current-widget :bug-ids (memq first-id ids)))))
-
;; Refresh the buffer. `save-excursion' does not work, so we
;; remember the position.
(let ((pos (point)))
- (debbugs-gnu-show-reports debbugs-gnu-current-widget)
+ (debbugs-gnu-show-reports)
(goto-char pos)))
(defvar debbugs-gnu-sort-state 'number)
\\{debbugs-gnu-mode-map}"
(set (make-local-variable 'debbugs-gnu-sort-state) 'number)
(set (make-local-variable 'debbugs-gnu-current-limit) nil)
+ (set (make-local-variable 'debbugs-gnu-current-suppress) nil)
(setq tabulated-list-format [("Id" 5 debbugs-gnu-sort-id)
("State" 20 debbugs-gnu-sort-state)
("Submitter" 25 t)
(message "Bug %d is not blocking any other bug" id)
(apply 'debbugs-gnu-bugs (cdr (assq 'blocks status))))))
+(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)))))
+ (id (debbugs-gnu-current-id t))
+ (inhibit-read-only t)
+ status)
+ (setq debbugs-gnu-current-limit nil)
+ (goto-char (point-min))
+ (while (not (eobp))
+ (setq status (debbugs-gnu-current-status))
+ (if (not (memq (cdr (assq 'id status)) blockers))
+ (delete-region (point) (progn (forward-line 1) (point)))
+ (push (cdr (assq 'id status)) debbugs-gnu-current-limit)
+ (forward-line 1)))
+ (when id
+ (debbugs-gnu-goto id))))
+
(defun debbugs-gnu-narrow-to-status (string &optional status-only)
"Only display the bugs matching STRING.
If STATUS-ONLY (the prefix), ignore matches in the From and
(while (not (eobp))
(setq status (debbugs-gnu-current-status))
(if (and (not (member string (assq 'keywords status)))
- (not (member string (assq 'severity status)))
+ (not (equal string (cdr (assq 'severity status))))
(or status-only
(not (string-match string (cdr (assq 'originator status)))))
(or status-only
(defun debbugs-gnu-toggle-suppress ()
"Suppress bugs marked in `debbugs-gnu-suppress-bugs'."
(interactive)
- (widget-put debbugs-gnu-current-widget :suppress
- (not (widget-get debbugs-gnu-current-widget :suppress)))
+ (setq debbugs-gnu-current-suppress (not debbugs-gnu-current-suppress))
(tabulated-list-init-header)
(tabulated-list-print))
(get-text-property (line-beginning-position) 'tabulated-list-id))
(defun debbugs-gnu-current-query ()
- (widget-get debbugs-gnu-current-widget :query))
+ debbugs-gnu-current-query)
(defun debbugs-gnu-display-status (query status)
"Display the query and status of the report on the current line."
(define-key rmail-mode-map "C" 'debbugs-gnu-send-control-message)
(rmail-show-message 1)))
+(defvar gnus-suppress-duplicates)
+(defvar gnus-save-duplicate-list)
+
+(defun debbugs-read-emacs-bug-with-gnus (id status merged)
+ "Read email exchange for debbugs bug ID.
+STATUS is the bug's status list.
+MERGED is the list of bugs merged with this one."
+ (require 'gnus-dup)
+ (setq gnus-suppress-duplicates t
+ gnus-save-duplicate-list t)
+ ;; Use Gnus.
+ (gnus-read-ephemeral-emacs-bug-group
+ (cons id (if (listp merged) merged (list merged)))
+ (cons (current-buffer)
+ (current-window-configuration)))
+ (with-current-buffer (window-buffer (selected-window))
+ (set (make-local-variable 'debbugs-gnu-bug-number) id)
+ (set (make-local-variable 'debbugs-gnu-subject)
+ (format "Re: bug#%d: %s" id (cdr (assq 'subject status))))
+ (debbugs-gnu-summary-mode 1)))
+
(defun debbugs-gnu-select-report ()
"Select the report on the current line."
(interactive)
(let* ((status (debbugs-gnu-current-status))
(id (cdr (assq 'id status)))
(merged (cdr (assq 'mergedwith status))))
- (if (not id)
- (message "No bug report on the current line")
- (if (eq debbugs-gnu-mail-backend 'rmail)
- (debbugs-read-emacs-bug-with-rmail id status (if (listp merged)
- merged
- (list merged)))
- ;; Use Gnus.
- (gnus-read-ephemeral-emacs-bug-group
- (cons id (if (listp merged)
- merged
- (list merged)))
- (cons (current-buffer)
- (current-window-configuration)))
- (with-current-buffer (window-buffer (selected-window))
- (set (make-local-variable 'debbugs-gnu-bug-number) id)
- (set (make-local-variable 'debbugs-gnu-subject)
- (format "Re: bug#%d: %s" id (cdr (assq 'subject status))))
- (debbugs-gnu-summary-mode 1))))))
+ (setq merged (if (listp merged) merged (list merged)))
+ (cond
+ ((not id)
+ (message "No bug report on the current line"))
+ ((eq debbugs-gnu-mail-backend 'rmail)
+ (debbugs-read-emacs-bug-with-rmail id status merged))
+ ((eq debbugs-gnu-mail-backend 'gnus)
+ (debbugs-read-emacs-bug-with-gnus id status merged))
+ (t (error "No valid mail backend specified")))))
(defvar debbugs-gnu-summary-mode-map
(let ((map (make-sparse-keymap)))
'tabulated-list-entries
;; `tabulated-list-id' is the parameter list for `debbugs-gnu'.
`((("tagged") (,user) nil nil (,tag))
- ,(vector (propertize user 'mouse-face widget-mouse-face)
- (propertize tag 'mouse-face widget-mouse-face)))
+ ,(vector (propertize user 'mouse-face highlight)
+ (propertize tag 'mouse-face highlight)))
'append)))
;; Add local tags.
(add-to-list
'tabulated-list-entries
`((("tagged"))
- ,(vector "" (propertize "(local tags)"
- 'mouse-face widget-mouse-face)))))
+ ,(vector
+ "" (propertize "(local tags)" 'mouse-face highlight)))))
;; Show them.
(tabulated-list-init-header)
(defvar debbugs-gnu-trunk-directory "~/src/emacs/trunk/"
"The directory where the main source tree lives.")
-(defvar debbugs-gnu-branch-directory "~/src/emacs/emacs-24/"
+(defvar debbugs-gnu-branch-directory "~/src/emacs/emacs-25/"
"The directory where the previous source tree lives.")
(defun debbugs-gnu-apply-patch (&optional branch)