(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)
(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.")
-
-(defface debbugs-done '((t (:foreground "DarkGrey")))
- "Face for closed bug reports.")
-
-(defun debbugs-emacs (severities &optional package list-done archivedp)
- "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 ((debbugs-port "gnu.org")
- (buffer-read-only nil)
- (ids nil)
- (default 400))
- (dolist (severity severities)
- (setq ids (nconc ids
- (debbugs-get-bugs :package (or package "emacs")
- :severity severity
- :archive (if archivedp
- "1" "0")))))
- (erase-buffer)
-
- (when (> (length ids) default)
- (let* ((cursor-in-echo-area nil)
- (input
- (read-string
- (format
- "How many reports (available %d, default %d): "
- (length ids) default)
- nil
- nil
- (number-to-string default))))
- (setq ids (last (sort ids '<) (string-to-number input)))))
-
- (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
- ((equal (cdr (assq 'pending status)) "done")
- 'debbugs-done)
- ((= (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"
- "done"
- "unarchive" "reopen" "close"
- "merge" "forcemerge"
- "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
- ((member message '("unarchive" "reopen" "close"))
- (format "%s %d\n" message id))
- ((member message '("merge" "forcemerge"))
- (format "%s %d %s\n" message id
- (read-string "Merge with bug #: ")))
- ((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:
;; - 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