;; Michael Albinus <michael.albinus@gmx.org>
;; Keywords: comm, hypermedia, maint
;; Package: debbugs
-;; Version: 0.7
+;; Version: 0.8
;; This file is not part of GNU Emacs.
;; submitter, and the title of the bug. On every bug line you could
;; apply the following actions by the following keystrokes:
-;; RET: Show corresponding messages in Gnus
+;; RET: Show corresponding messages in Gnus/Rmail
;; "C": Send a control message
;; "t": Mark the bug locally as tagged
;; "b": Show bugs this bug is blocked by
;; "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))
(autoload 'message-make-from "message")
(autoload 'vc-dir-hide-up-to-date "vc-dir")
(autoload 'vc-dir-mark "vc-dir")
+(autoload 'rmail-get-new-mail "rmail")
+(autoload 'rmail-show-message "rmail")
+(autoload 'rmail-summary "rmailsum")
(defvar compilation-in-progress)
(defgroup debbugs-gnu ()
: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 500
- "*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")
+(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."
+ :group 'debbugs-gnu
+ :type '(choice (const :tag "Use Gnus" '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-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."
(set-buffer-modified-p nil)
(special-mode))
+(defvar rmail-current-message)
+(defvar rmail-total-messages)
+(defvar rmail-mode-map)
+(defvar rmail-summary-mode-map)
+
+(defun debbugs-read-emacs-bug-with-rmail (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."
+ (let* ((mbox-dir (make-temp-file "debbugs" t))
+ (mbox-fname (format "%s/bug_%d.mbox" mbox-dir id)))
+ (debbugs-get-mbox id 'mboxmaint mbox-fname)
+ (rmail mbox-fname)
+ ;; Download messages of all the merged bug reports and append them
+ ;; to the mailbox of the requested bug.
+ (when merged
+ (dolist (bugno merged)
+ (let ((fn (make-temp-file "url")))
+ (debbugs-get-mbox bugno 'mboxmaint fn)
+ (rmail-get-new-mail fn)
+ (delete-file fn)
+ ;; Remove the 'unseen' attribute from all the messages we've
+ ;; just read, so that all of them appear in the summary with
+ ;; the same face.
+ (while (< rmail-current-message rmail-total-messages)
+ (rmail-show-message (1+ rmail-current-message))))))
+ (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))))
+ (rmail-summary)
+ (define-key rmail-summary-mode-map "C" 'debbugs-gnu-send-control-message)
+ (set-window-text-height nil 10)
+ (other-window 1)
+ (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))))
- (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)
(gnus-with-article-buffer
(dolist (handle (mapcar 'cdr (gnus-article-mime-handles)))
(when (string-match "diff\\|patch" (mm-handle-media-type handle))
- (push (mm-handle-buffer handle) patch-buffers))))
+ (push (cons (mm-handle-encoding handle)
+ (mm-handle-buffer handle))
+ patch-buffers))))
(unless patch-buffers
(gnus-summary-show-article 'raw)
(article-decode-charset)
- (push (current-buffer) patch-buffers))
- (dolist (buffer patch-buffers)
- (with-current-buffer buffer
+ (push (cons nil gnus-article-buffer) patch-buffers))
+ (dolist (elem patch-buffers)
+ (with-temp-buffer
+ (insert-buffer-substring (cdr elem))
+ (cond ((eq (car elem) 'base64)
+ (base64-decode-region (point-min) (point-max)))
+ ((eq (car elem) 'qp)
+ (quoted-printable-decode-region (point-min) (point-max))))
+ (debbugs-gnu-fix-patch dir)
(call-process-region (point-min) (point-max)
"patch" nil output-buffer nil
"-r" rej "--no-backup-if-mismatch"
(switch-to-buffer "*vc-diff*")
(goto-char (point-min))))
+(defun debbugs-gnu-fix-patch (dir)
+ (setq dir (directory-file-name (expand-file-name dir)))
+ (goto-char (point-min))
+ (while (re-search-forward diff-file-header-re nil t)
+ (goto-char (match-beginning 0))
+ (let ((target-name (car (diff-hunk-file-names))))
+ (when (and target-name
+ (or (not (string-match "/" target-name))
+ (and (string-match "^[ab]/" target-name)
+ (not (file-exists-p
+ (expand-file-name (substring target-name 2)
+ dir))))
+ (file-exists-p (expand-file-name target-name dir))))
+ ;; We have a simple patch that refers to a file somewhere in the
+ ;; tree. Find it.
+ (when-let ((files (directory-files-recursively
+ dir (concat "^" (regexp-quote
+ (file-name-nondirectory target-name))
+ "$"))))
+ (when (re-search-forward (concat "^[+]+ "
+ (regexp-quote target-name)
+ "\\([ \t\n]\\)")
+ nil t)
+ (replace-match (concat "+++ a"
+ (substring (car files) (length dir))
+ (match-string 1))
+ nil t)))))
+ (forward-line 2)))
+
(defun debbugs-gnu-find-contributor (string)
"Search through ChangeLogs to find contributors."
(interactive "sContributor match: ")
;; Fall back on the email address.
(t
(cadr from))))))
- (goto-char (point-min))
+ (goto-char (point-max))
(end-of-line)
(insert " (tiny change"))
(goto-char point)))))
(save-some-buffers t)
(when (get-buffer "*vc-dir*")
(kill-buffer (get-buffer "*vc-dir*")))
- (vc-dir debbugs-gnu-trunk-directory)
+ (let ((trunk (expand-file-name debbugs-gnu-trunk-directory)))
+ (if (equal (subseq default-directory 0 (length trunk))
+ trunk)
+ (vc-dir debbugs-gnu-trunk-directory)
+ (vc-dir debbugs-gnu-branch-directory)))
(goto-char (point-min))
(while (not (search-forward "edited" nil t))
(sit-for 0.01))