X-Git-Url: https://code.delx.au/gnu-emacs-elpa/blobdiff_plain/09e8c98b0b5a725897b25ff235608391fde2a0a3..HEAD:/packages/debbugs/debbugs.el diff --git a/packages/debbugs/debbugs.el b/packages/debbugs/debbugs.el index 422a775e5..8221c3723 100644 --- a/packages/debbugs/debbugs.el +++ b/packages/debbugs/debbugs.el @@ -5,7 +5,7 @@ ;; Author: Michael Albinus ;; 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