X-Git-Url: https://code.delx.au/gnu-emacs-elpa/blobdiff_plain/de381673a28c541fcaf1f70f5554b67786396eb9..ab3b9137facc977cf39bb407cb1d7763b2e9a449:/packages/debbugs/debbugs-gnu.el diff --git a/packages/debbugs/debbugs-gnu.el b/packages/debbugs/debbugs-gnu.el index 4d9d6adf5..4d7ab2404 100644 --- a/packages/debbugs/debbugs-gnu.el +++ b/packages/debbugs/debbugs-gnu.el @@ -1,20 +1,21 @@ ;;; debbugs-gnu.el --- interface for the GNU bug tracker -;; Copyright (C) 2011, 2012 Free Software Foundation, Inc. +;; Copyright (C) 2011-2014 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen +;; Michael Albinus ;; Keywords: comm, hypermedia, maint ;; Package: debbugs -;; Version: 0.4 +;; Version: 0.6 ;; This file is not part of GNU Emacs. -;; debbugs-gnu is free software: you can redistribute it and/or modify +;; 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. -;; debbugs-gnu is distributed in the hope that it will be useful, +;; 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. @@ -35,6 +36,7 @@ ;; (autoload 'debbugs-gnu "debbugs-gnu" "" 'interactive) ;; (autoload 'debbugs-gnu-search "debbugs-gnu" "" 'interactive) ;; (autoload 'debbugs-gnu-usertags "debbugs-gnu" "" 'interactive) +;; (autoload 'debbugs-gnu-bugs "debbugs-gnu" "" 'interactive) ;; The bug tracker is called interactively by ;; @@ -51,8 +53,8 @@ ;; function will ask for user tags (a comma separated list), and shows ;; just the bugs which are tagged with them. In general, user tags ;; shall be strings denoting to subprojects of the package, like -;; "cedet" or "tramp" of the package "emacs. If no user tag is given, -;; locally tagged bugs are shown. +;; "cedet" or "tramp" of the package "emacs". If no user tag is +;; 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, "emacs" is @@ -125,14 +127,21 @@ ;; all users who have tagged bugs. This list can be retrieved via ;; . +;; Finally, if you simply want to list some bugs with known bug +;; numbers, call the command +;; +;; M-x debbugs-gnu-bugs + +;; The bug numbers to be shown shall be entered as comma separated list. + ;;; Code: (require 'debbugs) (require 'widget) +(require 'wid-edit) (require 'tabulated-list) (eval-when-compile (require 'cl)) -(autoload 'widget-convert "wid-edit.el") (autoload 'gnus-read-ephemeral-emacs-bug-group "gnus-group") (autoload 'mail-header-subject "nnheader") (autoload 'gnus-summary-article-header "gnus-sum") @@ -163,18 +172,31 @@ (defcustom debbugs-gnu-default-packages '("emacs") "*The list of packages to be searched for." ;; + ;; :group 'debbugs-gnu - :type '(set (const "automake") + :type '(set (const "auctex") + (const "automake") + (const "cc-mode") (const "coreutils") + (const "cppi") (const "debbugs.gnu.org") + (const "diffutils") (const "emacs") (const "emacs-xwidgets") (const "fm") (const "gnus") + (const "grep") (const "guile") + (const "guix") + (const "gzip") + (const "idutils") (const "libtool") + (const "mh-e") + (const "org-mode") + (const "parted") + (const "vc-dwim") (const "woodchuck")) - :version "24.1") + :version "24.4") (defconst debbugs-gnu-all-packages (mapcar 'cadr (cdr (get 'debbugs-gnu-default-packages 'custom-type))) @@ -340,8 +362,8 @@ marked as \"client-side filter\"." val1 (completing-read "Enter status: " '("done" "forwarded" "open"))) (when (not (zerop (length val1))) - (add-to-list - 'debbugs-gnu-current-query (cons (intern key) val1)))) + (add-to-list + 'debbugs-gnu-current-query (cons (intern key) val1)))) ;; Client-side filters. ((member key '("date" "log_modified" "last_modified" @@ -406,7 +428,7 @@ marked as \"client-side filter\"." ;;;###autoload (defun debbugs-gnu (severities &optional packages archivedp suppress tags) - "List all outstanding Emacs bugs." + "List all outstanding bugs." (interactive (let (severities archivedp) (list @@ -445,6 +467,9 @@ marked as \"client-side filter\"." (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)))) @@ -507,6 +532,7 @@ marked as \"client-side filter\"." (defun debbugs-gnu-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)) @@ -535,6 +561,8 @@ marked as \"client-side filter\"." (sort (cond + ;; If the query is just a list of bug numbers, we return them. + (bugs (cdr bugs)) ;; If the query contains the pseudo-severity "tagged", we return ;; just the local tagged bugs. (local-tags (copy-sequence debbugs-gnu-local-tags)) @@ -555,8 +583,6 @@ marked as \"client-side filter\"." (defvar debbugs-gnu-current-widget nil) (defvar debbugs-gnu-current-limit nil) -(defvar widget-mouse-face) - (defun debbugs-gnu-show-reports (widget) "Show bug reports as given in WIDGET property :bug-ids." ;; The tabulated mode sets several local variables. We must get rid @@ -1153,16 +1179,15 @@ The following commands are available: (setq buffer-read-only t)) ;;;###autoload -(defun debbugs-gnu-usertags (&optional users) - "List all outstanding Emacs bugs." +(defun debbugs-gnu-usertags (&rest users) + "List all user tags for USERS, which is \(\"emacs\"\) by default." (interactive - (list - (if current-prefix-arg - (completing-read-multiple - "Package name(s) or email address: " - (append debbugs-gnu-all-packages (list user-mail-address)) nil nil - (mapconcat 'identity debbugs-gnu-default-packages ",")) - debbugs-gnu-default-packages))) + (if current-prefix-arg + (completing-read-multiple + "Package name(s) or email address: " + (append debbugs-gnu-all-packages (list user-mail-address)) nil nil + (mapconcat 'identity debbugs-gnu-default-packages ",")) + debbugs-gnu-default-packages)) (unwind-protect (let ((inhibit-read-only t) @@ -1222,6 +1247,17 @@ The following commands are available: (let ((args (get-text-property (line-beginning-position) 'tabulated-list-id))) (when args (apply 'debbugs-gnu args)))) +;;;###autoload +(defun debbugs-gnu-bugs (&rest bugs) + "List all BUGS, a list of bug numbers." + (interactive + (mapcar 'string-to-number + (completing-read-multiple "Bug numbers: " nil 'natnump))) + (dolist (elt bugs) + (unless (natnump elt) (signal 'wrong-type-argument (list 'natnump elt)))) + (add-to-list 'debbugs-gnu-current-query (cons 'bugs bugs)) + (debbugs-gnu nil)) + (provide 'debbugs-gnu) ;;; TODO: