]> code.delx.au - gnu-emacs-elpa/blobdiff - packages/debbugs/debbugs-gnu.el
Fix some quoting problems in doc strings
[gnu-emacs-elpa] / packages / debbugs / debbugs-gnu.el
index fe0a7e580f41613f7c91020dbb66eeb7803266e1..55841fdf0384e4b6514801b97adc1c20bd7880be 100644 (file)
   :group 'debbugs
   :version "24.1")
 
   :group 'debbugs
   :version "24.1")
 
-(defvar debbugs-gnu-blocking-report 19759
-  "The ID of the current release report used to track blocking bug reports.")
-
 (defcustom debbugs-gnu-default-severities '("serious" "important" "normal")
   "*The list severities bugs are searched for.
 \"tagged\" is not a severity but marks locally tagged bugs."
 (defcustom debbugs-gnu-default-severities '("serious" "important" "normal")
   "*The list severities bugs are searched for.
 \"tagged\" is not a severity but marks locally tagged bugs."
              (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.")
              (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")
@@ -257,8 +261,8 @@ suppressed bugs is toggled by `debbugs-gnu-toggle-suppress'."
 
 (defcustom debbugs-gnu-mail-backend 'gnus
   "*The email backend to use for reading bug report email exchange.
 
 (defcustom debbugs-gnu-mail-backend 'gnus
   "*The email backend to use for reading bug report email exchange.
-If this is 'gnus, the default, use Gnus.
-If this is 'rmail, use Rmail instead."
+If this is `gnus', the default, use Gnus.
+If this is `rmail', use Rmail instead."
   :group 'debbugs-gnu
   :type '(choice (const :tag "Use Gnus" 'gnus)
                 (const :tag "Use Rmail" 'rmail))
   :group 'debbugs-gnu
   :type '(choice (const :tag "Use Gnus" 'gnus)
                 (const :tag "Use Rmail" 'rmail))
@@ -318,6 +322,22 @@ a date, value is the cons cell \(BEFORE . AFTER\).")
 The specification which bugs shall be suppressed is taken from
   `debbugs-gnu-default-suppress-bugs'.")
 
 The specification which bugs shall be suppressed is taken from
   `debbugs-gnu-default-suppress-bugs'.")
 
+(defcustom debbugs-gnu-emacs-current-release "25.1"
+  "The current Emacs relase developped for."
+  :group 'debbugs-gnu
+  :type '(set (const "24.5")
+             (const "25.1")
+             (const "25.2"))
+  :version "25.1")
+
+(defconst debbugs-gnu-blocking-reports
+  '(("24.5" . 19758)
+    ("25.1" . 19759)
+    ("25.2" . 21966))
+  "The IDs of the Emacs report used to track blocking bug reports.
+It is a list of cons cells, each one containing the Emacs
+version (a string) and the bug report number (a number).")
+
 (defun debbugs-gnu-calendar-read (prompt acceptable &optional initial-contents)
   "Return a string read from the minibuffer.
 Derived from `calendar-read'."
 (defun debbugs-gnu-calendar-read (prompt acceptable &optional initial-contents)
   "Return a string read from the minibuffer.
 Derived from `calendar-read'."
@@ -336,12 +356,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 +376,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 +387,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 +436,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)"))
+               '("open" "forwarded" "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 +497,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 +516,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 +553,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 +589,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 +626,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 +720,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)))
@@ -1004,9 +1059,16 @@ The following commands are available:
 (defun debbugs-gnu-show-all-blocking-reports ()
   "Narrow the display to just the reports that are blocking a release."
   (interactive)
 (defun debbugs-gnu-show-all-blocking-reports ()
   "Narrow the display to just the reports that are blocking a release."
   (interactive)
-  (let ((blockers (cdr (assq 'blockedby
-                            (car (debbugs-get-status
-                                  debbugs-gnu-blocking-report)))))
+  (let ((blockers
+        (cdr
+         (assq
+          'blockedby
+          (car
+           (debbugs-get-status
+            (cdr
+             (assoc
+              debbugs-gnu-emacs-current-release
+              debbugs-gnu-blocking-reports)))))))
        (id (debbugs-gnu-current-id t))
        (inhibit-read-only t)
        status)
        (id (debbugs-gnu-current-id t))
        (inhibit-read-only t)
        status)
@@ -1266,7 +1328,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