branch: externals/debbugs
commit e88ffe965d1dc2021ee40410c96a89c05b5f555e
Author: Matthias Meulien <[email protected]>
Commit: Michael Albinus <[email protected]>
Bookmarks support (Bug#78864)
* debbugs-bookmarks.el: Bookmark support for debbugs.
* debbugs-gnu.el (debbugs-gnu-mode): Set `bookmark-make-record-function'.
* debbugs-ug.texi (Tabulated Lists): Document support for bookmarks.
* test/debbugs-gnu-tests.el: Test `debbugs-gnu-bookmark-name'.
---
debbugs-bookmarks.el | 143 ++++++++++++++++++++++++++++++++++++++++++++++
debbugs-gnu.el | 4 ++
debbugs-ug.texi | 7 ++-
test/debbugs-gnu-tests.el | 29 +++++++++-
4 files changed, 180 insertions(+), 3 deletions(-)
diff --git a/debbugs-bookmarks.el b/debbugs-bookmarks.el
new file mode 100644
index 0000000000..897bd24307
--- /dev/null
+++ b/debbugs-bookmarks.el
@@ -0,0 +1,143 @@
+;;; debbugs-bookmarks.el --- Bookmark support for debbugs -*-
lexical-binding: t; -*-
+
+;; Copyright (C) 2025 Matthias Meulien
+
+;; Author: Matthias Meulien <[email protected]>
+;; Keywords: convenience
+;; Package: debbugs
+
+;; This file is not part of GNU Emacs.
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This file implements the bookmark interface, so one can bookmark a
+;; bug query.
+
+;; Use `bookmark-set' in a Debbugs buffer to set a bookmark for the
+;; current query (as described by `debbugs-gnu-current-query'). Then
+;; `bookmark-jump' to restore a bookmark.
+
+;;; Code:
+
+(declare-function bookmark-make-record-default
+ "bookmark" (&optional no-file no-context posn))
+(declare-function bookmark-prop-get "bookmark" (bookmark prop))
+(declare-function bookmark-default-handler "bookmark" (bmk))
+(declare-function bookmark-get-bookmark-record "bookmark" (bmk))
+
+(declare-function debbugs-gnu-show-reports "debbugs-gnu" (&optional offline))
+
+(defvar debbugs-gnu-current-buffer)
+(defvar debbugs-gnu-current-filter)
+(defvar debbugs-gnu-current-print-function)
+(defvar debbugs-gnu-current-query)
+(defvar debbugs-gnu-current-suppress)
+(defvar debbugs-gnu-local-query)
+(defvar debbugs-gnu-local-filter)
+(defvar debbugs-gnu-local-print-function)
+(defvar debbugs-gnu-local-suppress)
+
+(defun debbugs-gnu-bookmark-name (query)
+ "Candidate for bookmark name.
+The name depends on whether the query specifies bug identifiers or a
+phrase. When a phrase is specified, the subject may override the phrase
+and packages if any are mentionned.
+
+Examples of generated names follows:
+- Bug #20777
+- Bugs #20777, #18338, #38388
+- Bugs about \"display\" in emacs package
+- Bugs about \"display\" in packages emacs,org
+- Bugs with subject \"display\" in packages emacs,org
+- Bugs about \"something\" reported by [email protected]
+- Tagged bugs
+- Bugs
+"
+ (let* ((bugs (cdr (assq 'bugs query)))
+ (bug-count (length bugs))
+ (bugs-substring
+ (cond
+ ((eq bug-count 0) nil)
+ ((eq bug-count 1) (concat "Bug #" (int-to-string (car bugs))))
+ ((concat "Bugs "
+ (string-join
+ (mapcar (lambda (elt) (concat "#" (int-to-string elt)))
+ bugs)
+ ", "))))))
+ (if bugs-substring
+ bugs-substring
+ (let* ((packages (mapcar 'cdr
+ (seq-filter
+ (lambda (elt) (eq (car elt) 'package))
+ query)))
+ (package-count (length packages))
+ (packages-token
+ (cond
+ ((eq package-count 0) nil)
+ ((eq package-count 1) (concat "in " (car packages) " package"))
+ (t (concat "in packages " (string-join packages ",")))))
+ (severity (cdr (assq 'severity query)))
+ (first-token (if (equal severity "tagged") "Tagged bugs" "Bugs"))
+ (subject (cdr (assq 'subject query)))
+ (phrase (cdr (assq 'phrase query)))
+ (phrase-token
+ (when phrase
+ (if subject
+ (concat "with subject \"" subject "\"")
+ (concat "about \"" phrase "\""))))
+ (submitter (cdr (assq 'submitter query)))
+ (submitter-token
+ (when submitter (concat "reported by " submitter))))
+ (string-join (append (seq-filter
+ (lambda (x) x)
+ (list first-token phrase-token submitter-token
+ packages-token)))
+ " ")))))
+
+;;;###autoload
+(defun debbugs-gnu-bookmark-make-record ()
+ "Make record used to bookmark a Debbugs buffer.
+This implements the `bookmark-make-record-function' type for
+such buffers."
+ (let ((bookmark-name (debbugs-gnu-bookmark-name debbugs-gnu-local-query)))
+ `(,bookmark-name
+ ,@(bookmark-make-record-default 'no-file)
+ (filename . nil)
+ (handler . debbugs-gnu-bookmark-jump)
+ (debbugs-gnu-current-filter . ,debbugs-gnu-local-filter)
+ (debbugs-gnu-current-print-function . ,debbugs-gnu-local-print-function)
+ (debbugs-gnu-current-query . ,debbugs-gnu-local-query)
+ (debbugs-gnu-current-suppress . ,debbugs-gnu-local-suppress))))
+
+(put 'debbugs-gnu-bookmark-jump 'bookmark-handler-type "Debbugs")
+
+;;;###autoload
+(defun debbugs-gnu-bookmark-jump (bmk)
+ "Provide the `bookmark-jump' behavior for a Debbugs buffer.
+This implements the `handler' function interface for the record
+type returned by `debbugs-gnu-bookmark-make-record'."
+ (let* ((debbugs-gnu-current-filter (bookmark-prop-get bmk
'debbugs-gnu-current-filter))
+ (debbugs-gnu-current-print-function (bookmark-prop-get bmk
'debbugs-gnu-current-print-function))
+ (debbugs-gnu-current-query (bookmark-prop-get bmk
'debbugs-gnu-current-query))
+ (debbugs-gnu-current-suppress (bookmark-prop-get bmk
'debbugs-gnu-current-suppress))
+ (buf (progn ;; Don't use save-window-excursion (bug#39722)
+ (debbugs-gnu-show-reports)
+ debbugs-gnu-current-buffer)))
+ (bookmark-default-handler
+ `("" (buffer . ,buf) . ,(bookmark-get-bookmark-record bmk)))))
+
+(provide 'debbugs-bookmarks)
+;;; debbugs-bookmarks.el ends here
diff --git a/debbugs-gnu.el b/debbugs-gnu.el
index 062a39d2f7..8a5fbd11b7 100644
--- a/debbugs-gnu.el
+++ b/debbugs-gnu.el
@@ -186,6 +186,7 @@
;;; Code:
(require 'debbugs)
+(require 'debbugs-bookmarks)
(require 'debbugs-compat)
(require 'tabulated-list)
(require 'add-log)
@@ -1365,6 +1366,8 @@ Interactively, it is non-nil with the prefix argument."
:type 'natnum
:version "30.1")
+(defvar bookmark-make-record-function)
+
(define-derived-mode debbugs-gnu-mode tabulated-list-mode "Debbugs"
"Major mode for listing bug reports.
The bugs are taken from the cache when the list is refreshed.
@@ -1383,6 +1386,7 @@ modified on the debbugs server, consider typing \\`C-u g'.
(set (make-local-variable 'debbugs-gnu-local-print-function)
debbugs-gnu-current-print-function)
(set (make-local-variable 'tabulated-list-entries) nil)
+ (setq-local bookmark-make-record-function #'debbugs-gnu-bookmark-make-record)
(setq tabulated-list-format
`[("Id" ,debbugs-gnu-width-id debbugs-gnu-sort-id)
("State" ,debbugs-gnu-width-state debbugs-gnu-sort-state)
diff --git a/debbugs-ug.texi b/debbugs-ug.texi
index ef2f20b081..4cef6f3ed3 100644
--- a/debbugs-ug.texi
+++ b/debbugs-ug.texi
@@ -500,7 +500,7 @@ column shows bugs which have been marked locally. The
title text is
italic (@code{debbugs-gnu-marked-stale}) if the marked bug hasn't been
touched for more than a week.
-The minor mode @code{debbugs-gnu-mode} is active in bug report
+The major mode @code{debbugs-gnu-mode} is active in bug report
buffers. This enables the following key strokes:
@multitable @columnfractions .20 .80
@@ -624,6 +624,11 @@ Both tagged and marked bugs are kept persistent in the file
The user option @code{debbugs-gnu-suppress-closed} controls whether
closed bugs are shown in the initial list.
+Tabulated list of bug reports can be bookmarked with the usual
+@code{bookmark-set} command. The corresponding handler saves search
+query, not results; thus jumping to a bookmarked list of bug reports
+performs the same search that generated the bookmarked list.
+
@vindex debbugs-gnu-mail-backend
@kindex @kbd{@key{RET}}
The user option @code{debbugs-gnu-mail-backend} controls the
diff --git a/test/debbugs-gnu-tests.el b/test/debbugs-gnu-tests.el
index 11b4e6a106..ca12e3472b 100644
--- a/test/debbugs-gnu-tests.el
+++ b/test/debbugs-gnu-tests.el
@@ -28,6 +28,7 @@
(require 'ert)
(require 'debbugs-gnu)
+(require 'debbugs-bookmarks)
(require 'debbugs-test-helpers)
;;; Tests:
@@ -35,12 +36,36 @@
(ert-deftest--debbugs debbugs-test-gnu-search ()
"Test `debbugs-gnu-search'."
(cl-letf (((symbol-function #'debbugs-gnu)
- #'list))
+ #'list)
+ (debbugs-gnu-current-query nil))
(should
(equal '(nil ("guix" "guix-patches") nil)
(debbugs-gnu-search "frogs" '((pending . "pending")) nil '("guix"
"guix-patches") nil)))
(should (equal debbugs-gnu-current-query '((phrase . "frogs"))))
- (should (equal debbugs-gnu-current-filter '((pending . "pending"))))))
+ (should (equal debbugs-gnu-current-filter '((pending . "pending"))))
+ (should (equal (debbugs-gnu-bookmark-name debbugs-gnu-current-query) "Bugs
about \"frogs\""))))
+
+(ert-deftest--debbugs debbugs-test-gnu-search-with-submitter-and-package ()
+ "Test `debbugs-gnu-search' with submitter and package."
+ (cl-letf (((symbol-function #'debbugs-gnu)
+ #'list)
+ (debbugs-gnu-current-query nil))
+ (should
+ (equal '(nil nil nil)
+ (debbugs-gnu-search nil '((submitter . "Phineas") (package .
"emacs")) nil nil nil)))
+ (should (equal debbugs-gnu-current-query '((package . "emacs") (submitter
. "Phineas"))))
+ (should (equal (debbugs-gnu-bookmark-name debbugs-gnu-current-query) "Bugs
reported by Phineas in emacs package"))))
+
+(ert-deftest--debbugs debbugs-test-gnu-search-tagged-bugs ()
+ "Test `debbugs-gnu-search' on tagged bugs."
+ (cl-letf (((symbol-function #'debbugs-gnu)
+ #'list)
+ (debbugs-gnu-current-query nil))
+ (should
+ (equal '(nil ("guix" "guix-patches") nil)
+ (debbugs-gnu-search "frogs" '((severity . "tagged")) nil '("guix"
"guix-patches") nil)))
+ (should (equal debbugs-gnu-current-query '((severity . "tagged") (phrase .
"frogs"))))
+ (should (equal (debbugs-gnu-bookmark-name debbugs-gnu-current-query)
"Tagged bugs about \"frogs\""))))
(provide 'debbugs-gnu-tests)
