]> code.delx.au - gnu-emacs-elpa/blobdiff - packages/debbugs/debbugs.el
Make debbugs-newest-bugs more robust
[gnu-emacs-elpa] / packages / debbugs / debbugs.el
index 422a775e5a2070dc44c213ab5bbba904a68e364e..8221c37230885f9abb745105c51d2b2d95ded918 100644 (file)
@@ -5,7 +5,7 @@
 ;; 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.
@@ -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)
@@ -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.
 
-  :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),
@@ -225,8 +225,8 @@ patch:
               (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
@@ -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.
@@ -282,7 +320,7 @@ Every returned entry is an association list with the following attributes:
   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.
 
@@ -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)))
 
@@ -565,17 +603,15 @@ The following conditions are possible:
 
   ATTRIBUTE is one of the following keywords:
 
-  :status --  Status of bug.  Valid values are \"done\",
-  \"forwarded\" and \"open\".
-
   :subject, :@title -- The subject of a message or the title of
   the bug, a string.
 
   :date, :@cdate -- The submission or modification dates of a
   message, a number.
 
-  :submitter, :@author -- The email address of the submitter of a
-  bug or the author of a message belonging to this bug, a string.
+  :@author -- The email address of the author of a message
+  belonging to this bug, a string.  It may be different than
+  the email of the person submitting the bug.
   The special email address \"me\" is used as pattern, replaced
   with `user-mail-address'.
 
@@ -634,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)
@@ -652,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\"))"
@@ -724,8 +760,9 @@ Examples:
 
              ;; Attribute condition.
              ((:submitter :@author)
-              ;; It shouldn't happen in a phrase condition.
-              (if phrase-cond
+              ;; It shouldn't happen.
+              (if (or (and (eq kw :submitter) phrase-cond)
+                      (and (eq kw :@author) attr-cond))
                   (error "Wrong keyword: %s" kw))
               (if (not (stringp (car elt)))
                   (setq vec (vconcat vec (list key "")))
@@ -740,7 +777,8 @@ Examples:
                     (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.
@@ -749,15 +787,16 @@ Examples:
               (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
-                      (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.
@@ -772,7 +811,8 @@ Examples:
                     (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.
@@ -788,7 +828,8 @@ Examples:
                       (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.
@@ -821,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)
@@ -838,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
@@ -869,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