From mboxrd@z Thu Jan 1 00:00:00 1970 From: Michael Albinus Subject: org-debbugs.el Date: Fri, 27 Sep 2013 21:28:00 +0200 Message-ID: <87mwmydpz3.fsf_-_@gmx.de> References: <86ioxp2vbb.fsf@somewhere.org> <20130925080403.GS12411@kuru.dyndns-at-home.com> <86siwt1d9c.fsf@somewhere.org> <8738otjkdt.fsf@gmx.de> <871u4czq4t.fsf@gmx.de> <20130926002156.GA13887@kuru.dyndns-at-home.com> <86vc1of3cp.fsf@somewhere.org> <87eh8ckjtk.fsf@gmx.de> Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" Return-path: Received: from eggs.gnu.org ([2001:4830:134:3::10]:47906) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1VPdiE-0000gA-IS for emacs-orgmode@gnu.org; Fri, 27 Sep 2013 15:28:33 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1VPdi7-0002aX-Id for emacs-orgmode@gnu.org; Fri, 27 Sep 2013 15:28:26 -0400 Received: from plane.gmane.org ([80.91.229.3]:47280) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1VPdi7-0002aD-83 for emacs-orgmode@gnu.org; Fri, 27 Sep 2013 15:28:19 -0400 Received: from public by plane.gmane.org with local (Exim 4.69) (envelope-from ) id 1VPdi6-0005If-1o for emacs-orgmode@gnu.org; Fri, 27 Sep 2013 21:28:18 +0200 In-Reply-To: <87eh8ckjtk.fsf@gmx.de> (Michael Albinus's message of "Thu, 26 Sep 2013 11:34:31 +0200") List-Id: "General discussions about Org-mode." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: emacs-orgmode-bounces+geo-emacs-orgmode=m.gmane.org@gnu.org Sender: emacs-orgmode-bounces+geo-emacs-orgmode=m.gmane.org@gnu.org To: public-emacs-orgmode-mXXj517/zsQ@plane.gmane.org --=-=-= Content-Type: text/plain Hi, I have produced a very first shot of org-debbugs.el. It shows you bug reports from debbugs.gnu.org as TODO items. It needs the debbugs package from the GNU ELPA repository. If you want to try it, you could call (org-debbugs nil '("org-mode")) You will see a list of TODO items which belong to the org-mode bugs on debbugs.gnu.org. The last link of such an item, [[Messages]], shows you all corresponding messages for that bug. If you want to see a bulk of bug reports, call (org-debbugs '("serious" "important" "normal") '("emacs")) This returns much more bugs (from the "emacs" project), presented as chunk of 500 TODO items. If you follow the link at the very end of the buffer, you will get the next 500 items. And so on. You can call it also interactively, via "M-x org-debbugs" or "C-u M-x org-debbugs". Have fun! Best regards, Michael. --=-=-= Content-Type: application/emacs-lisp Content-Disposition: attachment; filename=org-debbugs.el Content-Transfer-Encoding: quoted-printable ;;; org-debbugs.el --- org-mode interface for the GNU bug tracker ;; Copyright (C) 2013 Free Software Foundation, Inc. ;; Author: Michael Albinus ;; Keywords: comm, hypermedia, maint, outlines ;; This file is not part of GNU Emacs. ;; This program is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation, either version 3 of the License, or ;; (at your option) any later version. ;; This program is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs. If not, see . ;;; Commentary: ;; This package provides an interface to bug reports which are located ;; on the GNU bug tracker debbugs.gnu.org. Its main purpose is to ;; show and manipulate bug reports as org-mode TODO items. ;; If you have `org-debbugs.el' in your load-path, you could enable ;; the bug tracker commands by the following lines in your ~/.emacs ;; ;; (autoload 'org-debbugs "org-debbugs" "" 'interactive) ;; The bug tracker is called interactively by ;; ;; M-x org-debbugs ;; It asks for the severities, for which bugs shall be shown. This can ;; be either just one severity, or a list of severities, separated by ;; comma. Valid severities are "serious", "important", "normal", ;; "minor" or "wishlist". Severities "critical" and "grave" are not ;; used, although configured on the GNU bug tracker. If no severity ;; is given, all bugs are selected. ;; 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), whether archived bugs shall be shown, and whether ;; closed bugs shall be shown. ;; 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. ;; These default values could be changed also by customer options ;; `org-debbugs-default-severities', `org-debbugs-default-packages' ;; and `org-debbugs-default-hits-per-page'. ;; The commands create a TODO list. The last entry in an TODO record ;; is the link [[Messages]]. If you follow this link, a gnus ;; ephemeral group is opened presenting all releated messages for this ;; bug. ;;; Code: (require 'debbugs) (eval-when-compile (require 'cl)) (autoload 'gnus-read-ephemeral-emacs-bug-group "gnus-group") (autoload 'mail-header-subject "nnheader") (autoload 'gnus-summary-article-header "gnus-sum") (autoload 'message-make-from "message") (defcustom org-debbugs-default-severities '("serious" "important" "normal") "*The list severities bugs are searched for. \"tagged\" is not a severity but marks locally tagged bugs." ;; ; :group 'debbugs-gnu :type '(set (const "serious") (const "important") (const "normal") (const "minor") (const "wishlist")) :version "24.4") (defconst org-debbugs-all-severities (mapcar 'cadr (cdr (get 'org-debbugs-default-severities 'custom-type))) "*List of all possible severities.") (defconst org-debbugs-severity-priority '(("serious" . "A") ("important" . "B") ("normal" . "C") ("minor" . "D") ("wishlist" . "E"))) (defun org-debbugs-get-severity-priority (state) (or (cdr (assoc (cdr (assq 'severity state)) org-debbugs-severity-priority)) "E")) (defcustom org-debbugs-default-packages '("org-mode") "*The list of packages to be searched for." ;; ;; :group 'debbugs-gnu :type '(set (const "automake") (const "cc-mode") (const "coreutils") (const "debbugs.gnu.org") (const "emacs") (const "emacs-xwidgets") (const "fm") (const "gnus") (const "guile") (const "libtool") (const "ns") (const "org-mode") (const "w32") (const "woodchuck")) :version "24.4") (defconst org-debbugs-all-packages (mapcar 'cadr (cdr (get 'org-debbugs-default-packages 'custom-type))) "*List of all possible package names.") (defcustom org-debbugs-default-hits-per-page 500 "*The number of bugs shown per page." :group 'debbugs-gnu :type 'integer :version "24.1") (defvar org-debbugs-current-query nil "The query object of the current search. It will be applied server-side, when calling `debbugs-get-bugs'. It has the same format as `debbugs-gnu-default-suppress-bugs'.") (defvar org-debbugs-ids nil "The list of bug ids to be shown following the link.") ;;;###autoload (defun org-debbugs (severities &optional packages archivedp suppress tags) "List all outstanding Emacs bugs." (interactive (let (severities archivedp) (list (setq severities (completing-read-multiple "Severities: " org-debbugs-all-severities nil t (mapconcat 'identity org-debbugs-default-severities ","))) ;; The next parameters are asked only when there is a prefix. (if current-prefix-arg (completing-read-multiple "Packages: " org-debbugs-all-packages nil t (mapconcat 'identity org-debbugs-default-packages ",")) org-debbugs-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 queries. (dolist (severity (if (consp severities) severities (list severities))) (when (not (zerop (length severity))) (add-to-list 'org-debbugs-current-query (cons 'severity severity)))) (dolist (package (if (consp packages) packages (list packages))) (when (not (zerop (length package))) (add-to-list 'org-debbugs-current-query (cons 'package package)))) (when archivedp (add-to-list 'org-debbugs-current-query '(archive . "1"))) (dolist (tag (if (consp tags) tags (list tags))) (when (not (zerop (length tag))) (add-to-list 'org-debbugs-current-query (cons 'tag tag)))) (with-current-buffer (get-buffer-create "*Org Bugs*") (erase-buffer)) (unwind-protect (let ((hits org-debbugs-default-hits-per-page)) (setq org-debbugs-ids (org-debbugs-get-bugs org-debbugs-current-query)) (when (> (length org-debbugs-ids) hits) (let ((cursor-in-echo-area nil)) (setq hits (string-to-number (read-string (format "How many reports (available %d, default %d): " (length org-debbugs-ids) hits) nil nil (number-to-string hits)))))) (org-debbugs-show-next-reports hits)) ;; Reset query and filter. (setq org-debbugs-current-query nil org-debbugs-current-filter nil))) (defun org-debbugs-get-bugs (query) "Retrieve bugs numbers from debbugs.gnu.org according search criteria." (let* ((debbugs-port "gnu.org") (bugs (assoc 'bugs query)) (tags (assoc 'tag query)) (local-tags (and (member '(severity . "tagged") query) (not tags))) (phrase (assoc 'phrase query)) args) ;; Compile query arguments. (unless (or query tags) (dolist (elt debbugs-gnu-default-packages) (setq args (append args (list :package elt))))) (dolist (elt query) (unless (equal elt '(severity . "tagged")) (setq args (append args (if phrase (cond ((eq (car elt) 'phrase) (list (list :phrase (cdr elt) :max 500))) ((eq (car elt) 'date) (list (list :date (cddr elt) (cadr elt) :operator "NUMBT"))) (t (list (list (intern (concat ":" (symbol-name (car elt)))) (cdr elt) :operator "ISTRINC")))) (list (intern (concat ":" (symbol-name (car elt)))) (cdr elt))))))) (sort (cond ;; If the query is just a list of bug numbers, we return them. (bugs (cdr bugs)) ;; A full text query. (phrase (mapcar (lambda (x) (cdr (assoc "id" x))) (apply 'debbugs-search-est args))) ;; User tags. (tags (setq args (mapcar (lambda (x) (if (eq x :package) :user x)) args)) (apply 'debbugs-get-usertag args)) ;; Otherwise, we retrieve the bugs from the server. (t (apply 'debbugs-get-bugs args))) ;; Sort function. '<))) (defun org-debbugs-show-reports (bug-numbers) "Show bug reports as given in BUG-NUMBERS." (pop-to-buffer (get-buffer-create "*Org Bugs*")) (org-mode) (let ((inhibit-read-only t) (debbugs-port "gnu.org")) (delete-region (point-min) (point-max)) (dolist (status (sort (apply 'debbugs-get-status bug-numbers) (lambda (x y) (< (cdr (assq 'id x)) (cdr (assq 'id y)))))) (let* ((id (cdr (assq 'id status))) (priority (org-debbugs-get-severity-priority status)) (date (cdr (assq 'date status))) (last-modified (cdr (assq 'last_modified status))) (originator (cdr (assq 'originator status))) (subject (decode-coding-string (cdr (assq 'subject status)) 'utf-8))) ;; Headline. (insert (format "* TODO [#%s] %s\n" priority subject)) ;; Date. (when date (insert (format-time-string " [%Y-%m-%d %a]\n" (seconds-to-time date)))) ;; Properties. (insert " :PROPERTIES:\n") (insert (format " :DEBGUGS_ID: %s\n" id)) (insert (format " :CREATOR: %s\n" originator)) (insert " :END:\n") ;; Messages. (insert (format " [[elisp:(gnus-read-ephemeral-emacs-bug-group %s)][Messages]]\n" id)) ;; Last modified. (when last-modified (insert (format-time-string " [%Y-%m-%d %a]\n" (seconds-to-time last-modified)))))) (goto-char (point-min)) (org-overview) (set-buffer-modified-p nil))) (defun org-debbugs-show-next-reports (hits) "Show next HITS of bug reports." (with-current-buffer (get-buffer-create "*Org Bugs*") (goto-char (point-max)) (forward-line -1) (narrow-to-region (point) (point-max)) (org-debbugs-show-reports (butlast org-debbugs-ids (- (length org-debbugs-ids) hits))) (setq org-debbugs-ids (last org-debbugs-ids (- (length org-debbugs-ids) hits))) (when org-debbugs-ids (save-excursion (goto-char (point-max)) (insert (format "* [[elisp:(org-debbugs-show-next-reports %s)][Next bugs]]\n" hits)))) (widen))) ;; TODO ;; - Refactor it in order to avoid code duplication with debbugs-gnu.el. (provide 'org-debbugs) --=-=-=--