]> code.delx.au - gnu-emacs-elpa/blobdiff - packages/debbugs/debbugs-gnu.el
Update the README for the debbugs package.
[gnu-emacs-elpa] / packages / debbugs / debbugs-gnu.el
index 6a09320d2d00f8d38d19d58d3ebdf8ef8019d960..1115db819d893fc85f28fd7b01a30214558041c3 100644 (file)
@@ -5,7 +5,7 @@
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;; Keywords: comm, hypermedia, maint
 ;; Package: debbugs
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;; Keywords: comm, hypermedia, maint
 ;; Package: debbugs
-;; Version: 0.1
+;; Version: 0.3
 
 ;; This file is part of GNU Emacs.
 
 
 ;; This file is part of GNU Emacs.
 
 ;;; Commentary:
 
 ;; This package provides an interface to bug reports which are located
 ;;; Commentary:
 
 ;; This package provides an interface to bug reports which are located
-;; on the GNU bug tracker debbugs.gnu.org.  It's main purpose is to
+;; on the GNU bug tracker debbugs.gnu.org.  Its main purpose is to
 ;; show and manipulate bug reports from Emacs, but it could be used
 ;; also for other GNU projects which use the same bug tracker.
 
 ;; If you have `debbugs-gnu.el' in your load-path, you could enable
 ;; show and manipulate bug reports from Emacs, but it could be used
 ;; also for other GNU projects which use the same bug tracker.
 
 ;; If you have `debbugs-gnu.el' in your load-path, you could enable
-;; the bug tracker command by the following line in your ~/.emacs
+;; the bug tracker command by the following lines in your ~/.emacs
 ;;
 ;;   (autoload 'debbugs-gnu "debbugs-gnu" "" 'interactive)
 ;;
 ;;   (autoload 'debbugs-gnu "debbugs-gnu" "" 'interactive)
+;;   (autoload 'debbugs-gnu-search "debbugs-gnu" "" 'interactive)
 
 ;; The bug tracker is called interactively by
 ;;
 
 ;; The bug tracker is called interactively by
 ;;
 
 ;; It asks for the severities, for which bugs shall be shown. This can
 ;; be either just one severity, or a list of severities, separated by
 
 ;; It asks for the severities, for which bugs shall be shown. This can
 ;; be either just one severity, or a list of severities, separated by
