;;; debbugs-org.el --- Org-mode interface for the GNU bug tracker
-;; Copyright (C) 2013 Free Software Foundation, Inc.
+;; Copyright (C) 2013-2014 Free Software Foundation, Inc.
;; Author: Michael Albinus <michael.albinus@gmx.org>
;; Keywords: comm, hypermedia, maint, outlines
;; Package: debbugs
-;; Version: 0.5
+;; Version: 0.6
;; This file is not part of GNU Emacs.
;; given, locally tagged bugs are shown.
;; If a prefix is given to the command, more search parameters are
-;; asked for, like packages (also a comma separated list, "org-mode" is
-;; the default), or whether archived bugs shall be shown.
+;; asked for, like packages (also a comma separated list, "emacs" is
+;; the default), whether archived bugs shall be shown, and whether
+;; closed bugs shall be shown.
;; Another command is
;;
;; We do not add the bug numbers list to the elisp:link, because this
;; would be much too long. Instead, this variable shall keep the bug
;; numbers.
-(defvar debbugs-org-ids nil
+(defvar-local debbugs-org-ids nil
"The list of bug ids to be shown following the elisp link.")
+(defvar debbugs-org-show-buffer-name "*Org Bugs*"
+ "The buffer name we present the bug reports.
+This could be a temporary buffer, or a buffer linked with a file.")
+
+(defvar debbugs-org-mode) ;; Silence compiler.
+(defun debbugs-org-show-buffer-name ()
+ "The buffer name we present the bug reports.
+This could be a temporary buffer, or a buffer linked with a file."
+ (if debbugs-org-mode (buffer-name) debbugs-org-show-buffer-name))
+
;;;###autoload
(defun debbugs-org-search ()
"Search for bugs interactively.
(interactive)
(unwind-protect
- (let ((date-format "\\([[:digit:]]\\{4\\}\\)-\\([[:digit:]]\\{1,2\\}\\)-\\([[:digit:]]\\{1,2\\}\\)")
- key val1 val2 phrase severities packages archivedp)
+ ;; Check for the phrase.
+ (let ((phrase (read-string debbugs-gnu-phrase-prompt))
+ key val1 severities packages)
- ;; Check for the phrase.
- (setq phrase (read-string debbugs-gnu-phrase-prompt))
(add-to-list 'debbugs-gnu-current-query (cons 'phrase phrase))
;; The other queries.
(setq debbugs-gnu-current-query nil)))
;;;###autoload
-(defun debbugs-org (severities &optional packages archivedp tags)
+(defun debbugs-org (severities &optional packages archivedp suppress tags)
"List all outstanding bugs."
(interactive
(let (severities archivedp)
debbugs-gnu-default-packages)
(when current-prefix-arg
(setq archivedp (y-or-n-p "Show archived bugs?")))
+ (when (and current-prefix-arg (not archivedp))
+ (y-or-n-p "Suppress unwanted bugs?"))
;; This one must be asked for severity "tagged".
(when (member "tagged" severities)
(split-string (read-string "User tag(s): ") "," t)))))
(add-to-list 'debbugs-gnu-current-query (cons 'package package))))
(when archivedp
(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")))
(dolist (tag (if (consp tags) tags (list tags)))
(when (not (zerop (length tag)))
(add-to-list 'debbugs-gnu-current-query (cons 'tag tag))))
- (with-current-buffer (get-buffer-create "*Org Bugs*")
- (erase-buffer))
+ (unwind-protect
+ (with-current-buffer (get-buffer-create (debbugs-org-show-buffer-name))
+ (erase-buffer)
- (unwind-protect
- (let ((hits debbugs-gnu-default-hits-per-page))
- (setq debbugs-org-ids (debbugs-gnu-get-bugs debbugs-gnu-current-query))
-
- (when (> (length debbugs-org-ids) hits)
- (let ((cursor-in-echo-area nil))
- (setq hits
- (string-to-number
- (read-string
- (format
- "How many reports (available %d, default %d): "
- (length debbugs-org-ids) hits)
- nil
- nil
- (number-to-string hits))))))
-
- (debbugs-org-show-next-reports hits))
-
- ;; Reset query.
- (setq debbugs-gnu-current-query nil)))
+ (let ((hits debbugs-gnu-default-hits-per-page))
+ (setq debbugs-org-ids
+ (debbugs-gnu-get-bugs debbugs-gnu-current-query))
+
+ (when (> (length debbugs-org-ids) hits)
+ (let ((cursor-in-echo-area nil))
+ (setq hits
+ (string-to-number
+ (read-string
+ (format
+ "How many reports (available %d, default %d): "
+ (length debbugs-org-ids) hits)
+ nil
+ nil
+ (number-to-string hits))))))
+
+ (debbugs-org-show-next-reports hits)))
+
+ ;; Reset query.
+ (setq debbugs-gnu-current-query nil)))
(defun debbugs-org-show-reports (bug-numbers)
"Show bug reports as given in BUG-NUMBERS."
- (pop-to-buffer (get-buffer-create "*Org Bugs*"))
- (org-mode)
- (debbugs-org-mode 1)
- ;; FIXME: Does not show any effect.
- (set (make-local-variable 'org-priority-faces) debbugs-org-priority-faces)
+ (pop-to-buffer (get-buffer-create (debbugs-org-show-buffer-name)))
+ ;; Local variable `debbugs-org-ids' must survive.
+ (let ((doi debbugs-org-ids))
+ (org-mode)
+ (debbugs-org-mode 1)
+ (setq debbugs-org-ids doi))
(let ((inhibit-read-only t)
(debbugs-port "gnu.org"))
-
(dolist (status
(sort
(apply 'debbugs-get-status bug-numbers)
;; Handle tags.
(when (string-match "^\\([0-9.]+\\); \\(.+\\)$" subject)
- (add-to-list 'tags (match-string 1 subject))
+ (let ((x (match-string 1 subject))) (pushnew x tags :test #'equal))
(setq subject (match-string 2 subject)))
(when archived
- (add-to-list 'tags "ARCHIVE"))
+ (pushnew "ARCHIVE" tags :test #'equal))
(setq tags
(mapcar
;; Replace all invalid TAG characters by "_".
;; Properties.
(insert " :PROPERTIES:\n")
- (insert (format " :DEBGUGS_ID: %s\n" id))
+ (insert (format " :DEBBUGS_ID: %s\n" id))
(when merged
(insert
(format
(seconds-to-time last-modified))))
;; Add text properties.
- (add-text-properties beg (point) `(tabulated-list-id ,status))))
-
+ (add-text-properties beg (point) `(tabulated-list-id ,status))))))
+
+(defun debbugs-org-regenerate-status ()
+ "Regenerate the `tabulated-list-id' text property.
+This property is used when following the [Messages] link, so you
+need to regenerate it when opening an .org file after you killed
+the corresponding buffer (e.g. by closing Emacs)."
+ (save-excursion
(goto-char (point-min))
- (org-overview)
- (set-buffer-modified-p nil)))
+ (while (re-search-forward ":DEBBUGS_ID:[ \t]*\\([0-9]+\\)" nil t)
+ (let* ((bugnum (string-to-number (match-string 1)))
+ (mw (org-entry-get (point) "MERGEDWIDTH"))
+ (tli (list (cons 'id bugnum)
+ (cons 'bug_num bugnum)
+ (cons 'mergedwidth (if mw (string-to-number mw)))))
+ (beg (org-back-to-heading t))
+ (end (org-end-of-subtree t)))
+ (add-text-properties beg end `(tabulated-list-id ,tli))))))
(defun debbugs-org-show-next-reports (hits)
"Show next HITS of bug reports."
- (with-current-buffer (get-buffer-create "*Org Bugs*")
+ (with-current-buffer (get-buffer-create (debbugs-org-show-buffer-name))
(save-excursion
(goto-char (point-max))
- (forward-line -1)
- (delete-region (point) (point-max))
+ (when (re-search-backward
+ "^* COMMENT \\[\\[elisp:(debbugs-org-show-next-reports" nil t)
+ (forward-line -1)
+ (delete-region (point) (point-max)))
(debbugs-org-show-reports
(butlast debbugs-org-ids (- (length debbugs-org-ids) hits)))
(setq debbugs-org-ids
(last debbugs-org-ids (- (length debbugs-org-ids) hits)))
+ (goto-char (point-max))
(when debbugs-org-ids
- (goto-char (point-max))
(insert
(format
- "* [[elisp:(debbugs-org-show-next-reports %s)][Next bugs]]\n"
- hits))))))
+ "* COMMENT [[elisp:(debbugs-org-show-next-reports %s)][Next bugs]]\n\n"
+ hits)))
+ (insert "* COMMENT Local " "Variables\n")
+ (when debbugs-org-ids
+ (insert "#+NAME: init\n"
+ "#+BEGIN_SRC elisp\n"
+ (format "(setq debbugs-org-ids '%s)\n" debbugs-org-ids)
+ "#+END_SRC\n\n"))
+ (insert "# Local " "Variables:\n"
+ "# mode: org\n"
+ "# eval: (debbugs-org-mode 1)\n")
+ (when debbugs-org-ids
+ (insert (format "# eval: (%s \"init\")\n"
+ (if (macrop 'org-sbe) "org-sbe" "sbe"))))
+ (insert "# End:\n")
+ (goto-char (point-min))
+ (org-overview)
+ (set-buffer-modified-p nil))))
(defconst debbugs-org-mode-map
(let ((map (make-sparse-keymap)))
;; Make byte-compiler quiet.
(defvar gnus-posting-styles)
+;;;###autoload
(define-minor-mode debbugs-org-mode
"Minor mode for providing a debbugs interface in org-mode buffers.
\\{debbugs-org-mode-map}"
:lighter " Debbugs" :keymap debbugs-org-mode-map
+ ;; FIXME: Does not show any effect.
+ (set (make-local-variable 'org-priority-faces) debbugs-org-priority-faces)
(set (make-local-variable 'gnus-posting-styles)
`((".*"
(eval
("[0-9]+@debbugs.*" "quiet@debbugs.gnu.org")))
;; `gnus-posting-styles' is eval'ed after
;; `message-simplify-subject'. So we cannot use m-s-s.
- (setq subject ,debbugs-gnu-subject))))))))
+ (setq subject ,debbugs-gnu-subject)))))))
+ (debbugs-org-regenerate-status))
;;;###autoload
(defun debbugs-org-bugs (&rest bugs)