[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[ELPA-diffs] /srv/bzr/emacs/elpa r276: * debbugs.el (debbugs-get-usertag
From: |
Michael Albinus |
Subject: |
[ELPA-diffs] /srv/bzr/emacs/elpa r276: * debbugs.el (debbugs-get-usertag): Change parameters to a KEY-VALUE sequence. |
Date: |
Thu, 18 Oct 2012 15:27:09 +0200 |
User-agent: |
Bazaar (2.5.0) |
------------------------------------------------------------
revno: 276
committer: Michael Albinus <address@hidden
branch nick: elpa
timestamp: Thu 2012-10-18 15:27:09 +0200
message:
* debbugs.el (debbugs-get-usertag): Change parameters to a KEY-VALUE sequence.
* debbugs-gnu.el (debbugs-gnu): Rename USERTAGS to TAGS.
(debbugs-gnu-get-bugs): Adapt to new interface of `debbugs-get-usertag'.
(debbugs-gnu-display-status): Use `special-mode'.
(debbugs-gnu-send-control-message): Implement "usertag" message.
* README: "get_usertag" is implemented now.
modified:
packages/debbugs/README
packages/debbugs/debbugs-gnu.el
packages/debbugs/debbugs.el
=== modified file 'packages/debbugs/README'
--- a/packages/debbugs/README 2012-03-22 20:18:09 +0000
+++ b/packages/debbugs/README 2012-10-18 13:27:09 +0000
@@ -6,8 +6,8 @@
This package works by implementing basic functions to access a debbugs
SOAP server (see <http://wiki.debian.org/DebbugsSoapInterface>). It
implements the SOAP functions "get_bugs", "newest_bugs", "get_status",
-"get_bug_log" and "search_est". The SOAP functions "get_usertag" and
-"get_versions" are not implemented (yet).
+"get_bug_log" and "search_est". The SOAP function "get_versions" is
+not implemented (yet).
You can connect to other debbugs servers by customizing the variable
`debbugs-port'.
=== modified file 'packages/debbugs/debbugs-gnu.el'
--- a/packages/debbugs/debbugs-gnu.el 2012-10-17 12:45:06 +0000
+++ b/packages/debbugs/debbugs-gnu.el 2012-10-18 13:27:09 +0000
@@ -389,7 +389,7 @@
debbugs-gnu-current-filter nil)))
;;;###autoload
-(defun debbugs-gnu (severities &optional packages archivedp suppress usertags)
+(defun debbugs-gnu (severities &optional packages archivedp suppress tags)
"List all outstanding Emacs bugs."
(interactive
(let (severities archivedp)
@@ -429,9 +429,9 @@
(add-to-list 'debbugs-gnu-current-query (cons 'package package))))
(when archivedp
(add-to-list 'debbugs-gnu-current-query '(archive . "1")))
- (dolist (usertag (if (consp usertags) usertags (list usertags)))
- (when (not (zerop (length usertag)))
- (add-to-list 'debbugs-gnu-current-query (cons 'usertag usertag))))
+ (dolist (tag (if (consp tags) tags (list tags)))
+ (when (not (zerop (length tag)))
+ (add-to-list 'debbugs-gnu-current-query (cons 'tag tag))))
(unwind-protect
(let ((hits debbugs-gnu-default-hits-per-page)
@@ -490,16 +490,13 @@
(defun debbugs-gnu-get-bugs (query)
"Retrieve bugs numbers from debbugs.gnu.org according search criteria."
- (let ((debbugs-port "gnu.org")
- (tagged (when (member '(severity . "tagged") query)
- (copy-sequence debbugs-gnu-local-tags)))
- (phrase (assoc 'phrase query))
- usertags args)
- ;; Compile query and usertags arguments.
- (dolist (elt query)
- (when (equal (car elt) 'usertag)
- (add-to-list 'usertags (cdr elt))))
- (unless (or query usertags)
+ (let* ((debbugs-port "gnu.org")
+ (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)
@@ -522,24 +519,18 @@
(sort
(cond
- ;; If the query contains only the pseudo-severity "tagged", we
- ;; return just the local tagged bugs.
- ((and tagged (not usertags) (not (memq :severity args))) tagged)
+ ;; If the query contains the pseudo-severity "tagged", we return
+ ;; just the local tagged bugs.
+ (local-tags (copy-sequence debbugs-gnu-local-tags))
;; A full text query.
(phrase
- (append
- (mapcar
- (lambda (x) (cdr (assoc "id" x)))
- (apply 'debbugs-search-est args))
- tagged))
+ (mapcar
+ (lambda (x) (cdr (assoc "id" x)))
+ (apply 'debbugs-search-est args)))
;; User tags.
- (usertags
- (let (result)
- (dolist (elt packages result)
- (setq result
- (append result (apply 'debbugs-get-usertag elt usertags))))))
+ (tags (apply 'debbugs-get-usertag args))
;; Otherwise, we retrieve the bugs from the server.
- (t (append (apply 'debbugs-get-bugs args) tagged)))
+ (t (apply 'debbugs-get-bugs args)))
;; Sort function.
'<)))
@@ -964,10 +955,12 @@
(interactive (list (debbugs-gnu-current-query)
(debbugs-gnu-current-status)))
(pop-to-buffer "*Bug Status*")
- (erase-buffer)
- (when query (pp query (current-buffer)))
- (when status (pp status (current-buffer)))
- (goto-char (point-min))
+ (let ((inhibit-read-only t))
+ (erase-buffer)
+ (when query (pp query (current-buffer)))
+ (when status (pp status (current-buffer)))
+ (goto-char (point-min)))
+ (set-buffer-modified-p nil)
(special-mode))
(defun debbugs-gnu-select-report ()
@@ -1053,7 +1046,8 @@
"invalid"
"reassign"
"patch" "wontfix" "moreinfo" "unreproducible" "fixed" "notabug"
- "pending" "help" "security" "confirmed")
+ "pending" "help" "security" "confirmed"
+ "usertag")
nil t)
current-prefix-arg))
(let* ((id (or debbugs-gnu-bug-number ; Set on group entry.
@@ -1105,6 +1099,14 @@
((equal message "invalid")
(format "tags %d notabug\ntags %d wontfix\nclose %d\n"
id id id))
+ ((equal message "usertag")
+ (format "user %s\nusertag %d %s\n"
+ (completing-read
+ "Package name or email address: "
+ (append
+ debbugs-gnu-all-packages (list user-mail-address))
+ nil nil (car debbugs-gnu-default-packages))
+ id (read-string "User tag: ")))
(t
(format "tags %d%s %s\n"
id (if reverse " -" "")
=== modified file 'packages/debbugs/debbugs.el'
--- a/packages/debbugs/debbugs.el 2012-10-17 12:32:38 +0000
+++ b/packages/debbugs/debbugs.el 2012-10-18 13:27:09 +0000
@@ -320,45 +320,81 @@
(cdr (assoc 'value x))))
object))))
-(defun debbugs-get-usertag (user &rest tags)
- "Return a list of bug numbers which are tagged by USER.
-
-USER, a string, is either the email address of the user who has
-applied a user tag, or a pseudo-user like \"emacs\". Usually,
-pseudo-users are package names.
-
-TAGS is a list of strings applied as user tags. The returning
-bug numbers list is filtered for these tags.
-
-If TAGS is nil, no bug numbers will be returned but a list of
-existing tags for USER.
+(defun debbugs-get-usertag (&rest query)
+ "Return a list of bug numbers which match QUERY.
+
+QUERY is a sequence of keyword-value pairs where the values are
+strings, i.e. :KEYWORD \"VALUE\" [:KEYWORD \"VALUE\"]*
+
+Valid keywords are:
+
+ :package -- The value is the name of the package a bug belongs
+ to, like \"emacs\", \"coreutils\", \"gnus\", or \"tramp\". It
+ can also be an email address of a user who has applied a user
+ tag. The special email address \"me\" is used as pattern,
+ replaced with `user-mail-address'. There must be at least one
+ such entry; it is recommended to have exactly one.
+
+ :tag -- A string applied as user tag. Often, it is a
+ subproduct identification, like \"cedet\" or \"tramp\" for the
+ package \"emacs\".
+
+If there is no :tag entry, no bug numbers will be returned but a list of
+existing user tags for :package.
Example:
- \(debbugs-get-usertag \"emacs\")
+ \(debbugs-get-usertag :package \"emacs\")
=> (\"www\" \"solaris\" \"ls-lisp\" \"cygwin\")
- \(debbugs-get-usertag \"emacs\" \"www\" \"cygwin\")
+ \(debbugs-get-usertag :package \"emacs\" :tag \"www\" :tag \"cygwin\")
=> (807 1223 5637)"
- (when (stringp user)
- (let ((object
- (car (soap-invoke debbugs-wsdl debbugs-port "get_usertag" user)))
- result)
- (if (null tags)
- ;; Return the list of existing tags.
- (mapcar
- (lambda (x) (symbol-name (car x)))
- object)
-
- ;; Return bug numbers.
- (mapcar
- (lambda (x)
- (when (member (symbol-name (car x)) tags)
- (setq result (append (cdr x) result))))
- object)
- (sort result '<)))))
+
+ (let (user tags kw key val object result)
+ ;; Check query.
+ (while (and (consp query) (<= 2 (length query)))
+ (setq kw (pop query)
+ val (pop query))
+ (unless (and (keywordp kw) (stringp val))
+ (error "Wrong query: %s %s" kw val))
+ (setq key (substring (symbol-name kw) 1))
+ (case kw
+ ((:package)
+ ;; Value shall be one word.
+ (if (string-match "\\`\\S-+\\'" val)
+ (progn
+ (when (string-equal "me" val)
+ (setq val user-mail-address))
+ (when (string-match "<\\(.+\\)>" val)
+ (setq val (match-string 1 val)))
+ (add-to-list 'user val))
+ (error "Wrong %s: %s" key val)))
+ ((:tag)
+ ;; Value shall be one word. Extract email address, if existing.
+ (if (string-match "\\`\\S-+\\'" val)
+ (add-to-list 'tags val)
+ (error "Wrong %s: %s" key val)))
+ (t (error "Unknown key: %s" kw))))
+
+ (unless (null query)
+ (error "Unknown key: %s" (car query)))
+ (unless (= (length user) 1)
+ (error "There must be exactly one :package entry"))
+
+ (setq
+ object
+ (car (soap-invoke debbugs-wsdl debbugs-port "get_usertag" (car user))))
+
+ (if (null tags)
+ ;; Return the list of existing tags.
+ (mapcar (lambda (x) (symbol-name (car x))) object)
+
+ ;; Return bug numbers.
+ (dolist (elt object result)
+ (when (member (symbol-name (car elt)) tags)
+ (setq result (append (cdr elt) result)))))))
(defun debbugs-get-bug-log (bug-number)
"Return a list of messages related to BUG-NUMBER.
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- [ELPA-diffs] /srv/bzr/emacs/elpa r276: * debbugs.el (debbugs-get-usertag): Change parameters to a KEY-VALUE sequence.,
Michael Albinus <=