1 ;;; debbugs-org.el --- Org-mode interface for the GNU bug tracker
3 ;; Copyright (C) 2013-2014 Free Software Foundation, Inc.
5 ;; Author: Michael Albinus <michael.albinus@gmx.org>
6 ;; Keywords: comm, hypermedia, maint, outlines
10 ;; This file is not part of GNU Emacs.
12 ;; This program is free software: you can redistribute it and/or modify
13 ;; it under the terms of the GNU General Public License as published by
14 ;; the Free Software Foundation, either version 3 of the License, or
15 ;; (at your option) any later version.
17 ;; This program is distributed in the hope that it will be useful,
18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20 ;; GNU General Public License for more details.
22 ;; You should have received a copy of the GNU General Public License
23 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
27 ;; This package provides an interface to bug reports which are located
28 ;; on the GNU bug tracker debbugs.gnu.org. Its main purpose is to
29 ;; show and manipulate bug reports as org-mode TODO items.
31 ;; If you have `debbugs-org.el' in your load-path, you could enable
32 ;; the bug tracker commands by the following lines in your ~/.emacs
34 ;; (autoload 'debbugs-org "debbugs-org" "" 'interactive)
35 ;; (autoload 'debbugs-org-search "debbugs-org" "" 'interactive)
36 ;; (autoload 'debbugs-org-bugs "debbugs-org" "" 'interactive)
38 ;; The bug tracker is called interactively by
42 ;; It asks for the severities, for which bugs shall be shown. This can
43 ;; be either just one severity, or a list of severities, separated by
44 ;; comma. Valid severities are "serious", "important", "normal",
45 ;; "minor" or "wishlist". Severities "critical" and "grave" are not
46 ;; used, although configured on the GNU bug tracker. If no severity
47 ;; is given, all bugs are selected.
49 ;; There is also the pseudo severity "tagged". When it is used, the
50 ;; function will ask for user tags (a comma separated list), and shows
51 ;; just the bugs which are tagged with them. In general, user tags
52 ;; shall be strings denoting to subprojects of the package, like
53 ;; "cedet" or "tramp" of the package "emacs". If no user tag is
54 ;; given, locally tagged bugs are shown.
56 ;; If a prefix is given to the command, more search parameters are
57 ;; asked for, like packages (also a comma separated list, "emacs" is
58 ;; the default), whether archived bugs shall be shown, and whether
59 ;; closed bugs shall be shown.
63 ;; M-x debbugs-org-search
65 ;; It behaves like `debbugs-org', but asks at the beginning for a
66 ;; search phrase to be used for full text search. Additionally, it
67 ;; asks for key-value pairs to filter bugs. Keys are as described in
68 ;; `debbugs-get-status', the corresponding value must be a regular
69 ;; expression to match for. The other parameters are as described in
72 ;; The bug reports are downloaded from the bug tracker. In order to
73 ;; not generate too much load of the server, up to 500 bugs will be
74 ;; downloaded at once. If there are more hits, you will be asked to
75 ;; change this limit, but please don't increase this number too much.
77 ;; These default values could be changed also by customer options
78 ;; `debbugs-gnu-default-severities', `debbugs-gnu-default-packages'
79 ;; and `debbugs-gnu-default-hits-per-page'.
81 ;; The commands create a TODO list. Besides the usual handling of
82 ;; TODO items, you could apply the following actions by the following
85 ;; "C-c # C": Send a debbugs control message
86 ;; "C-c # t": Mark the bug locally as tagged
87 ;; "C-c # d": Show bug attributes
89 ;; The last entry in a TODO record is the link [[Messages]]. If you
90 ;; follow this link, a Gnus ephemeral group is opened presenting all
91 ;; related messages for this bug. Here you could also send debbugs
92 ;; control messages by keystroke "C".
94 ;; Finally, if you simply want to list some bugs with known bug
95 ;; numbers, call the command
97 ;; M-x debbugs-org-bugs
99 ;; The bug numbers to be shown shall be entered as comma separated list.
103 (require 'debbugs-gnu)
105 (eval-when-compile (require 'cl))
107 (defconst debbugs-org-severity-priority
110 (lambda (x) (prog1 (cons x (char-to-string priority)) (incf priority)))
111 debbugs-gnu-all-severities))
112 "Mapping of debbugs severities to TODO priorities.")
114 (defun debbugs-org-get-severity-priority (state)
115 "Returns the TODO priority of STATE."
116 (or (cdr (assoc (cdr (assq 'severity state))
117 debbugs-org-severity-priority))
118 (cdr (assoc "minor" debbugs-org-severity-priority))))
120 (defconst debbugs-org-priority-faces
121 '(("A" . org-warning)
123 "Highlighting of prioritized TODO items.")
125 ;; We do not add the bug numbers list to the elisp:link, because this
126 ;; would be much too long. Instead, this variable shall keep the bug
128 (defvar-local debbugs-org-ids nil
129 "The list of bug ids to be shown following the elisp link.")
131 (defvar debbugs-org-show-buffer-name "*Org Bugs*"
132 "The buffer name we present the bug reports.
133 This could be a temporary buffer, or a buffer linked with a file.")
135 (defvar debbugs-org-mode) ;; Silence compiler.
136 (defun debbugs-org-show-buffer-name ()
137 "The buffer name we present the bug reports.
138 This could be a temporary buffer, or a buffer linked with a file."
139 (if debbugs-org-mode (buffer-name) debbugs-org-show-buffer-name))
142 (defun debbugs-org-search ()
143 "Search for bugs interactively.
144 Search arguments are requested interactively. The \"search
145 phrase\" is used for full text search in the bugs database.
146 Further key-value pairs are requested until an empty key is
151 ;; Check for the phrase.
152 (let ((phrase (read-string debbugs-gnu-phrase-prompt))
153 key val1 severities packages)
155 (add-to-list 'debbugs-gnu-current-query (cons 'phrase phrase))
157 ;; The other queries.
160 (setq key (completing-read
162 '("severity" "package" "tags" "submitter" "author"
166 ;; Server-side queries.
167 ((equal key "severity")
170 (completing-read-multiple
171 "Enter severities: " debbugs-gnu-all-severities nil t
172 (mapconcat 'identity debbugs-gnu-default-severities ","))))
174 ((equal key "package")
177 (completing-read-multiple
178 "Enter packages: " debbugs-gnu-all-packages nil t
179 (mapconcat 'identity debbugs-gnu-default-packages ","))))
181 ((member key '("tags" "subject"))
182 (setq val1 (read-string (format "Enter %s: " key)))
183 (when (not (zerop (length val1)))
185 'debbugs-gnu-current-query (cons (intern key) val1))))
187 ((member key '("submitter" "author"))
188 (when (equal key "author") (setq key "@author"))
189 (setq val1 (read-string "Enter email address: "))
190 (when (not (zerop (length val1)))
192 'debbugs-gnu-current-query (cons (intern key) val1))))
194 ((equal key "status")
197 (completing-read "Enter status: " '("done" "forwarded" "open")))
198 (when (not (zerop (length val1)))
200 'debbugs-gnu-current-query (cons (intern key) val1))))
203 (t (throw :finished nil)))))
206 (debbugs-org severities packages))
208 ;; Reset query and filter.
209 (setq debbugs-gnu-current-query nil)))
212 (defun debbugs-org (severities &optional packages archivedp suppress tags)
213 "List all outstanding bugs."
215 (let (severities archivedp)
218 (completing-read-multiple
219 "Severities: " debbugs-gnu-all-severities nil t
220 (mapconcat 'identity debbugs-gnu-default-severities ",")))
221 ;; The next parameters are asked only when there is a prefix.
222 (if current-prefix-arg
223 (completing-read-multiple
224 "Packages: " debbugs-gnu-all-packages nil t
225 (mapconcat 'identity debbugs-gnu-default-packages ","))
226 debbugs-gnu-default-packages)
227 (when current-prefix-arg
228 (setq archivedp (y-or-n-p "Show archived bugs?")))
229 (when (and current-prefix-arg (not archivedp))
230 (y-or-n-p "Suppress unwanted bugs?"))
231 ;; This one must be asked for severity "tagged".
232 (when (member "tagged" severities)
233 (split-string (read-string "User tag(s): ") "," t)))))
235 ;; Initialize variables.
236 (when (and (file-exists-p debbugs-gnu-persistency-file)
237 (not debbugs-gnu-local-tags))
239 (insert-file-contents debbugs-gnu-persistency-file)
240 (eval (read (current-buffer)))))
243 (dolist (severity (if (consp severities) severities (list severities)))
244 (when (not (zerop (length severity)))
245 (add-to-list 'debbugs-gnu-current-query (cons 'severity severity))))
246 (dolist (package (if (consp packages) packages (list packages)))
247 (when (not (zerop (length package)))
248 (add-to-list 'debbugs-gnu-current-query (cons 'package package))))
250 (add-to-list 'debbugs-gnu-current-query '(archive . "1")))
252 (add-to-list 'debbugs-gnu-current-query '(status . "open"))
253 (add-to-list 'debbugs-gnu-current-query '(status . "forwarded")))
254 (dolist (tag (if (consp tags) tags (list tags)))
255 (when (not (zerop (length tag)))
256 (add-to-list 'debbugs-gnu-current-query (cons 'tag tag))))
259 (with-current-buffer (get-buffer-create (debbugs-org-show-buffer-name))
262 (let ((hits debbugs-gnu-default-hits-per-page))
263 (setq debbugs-org-ids
264 (debbugs-gnu-get-bugs debbugs-gnu-current-query))
266 (when (> (length debbugs-org-ids) hits)
267 (let ((cursor-in-echo-area nil))
272 "How many reports (available %d, default %d): "
273 (length debbugs-org-ids) hits)
276 (number-to-string hits))))))
278 (debbugs-org-show-next-reports hits)))
281 (setq debbugs-gnu-current-query nil)))
283 (defun debbugs-org-show-reports (bug-numbers)
284 "Show bug reports as given in BUG-NUMBERS."
285 (pop-to-buffer (get-buffer-create (debbugs-org-show-buffer-name)))
286 ;; Local variable `debbugs-org-ids' must survive.
287 (let ((doi debbugs-org-ids))
290 (setq debbugs-org-ids doi))
292 (let ((inhibit-read-only t)
293 (debbugs-port "gnu.org"))
296 (apply 'debbugs-get-status bug-numbers)
297 (lambda (x y) (< (cdr (assq 'id x)) (cdr (assq 'id y))))))
299 (id (cdr (assq 'id status)))
300 (done (string-equal (cdr (assq 'pending status)) "done"))
301 (priority (debbugs-org-get-severity-priority status))
302 (archived (cdr (assq 'archived status)))
303 (tags (append (cdr (assq 'found_versions status))
304 (cdr (assq 'tags status))))
305 (subject (when (cdr (assq 'subject status))
306 (decode-coding-string
307 (cdr (assq 'subject status)) 'utf-8)))
308 (date (cdr (assq 'date status)))
309 (last-modified (cdr (assq 'last_modified status)))
310 (originator (when (cdr (assq 'originator status))
311 (decode-coding-string
312 (cdr (assq 'originator status)) 'utf-8)))
313 (owner (when (cdr (assq 'owner status))
314 (decode-coding-string (cdr (assq 'owner status)) 'utf-8)))
315 (closed-by (when (cdr (assq 'done status))
316 (decode-coding-string
317 (cdr (assq 'done status)) 'utf-8)))
318 (merged (cdr (assq 'mergedwith status))))
321 (when (string-match "^\\([0-9.]+\\); \\(.+\\)$" subject)
322 (let ((x (match-string 1 subject))) (pushnew x tags :test #'equal))
323 (setq subject (match-string 2 subject)))
325 (pushnew "ARCHIVE" tags :test #'equal))
328 ;; Replace all invalid TAG characters by "_".
329 (lambda (x) (replace-regexp-in-string "[^A-Za-z0-9_@]" "_" x))
336 (if done "DONE" "TODO")
338 (if tags (mapconcat 'identity (append '("") tags '("")) ":") "")))
344 " [%Y-%m-%d %a] Submitted\n" (seconds-to-time date))))
347 (insert " :PROPERTIES:\n")
348 (insert (format " :DEBBUGS_ID: %s\n" id))
352 " :MERGED_WITH: %s\n"
354 merged (mapconcat 'number-to-string merged " ")))))
355 (insert (format " :CREATOR: %s\n" originator))
356 (when owner (insert (format " :OWNER: %s\n" owner)))
357 (when closed-by (insert (format " :CLOSED_BY: %s\n" closed-by)))
362 " [[elisp:(debbugs-gnu-select-report)][Messages]]\n")
368 " [%Y-%m-%d %a] Last modified\n"
369 (seconds-to-time last-modified))))
371 ;; Add text properties.
372 (add-text-properties beg (point) `(tabulated-list-id ,status))))))
374 (defun debbugs-org-regenerate-status ()
375 "Regenerate the `tabulated-list-id' text property.
376 This property is used when following the [Messages] link, so you
377 need to regenerate it when opening an .org file after you killed
378 the corresponding buffer (e.g. by closing Emacs)."
380 (goto-char (point-min))
381 (while (re-search-forward ":DEBBUGS_ID:[ \t]*\\([0-9]+\\)" nil t)
382 (let* ((bugnum (string-to-number (match-string 1)))
383 (mw (org-entry-get (point) "MERGEDWIDTH"))
384 (tli (list (cons 'id bugnum)
385 (cons 'bug_num bugnum)
386 (cons 'mergedwidth (if mw (string-to-number mw)))))
387 (beg (org-back-to-heading t))
388 (end (org-end-of-subtree t)))
389 (add-text-properties beg end `(tabulated-list-id ,tli))))))
391 (defun debbugs-org-show-next-reports (hits)
392 "Show next HITS of bug reports."
393 (with-current-buffer (get-buffer-create (debbugs-org-show-buffer-name))
395 (goto-char (point-max))
396 (when (re-search-backward
397 "^* COMMENT \\[\\[elisp:(debbugs-org-show-next-reports" nil t)
399 (delete-region (point) (point-max)))
400 (debbugs-org-show-reports
401 (butlast debbugs-org-ids (- (length debbugs-org-ids) hits)))
402 (setq debbugs-org-ids
403 (last debbugs-org-ids (- (length debbugs-org-ids) hits)))
404 (goto-char (point-max))
405 (when debbugs-org-ids
408 "* COMMENT [[elisp:(debbugs-org-show-next-reports %s)][Next bugs]]\n\n"
410 (insert "* COMMENT Local " "Variables\n")
411 (when debbugs-org-ids
412 (insert "#+NAME: init\n"
413 "#+BEGIN_SRC elisp\n"
414 (format "(setq debbugs-org-ids '%s)\n" debbugs-org-ids)
416 (insert "# Local " "Variables:\n"
418 "# eval: (debbugs-org-mode 1)\n")
419 (when debbugs-org-ids
420 (insert (format "# eval: (%s \"init\")\n"
421 (if (macrop 'org-sbe) "org-sbe" "sbe"))))
423 (goto-char (point-min))
425 (set-buffer-modified-p nil))))
427 (defconst debbugs-org-mode-map
428 (let ((map (make-sparse-keymap)))
429 (define-key map (kbd "C-c # t") 'debbugs-gnu-toggle-tag)
430 (define-key map (kbd "C-c # C") 'debbugs-gnu-send-control-message)
431 (define-key map (kbd "C-c # d") 'debbugs-gnu-display-status)
433 "Keymap for the `debbugs-org-mode' minor mode.")
435 ;; Make byte-compiler quiet.
436 (defvar gnus-posting-styles)
439 (define-minor-mode debbugs-org-mode
440 "Minor mode for providing a debbugs interface in org-mode buffers.
442 \\{debbugs-org-mode-map}"
443 :lighter " Debbugs" :keymap debbugs-org-mode-map
444 ;; FIXME: Does not show any effect.
445 (set (make-local-variable 'org-priority-faces) debbugs-org-priority-faces)
446 (set (make-local-variable 'gnus-posting-styles)
449 (when (buffer-live-p gnus-article-copy)
450 (with-current-buffer gnus-article-copy
451 (set (make-local-variable 'message-prune-recipient-rules)
452 '((".*@debbugs.*" "emacs-pretest-bug")
453 (".*@debbugs.*" "bug-gnu-emacs")
454 ("[0-9]+@debbugs.*" "submit@debbugs.gnu.org")
455 ("[0-9]+@debbugs.*" "quiet@debbugs.gnu.org")))
456 ;; `gnus-posting-styles' is eval'ed after
457 ;; `message-simplify-subject'. So we cannot use m-s-s.
458 (setq subject ,debbugs-gnu-subject)))))))
459 (debbugs-org-regenerate-status))
462 (defun debbugs-org-bugs (&rest bugs)
463 "List all BUGS, a list of bug numbers."
465 (mapcar 'string-to-number
466 (completing-read-multiple "Bug numbers: " nil 'natnump)))
468 (unless (natnump elt) (signal 'wrong-type-argument (list 'natnump elt))))
469 (add-to-list 'debbugs-gnu-current-query (cons 'bugs bugs))
474 ;; - Refactor it in order to avoid code duplication with debbugs-gnu.el.
475 ;; - Make headline customizable.
476 ;; - Sort according to different TODO properties.
478 (provide 'debbugs-org)