- (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
+ ((:user)
+ ;; Value shall be one word. Extract email address, if existing.
+ (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.
+ (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 :user 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)))))))