;;; debbugs-gnu.el --- interface for the GNU bug tracker
-;; Copyright (C) 2011-2015 Free Software Foundation, Inc.
+;; Copyright (C) 2011-2016 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Michael Albinus <michael.albinus@gmx.org>
(require 'debbugs)
(require 'tabulated-list)
(require 'add-log)
+(require 'subr-x)
(eval-when-compile (require 'cl))
(autoload 'article-decode-charset "gnus-art")
(autoload 'diff-goto-source "diff-mode")
+(autoload 'diff-hunk-file-names "diff-mode")
(autoload 'gnus-article-mime-handles "gnus-art")
(autoload 'gnus-read-ephemeral-emacs-bug-group "gnus-group")
(autoload 'gnus-summary-article-header "gnus-sum")
(autoload 'log-edit-insert-changelog "log-edit")
(autoload 'mail-header-subject "nnheader")
(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")
+(autoload 'vc-dir-hide-up-to-date "vc-dir")
+(autoload 'vc-dir-mark "vc-dir")
+
(defvar compilation-in-progress)
+(defvar diff-file-header-re)
+(defvar gnus-article-buffer)
+(defvar gnus-posting-styles)
+(defvar gnus-save-duplicate-list)
+(defvar gnus-suppress-duplicates)
+(defvar rmail-current-message)
+(defvar rmail-mode-map)
+(defvar rmail-summary-mode-map)
+(defvar rmail-total-messages)
(defgroup debbugs-gnu ()
"UI for the debbugs.gnu.org bug tracker."
"*The list severities bugs are searched for.
\"tagged\" is not a severity but marks locally tagged bugs."
;; <http://debbugs.gnu.org/Developer.html#severities>
+ ;; /ssh:debbugs:/etc/debbugs/config @gSeverityList
+ ;; We don't use "critical" and "grave".
:group 'debbugs-gnu
:type '(set (const "serious")
(const "important")
(mapcar 'cadr (cdr (get 'debbugs-gnu-default-packages 'custom-type)))
"*List of all possible package names.")
-;; 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"))
"*A list of specs for bugs to be suppressed.
"Show bug reports."
(let ((inhibit-read-only t)
(debbugs-port "gnu.org")
- (buffer-name "*Emacs Bugs*")
- all-status)
+ (buffer-name "*Emacs Bugs*"))
;; The tabulated mode sets several local variables. We must get
;; rid of them.
(when (get-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)
+ (dolist (status
+ (apply 'debbugs-get-status
+ (debbugs-gnu-get-bugs debbugs-gnu-current-query)))
(let* ((id (cdr (assq 'id status)))
(words
(mapconcat
'utf-8))
merged)
(unless (equal (cdr (assq 'pending status)) "pending")
- (setq words
- (concat words "," (cdr (assq 'pending status)))))
+ (setq words (concat words "," (cdr (assq 'pending status)))))
(let ((packages (delete "emacs" (cdr (assq 'package status)))))
(when packages
(setq words (concat words "," (mapconcat 'identity packages ",")))))
'debbugs-gnu-tagged
'default))))
'append))))
+
(tabulated-list-init-header)
(tabulated-list-print)
(defun debbugs-gnu-rescan ()
"Rescan the current set of bug reports."
(interactive)
-
;; Refresh the buffer. `save-excursion' does not work, so we
;; remember the position.
(let ((pos (point)))
(if (and (not (member string (assq 'keywords status)))
(not (equal string (cdr (assq 'severity status))))
(or status-only
- (not (string-match string (cdr (assq 'originator status)))))
+ (not (string-match
+ string (cdr (assq 'originator status)))))
(or status-only
(not (string-match string (cdr (assq 'subject status))))))
(delete-region (point) (progn (forward-line 1) (point)))
"Display the query and status of the report on the current line."
(interactive (list (debbugs-gnu-current-query)
(debbugs-gnu-current-status)))
- (pop-to-buffer "*Bug Status*")
+ (switch-to-buffer "*Bug Status*")
(let ((inhibit-read-only t))
(erase-buffer)
(when query (pp query (current-buffer)))
(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.
(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.
(define-key map [(meta m)] 'debbugs-gnu-apply-patch)
map))
-(defvar gnus-posting-styles)
-
(define-minor-mode debbugs-gnu-summary-mode
"Minor mode for providing a debbugs interface in Gnus summary buffers.
;; Create buffer.
(when (get-buffer buffer-name)
(kill-buffer buffer-name))
- (pop-to-buffer (get-buffer-create buffer-name))
+ (switch-to-buffer (get-buffer-create buffer-name))
(debbugs-gnu-usertags-mode)
(setq tabulated-list-format `[("User" ,user-tab-length t)
("Tag" 10 t)])
(setq tabulated-list-sort-key (cons "User" nil))
;(setq tabulated-list-printer 'debbugs-gnu-print-entry)
- (erase-buffer)
;; Retrieve user tags.
(dolist (user users)
'tabulated-list-entries
;; `tabulated-list-id' is the parameter list for `debbugs-gnu'.
`((("tagged") (,user) nil nil (,tag))
- ,(vector (propertize user 'mouse-face highlight)
- (propertize tag 'mouse-face highlight)))
+ ,(vector (propertize user 'mouse-face 'highlight)
+ (propertize tag 'mouse-face 'highlight)))
'append)))
;; Add local tags.
'tabulated-list-entries
`((("tagged"))
,(vector
- "" (propertize "(local tags)" 'mouse-face highlight)))))
+ "" (propertize "(local tags)" 'mouse-face 'highlight)))))
;; Show them.
(tabulated-list-init-header)
(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 gnus-article-buffer patch-buffers))
- (dolist (buffer patch-buffers)
+ (push (cons nil gnus-article-buffer) patch-buffers))
+ (dolist (elem patch-buffers)
(with-temp-buffer
- (insert-buffer-substring 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
(defun debbugs-gnu-fix-patch (dir)
(setq dir (directory-file-name (expand-file-name dir)))
(goto-char (point-min))
- (re-search-forward diff-file-header-re nil t)
- (goto-char (match-beginning 0))
- (let ((file-names (diff-hunk-file-names)))
- (when (and file-names
- (not (string-match "/" (car file-names))))
- ;; 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 (car file-names))
- "$"))))
- (when (re-search-forward (concat "^[+]+ "
- (regexp-quote (car file-names))
- "[ \t]")
- nil t)
- (replace-match (concat "+++ a"
- (substring (car files) (length dir))
- "\t")
- nil t))))))
+ (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."
;; 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)))))
(when (get-buffer "*vc-dir*")
(kill-buffer (get-buffer "*vc-dir*")))
(let ((trunk (expand-file-name debbugs-gnu-trunk-directory)))
- (if (equal (subseq default-directory 0 (length trunk))
+ (if (equal (cl-subseq default-directory 0 (length trunk))
trunk)
(vc-dir debbugs-gnu-trunk-directory)
(vc-dir debbugs-gnu-branch-directory)))
;;; TODO:
-;; * Reorganize pages after client-side filtering.
+;; * Another random thought - is it possible to implement some local
+;; cache, so only changed bugs are fetched? Glenn Morris.
;;; debbugs-gnu.el ends here