X-Git-Url: https://code.delx.au/gnu-emacs-elpa/blobdiff_plain/721c270052e4e4fc671472ac871d6fe61be3681b..aea4c6ae3a0b470ca16b2b209f8ee344c7b21a94:/packages/debbugs/debbugs-org.el diff --git a/packages/debbugs/debbugs-org.el b/packages/debbugs/debbugs-org.el index f56c539c1..71adf1de0 100644 --- a/packages/debbugs/debbugs-org.el +++ b/packages/debbugs/debbugs-org.el @@ -1,11 +1,10 @@ -;;; debbugs-org.el --- Org-mode interface for the GNU bug tracker +;;; debbugs-org.el --- Org-mode interface for the GNU bug tracker -*- lexical-binding:t -*- -;; Copyright (C) 2013-2015 Free Software Foundation, Inc. +;; Copyright (C) 2013-2016 Free Software Foundation, Inc. ;; Author: Michael Albinus ;; Keywords: comm, hypermedia, maint, outlines ;; Package: debbugs -;; Version: 0.8 ;; This file is not part of GNU Emacs. @@ -56,7 +55,7 @@ ;; If a prefix is given to the command, more search parameters are ;; 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. +;; closed bugs shall be suppressed from being retrieved. ;; Another command is ;; @@ -71,12 +70,11 @@ ;; The bug reports are downloaded from the bug tracker. In order to ;; not generate too much load of the server, up to 500 bugs will be -;; downloaded at once. If there are more hits, you will be asked to -;; change this limit, but please don't increase this number too much. +;; downloaded at once. If there are more hits, several downloads will +;; be performed, until all bugs are retrieved. ;; These default values could be changed also by customer options -;; `debbugs-gnu-default-severities', `debbugs-gnu-default-packages' -;; and `debbugs-gnu-default-hits-per-page'. +;; `debbugs-gnu-default-severities' and `debbugs-gnu-default-packages'. ;; The commands create a TODO list. Besides the usual handling of ;; TODO items, you could apply the following actions by the following @@ -87,9 +85,9 @@ ;; "C-c # d": Show bug attributes ;; The last entry in a TODO record is the link [[Messages]]. If you -;; follow this link, a Gnus ephemeral group is opened presenting all -;; related messages for this bug. Here you could also send debbugs -;; control messages by keystroke "C". +;; follow this link, a Gnus ephemeral group or an Rmail buffer is +;; opened presenting all related messages for this bug. Here you +;; could also send debbugs control messages by keystroke "C". ;; Finally, if you simply want to list some bugs with known bug ;; numbers, call the command @@ -102,12 +100,16 @@ (require 'debbugs-gnu) (require 'org) -(eval-when-compile (require 'cl)) +(eval-when-compile (require 'cl-lib)) + +;; Buffer-local variables. +(defvar debbugs-gnu-local-query) +(defvar debbugs-gnu-local-filter) (defconst debbugs-org-severity-priority (let ((priority ?A)) (mapcar - (lambda (x) (prog1 (cons x (char-to-string priority)) (incf priority))) + (lambda (x) (prog1 (cons x (char-to-string priority)) (cl-incf priority))) debbugs-gnu-all-severities)) "Mapping of debbugs severities to TODO priorities.") @@ -122,22 +124,10 @@ ("B" . org-warning)) "Highlighting of prioritized TODO items.") -;; 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-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*" +(defvar debbugs-org-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. @@ -203,10 +193,13 @@ returned." (t (throw :finished nil))))) ;; Do the search. - (debbugs-org severities packages)) + (debbugs-org severities packages)))) - ;; Reset query and filter. - (setq debbugs-gnu-current-query nil))) +;;;###autoload +(defun debbugs-org-patches () + "List the bug reports that have been marked as containing a patch." + (interactive) + (debbugs-org nil debbugs-gnu-default-packages nil nil "patch")) ;;;###autoload (defun debbugs-org (severities &optional packages archivedp suppress tags) @@ -255,46 +248,28 @@ returned." (when (not (zerop (length tag))) (add-to-list 'debbugs-gnu-current-query (cons 'tag tag)))) - (unwind-protect - (with-current-buffer (get-buffer-create (debbugs-org-show-buffer-name)) - (erase-buffer) - - (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 (debbugs-org-show-buffer-name))) - ;; Local variable `debbugs-org-ids' must survive. - (let ((doi debbugs-org-ids)) + ;; Show result. + (debbugs-org-show-reports) + + ;; Reset query. + (setq debbugs-gnu-current-query nil)) + +(defun debbugs-org-show-reports () + "Show bug reports as retrieved via `debbugs-gnu-current-query'." + (let ((inhibit-read-only t) + (org-startup-folded t)) + (when (get-buffer debbugs-org-buffer-name) + (kill-buffer debbugs-org-buffer-name)) + (switch-to-buffer (get-buffer-create debbugs-org-buffer-name)) (org-mode) (debbugs-org-mode 1) - (setq debbugs-org-ids doi)) - (let ((inhibit-read-only t) - (debbugs-port "gnu.org")) (dolist (status + ;; `debbugs-get-status' returns in random order, so we must sort. (sort - (apply 'debbugs-get-status bug-numbers) - (lambda (x y) (< (cdr (assq 'id x)) (cdr (assq 'id y)))))) + (apply 'debbugs-get-status + (debbugs-gnu-get-bugs debbugs-gnu-local-query)) + (lambda (a b) (> (cdr (assq 'id a)) (cdr (assq 'id b)))))) (let* ((beg (point)) (id (cdr (assq 'id status))) (done (string-equal (cdr (assq 'pending status)) "done")) @@ -319,10 +294,10 @@ returned." ;; Handle tags. (when (string-match "^\\([0-9.]+\\); \\(.+\\)$" subject) - (let ((x (match-string 1 subject))) (pushnew x tags :test #'equal)) + (let ((x (match-string 1 subject))) (cl-pushnew x tags :test #'equal)) (setq subject (match-string 2 subject))) (when archived - (pushnew "ARCHIVE" tags :test #'equal)) + (cl-pushnew "ARCHIVE" tags :test #'equal)) (setq tags (mapcar ;; Replace all invalid TAG characters by "_". @@ -369,7 +344,17 @@ returned." (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)))) + + ;; The end. + (insert "* COMMENT Local " "Variables\n" + "# Local " "Variables:\n" + "# mode: org\n" + "# eval: (debbugs-org-mode 1)\n" + "# End:\n") + (goto-char (point-min)) + (org-overview) + (set-buffer-modified-p nil))) (defun debbugs-org-regenerate-status () "Regenerate the `tabulated-list-id' text property. @@ -388,42 +373,6 @@ the corresponding buffer (e.g. by closing Emacs)." (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 (debbugs-org-show-buffer-name)) - (save-excursion - (goto-char (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 - (insert - (format - "* 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))) (define-key map (kbd "C-c # t") 'debbugs-gnu-toggle-tag) @@ -441,6 +390,9 @@ the corresponding buffer (e.g. by closing Emacs)." \\{debbugs-org-mode-map}" :lighter " Debbugs" :keymap debbugs-org-mode-map + (set (make-local-variable 'debbugs-gnu-local-query) debbugs-gnu-current-query) + (set (make-local-variable 'debbugs-gnu-local-filter) + debbugs-gnu-current-filter) ;; FIXME: Does not show any effect. (set (make-local-variable 'org-priority-faces) debbugs-org-priority-faces) (set (make-local-variable 'gnus-posting-styles)