* packages/debbugs/debbugs-gnu.el (debbugs-gnu-default-packages): Add "hyperbole".

[gnu-emacs-elpa] / packages / debbugs / debbugs-gnu.el

diff --git a/packages/debbugs/debbugs-gnu.el b/packages/debbugs/debbugs-gnu.el
index fe0a7e580f41613f7c91020dbb66eeb7803266e1..ce694cbb6b1844326538a886d0c44bd7aa3d3724 100644 (file)
--- a/packages/debbugs/debbugs-gnu.el
+++ b/packages/debbugs/debbugs-gnu.el
@@ -205,6 +205,12 @@
              (const "tagged"))
   :version "24.1")
 
              (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.1")
+

 (defconst debbugs-gnu-all-severities
   (mapcar 'cadr (cdr (get 'debbugs-gnu-default-severities 'custom-type)))
   "*List of all possible severities.")
 (defconst debbugs-gnu-all-severities
   (mapcar 'cadr (cdr (get 'debbugs-gnu-default-severities 'custom-type)))
   "*List of all possible severities.")


@@ -230,6 +236,7 @@
              (const "guile")
              (const "guix")
              (const "gzip")
              (const "guile")
              (const "guix")
              (const "gzip")

+             (const "hyperbole")

              (const "idutils")
              (const "libtool")
              (const "mh-e")
              (const "idutils")
              (const "libtool")
              (const "mh-e")


@@ -336,12 +343,6 @@ 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."))
 
 be empty, in this case only the following attributes are used for
 search."))
 

-;;;###autoload
-(defun debbugs-gnu-patches ()
-  "List the bug reports that have been marked as containing a patch."
-  (interactive)
-  (debbugs-gnu nil '("emacs") nil nil "patch"))
-

 ;;;###autoload
 (defun debbugs-gnu-search ()
   "Search for Emacs bugs interactively.
 ;;;###autoload
 (defun debbugs-gnu-search ()
   "Search for Emacs bugs interactively.


@@ -362,7 +363,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 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
 
        ;; The other queries.
        (catch :finished


@@ -370,13 +374,28 @@ marked as \"client-side filter\"."
            (setq key (completing-read
                       "Enter attribute: "
                       (if phrase
            (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"))
+                          (append
+                           '("severity" "package" "tags"
+                             "author" "date" "subject")
+                            ;; Client-side filters.
+                           (mapcar
+                            (lambda (key)
+                              (propertize
+                               key 'face 'debbugs-gnu-done
+                               'help-echo "Client-side filter"))
+                            '("status")))
+                        (append
+                         '("severity" "package" "archive" "src" "status" "tag"
+                           "owner" "submitter" "maint" "correspondent")
+                         ;; Client-side filters.
+                         (mapcar
+                          (lambda (key)
+                            (propertize
+                             key 'face 'debbugs-gnu-done
+                             'help-echo "Client-side filter"))
+                          '("date" "log_modified" "last_modified"
+                            "found_date" "fixed_date" "unarchived"
+                            "subject" "done" "forwarded" "msgid" "summary"))))

                       nil t))
            (cond
             ;; Server-side queries.
                       nil t))
            (cond
             ;; Server-side queries.


@@ -404,21 +423,29 @@ marked as \"client-side filter\"."
                (add-to-list
                 'debbugs-gnu-current-query (cons (intern key) val1))))
 
                (add-to-list
                 'debbugs-gnu-current-query (cons (intern key) val1))))
 

-            ((member key '("owner" "submitter" "maint" "correspondent"))
+            ((member
+              key '("author" "owner" "submitter" "maint" "correspondent"))

              (setq val1 (read-string "Enter email address: "))
              (when (not (zerop (length val1)))
                (add-to-list
              (setq val1 (read-string "Enter email address: "))
              (when (not (zerop (length val1)))
                (add-to-list

-                'debbugs-gnu-current-query (cons (intern key) val1))))
+                'debbugs-gnu-current-query
+                (cons (intern (if (equal key "author") "@author" key)) val1))))

 
 

+            ;; Client-side filters.

             ((equal key "status")
              (setq
               val1
             ((equal key "status")
              (setq
               val1

-              (completing-read "Enter status: " '("done" "forwarded" "open")))
+              (completing-read
+               (format "Enter status%s: "
+                       (if (null phrase) "" " (client-side filter)"))
+               '("pending" "forwarded" "fixed" "done")))

              (when (not (zerop (length val1)))
              (when (not (zerop (length val1)))

-               (add-to-list
-                'debbugs-gnu-current-query (cons (intern key) val1))))
+                (if (null phrase)
+                    (add-to-list
+                     'debbugs-gnu-current-query (cons (intern key) val1))
+                  (add-to-list
+                   'debbugs-gnu-current-filter (cons 'pending val1)))))

 
 

-            ;; Client-side filters.

             ((member key '("date" "log_modified" "last_modified"
                            "found_date" "fixed_date" "unarchived"))
              (setq val1
             ((member key '("date" "log_modified" "last_modified"
                            "found_date" "fixed_date" "unarchived"))
              (setq val1


@@ -457,12 +484,13 @@ marked as \"client-side filter\"."
                     'debbugs-gnu-current-query 'debbugs-gnu-current-filter)
                 (cons (intern key) (cons val1 val2)))))
 
                     'debbugs-gnu-current-query 'debbugs-gnu-current-filter)
                 (cons (intern key) (cons val1 val2)))))
 

+            ;; "subject", "done", "forwarded", "msgid", "summary".

             ((not (zerop (length key)))
              (setq val1
                    (funcall
                     (if phrase 'read-string 'read-regexp)
             ((not (zerop (length key)))
              (setq val1
                    (funcall
                     (if phrase 'read-string 'read-regexp)

-                    (format "Enter %s%s"
-                            key (if phrase ": " " (client-side filter)"))))
+                    (format "Enter %s%s: "
+                            key (if phrase "" " (client-side filter)"))))

              (when (not (zerop (length val1)))
                (add-to-list
                 (if phrase
              (when (not (zerop (length val1)))
                (add-to-list
                 (if phrase


@@ -475,6 +503,12 @@ marked as \"client-side filter\"."
        ;; Do the search.
        (debbugs-gnu severities packages archivedp))))
 
        ;; Do the search.
        (debbugs-gnu severities packages archivedp))))
 

+;;;###autoload
+(defun debbugs-gnu-patches ()
+  "List the bug reports that have been marked as containing a patch."
+  (interactive)
+  (debbugs-gnu nil debbugs-gnu-default-packages nil nil "patch"))
+

 ;;;###autoload
 (defun debbugs-gnu (severities &optional packages archivedp suppress tags)
   "List all outstanding bugs."
 ;;;###autoload
 (defun debbugs-gnu (severities &optional packages archivedp suppress tags)
   "List all outstanding bugs."


@@ -506,7 +540,8 @@ marked as \"client-side filter\"."
       (insert-file-contents debbugs-gnu-persistency-file)
       (eval (read (current-buffer)))))
   ;; Per default, we suppress retrieved unwanted bugs.
       (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.
     (setq debbugs-gnu-current-suppress t))
 
   ;; Add queries.


@@ -541,7 +576,7 @@ marked as \"client-side filter\"."
   "Retrieve bug numbers from debbugs.gnu.org according search criteria."
   (let* ((debbugs-port "gnu.org")
         (bugs (assoc 'bugs query))
   "Retrieve bug numbers from debbugs.gnu.org according search criteria."
   (let* ((debbugs-port "gnu.org")
         (bugs (assoc 'bugs query))

-        (tags (assoc 'tag query))
+        (tags (and (member '(severity . "tagged") query) (assoc 'tag query)))

         (local-tags (and (member '(severity . "tagged") query) (not tags)))
         (phrase (assoc 'phrase query))
         args)
         (local-tags (and (member '(severity . "tagged") query) (not tags)))
         (phrase (assoc 'phrase query))
         args)


@@ -578,6 +613,10 @@ marked as \"client-side filter\"."
       (mapcar
        (lambda (x) (cdr (assoc "id" x)))
        (apply 'debbugs-search-est args)))
       (mapcar
        (lambda (x) (cdr (assoc "id" x)))
        (apply 'debbugs-search-est args)))

+     ;; User tags.
+     (tags
+      (setq args (mapcar (lambda (x) (if (eq x :package) :user x)) args))
+      (apply 'debbugs-get-usertag args))

      ;; Otherwise, we retrieve the bugs from the server.
      (t (apply 'debbugs-get-bugs args)))))
 
      ;; Otherwise, we retrieve the bugs from the server.
      (t (apply 'debbugs-get-bugs args)))))
 


@@ -668,8 +707,11 @@ are taken from the cache instead."
                'debbugs-gnu-done)
               ((member "pending" (cdr (assq 'keywords status)))
                'debbugs-gnu-pending)
                '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)))
                'debbugs-gnu-new)
               ((< (- (float-time)
                      (cdr (assq 'log_modified status)))


@@ -1266,7 +1308,7 @@ removed instead."
            "usertag")
          nil t)
         current-prefix-arg))
            "usertag")
          nil t)
         current-prefix-arg))

-  (let* ((id (or (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
                 debbugs-gnu-bug-number ; Set on group entry.
                 (debbugs-gnu-guess-current-id)))
         (version