Use dynamic completion for bug numbers in debbugs

[gnu-emacs-elpa] / packages / debbugs / debbugs.el

diff --git a/packages/debbugs/debbugs.el b/packages/debbugs/debbugs.el
index 8efeddbe2188857a19b1c946d0289408d73b70e4..7feb02341f14590584a144c0475031c61c60b3f4 100644 (file)
--- a/packages/debbugs/debbugs.el
+++ b/packages/debbugs/debbugs.el
@@ -5,7 +5,7 @@
 ;; Author: Michael Albinus <michael.albinus@gmx.de>
 ;; Keywords: comm, hypermedia
 ;; Package: debbugs
 ;; Author: Michael Albinus <michael.albinus@gmx.de>
 ;; Keywords: comm, hypermedia
 ;; Package: debbugs

-;; Version: 0.9.5
+;; Version: 0.9.7

 ;; Package-Requires: ((soap-client "3.1.1") (cl-lib "0.5"))
 
 ;; This file is not part of GNU Emacs.
 ;; Package-Requires: ((soap-client "3.1.1") (cl-lib "0.5"))
 
 ;; This file is not part of GNU Emacs.


@@ -108,7 +108,7 @@ This corresponds to the Debbugs server to be accessed, either
 
 (defcustom debbugs-cache-expiry (* 60 60)
   "How many seconds debbugs query results are cached.
 
 (defcustom debbugs-cache-expiry (* 60 60)
   "How many seconds debbugs query results are cached.

-`t' or 0 disables caching, `nil' disables expiring."
+t or 0 disables caching, nil disables expiring."

   :group 'debbugs
   :type '(choice (const :tag "Always" t)
                 (const :tag "Never" nil)
   :group 'debbugs
   :type '(choice (const :tag "Always" t)
                 (const :tag "Never" nil)


@@ -181,8 +181,8 @@ Valid keywords are:
   the value of field `affects' in bug's status.  The returned bugs
   do not necessary belong to this package.
 
   the value of field `affects' in bug's status.  The returned bugs
   do not necessary belong to this package.
 

-  :status -- Status of bug.  Valid values are \"done\",
-  \"forwarded\" and \"open\".
+  :status -- Status of bug.  Valid values are \"open\",
+  \"forwarded\" and \"done\".

 
   :archive -- A keyword to filter for bugs which are already
   archived, or not.  Valid values are \"0\" (not archived),
 
   :archive -- A keyword to filter for bugs which are already
   archived, or not.  Valid values are \"0\" (not archived),


@@ -225,8 +225,8 @@ patch:
               (setq vec (vconcat vec (list key val))))
           (error "Wrong %s: %s" key val)))
        (:status
               (setq vec (vconcat vec (list key val))))
           (error "Wrong %s: %s" key val)))
        (:status

-        ;; Possible values: "done", "forwarded" and "open"
-        (if (string-match "\\`\\(done\\|forwarded\\|open\\)\\'" val)
+        ;; Possible values: "open", "forwarded" and "done".
+        (if (string-match "\\`\\(open\\|forwarded\\|done\\)\\'" val)

             (setq vec (vconcat vec (list key val)))
           (error "Wrong %s: %s" key val)))
        (:archive
             (setq vec (vconcat vec (list key val)))
           (error "Wrong %s: %s" key val)))
        (:archive


@@ -242,7 +242,38 @@ patch:
 
 (defun debbugs-newest-bugs (amount)
   "Return the list of bug numbers, according to AMOUNT (a number) latest bugs."
 
 (defun debbugs-newest-bugs (amount)
   "Return the list of bug numbers, according to AMOUNT (a number) latest bugs."

-  (sort (car (soap-invoke debbugs-wsdl debbugs-port "newest_bugs" amount)) '<))
+  (if (= amount 1)
+      ;; We cache it as bug "0" in `debbugs-cache-data'.
+      (list (cdr (assoc 'newest_bug
+        (let ((status (gethash 0 debbugs-cache-data)))
+         (if (and
+              status
+              (or
+               (null debbugs-cache-expiry)
+               (and
+                (natnump debbugs-cache-expiry)
+                (> (cdr (assoc 'cache_time status))
+                   (- (float-time) debbugs-cache-expiry)))))
+             ;; Take the cached value.
+             status
+
+           (setq
+            status
+            ;; Put also a time stamp.
+            (list
+             (cons 'cache_time (float-time))
+             (cons 'newest_bug
+                   (caar
+                    (soap-invoke
+                     debbugs-wsdl debbugs-port "newest_bugs" amount)))))
+           (if (and debbugs-cache-expiry (natnump debbugs-cache-expiry))
+               ;; Cache it.
+               (puthash 0 status debbugs-cache-data)
+             ;; Don't cache.
+             status))))))
+
+    (sort
+     (car (soap-invoke debbugs-wsdl debbugs-port "newest_bugs" amount)) '<)))

 
 (defun debbugs-convert-soap-value-to-string (string-value)
   "If STRING-VALUE is unibyte, decode its contents as a UTF-8 string.
 
 (defun debbugs-convert-soap-value-to-string (string-value)
   "If STRING-VALUE is unibyte, decode its contents as a UTF-8 string.


@@ -282,7 +313,7 @@ Every returned entry is an association list with the following attributes:
   can be \"fixed\", \"notabug\", \"wontfix\", \"unreproducible\",
   \"moreinfo\" or \"patch\".
 
   can be \"fixed\", \"notabug\", \"wontfix\", \"unreproducible\",
   \"moreinfo\" or \"patch\".
 

-  `pending': The string \"pending\", \"forwarded\" or \"done\".
+  `pending': The string \"pending\", \"forwarded\", \"fixed\" or \"done\".

 
   `subject': Subject/Title of the bugreport.
 
 
   `subject': Subject/Title of the bugreport.
 


@@ -303,7 +334,7 @@ Every returned entry is an association list with the following attributes:
 
   `done': The email address of the worker who has closed the bug (if done).
 
 
   `done': The email address of the worker who has closed the bug (if done).
 

-  `archived': `t' if the bug is archived, `nil' otherwise.
+  `archived': t if the bug is archived, nil otherwise.

 
   `unarchived': The date the bug has been unarchived, if ever.
 
 
   `unarchived': The date the bug has been unarchived, if ever.
 


@@ -359,7 +390,7 @@ Example:
                      (and
                       (natnump debbugs-cache-expiry)
                       (> (cdr (assoc 'cache_time status))
                      (and
                       (natnump debbugs-cache-expiry)
                       (> (cdr (assoc 'cache_time status))

-                         (- (float-time)) debbugs-cache-expiry))))
+                         (- (float-time) debbugs-cache-expiry)))))

                    (progn
                      (setq cached-bugs (append cached-bugs (list status)))
                      nil)
                    (progn
                      (setq cached-bugs (append cached-bugs (list status)))
                      nil)


@@ -529,7 +560,7 @@ Every message is an association list with the following attributes:
 
   `body': The message body.
 
 
   `body': The message body.
 

-  `attachments' A list of possible attachments, or `nil'.  Not
+  `attachments' A list of possible attachments, or nil.  Not

   implemented yet server side."
   (car (soap-invoke debbugs-wsdl debbugs-port "get_bug_log" bug-number)))
 
   implemented yet server side."
   (car (soap-invoke debbugs-wsdl debbugs-port "get_bug_log" bug-number)))
 


@@ -632,9 +663,9 @@ same attributes as in the conditions.  Additional attributes are
 Examples:
 
   \(debbugs-search-est
 Examples:
 
   \(debbugs-search-est

-    '\(:phrase \"armstrong AND debbugs\" :skip 10 :max 2)
-    '\(:severity \"normal\" :operator \"STRINC\")
-    '\(:date :order \"NUMA\"))
+    \\='\(:phrase \"armstrong AND debbugs\" :skip 10 :max 2)
+    \\='\(:severity \"normal\" :operator \"STRINC\")
+    \\='\(:date :order \"NUMA\"))

 
   => \(\(\(msg_num . 21)
        \(date . 1229208302)
 
   => \(\(\(msg_num . 21)
        \(date . 1229208302)


@@ -650,9 +681,9 @@ Examples:
 
   ;; Show all messages from me between 2011-08-01 and 2011-08-31.
   \(debbugs-search-est
 
   ;; Show all messages from me between 2011-08-01 and 2011-08-31.
   \(debbugs-search-est

-    '\(:max 20)
-    '\(:@author \"me\" :operator \"ISTRINC\")
-    `\(:date
+    \\='\(:max 20)
+    \\='\(:@author \"me\" :operator \"ISTRINC\")
+    \\=`\(:date

       ,\(floor \(float-time \(encode-time 0 0 0  1 8 2011)))
       ,\(floor \(float-time \(encode-time 0 0 0 31 8 2011)))
       :operator \"NUMBT\"))"
       ,\(floor \(float-time \(encode-time 0 0 0  1 8 2011)))
       ,\(floor \(float-time \(encode-time 0 0 0 31 8 2011)))
       :operator \"NUMBT\"))"


@@ -697,7 +728,7 @@ Examples:
            (setq kw (pop elt))
            (unless (keywordp kw)
              (error "Wrong keyword: %s" kw))
            (setq kw (pop elt))
            (unless (keywordp kw)
              (error "Wrong keyword: %s" kw))

-           (setq key (format "'%s'" (substring (symbol-name kw) 1)))
+           (setq key (substring (symbol-name kw) 1))

            (cl-case kw
              ;; Phrase condition.
              (:phrase
            (cl-case kw
              ;; Phrase condition.
              (:phrase


@@ -739,7 +770,8 @@ Examples:
                     (unless (member x val)
                       (setq val (append val (list x))))))
                 (setq vec
                     (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.
 
              (:status
               ;; It shouldn't happen in a phrase condition.


@@ -748,15 +780,16 @@ Examples:
               (setq attr-cond t)
               (if (not (stringp (car elt)))
                   (setq vec (vconcat vec (list key "")))
               (setq attr-cond t)
               (if (not (stringp (car elt)))
                   (setq vec (vconcat vec (list key "")))

-                ;; Possible values: "done", "forwarded" and "open"
-                (while  (and (stringp (car elt))
-                             (string-match
-                              "\\`\\(done\\|forwarded\\|open\\)\\'" (car elt)))
+                ;; Possible values: "open", "forwarded" and "done".
+                (while (and (stringp (car elt))
+                            (string-match
+                             "\\`\\(open\\|forwarded\\|done\\)\\'" (car elt)))

                   (let ((x (pop elt)))
                     (unless (member x val)
                       (setq val (append val (list x))))))
                 (setq vec
                   (let ((x (pop elt)))
                     (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.
 
              ((:subject :package :tags :severity :@title)
               ;; It shouldn't happen in a phrase condition.


@@ -771,7 +804,8 @@ Examples:
                     (unless (member x val)
                       (setq val (append val (list x))))))
                 (setq vec
                     (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.
 
              ((:date :@cdate)
               ;; It shouldn't happen in a phrase condition.


@@ -787,7 +821,8 @@ Examples:
                       (setq val (append val (list x))))))
                 (setq vec
                       (vconcat
                       (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.
 
              ((:operator :order)
               ;; It shouldn't happen in a phrase condition.


@@ -820,7 +855,7 @@ BUG-OR-MESSAGE must be list element returned by either
 Example: Return the originator of last submitted bug.
 
 \(debbugs-get-attribute
 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)
   (cdr (assoc attribute bug-or-message)))
 
 (defun debbugs-get-message-numbers (messages)


@@ -837,11 +872,11 @@ the header lines of the message, the second element is the body
 of the message.  Further elements of the list, if any, are
 attachments of the message.
 
 of the message.  Further elements of the list, if any, are
 attachments of the message.
 

-If there is no message with MESSAGE-NUMBER, the function returns `nil'.
+If there is no message with MESSAGE-NUMBER, the function returns nil.

 
 Example: Return the first message of last submitted bug.
 
 
 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
   \(debbugs-get-message messages
                       \(car \(debbugs-get-message-numbers messages))))"
   (while (and messages


@@ -868,8 +903,8 @@ following symbols:
    either symbol depends on actual Debbugs server configuration.
    For gnu.org, use the former; for debian.org - the latter.
 
    either symbol depends on actual Debbugs server configuration.
    For gnu.org, use the former; for debian.org - the latter.
 

-FILENAME, if non-`nil', is the name of file to store mbox.  If
-FILENAME is `nil', the downloaded mbox is inserted into the
+FILENAME, if non-nil, is the name of file to store mbox.  If
+FILENAME is nil, the downloaded mbox is inserted into the

 current buffer."
   (let (url (mt "") bn)
     (unless (setq url (plist-get
 current buffer."
   (let (url (mt "") bn)
     (unless (setq url (plist-get