]> code.delx.au - gnu-emacs-elpa/blobdiff - packages/debbugs/debbugs-gnu.el
Fix the copyright section to point out that it's not part of Emacs.
[gnu-emacs-elpa] / packages / debbugs / debbugs-gnu.el
index 753ac16c54d630e92040481bfc9cb5487a076a9f..3e394045c64a3871f6732839b511a2e8a3e2ec93 100644 (file)
@@ -5,16 +5,16 @@
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;; Keywords: comm, hypermedia, maint
 ;; Package: debbugs
-;; Version: 0.3
+;; Version: 0.4
 
-;; 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
+;; debbugs-gnu 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,
+;; debbugs-gnu 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 +34,7 @@
 ;;
 ;;   (autoload 'debbugs-gnu "debbugs-gnu" "" 'interactive)
 ;;   (autoload 'debbugs-gnu-search "debbugs-gnu" "" 'interactive)
+;;   (autoload 'debbugs-gnu-usertags "debbugs-gnu" "" 'interactive)
 
 ;; The bug tracker is called interactively by
 ;;
 ;; 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
+;; <http://debbugs.gnu.org/cgi/pkgindex.cgi?indexon=users>.
+
 ;;; Code:
 
 (require 'debbugs)
@@ -528,7 +545,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.
@@ -1113,6 +1132,97 @@ 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.
+\\<debbugs-gnu-usertags-mode-map>
+
+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 (&optional users)
+  "List all outstanding Emacs bugs."
+  (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)))
+
+  (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))))
+
 (provide 'debbugs-gnu)
 
 ;;; TODO: