Make debbugs-newest-bugs more robust

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

diff --git a/packages/debbugs/debbugs.el b/packages/debbugs/debbugs.el
index d4503915cbc0c7076d809d482dce29abfce463a9..8221c37230885f9abb745105c51d2b2d95ded918 100644 (file)
--- a/packages/debbugs/debbugs.el
+++ b/packages/debbugs/debbugs.el
@@ -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.
-`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)
@@ -242,7 +242,45 @@ patch:
 
 (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'.
+      (let ((status (gethash 0 debbugs-cache-data)))
+       (unless (and
+                status
+                (or
+                 (null debbugs-cache-expiry)
+                 (and
+                  (natnump debbugs-cache-expiry)
+                  (> (cdr (assoc 'cache_time status))
+                     (- (float-time) debbugs-cache-expiry)))))
+         ;; Due to `debbugs-gnu-completion-table', this function
+         ;; could be called in rapid sequence.  We cache temporarily
+         ;; the value nil, therefore.
+         (when (natnump debbugs-cache-expiry)
+           (puthash
+            0
+            (list (cons 'cache_time (1+ (- (float-time) debbugs-cache-expiry)))
+                  (list 'newest_bug))
+            debbugs-cache-data))
+         ;; Compute the value.
+         (setq
+          status
+          (list
+           (cons 'cache_time (float-time))
+           (cons 'newest_bug
+                 (caar
+                  (soap-invoke
+                   debbugs-wsdl debbugs-port "newest_bugs" amount)))))
+
+         ;; Cache it.
+         (when (or (null debbugs-cache-expiry) (natnump debbugs-cache-expiry))
+           (puthash 0 status debbugs-cache-data)))
+
+       ;; Return the value, as list.
+       (list (cdr (assoc 'newest_bug 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.
@@ -303,7 +341,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).
 
-  `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.
 
@@ -359,7 +397,7 @@ Example:
                      (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)
@@ -430,7 +468,7 @@ Example:
            (when (stringp (cdr y))
              (setcdr y (split-string (cdr y) ",\\| " t))))
          ;; Cache the result, and return.
-         (if (and debbugs-cache-expiry (natnump debbugs-cache-expiry))
+         (if (or (null debbugs-cache-expiry) (natnump debbugs-cache-expiry))
              (puthash
               (cdr (assoc 'key x))
               ;; Put also a time stamp.
@@ -529,7 +567,7 @@ Every message is an association list with the following attributes:
 
   `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)))
 
@@ -632,9 +670,9 @@ same attributes as in the conditions.  Additional attributes are
 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)
@@ -650,9 +688,9 @@ Examples:
 
   ;; 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\"))"
@@ -824,7 +862,7 @@ BUG-OR-MESSAGE must be list element returned by either
 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)
@@ -841,11 +879,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.
 
-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.
 
-\(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
@@ -872,8 +910,8 @@ following symbols:
    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