-;; comma.  Valid severities are "important", "normal", "minor" or
-;; "wishlist".  There is also the pseudo severity "tagged", which
-;; selects locally tagged bugs.
+;; comma.  Valid severities are "serious", "important", "normal",
+;; "minor" or "wishlist".  Severities "critical" and "grave" are not
+;; used, although configured on the GNU bug tracker.  If no severity
+;; is given, all bugs are selected.
 
 
-;; If a prefix is given, more search parameters are asked for, like
-;; packages (also a comma separated list, "emacs" is the default),
-;; whether archived bugs shall be shown, and whether closed bugs shall
-;; be shown.
+;; There is also the pseudo severity "tagged", which selects locally
+;; tagged bugs.
+
+;; If a prefix is given to the command, more search parameters are
+;; asked for, like packages (also a comma separated list, "emacs" is
+;; the default), whether archived bugs shall be shown, and whether
+;; closed bugs shall be shown.
+
+;; Another command is
+;;
+;;   M-x debbugs-gnu-search
+
+;; It behaves like `debbugs-gnu', but asks at the beginning for a
+;; search phrase to be used for full text search.  Additionally, it
+;; asks for key-value pairs to filter bugs.  Keys are as described in
+;; `debbugs-get-status', the corresponding value must be a regular
+;; expression to match for.  The other parameters are as described in
+;; `debbugs-gnu'.  Usually, there is just one value except for the
+;; attribute "date", which needs two arguments specifying a period in
+;; which the bug has been submitted or modified.
 
 ;; The bug reports are downloaded from the bug tracker.  In order to
 ;; not generate too much load of the server, up to 500 bugs will be
 
 ;; The bug reports are downloaded from the bug tracker.  In order to
 ;; not generate too much load of the server, up to 500 bugs will be
@@ -55,8 +73,8 @@
 ;; change this limit, but please don't increase this number too much.
 
 ;; These default values could be changed also by customer options
 ;; change this limit, but please don't increase this number too much.
 
 ;; These default values could be changed also by customer options
-;; `debbugs-gnu-default-severities', `debbugs-gnu-default-packages'
-;; and `debbugs-gnu-default-hits-per-page'.
+;; `debbugs-gnu-default-severities', `debbugs-gnu-default-packages',
+;; `debbugs-gnu-default-hits-per-page' and `debbugs-gnu-default-suppress-bugs'.
 
 ;; The command creates one or more pages of bug lists.  Every bug is
 ;; shown in one line, including the bug number, the status (combining
 
 ;; The command creates one or more pages of bug lists.  Every bug is
 ;; shown in one line, including the bug number, the status (combining
 
 ;; Furthermore, you could apply the global actions
 
 
 ;; Furthermore, you could apply the global actions
 
-;;   "s": Toggle bug sorting
 ;;   "g": Rescan bugs
 ;;   "g": Rescan bugs
-;;   "x": Suppress closed bugs
 ;;   "q": Quit the buffer
 ;;   "q": Quit the buffer
+;;   "s": Toggle bug sorting for age or for state
+;;   "x": Toggle suppressing of bugs
 
 ;; When you visit the related bug messages in Gnus, you could also
 ;; send control messages by keystroke "C".
 
 
 ;; When you visit the related bug messages in Gnus, you could also
 ;; send control messages by keystroke "C".
 
+;; In the header line of every bug list page, you can toggle sorting
+;; per column by selecting a column with the mouse.  The sorting
+;; happens as expected for the respective column; sorting in the Title
+;; column is depending on whether you are the owner of a bug.
+
 ;;; Code:
 
 (require 'debbugs)
 ;;; Code:
 
 (require 'debbugs)
   "*The list severities bugs are searched for.
 \"tagged\" is not a severity but marks locally tagged bugs."
   :group 'debbugs-gnu
   "*The list severities bugs are searched for.
 \"tagged\" is not a severity but marks locally tagged bugs."
   :group 'debbugs-gnu
-  :type '(set (const "important")
+  :type '(set (const "serious")
+             (const "important")
              (const "normal")
              (const "minor")
              (const "wishlist")
              (const "normal")
              (const "minor")
              (const "wishlist")
   :type 'integer
   :version "24.1")
 
   :type 'integer
   :version "24.1")
 
+(defcustom debbugs-gnu-default-suppress-bugs
+  '((pending . "done"))
+  "*A list of specs for bugs to be suppressed.
+An element of this list is a cons cell \(KEY . REGEXP\), with key
+being returned by `debbugs-get-status', and VAL a regular
+expression matching the corresponding value, a string.  Showing
+suppressed bugs is toggled by `debbugs-gnu-toggle-suppress'."
+  :group 'debbugs-gnu
+  :type '(alist :key-type symbol :value-type regexp)
+  :version "24.1")
+
 (defface debbugs-gnu-new '((t (:foreground "red")))
   "Face for new reports that nobody has answered.")
 
 (defface debbugs-gnu-handled '((t (:foreground "ForestGreen")))
   "Face for reports that have been modified recently.")
 
 (defface debbugs-gnu-new '((t (:foreground "red")))
   "Face for new reports that nobody has answered.")
 
 (defface debbugs-gnu-handled '((t (:foreground "ForestGreen")))
   "Face for reports that have been modified recently.")
 
+(defface debbugs-gnu-pending '((t (:foreground "MidnightBlue")))
+  "Face for reports that are pending.")
+
 (defface debbugs-gnu-stale '((t (:foreground "orange")))
   "Face for reports that have not been touched for a week.")
 
 (defface debbugs-gnu-stale '((t (:foreground "orange")))
   "Face for reports that have not been touched for a week.")
 
      (format "(setq debbugs-gnu-local-tags '%S)"
             (sort (copy-sequence debbugs-gnu-local-tags) '<)))))
 
      (format "(setq debbugs-gnu-local-tags '%S)"
             (sort (copy-sequence debbugs-gnu-local-tags) '<)))))
 
-(defvar debbugs-gnu-current-severities nil
-  "The severities strings to be searched for.")
-
-(defvar debbugs-gnu-current-packages nil
-  "The package names to be searched for.")
-
-(defvar debbugs-gnu-current-archive nil
-  "Whether to search in the archive.")
+(defvar debbugs-gnu-current-query nil
+  "The query object of the current search.
+It will be applied server-side, when calling `debbugs-get-bugs'.
+It has the same format as `debbugs-gnu-default-suppress-bugs'.")
+
+(defvar debbugs-gnu-current-filter nil
+  "The filter object for the current search.
+It will be applied client-side, when parsing the results of
+`debbugs-get-status'.  It has a similar format as
+`debbugs-gnu-default-suppress-bugs'.  In case of keys representing
+a date, value is the cons cell \(BEFORE . AFTER\).")
+
+(defun debbugs-gnu-calendar-read (prompt acceptable &optional initial-contents)
+  "Return a string read from the minibuffer.
+Derived from `calendar-read'."
+  (let ((value (read-string prompt initial-contents)))
+    (while (not (funcall acceptable value))
+      (setq value (read-string prompt initial-contents)))
+    value))
+
+(defconst debbugs-gnu-phrase-prompt
+  (propertize
+   "Enter search phrase: "
+   'help-echo "\
+The search phrase 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 can also
+be empty, in this case only the following attributes are used for
+search."))
+
+;;;###autoload
+(defun debbugs-gnu-search ()
+  "Search for Emacs bugs interactively.
+Search arguments are requested interactively.  The \"search
+phrase\" is used for full text search in the bugs database.
+Further key-value pairs are requested until an empty key is
+returned.  If a key cannot be queried by a SOAP request, it is
+marked as \"client-side filter\"."
+  (interactive)
 
 
-(defun debbugs-gnu (severities &optional packages archivedp suppress-done)
+  (unwind-protect
+      (let ((date-format "\\([[:digit:]]\\{4\\}\\)-\\([[:digit:]]\\{1,2\\}\\)-\\([[:digit:]]\\{1,2\\}\\)")
+           key val1 val2 phrase severities packages archivedp)
+
+       ;; Check for the phrase.
+       (setq phrase (read-string debbugs-gnu-phrase-prompt))
+       (if (zerop (length phrase))
+           (setq phrase nil)
+         (add-to-list 'debbugs-gnu-current-query (cons 'phrase phrase)))
+
+       ;; The other queries.
+       (catch :finished
+         (while t
+           (setq key (completing-read
+                      "Enter attribute: "
+                      (if phrase
+                          '("severity" "package" "tags" "submitter" "date"
+                            "subject" "status")
+                        '("severity" "package" "archive" "src" "tag"
+                          "owner" "submitter" "maint" "correspondent"
+                          "date" "log_modified" "last_modified"
+                          "found_date" "fixed_date" "unarchived"
+                          "subject" "done" "forwarded" "msgid" "summary"))
+                      nil t))
+           (cond
+            ;; Server-side queries.
+            ((equal key "severity")
+             (setq
+              severities
+              (completing-read-multiple
+               "Enter severities: "
+               (mapcar
+                'cadr (cdr (get 'debbugs-gnu-default-severities 'custom-type)))
+               nil t
+               (mapconcat 'identity debbugs-gnu-default-severities ","))))
+
+            ((equal key "package")
+             (setq
+              packages
+              (completing-read-multiple
+               "Enter packages: "
+               (mapcar
+                'cadr (cdr (get 'debbugs-gnu-default-packages 'custom-type)))
+               nil t (mapconcat 'identity debbugs-gnu-default-packages ","))))
+
+            ((equal key "archive")
+             ;; We simplify, by assuming just archived bugs are requested.
+             (setq archivedp t))
+
+            ((member key '("src" "tag" "tags"))
+             (setq val1 (read-string (format "Enter %s: " key)))
+             (when (not (zerop (length val1)))
+               (add-to-list
+                'debbugs-gnu-current-query (cons (intern key) val1))))
+
+            ((member key '("owner" "submitter" "maint" "correspondent"))
+             (setq val1 (read-string "Enter email address: "))
+             (when (not (zerop (length val1)))
+               (add-to-list
+                'debbugs-gnu-current-query (cons (intern key) val1))))
+
+            ((equal key "status")
+             (setq
+              val1
+              (completing-read "Enter status: " '("done" "forwarded" "open")))
+             (when (not (zerop (length val1)))
+           (add-to-list
+            'debbugs-gnu-current-query (cons (intern key) val1))))
+
+            ;; Client-side filters.
+            ((member key '("date" "log_modified" "last_modified"
+                           "found_date" "fixed_date" "unarchived"))
+             (setq val1
+                   (debbugs-gnu-calendar-read
+                    (format "Enter %s before YYYY-MM-DD%s: "
+                            key (if phrase "" " (client-side filter)"))
+                    (lambda (x)
+                      (string-match (concat "^\\(" date-format "\\|\\)$") x))))
+             (if (string-match date-format val1)
+                 (setq val1 (floor
+                             (float-time
+                              (encode-time
+                               0 0 0
+                               (string-to-number (match-string 3 val1))
+                               (string-to-number (match-string 2 val1))
+                               (string-to-number (match-string 1 val1))))))
+               (setq val1 nil))
+             (setq val2
+                   (debbugs-gnu-calendar-read
+                    (format "Enter %s after YYYY-MM-DD%s: "
+                            key (if phrase "" " (client-side filter)"))
+                    (lambda (x)
+                      (string-match (concat "^\\(" date-format "\\|\\)$") x))))
+             (if (string-match date-format val2)
+                 (setq val2 (floor
+                             (float-time
+                              (encode-time
+                               0 0 0
+                               (string-to-number (match-string 3 val2))
+                               (string-to-number (match-string 2 val2))
+                               (string-to-number (match-string 1 val2))))))
+               (setq val2 nil))
+             (when (or val1 val2)
+               (add-to-list
+                (if phrase
+                    'debbugs-gnu-current-query 'debbugs-gnu-current-filter)
+                (cons (intern key) (cons val1 val2)))))
+
+            ((not (zerop (length key)))
+             (setq val1
+                   (funcall
+                    (if phrase 'read-string 'read-regexp)
+                    (format "Enter %s%s"
+                            key (if phrase ": " " (client-side filter)"))))
+             (when (not (zerop (length val1)))
+               (add-to-list
+                (if phrase
+                    'debbugs-gnu-current-query 'debbugs-gnu-current-filter)
+                (cons (intern key) val1))))
+
+            ;; The End.
+            (t (throw :finished nil)))))
+
+       ;; Do the search.
+       (debbugs-gnu severities packages archivedp))
+
+    ;; Reset query and filter.
+    (setq debbugs-gnu-current-query nil
+         debbugs-gnu-current-filter nil)))
+
+;;;###autoload
+(defun debbugs-gnu (severities &optional packages archivedp suppress)
   "List all outstanding Emacs bugs."
   (interactive
    (let (archivedp)
      (list
       (completing-read-multiple
   "List all outstanding Emacs bugs."
   (interactive
    (let (archivedp)
      (list
       (completing-read-multiple
-       "Severity: "
+       "Severities: "
        (mapcar 'cadr (cdr (get 'debbugs-gnu-default-severities 'custom-type)))
        nil t (mapconcat 'identity debbugs-gnu-default-severities ","))
       ;; The optional parameters are asked only when there is a prefix.
        (mapcar 'cadr (cdr (get 'debbugs-gnu-default-severities 'custom-type)))
        nil t (mapconcat 'identity debbugs-gnu-default-severities ","))
       ;; The optional parameters are asked only when there is a prefix.
       (when current-prefix-arg
        (setq archivedp (y-or-n-p "Show archived bugs?")))
       (when (and current-prefix-arg (not archivedp))
       (when current-prefix-arg
        (setq archivedp (y-or-n-p "Show archived bugs?")))
       (when (and current-prefix-arg (not archivedp))
-       (y-or-n-p "Suppress closed bugs?")))))
+       (y-or-n-p "Suppress unwanted bugs?")))))
 
   ;; Initialize variables.
   (when (and (file-exists-p debbugs-gnu-persistency-file)
 
   ;; Initialize variables.
   (when (and (file-exists-p debbugs-gnu-persistency-file)
     (with-temp-buffer
       (insert-file-contents debbugs-gnu-persistency-file)
       (eval (read (current-buffer)))))
     (with-temp-buffer
       (insert-file-contents debbugs-gnu-persistency-file)
       (eval (read (current-buffer)))))
-  ;; Set lists.
-  (unless (consp severities)
-    (setq severities (list severities)))
-  (unless (consp packages)
-    (setq packages (list packages)))
-
-  (setq debbugs-gnu-current-severities severities
-       debbugs-gnu-current-packages packages
-       debbugs-gnu-current-archive (if archivedp "1" "0")
-       debbugs-gnu-widgets nil)
-
-  (let ((hits debbugs-gnu-default-hits-per-page)
-       (ids (debbugs-gnu-get-bugs)))
-
-    (if (> (length ids) hits)
-       (let ((cursor-in-echo-area nil))
-         (setq hits
-               (string-to-number
-                (read-string
-                 (format
-                  "How many reports (available %d, default %d): "
-                  (length ids) hits)
-                 nil
-                 nil
-                 (number-to-string hits))))))
-
-    (if (> (length ids) hits)
-       (let ((i 0)
-             curr-ids)
-         (while ids
-           (setq i (1+ i)
-                 curr-ids (butlast ids (- (length ids) hits)))
-           (add-to-list
-            'debbugs-gnu-widgets
-            (widget-convert
-             'push-button
-             :follow-link 'mouse-face
-             :notify (lambda (widget &rest ignore)
-                       (debbugs-gnu-show-reports widget))
-             :keymap debbugs-gnu-widget-map
-             :suppress-done suppress-done
-             :buffer-name (format "*Emacs Bugs*<%d>" i)
-             :bug-ids curr-ids
-             :help-echo (format "%d-%d" (car ids) (car (last curr-ids)))
-             :format " %[%v%]"
-             (number-to-string i))
-            'append)
-           (setq ids (last ids (- (length ids) hits))))
-         (debbugs-gnu-show-reports (car debbugs-gnu-widgets)))
-
-      (debbugs-gnu-show-reports
-       (widget-convert
-       'const
-       :suppress-done suppress-done
-       :buffer-name "*Emacs Bugs*"
-       :bug-ids ids)))))
-
-(defun debbugs-gnu-get-bugs ()
+  (setq debbugs-gnu-widgets nil)
+
+  ;; Add queries.
+  (dolist (severity (if (consp severities) severities (list severities)))
+    (when (not (zerop (length severity)))
+      (add-to-list 'debbugs-gnu-current-query (cons 'severity severity))))
+  (dolist (package (if (consp packages) packages (list packages)))
+    (when (not (zerop (length package)))
+      (add-to-list 'debbugs-gnu-current-query (cons 'package package))))
+  (when archivedp
+    (add-to-list 'debbugs-gnu-current-query '(archive . "1")))
+
+  (unwind-protect
+      (let ((hits debbugs-gnu-default-hits-per-page)
+           (ids (debbugs-gnu-get-bugs debbugs-gnu-current-query)))
+
+       (if (> (length ids) hits)
+           (let ((cursor-in-echo-area nil))
+             (setq hits
+                   (string-to-number
+                    (read-string
+                     (format
+                      "How many reports (available %d, default %d): "
+                      (length ids) hits)
+                     nil
+                     nil
+                     (number-to-string hits))))))
+
+       (if (> (length ids) hits)
+           (let ((i 0)
+                 curr-ids)
+             (while ids
+               (setq i (1+ i)
+                     curr-ids (butlast ids (- (length ids) hits)))
+               (add-to-list
+                'debbugs-gnu-widgets
+                (widget-convert
+                 'push-button
+                 :follow-link 'mouse-face
+                 :notify (lambda (widget &rest ignore)
+                           (debbugs-gnu-show-reports widget))
+                 :keymap debbugs-gnu-widget-map
+                 :suppress suppress
+                 :buffer-name (format "*Emacs Bugs*<%d>" i)
+                 :bug-ids curr-ids
+                 :query debbugs-gnu-current-query
+                 :filter debbugs-gnu-current-filter
+                 :help-echo (format "%d-%d" (car ids) (car (last curr-ids)))
+                 :format " %[%v%]"
+                 (number-to-string i))
+                'append)
+               (setq ids (last ids (- (length ids) hits))))
+             (debbugs-gnu-show-reports (car debbugs-gnu-widgets)))
+
+         (debbugs-gnu-show-reports
+          (widget-convert
+           'const
+           :suppress suppress
+           :buffer-name "*Emacs Bugs*"
+           :bug-ids ids
+           :query debbugs-gnu-current-query
+           :filter debbugs-gnu-current-filter))))
+
+    ;; Reset query and filter.
+    (setq debbugs-gnu-current-query nil
+         debbugs-gnu-current-filter nil)))
+
+(defun debbugs-gnu-get-bugs (query)
   "Retrieve bugs numbers from debbugs.gnu.org according search criteria."
   (let ((debbugs-port "gnu.org")
   "Retrieve bugs numbers from debbugs.gnu.org according search criteria."
   (let ((debbugs-port "gnu.org")
-       ids)
-    (dolist (severity debbugs-gnu-current-severities ids)
-      (if (string-equal severity "tagged")
-         (setq ids (nconc ids (copy-sequence debbugs-gnu-local-tags)))
-       (dolist (package debbugs-gnu-current-packages)
-         (setq ids
-               (nconc ids
-                      (debbugs-get-bugs
-                       :package package
-                       :severity severity
-                       :archive debbugs-gnu-current-archive))))))))
+       (tagged (when (member '(severity . "tagged") query)
+                 (copy-sequence debbugs-gnu-local-tags)))
+       (phrase (assoc 'phrase query))
+       args)
+    ;; Compile query arguments.
+    (unless query
+      (dolist (elt debbugs-gnu-default-packages)
+       (setq args (append args (list :package elt)))))
+    (dolist (elt query)
+      (unless (equal elt '(severity . "tagged"))
+       (setq args
+             (append
+              args
+              (if phrase
+                  (cond
+                   ((eq (car elt) 'phrase)
+                    (list (list :phrase (cdr elt) :max 500)))
+                   ((eq (car elt) 'date)
+                    (list (list :date (cddr elt) (cadr elt)
+                                :operator "NUMBT")))
+                   (t
+                    (list (list (intern (concat ":" (symbol-name (car elt))))
+                                (cdr elt) :operator "ISTRINC"))))
+                (list (intern (concat ":" (symbol-name (car elt))))
+                      (cdr elt)))))))
+
+    (cond
+     ;; If the query contains only the pseudo-severity "tagged", we
+     ;; return just the local tagged bugs.
+     ((and tagged (not (memq :severity args)))
+      (sort tagged '<))
+     ;; A full text query.
+     (phrase
+      (append
+       (mapcar
+       (lambda (x) (cdr (assoc "id" x)))
+       (apply 'debbugs-search-est args))
+       tagged))
+     ;; Otherwise, we retrieve the bugs from the server.
+     (t (sort (append (apply 'debbugs-get-bugs args) tagged) '<)))))
 
 (defvar debbugs-gnu-current-widget nil)
 
 
 (defvar debbugs-gnu-current-widget nil)
 
   (debbugs-gnu-mode)
   (let ((inhibit-read-only t)
        (debbugs-port "gnu.org"))
   (debbugs-gnu-mode)
   (let ((inhibit-read-only t)
        (debbugs-port "gnu.org"))
-
+    (erase-buffer)
     (set (make-local-variable 'debbugs-gnu-current-widget)
         widget)
 
     (set (make-local-variable 'debbugs-gnu-current-widget)
         widget)
 
        (unless (equal (cdr (assq 'pending status)) "pending")
          (setq words
                (concat words "," (cdr (assq 'pending status)))))
        (unless (equal (cdr (assq 'pending status)) "pending")
          (setq words
                (concat words "," (cdr (assq 'pending status)))))
+       (let ((packages (delete "emacs" (cdr (assq 'package status)))))
+         (when packages
+           (setq words (concat words "," (mapconcat 'identity packages ",")))))
        (when (setq merged (cdr (assq 'mergedwith status)))
          (setq words (format "%s,%s"
                              (if (numberp merged)
                                  merged
                                (mapconcat 'number-to-string merged ","))
                              words)))
        (when (setq merged (cdr (assq 'mergedwith status)))
          (setq words (format "%s,%s"
                              (if (numberp merged)
                                  merged
                                (mapconcat 'number-to-string merged ","))
                              words)))
-       (add-to-list
-        'tabulated-list-entries
-        (list
-         status
-         (vector
-          (propertize
-           (format "%5d" id)
-           'face
-           ;; Mark tagged bugs.
-           (if (memq id debbugs-gnu-local-tags)
-               'debbugs-gnu-tagged
-             'default))
-          (propertize
-           ;; Mark status and age.
-           words
-           'face
-           (cond
-            ((equal (cdr (assq 'pending status)) "done")
-             'debbugs-gnu-done)
-            ((= (cdr (assq 'date status))
-                (cdr (assq 'log_modified status)))
-             'debbugs-gnu-new)
-            ((< (- (float-time)
-                   (cdr (assq 'log_modified status)))
-                (* 60 60 24 7))
-             'debbugs-gnu-handled)
-            (t
-             'debbugs-gnu-stale)))
-          (propertize
-           ;; Prefer the name over the address.
-           (or (cdr address)
-               (car address))
-           'face
-           ;; Mark own submitted bugs.
-           (if (and (stringp (car address))
-                    (string-equal (car address) user-mail-address))
-               'debbugs-gnu-tagged
-             'default))
-          (propertize
-           subject
-           'face
-           ;; Mark owned bugs.
-           (if (and (stringp owner)
-                    (string-equal owner user-mail-address))
-               'debbugs-gnu-tagged
-             'default))))
-        'append)))
+       (when (or (not merged)
+                 (not (let ((found nil))
+                        (dolist (id (if (listp merged)
+                                        merged
+                                      (list merged)))
+                          (dolist (entry tabulated-list-entries)
+                            (when (equal id (cdr (assq 'id (car entry))))
+                              (setq found t))))
+                        found)))
+         (add-to-list
+          'tabulated-list-entries
+          (list
+           status
+           (vector
+            (propertize
+             (format "%5d" id)
+             'face
+             ;; Mark tagged bugs.
+             (if (memq id debbugs-gnu-local-tags)
+                 'debbugs-gnu-tagged
+               'default))
+            (propertize
+             ;; Mark status and age.
+             words
+             'face
+             (cond
+              ((equal (cdr (assq 'pending status)) "done")
+               'debbugs-gnu-done)
+              ((member "pending" (cdr (assq 'keywords status)))
+               'debbugs-gnu-pending)
+              ((= (cdr (assq 'date status))
+                  (cdr (assq 'log_modified status)))
+               'debbugs-gnu-new)
+              ((< (- (float-time)
+                     (cdr (assq 'log_modified status)))
+                  (* 60 60 24 7 2))
+               'debbugs-gnu-handled)
+              (t
+               'debbugs-gnu-stale)))
+            (propertize
+             ;; Prefer the name over the address.
+             (or (cdr address)
+                 (car address))
+             'face
+             ;; Mark own submitted bugs.
+             (if (and (stringp (car address))
+                      (string-equal (car address) user-mail-address))
+                 'debbugs-gnu-tagged
+               'default))
+            (propertize
+             subject
+             'face
+             ;; Mark owned bugs.
+             (if (and (stringp owner)
+                      (string-equal owner user-mail-address))
+                 'debbugs-gnu-tagged
+               'default))))
+          'append))))
+    (tabulated-list-init-header)
     (tabulated-list-print)
 
     (set-buffer-modified-p nil)
     (tabulated-list-print)
 
     (set-buffer-modified-p nil)
 Used instead of `tabulated-list-print-entry'."
   ;; This shall be in `debbugs-gnu-show-reports'.  But
   ;; `tabulated-list-print' erases the buffer, therefore we do it
 Used instead of `tabulated-list-print-entry'."
   ;; This shall be in `debbugs-gnu-show-reports'.  But
   ;; `tabulated-list-print' erases the buffer, therefore we do it
-  ;; here.
+  ;; here.  (bug#9047)
   (when (and debbugs-gnu-widgets (= (point) (point-min)))
     (widget-insert "Page:")
     (mapc
   (when (and debbugs-gnu-widgets (= (point) (point-min)))
     (widget-insert "Page:")
     (mapc
@@ -386,18 +640,43 @@ Used instead of `tabulated-list-print-entry'."
       (mapc (lambda (obj) (widget-apply obj :create)) debbugs-gnu-widgets)
       (widget-setup)))
 
       (mapc (lambda (obj) (widget-apply obj :create)) debbugs-gnu-widgets)
       (widget-setup)))
 
-  (when (or (not (widget-get debbugs-gnu-current-widget :suppress-done))
-           (not (equal (cdr (assq 'pending list-id)) "done")))
-    (let ((beg (point))
-         (pos 0)
-         (id               (aref cols 0))
-         (id-length        (nth 1 (aref tabulated-list-format 0)))
-         (state            (aref cols 1))
-         (state-length     (nth 1 (aref tabulated-list-format 1)))
-         (submitter        (aref cols 2))
-         (submitter-length (nth 1 (aref tabulated-list-format 2)))
-         (title            (aref cols 3))
-         (title-length     (nth 1 (aref tabulated-list-format 3))))
+  (let ((beg (point))
+       (pos 0)
+       (case-fold-search t)
+       (id               (aref cols 0))
+       (id-length        (nth 1 (aref tabulated-list-format 0)))
+       (state            (aref cols 1))
+       (state-length     (nth 1 (aref tabulated-list-format 1)))
+       (submitter        (aref cols 2))
+       (submitter-length (nth 1 (aref tabulated-list-format 2)))
+       (title            (aref cols 3))
+       (title-length     (nth 1 (aref tabulated-list-format 3))))
+    (when (and
+          ;; Filter suppressed bugs.
+          (or (not (widget-get debbugs-gnu-current-widget :suppress))
+              (not (catch :suppress
+                     (dolist (check debbugs-gnu-default-suppress-bugs)
+                       (when
+                           (string-match
+                            (cdr check)
+                            (or (cdr (assq (car check) list-id)) ""))
+                         (throw :suppress t))))))
+          ;; Filter search list.
+          (not (catch :suppress
+                 (dolist (check
+                          (widget-get debbugs-gnu-current-widget :filter))
+                   (let ((val (cdr (assq (car check) list-id))))
+                     (if (stringp (cdr check))
+                         ;; Regular expression.
+                         (when (not (string-match (cdr check) (or val "")))
+                           (throw :suppress t))
+                       ;; Time value.
+                       (when (or (and (numberp (cadr check))
+                                      (< (cadr check) val))
+                                 (and (numberp (cddr check))
+                                      (> (cddr check) val)))
+                         (throw :suppress t))))))))
+
       ;; Insert id.
       (indent-to (- id-length (length id)))
       (insert id)
       ;; Insert id.
       (indent-to (- id-length (length id)))
       (insert id)
@@ -418,6 +697,7 @@ Used instead of `tabulated-list-print-entry'."
       ;; Insert title.
       (indent-to (setq pos (+ pos submitter-length 1)) 1)
       (insert (propertize title 'help-echo title))
       ;; Insert title.
       (indent-to (setq pos (+ pos submitter-length 1)) 1)
       (insert (propertize title 'help-echo title))
+      ;; Add properties.
       (add-text-properties
        beg (point) `(tabulated-list-id ,list-id mouse-face ,widget-mouse-face))
       (insert ?\n))))
       (add-text-properties
        beg (point) `(tabulated-list-id ,list-id mouse-face ,widget-mouse-face))
       (insert ?\n))))
@@ -428,12 +708,11 @@ Used instead of `tabulated-list-print-entry'."
     (define-key map "\r" 'debbugs-gnu-select-report)
     (define-key map [mouse-1] 'debbugs-gnu-select-report)
     (define-key map [mouse-2] 'debbugs-gnu-select-report)
     (define-key map "\r" 'debbugs-gnu-select-report)
     (define-key map [mouse-1] 'debbugs-gnu-select-report)
     (define-key map [mouse-2] 'debbugs-gnu-select-report)
-    (define-key map "q" 'bury-buffer)
     (define-key map "s" 'debbugs-gnu-toggle-sort)
     (define-key map "t" 'debbugs-gnu-toggle-tag)
     (define-key map "d" 'debbugs-gnu-display-status)
     (define-key map "g" 'debbugs-gnu-rescan)
     (define-key map "s" 'debbugs-gnu-toggle-sort)
     (define-key map "t" 'debbugs-gnu-toggle-tag)
     (define-key map "d" 'debbugs-gnu-display-status)
     (define-key map "g" 'debbugs-gnu-rescan)
-    (define-key map "x" 'debbugs-gnu-toggle-suppress-done)
+    (define-key map "x" 'debbugs-gnu-toggle-suppress)
     (define-key map "C" 'debbugs-gnu-send-control-message)
     map))
 
     (define-key map "C" 'debbugs-gnu-send-control-message)
     map))
 
@@ -448,7 +727,8 @@ Used instead of `tabulated-list-print-entry'."
     (let ((first-id (car (widget-get debbugs-gnu-current-widget :bug-ids)))
          (last-id  (car
                     (last (widget-get debbugs-gnu-current-widget :bug-ids))))
     (let ((first-id (car (widget-get debbugs-gnu-current-widget :bug-ids)))
          (last-id  (car
                     (last (widget-get debbugs-gnu-current-widget :bug-ids))))
-         (ids (debbugs-gnu-get-bugs)))
+         (ids (debbugs-gnu-get-bugs
+               (widget-get debbugs-gnu-current-widget :query))))
 
       (while (and (<= first-id last-id) (not (memq first-id ids)))
        (setq first-id (1+ first-id)))
 
       (while (and (<= first-id last-id) (not (memq first-id ids)))
        (setq first-id (1+ first-id)))
@@ -481,7 +761,6 @@ The following commands are available:
                               ("Title"     10 debbugs-gnu-sort-title)])
   (setq tabulated-list-sort-key (cons "Id" nil))
   (setq tabulated-list-printer 'debbugs-gnu-print-entry)
                               ("Title"     10 debbugs-gnu-sort-title)])
   (setq tabulated-list-sort-key (cons "Id" nil))
   (setq tabulated-list-printer 'debbugs-gnu-print-entry)
-  (tabulated-list-init-header)
   (buffer-disable-undo)
   (setq truncate-lines t)
   (setq buffer-read-only t))
   (buffer-disable-undo)
   (setq truncate-lines t)
   (setq buffer-read-only t))
@@ -490,33 +769,61 @@ The following commands are available:
   (< (cdr (assq 'id (car s1)))
      (cdr (assq 'id (car s2)))))
 
   (< (cdr (assq 'id (car s1)))
      (cdr (assq 'id (car s2)))))
 
-(defvar debbugs-gnu-state-preference
+(defconst debbugs-gnu-state-preference
   '((debbugs-gnu-new . 1)
     (debbugs-gnu-stale . 2)
     (debbugs-gnu-handled . 3)
   '((debbugs-gnu-new . 1)
     (debbugs-gnu-stale . 2)
     (debbugs-gnu-handled . 3)
-    (debbugs-gnu-done . 4)))
+    (debbugs-gnu-done . 4)
+    (debbugs-gnu-pending . 5)))
+
+(defun debbugs-gnu-get-state-preference (face-string)
+  (or (cdr (assq (get-text-property 0 'face face-string)
+                debbugs-gnu-state-preference))
+      10))
+
+(defconst debbugs-gnu-severity-preference
+  '(("serious" . 1)
+    ("important" . 2)
+    ("normal" . 3)
+    ("minor" . 4)
+    ("wishlist" . 5)))
+
+(defun debbugs-gnu-get-severity-preference (state)
+  (or (cdr (assoc (cdr (assq 'severity state))
+                 debbugs-gnu-severity-preference))
+      10))
 
 (defun debbugs-gnu-sort-state (s1 s2)
   (let ((id1 (cdr (assq 'id (car s1))))
 
 (defun debbugs-gnu-sort-state (s1 s2)
   (let ((id1 (cdr (assq 'id (car s1))))
-       (st1 (aref (nth 1 s1) 1))
+       (age1 (debbugs-gnu-get-state-preference (aref (nth 1 s1) 1)))
        (id2 (cdr (assq 'id (car s2))))
        (id2 (cdr (assq 'id (car s2))))
-       (st2 (aref (nth 1 s2) 1)))
-    (< (or (and (memq id1 debbugs-gnu-local-tags) 0)
-          (cdr (assq (get-text-property 0 'face st1)
-                     debbugs-gnu-state-preference))
-          10)
-       (or (and (memq id2 debbugs-gnu-local-tags) 0)
-          (cdr (assq (get-text-property 0 'face st2)
-                     debbugs-gnu-state-preference))
-          10))))
+       (age2 (debbugs-gnu-get-state-preference (aref (nth 1 s2) 1))))
+    (cond
+     ;; Tagged bugs go to the end.
+     ((and (not (memq id1 debbugs-gnu-local-tags))
+          (memq id2 debbugs-gnu-local-tags))
+      t)
+     ((and (memq id1 debbugs-gnu-local-tags)
+          (not (memq id2 debbugs-gnu-local-tags)))
+      nil)
+     ;; Then, we check the age of the bugs.
+     ((< age1 age2)
+      t)
+     ((> age1 age2)
+      nil)
+     ;; If they have the same age, we check for severity.
+     ((< (debbugs-gnu-get-severity-preference (car s1))
+        (debbugs-gnu-get-severity-preference (car s2)))
+      t)
+     (t nil))))
 
 (defun debbugs-gnu-sort-title (s1 s2)
 
 (defun debbugs-gnu-sort-title (s1 s2)
-  (let ((owner1 (cdr (assq 'owner (car s1))))
-       (owner2 (cdr (assq 'owner (car s2)))))
-    (and (stringp owner1)
-        (string-equal owner1 user-mail-address)
-        (or (not (stringp owner2))
-            (not (string-equal owner1 user-mail-address))))))
+  (let ((owner (if (cdr (assq 'owner (car s1)))
+                  (car (mail-header-parse-address
+                        (decode-coding-string (cdr (assq 'owner (car s1)))
+                                              'utf-8))))))
+    (and (stringp owner)
+        (string-equal owner user-mail-address))))
 
 (defun debbugs-gnu-toggle-sort ()
   "Toggle sorting by age and by state."
 
 (defun debbugs-gnu-toggle-sort ()
   "Toggle sorting by age and by state."
@@ -547,15 +854,16 @@ The following commands are available:
         'face 'debbugs-gnu-tagged))))
   (debbugs-gnu-dump-persistency-file))
 
         'face 'debbugs-gnu-tagged))))
   (debbugs-gnu-dump-persistency-file))
 
-(defun debbugs-gnu-toggle-suppress-done ()
-  "Suppress bugs marked as done."
+(defun debbugs-gnu-toggle-suppress ()
+  "Suppress bugs marked in `debbugs-gnu-suppress-bugs'."
   (interactive)
   (interactive)
-  (widget-put debbugs-gnu-current-widget :suppress-done
-             (not (widget-get debbugs-gnu-current-widget :suppress-done)))
+  (widget-put debbugs-gnu-current-widget :suppress
+             (not (widget-get debbugs-gnu-current-widget :suppress)))
   (tabulated-list-init-header)
   (tabulated-list-print))
 
 (defvar debbugs-gnu-bug-number nil)
   (tabulated-list-init-header)
   (tabulated-list-print))
 
 (defvar debbugs-gnu-bug-number nil)
+(defvar debbugs-gnu-subject nil)
 
 (defun debbugs-gnu-current-id (&optional noerror)
   (or (cdr (assq 'id (debbugs-gnu-current-status)))
 
 (defun debbugs-gnu-current-id (&optional noerror)
   (or (cdr (assq 'id (debbugs-gnu-current-status)))
@@ -587,8 +895,10 @@ The following commands are available:
      (cons (current-buffer)
           (current-window-configuration)))
     (with-current-buffer (window-buffer (selected-window))
      (cons (current-buffer)
           (current-window-configuration)))
     (with-current-buffer (window-buffer (selected-window))
-      (debbugs-gnu-summary-mode 1)
-      (set (make-local-variable 'debbugs-gnu-bug-number) id))))
+      (set (make-local-variable 'debbugs-gnu-bug-number) id)
+      (set (make-local-variable 'debbugs-gnu-subject)
+          (format "Re: bug#%d: %s" id (cdr (assq 'subject status))))
+      (debbugs-gnu-summary-mode 1))))
 
 (defvar debbugs-gnu-summary-mode-map
   (let ((map (make-sparse-keymap)))
 
 (defvar debbugs-gnu-summary-mode-map
   (let ((map (make-sparse-keymap)))
@@ -603,21 +913,37 @@ The following commands are available:
 \\{debbugs-gnu-summary-mode-map}"
   :lighter " Debbugs" :keymap debbugs-gnu-summary-mode-map
   (set (make-local-variable 'gnus-posting-styles)
 \\{debbugs-gnu-summary-mode-map}"
   :lighter " Debbugs" :keymap debbugs-gnu-summary-mode-map
   (set (make-local-variable 'gnus-posting-styles)
-       '((".*"
+       `((".*"
          (eval
          (eval
-          (with-current-buffer gnus-article-copy
-            (set (make-local-variable 'message-prune-recipient-rules)
-                 '((".*@debbugs.*" "emacs-pretest-bug")
-                   (".*@debbugs.*" "bug-gnu-emacs")
-                   ("[0-9]+@debbugs.*" "submit@debbugs.gnu.org")
-                   ("[0-9]+@debbugs.*" "quiet@debbugs.gnu.org")))
-            (set (make-local-variable 'message-alter-recipients-function)
-                 (lambda (address)
-                   (if (string-match "\\([0-9]+\\)@donarmstrong" (car address))
-                       (let ((new (format "%s@debbugs.gnu.org"
-                                          (match-string 1 (car address)))))
-                         (cons new new))
-                     address)))))))))
+          (when (buffer-live-p gnus-article-copy)
+            (with-current-buffer gnus-article-copy
+              (set (make-local-variable 'message-prune-recipient-rules)
+                   '((".*@debbugs.*" "emacs-pretest-bug")
+                     (".*@debbugs.*" "bug-gnu-emacs")
+                     ("[0-9]+@debbugs.*" "submit@debbugs.gnu.org")
+                     ("[0-9]+@debbugs.*" "quiet@debbugs.gnu.org")))
+              (set (make-local-variable 'message-alter-recipients-function)
+                   (lambda (address)
+                     (if (string-match "\\([0-9]+\\)@donarmstrong"
+                                       (car address))
+                         (let ((new (format "%s@debbugs.gnu.org"
+                                            (match-string 1 (car address)))))
+                           (cons new new))
+                       address)))
+              ;; `gnus-posting-styles' is eval'ed after
+              ;; `message-simplify-subject'.  So we cannot use m-s-s.
+              (setq subject ,debbugs-gnu-subject))))))))
+
+(defun debbugs-gnu-guess-current-id ()
+  "Guess the ID based on \"#23\"."
+  (save-excursion
+    (beginning-of-line)
+    (and
+     (or (re-search-forward "#\\([0-9]+\\)" (line-end-position) t)
+        (progn
+          (goto-char (point-min))
+          (re-search-forward "#\\([0-9]+\\)" nil t)))
+     (string-to-number (match-string 1)))))
 
 (defun debbugs-gnu-send-control-message (message &optional reverse)
   "Send a control message for the current bug report.
 
 (defun debbugs-gnu-send-control-message (message &optional reverse)
   "Send a control message for the current bug report.
@@ -630,15 +956,19 @@ removed instead."
   (interactive
    (list (completing-read
          "Control message: "
   (interactive
    (list (completing-read
          "Control message: "
-         '("important" "normal" "minor" "wishlist"
+         '("serious" "important" "normal" "minor" "wishlist"
            "done" "donenotabug" "donewontfix" "doneunreproducible"
            "unarchive" "reopen" "close"
            "merge" "forcemerge"
            "owner" "noowner"
            "done" "donenotabug" "donewontfix" "doneunreproducible"
            "unarchive" "reopen" "close"
            "merge" "forcemerge"
            "owner" "noowner"
-           "patch" "wontfix" "moreinfo" "unreproducible" "fixed" "notabug")
+           "invalid"
+           "reassign"
+           "patch" "wontfix" "moreinfo" "unreproducible" "fixed" "notabug"
+           "pending" "help" "security" "confirmed")
          nil t)
         current-prefix-arg))
   (let* ((id (or debbugs-gnu-bug-number        ; Set on group entry.
          nil t)
         current-prefix-arg))
   (let* ((id (or debbugs-gnu-bug-number        ; Set on group entry.
+                (debbugs-gnu-guess-current-id)
                 (debbugs-gnu-current-id)))
         (version
          (when (member message '("close" "done"))
                 (debbugs-gnu-current-id)))
         (version
          (when (member message '("close" "done"))
@@ -671,6 +1001,8 @@ removed instead."
                        (read-string "Merge with bug #: ")))
               ((equal message "owner")
                (format "owner %d !\n" id))
                        (read-string "Merge with bug #: ")))
               ((equal message "owner")
                (format "owner %d !\n" id))
+              ((equal message "reassign")
+               (format "reassign %d %s\n" id (read-string "Package: ")))
               ((equal message "close")
                (format "close %d %s\n" id version))
               ((equal message "done")
               ((equal message "close")
                (format "close %d %s\n" id version))
               ((equal message "done")
@@ -678,8 +1010,12 @@ removed instead."
               ((member message '("donenotabug" "donewontfix"
                                  "doneunreproducible"))
                (format "tags %d %s\nclose %d\n" id (substring message 4) id))
               ((member message '("donenotabug" "donewontfix"
                                  "doneunreproducible"))
                (format "tags %d %s\nclose %d\n" id (substring message 4) id))
-              ((member message '("important" "normal" "minor" "wishlist"))
+              ((member message '("serious" "important" "normal"
+                                 "minor" "wishlist"))
                (format "severity %d %s\n" id message))
                (format "severity %d %s\n" id message))
+              ((equal message "invalid")
+               (format "tags %d notabug\ntags %d wontfix\nclose %d\n"
+                       id id id))
               (t
                (format "tags %d%s %s\n"
                        id (if reverse " -" "")
               (t
                (format "tags %d%s %s\n"
                        id (if reverse " -" "")
@@ -690,8 +1026,6 @@ removed instead."
 
 ;;; TODO:
 
 
 ;;; TODO:
 
-;; * Widget-oriented bug overview like webDDTs.
-;; * Actions on bugs.
-;; * Integration into gnus (nnir).
+;; * Reorganize pages after client-side filtering.
 
 ;;; debbugs-gnu.el ends here
 
 ;;; debbugs-gnu.el ends here