* debbugs.el (debbugs-get-usertag): Fix comments.

* debbugs-gnu.el: New command `debbugs-gnu-usertags' and helper functions.

2 files changed, 95 insertions, 2 deletions

diff --git a/packages/debbugs/debbugs-gnu.el b/packages/debbugs/debbugs-gnu.el
index 753ac16c54d..6eab007438b 100644
--- a/packages/debbugs/debbugs-gnu.el
+++ b/packages/debbugs/debbugs-gnu.el
@@ -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
 ;;
@@ -108,6 +109,22 @@
 ;; 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)
@@ -1113,6 +1130,82 @@ 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 packages)
+  "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 packages)))))
+
+	;; 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 (package packages)
+	  (dolist (tag (debbugs-get-usertag :package package))
+	    (add-to-list
+	     'tabulated-list-entries
+	     ;; `tabulated-list-id' is the parameter list for `debbugs-gnu'.
+	     `((("tagged") (,package) nil nil (,tag))
+	       ,(vector (propertize package 'mouse-face widget-mouse-face)
+			(propertize tag 'mouse-face widget-mouse-face)))
+	     'append)))
+
+	;; 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:
diff --git a/packages/debbugs/debbugs.el b/packages/debbugs/debbugs.el
index b3f7fe75300..c070bb1ddac 100644
--- a/packages/debbugs/debbugs.el
+++ b/packages/debbugs/debbugs.el
@@ -362,7 +362,7 @@ Example:
       (setq key (substring (symbol-name kw) 1))
       (case kw
 	((:package)
-	 ;; Value shall be one word.
+	 ;; Value shall be one word.  Extract email address, if existing.
 	 (if (string-match "\\`\\S-+\\'" val)
 	     (progn
 	       (when (string-equal "me" val)
@@ -372,7 +372,7 @@ Example:
 	       (add-to-list 'user val))
 	   (error "Wrong %s: %s" key val)))
 	((:tag)
-	 ;; Value shall be one word.  Extract email address, if existing.
+	 ;; Value shall be one word.
 	 (if (string-match "\\`\\S-+\\'" val)
 	     (add-to-list 'tags val)
 	   (error "Wrong %s: %s" key val)))