From: Pieter van Oostrum <pieter@vanoostrum.org>
Date: Thu, 5 Mar 2020 19:20:04 +0000 (+0100)
Subject: Add new filter command to Package Menu (Bug#39903)
X-Git-Tag: emacs-28.0.90~7402
X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=196bc13b7bc5a29fa4d27e83d7cf0db4d99aa8b7;p=emacs.git

Add new filter command to Package Menu (Bug#39903)

* lisp/emacs-lisp/package.el
(package-menu-filter-marked): New filter command.
* test/lisp/emacs-lisp/package-tests.el
(package-test-list-filter-marked): New test.
(package-menu-mode-menu):
(package-menu-mode-map): Update menu to include new filter command.

* doc/emacs/package.texi (Package Menu): Document the new command.
* etc/NEWS: Announce the new command.
---

diff --git a/doc/emacs/package.texi b/doc/emacs/package.texi
index db3cf317ff1..91e44b8eba8 100644
--- a/doc/emacs/package.texi
+++ b/doc/emacs/package.texi
@@ -202,6 +202,12 @@ This prompts first for one of the qualifiers @samp{<}, @samp{>} or
 @samp{=}, and then a package version, and shows packages that has a
 lower, equal or higher version than the one specified.
 
+@item / m
+@kindex / m @r{(Package Menu)}
+@findex package-menu-filter-marked
+Filter package list by non-empty mark (@code{package-menu-filter-marked}).
+This shows only the packages that have been marked to be installed or deleted.
+
 @item / /
 @kindex / / @r{(Package Menu)}
 @findex package-menu-filter-clear
diff --git a/etc/NEWS b/etc/NEWS
index 12406eea822..ae676a9bf83 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -219,6 +219,7 @@ key             binding
 / n             package-menu-filter-by-name
 / s             package-menu-filter-by-status
 / v             package-menu-filter-by-version
+/ m             package-menu-filter-marked
 / /             package-menu-filter-clear
 
 ** gdb-mi
diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el
index 4312ab9ca9a..ecf833b5473 100644
--- a/lisp/emacs-lisp/package.el
+++ b/lisp/emacs-lisp/package.el
@@ -2692,6 +2692,7 @@ either a full name or nil, and EMAIL is a valid email address."
     (define-key map (kbd "/ n") 'package-menu-filter-by-name)
     (define-key map (kbd "/ s") 'package-menu-filter-by-status)
     (define-key map (kbd "/ v") 'package-menu-filter-by-version)
+    (define-key map (kbd "/ m") 'package-menu-filter-marked)
     map)
   "Local keymap for `package-menu-mode' buffers.")
 
@@ -2722,6 +2723,7 @@ either a full name or nil, and EMAIL is a valid email address."
      ["Filter by Name" package-menu-filter-by-name :help "Filter packages by name"]
      ["Filter by Status" package-menu-filter-by-status :help "Filter packages by status"]
      ["Filter by Version" package-menu-filter-by-version :help "Filter packages by version"]
+     ["Filter Marked" package-menu-filter-marked :help "Filter packages marked for upgrade"]
      ["Clear Filter" package-menu-clear-filter :help "Clear package list filter"])
 
     ["Hide by Regexp" package-menu-hide-package :help "Hide all packages matching a regexp"]
@@ -3855,6 +3857,35 @@ If VERSION is nil or the empty string, show all packages."
            (funcall fun (package-desc-version pkg-desc) ver)))
        (format "versions:%s%s" predicate version)))))
 
+(defun package-menu-filter-marked ()
+  "Filter \"*Packages*\" buffer by non-empty upgrade mark.
+Unlike other filters, this leaves the marks intact."
+  (interactive)
+  (package--ensure-package-menu-mode)
+  (widen)
+  (let (found-entries mark pkg-id entry marks)
+    (save-excursion
+      (goto-char (point-min))
+      (while (not (eobp))
+        (setq mark (char-after))
+        (unless (eq mark ?\s)
+	  (setq pkg-id (tabulated-list-get-id))
+          (setq entry (package-menu--print-info-simple pkg-id))
+	  (push entry found-entries)
+	  ;; remember the mark
+	  (push (cons pkg-id mark) marks))
+        (forward-line))
+      (if found-entries
+          (progn
+            (setq tabulated-list-entries found-entries)
+            (package-menu--display t nil)
+	    ;; redo the marks, but we must remember the marks!!
+	    (goto-char (point-min))
+	    (while (not (eobp))
+	      (setq mark (cdr (assq (tabulated-list-get-id) marks)))
+	      (tabulated-list-put-tag (char-to-string mark) t)))
+	(user-error "No packages found")))))
+
 (defun package-menu-clear-filter ()
   "Clear any filter currently applied to the \"*Packages*\" buffer."
   (interactive)
diff --git a/test/lisp/emacs-lisp/package-tests.el b/test/lisp/emacs-lisp/package-tests.el
index c0ed82c474a..732bf5e061f 100644
--- a/test/lisp/emacs-lisp/package-tests.el
+++ b/test/lisp/emacs-lisp/package-tests.el
@@ -413,6 +413,21 @@ Must called from within a `tar-mode' buffer."
     ;; No installed packages in default environment.
     (should-error (package-menu-filter-by-status "installed"))))
 
+(ert-deftest package-test-list-filter-marked ()
+  "Ensure package list is filtered correctly by non-empty mark."
+  (with-package-test ()
+    (let ((buf (package-list-packages)))
+      (revert-buffer)
+      (search-forward-regexp "^ +simple-single")
+      (package-menu-mark-install)
+      (package-menu-filter-marked)
+      (goto-char (point-min))
+      (should (re-search-forward "^I +simple-single" nil t))
+      (should (= (count-lines (point-min) (point-max)) 1))
+      (package-menu-mark-unmark)
+      ;; No marked packages in default environment.
+      (should-error (package-menu-filter-marked)))))
+
 (ert-deftest package-test-list-filter-by-version ()
   (with-package-menu-test
     (should-error (package-menu-filter-by-version "1.1" 'unknown-symbol)))  )