;;; debbugs.el --- SOAP library to access debbugs servers
-;; Copyright (C) 2011 Free Software Foundation, Inc.
+;; Copyright (C) 2011, 2012 Free Software Foundation, Inc.
;; Author: Michael Albinus <michael.albinus@gmx.de>
;; Keywords: comm, hypermedia
;; Package: debbugs
-;; Version: 0.1
+;; Version: 0.3
;; This file is part of GNU Emacs.
;; This package provides some basic functions to access a debbugs SOAP
;; server (see <http://wiki.debian.org/DebbugsSoapInterface>).
-;; The SOAP functions "get_usertag" and "get_versions" are not
-;; implemented (yet).
+;; The SOAP function "get_versions" is not implemented (yet).
;;; Code:
(defun debbugs-get-bugs (&rest query)
"Return a list of bug numbers which match QUERY.
-QUERY is a keyword value sequence, whereby the values are strings.
-All queries are concatenated via AND.
+QUERY is a sequence of keyword-value pairs where the values are
+strings, i.e. :KEYWORD \"VALUE\" [:KEYWORD \"VALUE\"]*
+
+The keyword-value pair is a subquery. The keywords are allowed to
+have multiple occurrence within the query at any place. The
+subqueries with the same keyword form the logical subquery, which
+returns the union of bugs of every subquery it contains.
+
+The result of the QUERY is an intersection of results of all
+subqueries.
Valid keywords are:
:package -- The value is the name of the package a bug belongs
to, like \"emacs\", \"coreutils\", \"gnus\", or \"tramp\".
- :severity -- This is the severity of the bug. Currently,
- there exists the severities \"important\", \"grave\",
- \"normal\", \"minor\" and \"wishlist\".
+ :src -- This is used to retrieve bugs that belong to source
+ with given name.
+
+ :severity -- This is the severity of the bug. The exact set of
+ allowed values depends on the Debbugs port. Examples are
+ \"normal\", \"minor\", \"wishlist\" etc.
:tag -- An arbitrary string the bug is annotated with.
Usually, this is used to mark the status of the bug, like
\"fixed\", \"moreinfo\", \"notabug\", \"patch\",
- \"unreproducible\" or \"wontfix\".
+ \"unreproducible\" or \"wontfix\". The exact set of tags
+ depends on the Debbugs port.
:owner -- This is used to identify bugs by the owner's email
address. The special email address \"me\" is used as pattern,
by the submitter's email address. The special email address
\"me\" is used as pattern, replaced with `user-mail-address'.
+ :maint -- This is used to find bugs of the packages which are
+ maintained by the person with the given email address. The
+ special email address \"me\" is used as pattern, replaced with
+ `user-mail-address'.
+
+ :correspondent -- This allows to find bug reports where the
+ person with the given email address has participated. The
+ special email address \"me\" is used as pattern, replaced with
+ `user-mail-address'.
+
+ :affects -- With this keyword it is possible to find bugs which
+ affect the package with the given name. The bugs are chosen by
+ 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\".
+
:archive -- A keyword to filter for bugs which are already
archived, or not. Valid values are \"0\" (not archived),
\"1\" (archived) or \"both\". If this keyword is not given in
the query, `:archive \"0\"' is assumed by default.
-Example:
+Example. Get all opened and forwarded release critical bugs for
+the packages which are maintained by \"me\" and which have a
+patch:
- \(debbugs-get-bugs :submitter \"me\" :archive \"both\")
- => \(5516 5551 5645 7259)"
+ \(debbugs-get-bugs :maint \"me\" :tag \"patch\"
+ :severity \"critical\"
+ :status \"open\"
+ :severity \"grave\"
+ :status \"forwarded\"
+ :severity \"serious\")"
- (let (vec key val)
+ (let (vec kw key val)
;; Check query.
(while (and (consp query) (<= 2 (length query)))
- (setq key (pop query)
- val (pop query)
- vec (vconcat vec (list (substring (symbol-name key) 1))))
- (unless (and (keywordp key) (stringp val))
- (error "Wrong query: %s %s" key val))
- (case key
- ((:package :severity :tag)
+ (setq kw (pop query)
+ val (pop query))
+ (unless (and (keywordp kw) (stringp val))
+ (error "Wrong query: %s %s" kw val))
+ (setq key (substring (symbol-name kw) 1))
+ (case kw
+ ((:package :severity :tag :src :affects)
;; Value shall be one word.
- (if (string-match "\\`[A-Za-z]+\\'" val)
- (setq vec (vconcat vec (list val)))
- (error "Wrong %s: %s" (car (last vec)) val)))
- ;; Value is an email address.
- ((:owner :submitter)
+ (if (string-match "\\`\\S-+\\'" val)
+ (setq vec (vconcat vec (list key val)))
+ (error "Wrong %s: %s" key val)))
+ ((:owner :submitter :maint :correspondent)
+ ;; Value is an email address.
(if (string-match "\\`\\S-+\\'" val)
(progn
(when (string-equal "me" val)
(setq val user-mail-address))
(when (string-match "<\\(.+\\)>" val)
(setq val (match-string 1 val)))
- (setq vec (vconcat vec (list val))))
- (error "Wrong %s: %s" (car (last vec)) val)))
+ (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)
+ (setq vec (vconcat vec (list key val)))
+ (error "Wrong %s: %s" key val)))
(:archive
;; Value is `0' or `1' or `both'.
(if (string-match "\\`\\(0\\|1\\|both\\)\\'" val)
- (setq vec (vconcat vec (list val)))
- (error "Wrong %s: %s" (car (last vec)) val)))
- (t (error "Unknown key: %s" (car (last vec))))))
+ (setq vec (vconcat vec (list key val)))
+ (error "Wrong %s: %s" key val)))
+ (t (error "Unknown key: %s" kw))))
(unless (null query)
(error "Unknown key: %s" (car query)))
-
(sort (car (soap-invoke debbugs-wsdl debbugs-port "get_bugs" vec)) '<)))
(defun debbugs-newest-bugs (amount)
\(debbugs-get-status 10)
- => ;; Attributes with empty values are not show
+ => ;; Attributes with empty values are not shown
\(\(\(bug_num . 10)
\(source . \"unknown\")
\(date . 1203606305.0)
\(last_modified . 1271200046.0)
\(pending . \"pending\")
\(package \"emacs\")))"
- (let ((object
- (car
- (soap-invoke
- debbugs-wsdl debbugs-port "get_status"
- (apply 'vector bug-numbers)))))
- (mapcar
- (lambda (x)
- (let (y)
- ;; "archived" is the number 1 or 0.
- (setq y (assoc 'archived (cdr (assoc 'value x))))
- (setcdr y (= (cdr y) 1))
- ;; "found_versions" and "fixed_versions" are lists,
- ;; containing strings or numbers.
- (dolist (attribute '(found_versions fixed_versions))
- (setq y (assoc attribute (cdr (assoc 'value x))))
- (setcdr y (mapcar
- (lambda (z) (if (numberp z) (number-to-string z) z))
- (cdr y))))
- ;; "mergedwith" is a string, containing blank separated bug numbers.
- (setq y (assoc 'mergedwith (cdr (assoc 'value x))))
- (when (stringp (cdr y))
- (setcdr y (mapcar 'string-to-number (split-string (cdr y) " " t))))
- ;; "package" is a string, containing comma separated package names.
- ;; "keywords" and "tags" are strings, containing blank
- ;; separated package names.
- (dolist (attribute '(package keywords tags))
- (setq y (assoc attribute (cdr (assoc 'value x))))
+ (when bug-numbers
+ (let ((object
+ (car
+ (soap-invoke
+ debbugs-wsdl debbugs-port "get_status"
+ (apply 'vector bug-numbers)))))
+ (mapcar
+ (lambda (x)
+ (let (y)
+ ;; "archived" is the number 1 or 0.
+ (setq y (assoc 'archived (cdr (assoc 'value x))))
+ (setcdr y (= (cdr y) 1))
+ ;; "found_versions" and "fixed_versions" are lists,
+ ;; containing strings or numbers.
+ (dolist (attribute '(found_versions fixed_versions))
+ (setq y (assoc attribute (cdr (assoc 'value x))))
+ (setcdr y (mapcar
+ (lambda (z) (if (numberp z) (number-to-string z) z))
+ (cdr y))))
+ ;; "mergedwith" is a string, containing blank separated bug numbers.
+ (setq y (assoc 'mergedwith (cdr (assoc 'value x))))
(when (stringp (cdr y))
- (setcdr y (split-string (cdr y) ",\\| " t))))
- (cdr (assoc 'value x))))
- object)))
+ (setcdr y (mapcar 'string-to-number (split-string (cdr y) " " t))))
+ ;; "package" is a string, containing comma separated
+ ;; package names. "keywords" and "tags" are strings,
+ ;; containing blank separated package names.
+ (dolist (attribute '(package keywords tags))
+ (setq y (assoc attribute (cdr (assoc 'value x))))
+ (when (stringp (cdr y))
+ (setcdr y (split-string (cdr y) ",\\| " t))))
+ (cdr (assoc 'value x))))
+ object))))
+
+(defun debbugs-get-usertag (&rest query)
+ "Return a list of bug numbers which match QUERY.
+
+QUERY is a sequence of keyword-value pairs where the values are
+strings, i.e. :KEYWORD \"VALUE\" [:KEYWORD \"VALUE\"]*
+
+Valid keywords are:
+
+ :user -- The value is the name of the package a bug belongs to,
+ like \"emacs\", \"coreutils\", \"gnus\", or \"tramp\". It can
+ also be an email address of a user who has applied a user tag.
+ The special email address \"me\" is used as pattern, replaced
+ with `user-mail-address'. There must be at least one such
+ entry; it is recommended to have exactly one.
+
+ :tag -- A string applied as user tag. Often, it is a
+ subproduct identification, like \"cedet\" or \"tramp\" for the
+ package \"emacs\".
+
+If there is no :tag entry, no bug numbers will be returned but a list of
+existing user tags for :user.
+
+Example:
+
+ \(debbugs-get-usertag :user \"emacs\")
+
+ => (\"www\" \"solaris\" \"ls-lisp\" \"cygwin\")
+
+ \(debbugs-get-usertag :user \"emacs\" :tag \"www\" :tag \"cygwin\")
+
+ => (807 1223 5637)"
+
+ (let (user tags kw key val object result)
+ ;; Check query.
+ (while (and (consp query) (<= 2 (length query)))
+ (setq kw (pop query)
+ val (pop query))
+ (unless (and (keywordp kw) (stringp val))
+ (error "Wrong query: %s %s" kw val))
+ (setq key (substring (symbol-name kw) 1))
+ (case kw
+ ((:user)
+ ;; Value shall be one word. Extract email address, if existing.
+ (if (string-match "\\`\\S-+\\'" val)
+ (progn
+ (when (string-equal "me" val)
+ (setq val user-mail-address))
+ (when (string-match "<\\(.+\\)>" val)
+ (setq val (match-string 1 val)))
+ (add-to-list 'user val))
+ (error "Wrong %s: %s" key val)))
+ ((:tag)
+ ;; Value shall be one word.
+ (if (string-match "\\`\\S-+\\'" val)
+ (add-to-list 'tags val)
+ (error "Wrong %s: %s" key val)))
+ (t (error "Unknown key: %s" kw))))
+
+ (unless (null query)
+ (error "Unknown key: %s" (car query)))
+ (unless (= (length user) 1)
+ (error "There must be exactly one :user entry"))
+
+ (setq
+ object
+ (car (soap-invoke debbugs-wsdl debbugs-port "get_usertag" (car user))))
+
+ (if (null tags)
+ ;; Return the list of existing tags.
+ (mapcar (lambda (x) (symbol-name (car x))) object)
+
+ ;; Return bug numbers.
+ (dolist (elt object result)
+ (when (member (symbol-name (car elt)) tags)
+ (setq result (append (cdr elt) result)))))))
(defun debbugs-get-bug-log (bug-number)
"Return a list of messages related to BUG-NUMBER.
implemented yet server side."
(car (soap-invoke debbugs-wsdl debbugs-port "get_bug_log" bug-number)))
+(defun debbugs-search-est (&rest query)
+ "Return the result of a full text search according to QUERY.
+
+QUERY is a sequence of lists of keyword-value pairs where the
+values are strings or numbers, i.e. :KEYWORD \"VALUE\" [:KEYWORD
+VALUE]*
+
+Every sublist of the QUERY forms a hyperestraier condition. A
+detailed description of hyperestraier conditions can be found at
+URL `http://fallabs.com/hyperestraier/uguide-en.html#searchcond'.
+
+The following conditions are possible:
+
+\[:phrase SEARCH-PHRASE :skip NUMBER :max NUMBER\]
+
+ The string SEARCH-PHRASE forms the search on the database. It
+ contains words to be searched for, combined by operators like
+ AND, ANDNOT and OR. If there is no operator between the words,
+ AND is used by default. The phrase keyword and value can also
+ be omitted, this is useful in combination with other conditions.
+
+ :skip and :max are optional. They specify, how many hits are
+ skipped, and how many maximal hits are returned. This can be
+ used for paged results. Per default, :skip is 0 and :max is 10.
+
+ There must be exactly one such condition.
+
+\[ATTRIBUTE VALUE+ :operation OPERATION :order ORDER\]
+
+ 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.
+ The special email address \"me\" is used as pattern, replaced
+ with `user-mail-address'.
+
+ :package -- The value is the name of the package a bug belongs
+ to, like \"emacs\", \"coreutils\", \"gnus\", or \"tramp\".
+
+ :tags -- An arbitrary string the bug is annotated with.
+
+ :severity -- This is the severity of the bug. The exact set of
+ allowed values depends on the Debbugs port. Examples are
+ \"normal\", \"minor\", \"wishlist\" etc.
+
+ :operator defines the comparison operator to be applied to
+ ATTRIBUTE. For string attributes this could be \"STREQ\" \(is
+ equal to the string), \"STRNE\" \(is not equal to the string),
+ \"STRINC\" \(includes the string), \"STRBW\" \(begins with the
+ string), \"STREW\" \(ends with the string), \"STRAND\"
+ \(includes all tokens in the string), \"STROR\" \(includes at
+ least one token in the string), \"STROREQ\" \(is equal to at
+ least one token in the string) or \"STRRX\" \(matches regular
+ expressions of the string). For operators with tokens, several
+ values for ATTRIBUTE shall be used.
+
+ Numbers can be compared by the operators \"NUMEQ\" \(is equal
+ to the number), \"NUMNE\" \(is not equal to the number),
+ \"NUMGT\" \(is greater than the number), \"NUMGE\" \(is greater
+ than or equal to the number), \"NUMLT\" \(is less than the
+ number), \"NUMLE\" \(is less than or equal to the number) or
+ \"NUMBT\" \(is between the two numbers). In the last case,
+ there must be two values for ATTRIBUTE.
+
+ If an operator is leaded by \"!\", the meaning is inverted. If
+ a string operator is leaded by \"I\", the case of the value is
+ ignored.
+
+ The optional :order can be specified only in one condition. It
+ means, that ATTRIBUTE is used for sorting the results. The
+ following order operators exist: \"STRA\" \(ascending by
+ string), \"STRD\" \(descending by string), \"NUMA\" \(ascending
+ by number) or \"NUMD\" \(descending by number).
+
+ A special case is an :order, where there is no corresponding
+ attribute value and no operator. In this case, ATTRIBUTE is
+ not used for the search.
+
+The result of the QUERY is a list of association lists with the
+same attributes as in the conditions. Additional attributes are
+
+ `id': The bug number.
+
+ `msg_num': The number of the message inside the bug log.
+
+ `snippet': The surrounding text found by the search. For the
+ syntax of the snippet, consult the hyperestraier user guide.
+
+Examples:
+
+ \(debbugs-search-est
+ '\(:phrase \"armstrong AND debbugs\" :skip 10 :max 2)
+ '\(:severity \"normal\" :operator \"STRINC\")
+ '\(:date :order \"NUMA\"))
+
+ => \(\(\(msg_num . 21)
+ \(date . 1229208302)
+ \(@author . \"Glenn Morris <rgm@gnu.org>\")
+ \(@title . \"Re: bug#1567: Mailing an archived bug\")
+ \(id . 1567)
+ \(severity . \"normal\")
+ \(@cdate . \"Wed, 17 Dec 2008 14:34:50 -0500\")
+ \(snippet . \"...\")
+ \(subject . \"Mailing an archived bug\")
+ \(package . \"debbugs.gnu.org\"))
+ ...)
+
+ ;; Show all messages from me between 2011-08-01 and 2011-08-31.
+ \(debbugs-search-est
+ '\(: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\"))"
+
+ (let (args result)
+ ;; Compile search arguments.
+ (dolist (elt query)
+ (let (vec kw key val
+ phrase-cond attr-cond)
+
+ ;; Phrase is mandatory, even if empty.
+ (when (and (or (member :skip elt) (member :max elt))
+ (not (member :phrase elt)))
+ (setq vec (vector "phrase" "")))
+
+ ;; Parse condition.
+ (while (consp elt)
+ (setq kw (pop elt))
+ (unless (keywordp kw)
+ (error "Wrong keyword: %s" kw))
+ (setq key (substring (symbol-name kw) 1))
+ (case kw
+ ;; Phrase condition.
+ (:phrase
+ ;; It shouldn't happen in an attribute condition.
+ (if attr-cond
+ (error "Wrong keyword: %s" kw))
+ (setq phrase-cond t val (pop elt))
+ ;; Value is a string.
+ (if (stringp val)
+ (setq vec (vconcat vec (list key val)))
+ (error "Wrong %s: %s" key val)))
+
+ ((:skip :max)
+ ;; It shouldn't happen in an attribute condition.
+ (if attr-cond
+ (error "Wrong keyword: %s" kw))
+ (setq phrase-cond t val (pop elt))
+ ;; Value is a number.
+ (if (numberp val)
+ (setq vec (vconcat vec (list key (number-to-string val))))
+ (error "Wrong %s: %s" key val)))
+
+ ;; Attribute condition.
+ ((:submitter :@author)
+ ;; It shouldn't happen in a phrase condition.
+ (if phrase-cond
+ (error "Wrong keyword: %s" kw))
+ (if (not (stringp (car elt)))
+ (setq vec (vconcat vec (list key "")))
+ ;; Value is an email address.
+ (while (and (stringp (car elt))
+ (string-match "\\`\\S-+\\'" (car elt)))
+ (when (string-equal "me" (car elt))
+ (setcar elt user-mail-address))
+ (when (string-match "<\\(.+\\)>" (car elt))
+ (setcar elt (match-string 1 (car elt))))
+ (add-to-list 'val (pop elt) 'append))
+ (setq vec
+ (vconcat vec (list key (mapconcat 'identity val " "))))))
+
+ (:status
+ ;; It shouldn't happen in a phrase condition.
+ (if phrase-cond
+ (error "Wrong keyword: %s" kw))
+ (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)))
+ (add-to-list 'val (pop elt) 'append))
+ (setq vec
+ (vconcat vec (list key (mapconcat 'identity val " "))))))
+
+ ((:subject :package :tags :severity :@title)
+ ;; It shouldn't happen in a phrase condition.
+ (if phrase-cond
+ (error "Wrong keyword: %s" kw))
+ (setq attr-cond t)
+ (if (not (stringp (car elt)))
+ (setq vec (vconcat vec (list key "")))
+ ;; Just a string.
+ (while (stringp (car elt))
+ (add-to-list 'val (pop elt) 'append))
+ (setq vec
+ (vconcat vec (list key (mapconcat 'identity val " "))))))
+
+ ((:date :@cdate)
+ ;; It shouldn't happen in a phrase condition.
+ (if phrase-cond
+ (error "Wrong keyword: %s" kw))
+ (setq attr-cond t)
+ (if (not (numberp (car elt)))
+ (setq vec (vconcat vec (list key "")))
+ ;; Just a number.
+ (while (numberp (car elt))
+ (add-to-list 'val (pop elt) 'append))
+ (setq vec
+ (vconcat
+ vec (list key (mapconcat 'number-to-string val " "))))))
+
+ ((:operator :order)
+ ;; It shouldn't happen in a phrase condition.
+ (if phrase-cond
+ (error "Wrong keyword: %s" kw))
+ (setq attr-cond t val (pop elt))
+ ;; Value is a number.
+ (if (stringp val)
+ (setq vec (vconcat vec (list key val)))
+ (error "Wrong %s: %s" key val)))
+
+ (t (error "Unknown key: %s" kw))))
+
+ (setq args (vconcat args (list vec)))))
+
+ (setq result
+ (car (soap-invoke debbugs-wsdl debbugs-port "search_est" args)))
+ ;; The result contains lists (key value). We transform it into
+ ;; cons cells (key . value).
+ (dolist (elt1 result result)
+ (dolist (elt2 elt1)
+ (setcdr elt2 (cadr elt2))))))
+
(defun debbugs-get-attribute (bug-or-message attribute)
"Return the value of key ATTRIBUTE.
(defun debbugs-get-mbox (bug-number mbox-type &optional filename)
"Download mbox with messages of bug BUG-NUMBER from Debbugs server.
-BUG-NUMBER is a number of bug. It must be of integer type.
+BUG-NUMBER is a number of bug. It must be of integer type.
MBOX-TYPE specifies a type of mbox and can be one of the
following symbols:
`mboxmaint': Download maintainer's mbox.
- `mboxstat', `mboxstatus': Download status mbox. The use of
- either symbol depends on actual Debbugs server
- configuration. For gnu.org, use the former; for debian.org -
- the latter.
+ `mboxstat', `mboxstatus': Download status mbox. The use of
+ 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 current
-buffer."
+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
(cdr (assoc debbugs-port debbugs-servers))
(url-copy-file url filename t)
(url-insert-file-contents url))))
-;; Interface for the Emacs bug tracker.
-
-(autoload 'gnus-read-ephemeral-emacs-bug-group "gnus-group")
-(autoload 'mail-header-subject "nnheader")
-(autoload 'gnus-summary-article-header "gnus-sum")
-(autoload 'message-make-from "message")
-
-(defface debbugs-new '((t (:foreground "red")))
- "Face for new reports that nobody has answered.")
-
-(defface debbugs-handled '((t (:foreground "ForestGreen")))
- "Face for new reports that nobody has answered.")
-
-(defface debbugs-stale '((t (:foreground "orange")))
- "Face for new reports that nobody has answered.")
-
-(defun debbugs-emacs (severities &optional package list-done)
- "List all outstanding Emacs bugs."
- (interactive
- (list
- (completing-read "Severity: "
- '("important" "normal" "minor" "wishlist")
- nil t "normal")))
- (unless (consp severities)
- (setq severities (list severities)))
- (pop-to-buffer (get-buffer-create "*Emacs Bugs*"))
- (debbugs-mode)
- (let ((buffer-read-only nil)
- (ids nil))
- (dolist (severity severities)
- (setq ids (nconc ids
- (debbugs-get-bugs :package (or package "emacs")
- :severity severity))))
- (erase-buffer)
- (dolist (status (sort (apply 'debbugs-get-status ids)
- (lambda (s1 s2)
- (< (cdr (assq 'id s1))
- (cdr (assq 'id s2))))))
- (when (or list-done
- (not (equal (cdr (assq 'pending status)) "done")))
- (let ((address (mail-header-parse-address
- (decode-coding-string (cdr (assq 'originator status))
- 'utf-8))))
- (setq address
- ;; Prefer the name over the address.
- (or (cdr address)
- (car address)))
- (insert
- (format "%5d %-20s [%-23s] %s\n"
- (cdr (assq 'id status))
- (let ((words
- (mapconcat
- 'identity
- (cons (cdr (assq 'severity status))
- (cdr (assq 'keywords status)))
- ",")))
- (unless (equal (cdr (assq 'pending status)) "pending")
- (setq words (concat words "," (cdr (assq 'pending status)))))
- (if (> (length words) 20)
- (substring words 0 20)
- words))
- (if (> (length address) 23)
- (substring address 0 23)
- address)
- (decode-coding-string (cdr (assq 'subject status))
- 'utf-8)))
- (forward-line -1)
- (put-text-property
- (+ (point) 5) (+ (point) 26)
- 'face
- (cond
- ((= (cdr (assq 'date status))
- (cdr (assq 'log_modified status)))
- 'debbugs-new)
- ((< (- (float-time)
- (cdr (assq 'log_modified status)))
- (* 60 60 24 4))
- 'debbugs-handled)
- (t
- 'debbugs-stale)))
- (forward-line 1)))))
- (goto-char (point-min)))
-
-(defvar debbugs-mode-map nil)
-(unless debbugs-mode-map
- (setq debbugs-mode-map (make-sparse-keymap))
- (define-key debbugs-mode-map "\r" 'debbugs-select-report))
-
-(defun debbugs-mode ()
- "Major mode for listing bug reports.
-
-All normal editing commands are switched off.
-\\<debbugs-mode-map>
-
-The following commands are available:
-
-\\{debbugs-mode-map}"
- (interactive)
- (kill-all-local-variables)
- (setq major-mode 'debbugs-mode)
- (setq mode-name "Debbugs")
- (use-local-map debbugs-mode-map)
- (buffer-disable-undo)
- (setq truncate-lines t)
- (setq buffer-read-only t))
-
-(defun debbugs-select-report ()
- "Select the report on the current line."
- (interactive)
- (let (id)
- (save-excursion
- (beginning-of-line)
- (if (not (looking-at " *\\([0-9]+\\)"))
- (error "No bug report on the current line")
- (setq id (string-to-number (match-string 1)))))
- (gnus-read-ephemeral-emacs-bug-group
- id (cons (current-buffer)
- (current-window-configuration)))
- (with-current-buffer (window-buffer (selected-window))
- (debbugs-summary-mode 1))))
-
-(defvar debbugs-summary-mode-map
- (let ((map (make-sparse-keymap)))
- (define-key map "C" 'debbugs-send-control-message)
- map))
-
-(define-minor-mode debbugs-summary-mode
- "Minor mode for providing a debbugs interface in Gnus summary buffers.
-
-\\{debbugs-summary-mode-map}"
- :lighter " Debbugs" :keymap debbugs-summary-mode-map
- nil)
-
-(defun debbugs-send-control-message (message)
- "Send a control message for the current bug report.
-You can set the severity or add a tag, or close the report. If
-you use the special \"done\" MESSAGE, the report will be marked as
-fixed, and then closed."
- (interactive
- (list (completing-read
- "Control message: "
- '("important" "normal" "minor" "wishlist"
- "close" "done"
- "patch" "wontfix" "moreinfo" "unreproducible" "fixed" "notabug")
- nil t)))
- (let* ((subject (mail-header-subject (gnus-summary-article-header)))
- (id
- (if (string-match "bug#\\([0-9]+\\)" subject)
- (string-to-number (match-string 1 subject))
- (error "No bug number present"))))
- (with-temp-buffer
- (insert "To: control@debbugs.gnu.org\n"
- "From: " (message-make-from) "\n"
- (format "Subject: control message for bug #%d\n" id)
- "\n"
- (cond
- ((equal message "close")
- (format "close %d\n" id))
- ((equal message "done")
- (format "tags %d fixed\nclose %d\n" id id))
- ((member message '("important" "normal" "minor" "wishlist"))
- (format "severity %d %s\n" id message))
- (t
- (format "tags %d %s\n" id message))))
- (funcall send-mail-function))))
-
(provide 'debbugs)
;;; TODO:
;; * SOAP interface extensions (wishlist).
;; - Server-side sorting.
;; - Regexp and/or wildcards search.
-;; - Fulltext search.
;; - Returning message attachments.
-;; * Widget-oriented bug overview like webDDTs.
-;; * Actions on bugs.
-;; * Integration into gnus (nnir).
;;; debbugs.el ends here