]> 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 d68ec17d928404ba6e3149d26c9beac59b2e0c75..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".  If no severity is given, all bugs are selected.
+;; 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.
 
 ;; There is also the pseudo severity "tagged", which selects locally
 ;; tagged bugs.
 
 ;; There is also the pseudo severity "tagged", which selects locally
 ;; tagged bugs.
 ;; the default), whether archived bugs shall be shown, and whether
 ;; closed bugs shall be shown.
 
 ;; 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
 ;; downloaded at once.  If there are more hits, you will be asked to
 ;; change this limit, but please don't increase this number too much.
 
 ;; These default values could be changed also by customer options
 ;; 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
 ;; downloaded at once.  If there are more hits, you will be asked to
 ;; 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
@@ -76,7 +92,7 @@
 ;;   "g": Rescan bugs
 ;;   "q": Quit the buffer
 ;;   "s": Toggle bug sorting for age or for state
 ;;   "g": Rescan bugs
 ;;   "q": Quit the buffer
 ;;   "s": Toggle bug sorting for age or for state
-;;   "x": Toggle suppressing of closed bugs
+;;   "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".
   "*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-new '((t (:foreground "red")))
   "Face for new reports that nobody has answered.")
 
   "Face for reports that have been modified recently.")
 
 (defface debbugs-gnu-pending '((t (:foreground "MidnightBlue")))
   "Face for reports that have been modified recently.")
 
 (defface debbugs-gnu-pending '((t (:foreground "MidnightBlue")))
-  "Face for reports that have been modified recently.")
+  "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")
-       args ids)
-    (dolist (severity debbugs-gnu-current-severities (sort ids '<))
-      (if (string-equal severity "tagged")
-         (setq ids (nconc ids (copy-sequence debbugs-gnu-local-tags)))
-       (dolist (package debbugs-gnu-current-packages)
-         (setq args `(:archive ,debbugs-gnu-current-archive))
-         (when (not (zerop (length severity)))
-           (setq args (append args `(:severity ,severity))))
-         (when (not (zerop (length package)))
-           (setq args (append args `(:package ,package))))
-         (setq ids (nconc ids (apply 'debbugs-get-bugs args))))))))
+       (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)
     (erase-buffer)
     (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)
-            ((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))
-             '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)
 
     (tabulated-list-init-header)
     (tabulated-list-print)
 
@@ -400,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)
@@ -443,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))
 
@@ -463,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)))
@@ -517,10 +782,11 @@ The following commands are available:
       10))
 
 (defconst debbugs-gnu-severity-preference
       10))
 
 (defconst debbugs-gnu-severity-preference
-  '(("important" . 1)
-    ("normal" . 2)
-    ("minor" . 3)
-    ("wishlist" . 4)))
+  '(("serious" . 1)
+    ("important" . 2)
+    ("normal" . 3)
+    ("minor" . 4)
+    ("wishlist" . 5)))
 
 (defun debbugs-gnu-get-severity-preference (state)
   (or (cdr (assoc (cdr (assq 'severity state))
 
 (defun debbugs-gnu-get-severity-preference (state)
   (or (cdr (assoc (cdr (assq 'severity state))
@@ -588,11 +854,11 @@ 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))
 
   (tabulated-list-init-header)
   (tabulated-list-print))
 
@@ -631,7 +897,7 @@ The following commands are available:
     (with-current-buffer (window-buffer (selected-window))
       (set (make-local-variable 'debbugs-gnu-bug-number) id)
       (set (make-local-variable 'debbugs-gnu-subject)
     (with-current-buffer (window-buffer (selected-window))
       (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))))
+          (format "Re: bug#%d: %s" id (cdr (assq 'subject status))))
       (debbugs-gnu-summary-mode 1))))
 
 (defvar debbugs-gnu-summary-mode-map
       (debbugs-gnu-summary-mode 1))))
 
 (defvar debbugs-gnu-summary-mode-map
@@ -649,22 +915,35 @@ The following commands are available:
   (set (make-local-variable 'gnus-posting-styles)
        `((".*"
          (eval
   (set (make-local-variable 'gnus-posting-styles)
        `((".*"
          (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)))
-            ;; `gnus-posting-styles' is eval'ed after
-            ;; `message-simplify-subject'.  So we cannot use m-s-s.
-            (setq subject ,debbugs-gnu-subject)))))))
+          (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.
@@ -677,16 +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"
+           "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.
            "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.
+                (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"))
@@ -719,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")
@@ -726,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 " -" "")
@@ -738,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