]> code.delx.au - gnu-emacs-elpa/blobdiff - packages/debbugs/debbugs-gnu.el
Fix bug face for newly arrived bugs in debbugs-gnu.el
[gnu-emacs-elpa] / packages / debbugs / debbugs-gnu.el
index 10a31cbb482ab6582c2c12cc2faa739edf70321b..dd1fe3346f28529534649ccb4abf68b5c868c6a2 100644 (file)
@@ -1,4 +1,4 @@
-;;; debbugs-gnu.el --- interface for the GNU bug tracker
+;;; debbugs-gnu.el --- interface for the GNU bug tracker  -*- lexical-binding:t -*-
 
 ;; Copyright (C) 2011-2016 Free Software Foundation, Inc.
 
 (require 'debbugs)
 (require 'tabulated-list)
 (require 'add-log)
-(require 'subr-x)
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'subr-x))
+(eval-when-compile (require 'cl-lib))
 
 (autoload 'article-decode-charset "gnus-art")
 (autoload 'diff-goto-source "diff-mode")
              (const "tagged"))
   :version "24.1")
 
+(defcustom debbugs-gnu-suppress-closed t
+  "If non-nil, don't show closed bugs."
+  :group 'debbugs-gnu
+  :type 'boolean
+  :version "25.2")
+
 (defconst debbugs-gnu-all-severities
   (mapcar 'cadr (cdr (get 'debbugs-gnu-default-severities 'custom-type)))
   "*List of all possible severities.")
@@ -362,7 +368,10 @@ marked as \"client-side filter\"."
            (setq phrase nil)
          (add-to-list 'debbugs-gnu-current-query (cons 'phrase phrase)))
        ;; We suppress closed bugs if there is no phrase.
-       (setq debbugs-gnu-current-suppress (null phrase))
+       (setq debbugs-gnu-current-suppress
+             (if (not debbugs-gnu-suppress-closed)
+                 nil
+               (null phrase)))
 
        ;; The other queries.
        (catch :finished
@@ -506,7 +515,8 @@ marked as \"client-side filter\"."
       (insert-file-contents debbugs-gnu-persistency-file)
       (eval (read (current-buffer)))))
   ;; Per default, we suppress retrieved unwanted bugs.
-  (when (called-interactively-p 'any)
+  (when (and (called-interactively-p 'any)
+            debbugs-gnu-suppress-closed)
     (setq debbugs-gnu-current-suppress t))
 
   ;; Add queries.
@@ -668,8 +678,11 @@ are taken from the cache instead."
                'debbugs-gnu-done)
               ((member "pending" (cdr (assq 'keywords status)))
                'debbugs-gnu-pending)
-              ((= (cdr (assq 'date status))
-                  (cdr (assq 'log_modified status)))
+              ;; For some new bugs `date' and `log_modified' may
+              ;; differ in 1 second.
+              ((< (abs (- (cdr (assq 'date status))
+                          (cdr (assq 'log_modified status))))
+                  3)
                'debbugs-gnu-new)
               ((< (- (float-time)
                      (cdr (assq 'log_modified status)))
@@ -717,7 +730,8 @@ Used instead of `tabulated-list-print-entry'."
        (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))))
+       ;; (title-length     (nth 1 (aref tabulated-list-format 3)))
+        )
     (when (and
           ;; We may have a narrowing in effect.
           (or (not debbugs-gnu-limit)
@@ -951,7 +965,7 @@ The following commands are available:
       t)
      (t nil))))
 
-(defun debbugs-gnu-sort-title (s1 s2)
+(defun debbugs-gnu-sort-title (s1 _s2)
   (let ((owner (if (cdr (assq 'owner (car s1)))
                   (car (mail-header-parse-address
                         (decode-coding-string (cdr (assq 'owner (car s1)))
@@ -1265,9 +1279,9 @@ removed instead."
            "usertag")
          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)))
+  (let* ((id (or (debbugs-gnu-current-id t)
+                debbugs-gnu-bug-number ; Set on group entry.
+                (debbugs-gnu-guess-current-id)))
         (version
          (when (member message '("close" "done"))
            (read-string