-;;; debbugs.el --- SOAP library to access debbugs servers
+;;; debbugs.el --- SOAP library to access debbugs servers -*- lexical-binding:t -*-
;; Copyright (C) 2011-2016 Free Software Foundation, Inc.
;; Author: Michael Albinus <michael.albinus@gmx.de>
;; Keywords: comm, hypermedia
;; Package: debbugs
-;; Version: 0.9.1
-;; Package-Requires: ((async "1.6"))
+;; Version: 0.9.5
+;; Package-Requires: ((soap-client "3.1.1") (cl-lib "0.5"))
;; This file is not part of GNU Emacs.
;(setq soap-debug t message-log-max t)
(require 'soap-client)
-(eval-when-compile (require 'cl))
-
-(declare-function soap-invoke-async "soap-client")
-(declare-function async-start "async")
-(declare-function async-get "async")
+(eval-when-compile (require 'cl-lib))
(defgroup debbugs nil
"Debbugs library"
"The object manipulated by `debbugs-soap-invoke-async'.")
(defun debbugs-soap-invoke-async (operation-name &rest parameters)
- "Invoke the SOAP connection asynchronously.
-If possible, it uses `soap-invoke-async' from soapclient 3.0.
-Otherwise, `async-start' from the async package is used."
- (if (fboundp 'soap-invoke-async)
- ;; This is soap-client 3.0.
- (apply
- 'soap-invoke-async
- (lambda (response &rest args)
- (setq debbugs-soap-invoke-async-object
- (append debbugs-soap-invoke-async-object (car response))))
- nil
- debbugs-wsdl debbugs-port operation-name parameters)
- ;; Fallback with async.
- (async-start
- `(lambda ()
- (load ,(locate-library "soap-client"))
- (apply
- 'soap-invoke
- (soap-load-wsdl
- ,(expand-file-name
- "Debbugs.wsdl"
- (file-name-directory (locate-library "debbugs"))))
- ,debbugs-port ,operation-name ',parameters)))))
+ "Invoke the SOAP connection asynchronously."
+ (apply
+ #'soap-invoke-async
+ (lambda (response &rest _args)
+ (setq debbugs-soap-invoke-async-object
+ (append debbugs-soap-invoke-async-object (car response))))
+ nil debbugs-wsdl debbugs-port operation-name parameters))
(defun debbugs-get-bugs (&rest query)
"Return a list of bug numbers which match QUERY.
(unless (and (keywordp kw) (stringp val))
(error "Wrong query: %s %s" kw val))
(setq key (substring (symbol-name kw) 1))
- (case kw
+ (cl-case kw
((:package :severity :tag :src :affects)
;; Value shall be one word.
(if (string-match "\\`\\S-+\\'" val)
(debbugs-soap-invoke-async
"get_status"
(apply
- 'vector
+ #'vector
(butlast
bug-ids (- (length bug-ids)
debbugs-max-hits-per-request))))))
debbugs-max-hits-per-request))))
(dolist (res results)
- (if (bufferp res)
- ;; This is soap-client 3.0.
- (while (buffer-live-p res)
- (accept-process-output (get-buffer-process res) 0.1))
- ;; Fallback with async.
- (dolist (status (async-get res))
- (setq debbugs-soap-invoke-async-object
- (append debbugs-soap-invoke-async-object status)))))))
+ (while (buffer-live-p res)
+ (accept-process-output (get-buffer-process res) 0.1)))))
(append
cached-bugs
(setq y (assoc attribute (cdr (assoc 'value x))))
(when (stringp (cdr y))
(setcdr y (mapcar
- 'string-to-number (split-string (cdr y) " " t)))))
+ #'string-to-number (split-string (cdr y) " " t)))))
;; "subject", "originator", "owner" and "summary" may be an
;; xsd:base64Binary value containing a UTF-8-encoded string.
(dolist (attribute '(subject originator owner summary))
(puthash
(cdr (assoc 'key x))
;; Put also a time stamp.
- (cons (cons 'cache_time (floor (float-time)))
+ (cons (cons 'cache_time (float-time))
(cdr (assoc 'value x)))
debbugs-cache-data)
;; Don't cache.
(unless (and (keywordp kw) (stringp val))
(error "Wrong query: %s %s" kw val))
(setq key (substring (symbol-name kw) 1))
- (case kw
+ (cl-case kw
((:user)
;; Value shall be one word. Extract email address, if existing.
(if (string-match "\\`\\S-+\\'" val)
(setq val user-mail-address))
(when (string-match "<\\(.+\\)>" val)
(setq val (match-string 1 val)))
- (pushnew val user :test #'equal))
+ (cl-pushnew val user :test #'equal))
(error "Wrong %s: %s" key val)))
((:tag)
;; Value shall be one word.
(if (string-match "\\`\\S-+\\'" val)
- (pushnew val tags :test #'equal)
+ (cl-pushnew val tags :test #'equal)
(error "Wrong %s: %s" key val)))
(t (error "Unknown key: %s" kw))))
(let ((phrase (assoc :phrase query))
args result)
- (if (and phrase (not (member :skip phrase)) (not (member :skip phrase)))
+ (if (and phrase (not (member :skip phrase)) (not (member :max phrase)))
;; We loop, until we have all results.
(let ((skip 0)
(query (delete phrase query))
(while skip
(setq result1
(apply
- 'debbugs-search-est
+ #'debbugs-search-est
(append
(list
(append
;; Compile search arguments.
(dolist (elt query)
+ ;; FIXME: `vec' is used in an O(N²) way. It should be a list instead,
+ ;; on which we push elements, and we only convert it to a vector at
+ ;; the end.
(let (vec kw key val
phrase-cond attr-cond)
(unless (member x val)
(setq val (append val (list x))))))
(setq vec
- (vconcat vec (list key (mapconcat 'identity val " "))))))
+ (vconcat vec (list key (mapconcat #'identity val " "))))))
(:status
;; It shouldn't happen in a phrase condition.
(unless (member x val)
(setq val (append val (list x))))))
(setq vec
- (vconcat vec (list key (mapconcat 'identity val " "))))))
+ (vconcat vec (list key (mapconcat #'identity val " "))))))
((:subject :package :tags :severity :@title)
;; It shouldn't happen in a phrase condition.
(unless (member x val)
(setq val (append val (list x))))))
(setq vec
- (vconcat vec (list key (mapconcat 'identity val " "))))))
+ (vconcat vec (list key (mapconcat #'identity val " "))))))
((:date :@cdate)
;; It shouldn't happen in a phrase condition.
(setq val (append val (list x))))))
(setq vec
(vconcat
- vec (list key (mapconcat 'number-to-string val " "))))))
+ vec (list key (mapconcat #'number-to-string val " "))))))
((:operator :order)
;; It shouldn't happen in a phrase condition.
Example: Return the originator of last submitted bug.
\(debbugs-get-attribute
- \(car \(apply 'debbugs-get-status \(debbugs-newest-bugs 1))) 'originator)"
+ \(car \(apply #'debbugs-get-status \(debbugs-newest-bugs 1))) 'originator)"
(cdr (assoc attribute bug-or-message)))
(defun debbugs-get-message-numbers (messages)
Example: Return the first message of last submitted bug.
-\(let \(\(messages \(apply 'debbugs-get-bug-log \(debbugs-newest-bugs 1))))
+\(let \(\(messages \(apply #'debbugs-get-bug-log \(debbugs-newest-bugs 1))))
\(debbugs-get-message messages
\(car \(debbugs-get-message-numbers messages))))"
(while (and messages