X-Git-Url: https://code.delx.au/gnu-emacs-elpa/blobdiff_plain/ff63d0b9fbe70ad4d3d7db90df06711852f225d9..6e73bbb5f19c513fd4301b7f11016d86bcad2056:/packages/debbugs/debbugs-gnu.el diff --git a/packages/debbugs/debbugs-gnu.el b/packages/debbugs/debbugs-gnu.el index 753ac16c5..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.3 +;; Version: 0.6 -;; This file is part of GNU Emacs. +;; This file is not part of GNU Emacs. -;; GNU Emacs 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. -;; GNU Emacs 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. @@ -34,6 +35,8 @@ ;; ;; (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 ;; @@ -50,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 @@ -108,14 +111,37 @@ ;; happens as expected for the respective column; sorting in the Title ;; column is depending on whether you are the owner of a bug. +;; Another approach for listing bugs is calling the command +;; +;; M-x debbugs-gnu-usertags + +;; This command shows you all existing user tags for the packages +;; defined in `debbugs-gnu-default-packages'. A prefix for the +;; command allows you to use other packe names, or an arbitrary string +;; for a user who has tagged bugs. The command returns the list of +;; existing user tags for the given user(s) or package name(s), +;; respectively. Applying RET on a user tag, all bugs tagged with +;; this user tag are shown. + +;; Unfortunately, it is not possible with the SOAP interface to show +;; 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") @@ -146,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))) @@ -203,7 +242,6 @@ suppressed bugs is toggled by `debbugs-gnu-toggle-suppress'." (defvar debbugs-gnu-widget-map (let ((map (make-sparse-keymap))) (define-key map "\r" 'widget-button-press) - (define-key map [mouse-1] 'widget-button-press) (define-key map [mouse-2] 'widget-button-press) map)) @@ -324,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" @@ -390,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 @@ -429,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)))) @@ -491,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)) @@ -519,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)) @@ -528,7 +572,9 @@ marked as \"client-side filter\"." (lambda (x) (cdr (assoc "id" x))) (apply 'debbugs-search-est args))) ;; User tags. - (tags (apply 'debbugs-get-usertag args)) + (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. @@ -537,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 @@ -1113,6 +1157,107 @@ removed instead." message)))) (funcall send-mail-function)))) +(defvar debbugs-gnu-usertags-mode-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map tabulated-list-mode-map) + (define-key map "\r" 'debbugs-gnu-select-usertag) + (define-key map [mouse-1] 'debbugs-gnu-select-usertag) + (define-key map [mouse-2] 'debbugs-gnu-select-usertag) + map)) + +(define-derived-mode debbugs-gnu-usertags-mode tabulated-list-mode "Usertags" + "Major mode for listing user tags. + +All normal editing commands are switched off. +\\ + +The following commands are available: + +\\{debbugs-gnu-usertags-mode-map}" + (buffer-disable-undo) + (setq truncate-lines t) + (setq buffer-read-only t)) + +;;;###autoload +(defun debbugs-gnu-usertags (&rest users) + "List all user tags for USERS, which is \(\"emacs\"\) by default." + (interactive + (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) + (debbugs-port "gnu.org") + (buffer-name "*Emacs User Tags*") + (user-tab-length + (1+ (apply 'max (length "User") (mapcar 'length users))))) + + ;; Initialize variables. + (when (and (file-exists-p debbugs-gnu-persistency-file) + (not debbugs-gnu-local-tags)) + (with-temp-buffer + (insert-file-contents debbugs-gnu-persistency-file) + (eval (read (current-buffer))))) + + ;; Create buffer. + (when (get-buffer buffer-name) + (kill-buffer buffer-name)) + (pop-to-buffer (get-buffer-create buffer-name)) + (debbugs-gnu-usertags-mode) + (setq tabulated-list-format `[("User" ,user-tab-length t) + ("Tag" 10 t)]) + (setq tabulated-list-sort-key (cons "User" nil)) + ;(setq tabulated-list-printer 'debbugs-gnu-print-entry) + (erase-buffer) + + ;; Retrieve user tags. + (dolist (user users) + (dolist (tag (sort (debbugs-get-usertag :user user) 'string<)) + (add-to-list + 'tabulated-list-entries + ;; `tabulated-list-id' is the parameter list for `debbugs-gnu'. + `((("tagged") (,user) nil nil (,tag)) + ,(vector (propertize user 'mouse-face widget-mouse-face) + (propertize tag 'mouse-face widget-mouse-face))) + 'append))) + + ;; Add local tags. + (when debbugs-gnu-local-tags + (add-to-list + 'tabulated-list-entries + `((("tagged")) + ,(vector "" (propertize "(local tags)" + 'mouse-face widget-mouse-face))))) + + ;; Show them. + (tabulated-list-init-header) + (tabulated-list-print) + + (set-buffer-modified-p nil) + (goto-char (point-min))))) + +(defun debbugs-gnu-select-usertag () + "Select the user tag on the current line." + (interactive) + ;; We open the bug reports. + (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: