[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
master aea12d4 1/3: Add new filter commands to Package Menu (Bug#38424)
|
From: |
Stefan Kangas |
|
Subject: |
master aea12d4 1/3: Add new filter commands to Package Menu (Bug#38424) |
|
Date: |
Wed, 5 Feb 2020 07:35:40 -0500 (EST) |
branch: master
commit aea12d4903136c057bb14d3fd7683bf7a4e1eff6
Author: Stefan Kangas <address@hidden>
Commit: Stefan Kangas <address@hidden>
Add new filter commands to Package Menu (Bug#38424)
* lisp/emacs-lisp/package.el (package-menu-filter-by-version)
(package-menu-filter-by-status, package-menu-filter-by-archive):
New filter commands.
(package-menu--filter-by): New helper function.
(package-menu-filter-by-keyword, package-menu-filter-by-name): Use
the above helper function.
(package-menu-mode-menu):
(package-menu-mode-map): Update menu to include new filter commands.
* doc/emacs/package.texi (Package Menu): Document the new commands and
re-arrange the sort order of commands to be closer to the one in
describe-major-mode.
* etc/NEWS: Announce the new commands.
* lisp/emacs-lisp/package.el (package-menu--display): New function
extracted from....
(package-menu--generate): ...here.
* test/lisp/emacs-lisp/package-tests.el (with-package-menu-test):
New macro.
(package-test-update-listing, package-test-list-filter-by-name)
(package-test-list-filter-clear): Use above macro.
(package-test-list-filter-by-archive)
(package-test-list-filter-by-keyword)
(package-test-list-filter-by-status)
(package-test-list-filter-by-version-=)
(package-test-list-filter-by-version-<)
(package-test-list-filter-by-version->): New tests.
(package-test-filter-by-version): New helper function.
---
doc/emacs/package.texi | 63 ++++++----
etc/NEWS | 14 +++
lisp/emacs-lisp/package.el | 219 +++++++++++++++++++++++++++-------
test/lisp/emacs-lisp/package-tests.el | 117 +++++++++++++-----
4 files changed, 319 insertions(+), 94 deletions(-)
diff --git a/doc/emacs/package.texi b/doc/emacs/package.texi
index 1cac7f9..360fc98 100644
--- a/doc/emacs/package.texi
+++ b/doc/emacs/package.texi
@@ -151,27 +151,6 @@ Refresh the package list (@code{revert-buffer}). This
fetches the
list of available packages from the package archive again, and
redisplays the package list.
-@item / k
-@kindex / k @r{(Package Menu)}
-@findex package-menu-filter-by-keyword
-Filter the package list by keyword
-(@code{package-menu-filter-by-keyword}). This prompts for a keyword
-(e.g., @samp{games}), then shows only the packages that relate to that
-keyword.
-
-@item / n
-@kindex / n @r{(Package Menu)}
-@findex package-menu-filter-by-name
-Filter the package list by name (@code{package-menu-filter-by-name}).
-This prompts for a string, then shows only the packages whose names
-match a regexp with that value.
-
-@item / /
-@kindex / / @r{(Package Menu)}
-@findex package-menu-clear-filter
-Clear filter currently applied to the package list
-(@code{package-menu-clear-filter}).
-
@item H
@kindex H @r{(Package Menu)}
@findex package-menu-hide-package
@@ -183,6 +162,48 @@ Permanently hide packages that match a regexp
@findex package-menu-toggle-hiding
Toggle visibility of old versions of packages and also of versions
from lower-priority archives (@code{package-menu-toggle-hiding}).
+
+@item / a
+@kindex / a @r{(Package Menu)}
+@findex package-menu-filter-by-archive
+Filter package list by archive (@code{package-menu-filter-by-archive}).
+This prompts for a package archive (e.g., @samp{gnu}), then shows only
+packages from that archive.
+
+@item / k
+@kindex / k @r{(Package Menu)}
+@findex package-menu-filter-by-keyword
+Filter package list by keyword (@code{package-menu-filter-by-keyword}).
+This prompts for a keyword (e.g., @samp{games}), then shows only
+packages with that keyword.
+
+@item / n
+@kindex / n @r{(Package Menu)}
+@findex package-menu-filter-by-name
+Filter package list by name (@code{package-menu-filter-by-name}).
+This prompts for a regular expression, then shows only packages
+with names matching that regexp.
+
+@item / s
+@kindex / s @r{(Package Menu)}
+@findex package-menu-filter-by-status
+Filter package list by status (@code{package-menu-filter-by-status}).
+This prompts for one or more statuses (e.g., @samp{available}), then
+shows only packages with matching status.
+
+@item / v
+@kindex / v @r{(Package Menu)}
+@findex package-menu-filter-by-version
+Filter package list by version (@code{package-menu-filter-by-version}).
+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 / /
+@kindex / / @r{(Package Menu)}
+@findex package-menu-filter-clear
+Clear filter currently applied to the package list
+(@code{package-menu-filter-clear}).
@end table
@noindent
diff --git a/etc/NEWS b/etc/NEWS
index 093b54b..6ab6a8a 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -120,6 +120,20 @@ like cell phones, tablets or cameras.
*** Pcase 'map' pattern added keyword symbols abbreviation.
A pattern like '(map :sym)' binds the map's value for ':sym' to 'sym',
equivalent to '(map (:sym sym))'.
+** Package
+
++++
+*** New functions to filter the package list.
+The filter command key bindings are as follows:
+
+key binding
+--- -------
+/ a package-menu-filter-by-archive
+/ k package-menu-filter-by-keyword
+/ n package-menu-filter-by-name
+/ s package-menu-filter-by-status
+/ v package-menu-filter-by-version
+/ / package-menu-filter-clear
* New Modes and Packages in Emacs 28.1
diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el
index a9508c1..f14ef79 100644
--- a/lisp/emacs-lisp/package.el
+++ b/lisp/emacs-lisp/package.el
@@ -2679,15 +2679,18 @@ either a full name or nil, and EMAIL is a valid email
address."
(define-key map "i" 'package-menu-mark-install)
(define-key map "U" 'package-menu-mark-upgrades)
(define-key map "r" 'revert-buffer)
- (define-key map (kbd "/ k") 'package-menu-filter-by-keyword)
- (define-key map (kbd "/ n") 'package-menu-filter-by-name)
- (define-key map (kbd "/ /") 'package-menu-clear-filter)
(define-key map "~" 'package-menu-mark-obsolete-for-deletion)
(define-key map "x" 'package-menu-execute)
(define-key map "h" 'package-menu-quick-help)
(define-key map "H" #'package-menu-hide-package)
(define-key map "?" 'package-menu-describe-package)
(define-key map "(" #'package-menu-toggle-hiding)
+ (define-key map (kbd "/ /") 'package-menu-clear-filter)
+ (define-key map (kbd "/ a") 'package-menu-filter-by-archive)
+ (define-key map (kbd "/ k") 'package-menu-filter-by-keyword)
+ (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)
map)
"Local keymap for `package-menu-mode' buffers.")
@@ -2714,8 +2717,11 @@ either a full name or nil, and EMAIL is a valid email
address."
"--"
("Filter Packages"
+ ["Filter by Archive" package-menu-filter-by-archive :help "Filter
packages by archive"]
["Filter by Keyword" package-menu-filter-by-keyword :help "Filter
packages by keyword"]
["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"]
["Clear Filter" package-menu-clear-filter :help "Clear package list
filter"])
["Hide by Regexp" package-menu-hide-package :help "Permanently hide all
packages matching a regexp"]
@@ -3021,22 +3027,31 @@ When none are given, the package matches."
found)
t))
-(defun package-menu--generate (remember-pos packages &optional keywords)
- "Populate the Package Menu.
+(defun package-menu--display (remember-pos suffix)
+ "Display the Package Menu.
If REMEMBER-POS is non-nil, keep point on the same entry.
+
+If SUFFIX is non-nil, append that to \"Package\" for the first
+column in the header line."
+ (setf (car (aref tabulated-list-format 0))
+ (if suffix
+ (concat "Package[" suffix "]")
+ "Package"))
+ (tabulated-list-init-header)
+ (tabulated-list-print remember-pos))
+
+(defun package-menu--generate (remember-pos &optional packages keywords)
+ "Populate and display the Package Menu.
PACKAGES should be t, which means to display all known packages,
or a list of package names (symbols) to display.
With KEYWORDS given, only packages with those keywords are
shown."
(package-menu--refresh packages keywords)
- (setf (car (aref tabulated-list-format 0))
- (if keywords
- (let ((filters (mapconcat #'identity keywords ",")))
- (concat "Package[" filters "]"))
- "Package"))
- (tabulated-list-init-header)
- (tabulated-list-print remember-pos))
+ (package-menu--display remember-pos
+ (when keywords
+ (let ((filters (mapconcat #'identity keywords ",")))
+ (concat "Package[" filters "]")))))
(defun package-menu--print-info (pkg)
"Return a package entry suitable for `tabulated-list-entries'.
@@ -3673,45 +3688,160 @@ shown."
(select-window win)
(switch-to-buffer buf))))
+(defun package-menu--filter-by (predicate suffix)
+ "Filter \"*Packages*\" buffer by PREDICATE and add SUFFIX to header.
+PREDICATE is a function which will be called with one argument, a
+`package-desc' object, and returns t if that object should be
+listed in the Package Menu.
+
+SUFFIX is passed on to `package-menu--display' and is added to
+the header line of the first column."
+ ;; Update `tabulated-list-entries' so that it contains all
+ ;; packages before searching.
+ (package-menu--refresh t nil)
+ (let (found-entries)
+ (dolist (entry tabulated-list-entries)
+ (when (funcall predicate (car entry))
+ (push entry found-entries)))
+ (if found-entries
+ (progn
+ (setq tabulated-list-entries found-entries)
+ (package-menu--display t suffix))
+ (user-error "No packages found"))))
+
+(defun package-menu-filter-by-archive (archive)
+ "Filter the \"*Packages*\" buffer by ARCHIVE.
+Display only packages from package archive ARCHIVE.
+
+When called interactively, prompt for ARCHIVE, which can be a
+comma-separated string. If ARCHIVE is empty, show all packages.
+
+When called from Lisp, ARCHIVE can be a string or a list of
+strings. If ARCHIVE is nil or the empty string, show all
+packages."
+ (interactive (list (completing-read-multiple
+ "Filter by archive (comma separated): "
+ (mapcar #'car package-archives))))
+ (package--ensure-package-menu-mode)
+ (let ((re (if (listp archive)
+ (regexp-opt archive)
+ archive)))
+ (package-menu--filter-by (lambda (pkg-desc)
+ (let ((pkg-archive (package-desc-archive pkg-desc)))
+ (and pkg-archive
+ (string-match-p re pkg-archive))))
+ (concat "archive:" (if (listp archive)
+ (string-join archive ",")
+ archive)))))
+
(defun package-menu-filter-by-keyword (keyword)
"Filter the \"*Packages*\" buffer by KEYWORD.
-Show only those items that relate to the specified KEYWORD.
-
-KEYWORD can be a string or a list of strings. If it is a list, a
-package will be displayed if it matches any of the keywords.
-Interactively, it is a list of strings separated by commas.
-
-KEYWORD can also be used to filter by status or archive name by
-using keywords like \"arc:gnu\" and \"status:available\".
-Statuses available include \"incompat\", \"available\",
-\"built-in\" and \"installed\"."
- (interactive
- (list (completing-read-multiple
- "Keywords (comma separated): " (package-all-keywords))))
+Display only packages with specified KEYWORD.
+
+When called interactively, prompt for KEYWORD, which can be a
+comma-separated string. If KEYWORD is empty, show all packages.
+
+When called from Lisp, KEYWORD can be a string or a list of
+strings. If KEYWORD is nil or the empty string, show all
+packages."
+ (interactive (list (completing-read-multiple
+ "Keywords (comma separated): "
+ (package-all-keywords))))
+ (when (stringp keyword)
+ (setq keyword (list keyword)))
(package--ensure-package-menu-mode)
- (package-show-package-list t (if (stringp keyword)
- (list keyword)
- keyword)))
+ (if (not keyword)
+ (package-menu--generate t t)
+ (package-menu--filter-by (lambda (pkg-desc)
+ (package--has-keyword-p pkg-desc keyword))
+ (concat "keyword:" (string-join keyword ",")))))
(defun package-menu-filter-by-name (name)
- "Filter the \"*Packages*\" buffer by NAME.
-Show only those items whose name matches the regular expression
-NAME. If NAME is nil or the empty string, show all packages."
- (interactive (list (read-from-minibuffer "Filter by name (regexp): ")))
+ "Filter the \"*Packages*\" buffer by NAME regexp.
+Display only packages with name that matches regexp NAME.
+
+When called interactively, prompt for NAME.
+
+If NAME is nil or the empty string, show all packages."
+ (interactive (list (read-regexp "Filter by name (regexp)")))
(package--ensure-package-menu-mode)
(if (or (not name) (string-empty-p name))
- (package-show-package-list t nil)
- ;; Update `tabulated-list-entries' so that it contains all
- ;; packages before searching.
- (package-menu--refresh t nil)
- (let (matched)
- (dolist (entry tabulated-list-entries)
- (let* ((pkg-name (package-desc-name (car entry))))
- (when (string-match name (symbol-name pkg-name))
- (push pkg-name matched))))
- (if matched
- (package-show-package-list matched nil)
- (user-error "No packages found")))))
+ (package-menu--generate t t)
+ (package-menu--filter-by (lambda (pkg-desc)
+ (string-match-p name (symbol-name
+ (package-desc-name pkg-desc))))
+ (format "name:%s" name))))
+
+(defun package-menu-filter-by-status (status)
+ "Filter the \"*Packages*\" buffer by STATUS.
+Display only packages with specified STATUS.
+
+When called interactively, prompt for STATUS, which can be a
+comma-separated string. If STATUS is empty, show all packages.
+
+When called from Lisp, STATUS can be a string or a list of
+strings. If STATUS is nil or the empty string, show all
+packages."
+ (interactive (list (completing-read "Filter by status: "
+ '("avail-obso"
+ "available"
+ "built-in"
+ "dependency"
+ "disabled"
+ "external"
+ "held"
+ "incompat"
+ "installed"
+ "new"
+ "unsigned"))))
+ (package--ensure-package-menu-mode)
+ (if (or (not status) (string-empty-p status))
+ (package-menu--generate t t)
+ (package-menu--filter-by (lambda (pkg-desc)
+ (string-match-p status (package-desc-status pkg-desc)))
+ (format "status:%s" status))))
+
+(defun package-menu-filter-by-version (version predicate)
+ "Filter the \"*Packages*\" buffer by VERSION and PREDICATE.
+Display only packages with a matching version.
+
+When called interactively, prompt for one of the qualifiers `<',
+`>' or `=', and a package version. Show only packages that has a
+lower (`<'), equal (`=') or higher (`>') version than the
+specified one.
+
+When called from Lisp, VERSION should be a version string and
+PREDICATE should be the symbol `=', `<' or `>'.
+
+If VERSION is nil or the empty string, show all packages."
+ (interactive (let ((choice (intern
+ (char-to-string
+ (read-char-choice
+ "Filter by version? [Type =, <, > or q] "
+ '(?< ?> ?= ?q))))))
+ (if (eq choice 'q)
+ '(quit nil)
+ (list (read-from-minibuffer
+ (concat "Filter by version ("
+ (pcase choice
+ ('= "= equal to")
+ ('< "< less than")
+ ('> "> greater than"))
+ "): "))
+ choice))))
+ (unless (equal predicate 'quit)
+ (if (or (not version) (string-empty-p version))
+ (package-menu--generate t t)
+ (package-menu--filter-by
+ (let ((fun (pcase predicate
+ ('= 'version-list-=)
+ ('< 'version-list-<)
+ ('> '(lambda (a b) (not (version-list-<= a b))))
+ (_ (error "Unknown predicate: %s" predicate))))
+ (ver (version-to-list version)))
+ (lambda (pkg-desc)
+ (funcall fun (package-desc-version pkg-desc) ver)))
+ (format "versions:%s%s" predicate version)))))
(defun package-menu-clear-filter ()
"Clear any filter currently applied to the \"*Packages*\" buffer."
@@ -3760,6 +3890,7 @@ The return value is a string (or nil in case we can't
find it)."
(or (lm-header "package-version")
(lm-header "version")))))))))
+
;;;; Quickstart: precompute activation actions for faster start up.
;; Activating packages via `package-initialize' is costly: for N installed
diff --git a/test/lisp/emacs-lisp/package-tests.el
b/test/lisp/emacs-lisp/package-tests.el
index 7d354d6..adf917a 100644
--- a/test/lisp/emacs-lisp/package-tests.el
+++ b/test/lisp/emacs-lisp/package-tests.el
@@ -349,43 +349,102 @@ Must called from within a `tar-mode' buffer."
(goto-char (point-min))
(should (re-search-forward re nil t)))))))
+
+;;; Package Menu tests
+
+(defmacro with-package-menu-test (&rest body)
+ "Set up Package Menu (\"*Packages*\") buffer for testing."
+ (declare (indent 0) (debug (([&rest form]) body)))
+ `(with-package-test ()
+ (let ((buf (package-list-packages)))
+ (unwind-protect
+ (progn ,@body)
+ (kill-buffer buf)))))
+
(ert-deftest package-test-update-listing ()
"Ensure installed package status is updated."
- (with-package-test ()
- (let ((buf (package-list-packages)))
- (search-forward-regexp "^ +simple-single")
- (package-menu-mark-install)
- (package-menu-execute)
- (run-hooks 'post-command-hook)
- (should (package-installed-p 'simple-single))
- (switch-to-buffer "*Packages*")
- (goto-char (point-min))
- (should (re-search-forward "^\\s-+simple-single\\s-+1.3\\s-+installed"
nil t))
- (goto-char (point-min))
- (should-not (re-search-forward
"^\\s-+simple-single\\s-+1.3\\s-+\\(available\\|new\\)" nil t))
- (kill-buffer buf))))
+ (with-package-menu-test
+ (search-forward-regexp "^ +simple-single")
+ (package-menu-mark-install)
+ (package-menu-execute)
+ (run-hooks 'post-command-hook)
+ (should (package-installed-p 'simple-single))
+ (switch-to-buffer "*Packages*")
+ (goto-char (point-min))
+ (should (re-search-forward "^\\s-+simple-single\\s-+1.3\\s-+installed" nil
t))
+ (goto-char (point-min))
+ (should-not (re-search-forward
"^\\s-+simple-single\\s-+1.3\\s-+\\(available\\|new\\)" nil t))))
+
+(ert-deftest package-test-list-filter-by-archive ()
+ "Ensure package list is filtered correctly by archive version."
+ (with-package-menu-test
+ ;; TODO: Add another package archive to test filtering, because
+ ;; the testing environment currently only has one.
+ (package-menu-filter-by-archive "gnu")
+ (goto-char (point-min))
+ (should (looking-at "^\\s-+multi-file"))
+ (should (= (count-lines (point-min) (point-max)) 4))
+ (should-error (package-menu-filter-by-archive "non-existent archive"))))
+
+(ert-deftest package-test-list-filter-by-keyword ()
+ "Ensure package list is filtered correctly by package keyword."
+ (with-package-menu-test
+ (package-menu-filter-by-keyword "frobnicate")
+ (goto-char (point-min))
+ (should (re-search-forward "^\\s-+simple-single" nil t))
+ (should (= (count-lines (point-min) (point-max)) 1))
+ (should-error (package-menu-filter-by-keyword "non-existent-keyword"))))
(ert-deftest package-test-list-filter-by-name ()
"Ensure package list is filtered correctly by package name."
- (with-package-test ()
- (let ((buf (package-list-packages)))
- (package-menu-filter-by-name "tetris")
- (goto-char (point-min))
- (should (re-search-forward "^\\s-+tetris" nil t))
- (should (= (count-lines (point-min) (point-max)) 1))
- (kill-buffer buf))))
+ (with-package-menu-test ()
+ (package-menu-filter-by-name "tetris")
+ (goto-char (point-min))
+ (should (re-search-forward "^\\s-+tetris" nil t))
+ (should (= (count-lines (point-min) (point-max)) 1))))
+
+(ert-deftest package-test-list-filter-by-status ()
+ "Ensure package list is filtered correctly by package status."
+ (with-package-menu-test
+ (package-menu-filter-by-status "available")
+ (goto-char (point-min))
+ (should (re-search-forward "^\\s-+multi-file" nil t))
+ (should (= (count-lines (point-min) (point-max)) 4))
+ ;; No installed packages in default environment.
+ (should-error (package-menu-filter-by-status "installed"))))
+
+(ert-deftest package-test-list-filter-by-version ()
+ (with-package-menu-test
+ (should-error (package-menu-filter-by-version "1.1" 'unknown-symbol))) )
+
+(defun package-test-filter-by-version (version predicate name)
+ (with-package-menu-test
+ (package-menu-filter-by-version version predicate)
+ (goto-char (point-min))
+ ;; We just check that the given package is included in the
+ ;; listing. One could be more ambitious.
+ (should (re-search-forward name))))
+
+(ert-deftest package-test-list-filter-by-version-= ()
+ "Ensure package list is filtered correctly by package version (=)."
+ (package-test-filter-by-version "1.1" '= "^\\s-+simple-two-depend"))
+
+(ert-deftest package-test-list-filter-by-version-< ()
+ "Ensure package list is filtered correctly by package version (<)."
+ (package-test-filter-by-version "1.2" '< "^\\s-+simple-two-depend"))
+
+(ert-deftest package-test-list-filter-by-version-> ()
+ "Ensure package list is filtered correctly by package version (>)."
+ (package-test-filter-by-version "1.0" '> "^\\s-+simple-two-depend"))
(ert-deftest package-test-list-clear-filter ()
"Ensure package list filter is cleared correctly."
- (with-package-test ()
- (let ((buf (package-list-packages)))
- (let ((num-packages (count-lines (point-min) (point-max))))
- (should (> num-packages 1))
- (package-menu-filter-by-name "tetris")
- (should (= (count-lines (point-min) (point-max)) 1))
- (package-menu-clear-filter)
- (should (= (count-lines (point-min) (point-max)) num-packages)))
- (kill-buffer buf))))
+ (with-package-menu-test
+ (let ((num-packages (count-lines (point-min) (point-max))))
+ (package-menu-filter-by-name "tetris")
+ (should (= (count-lines (point-min) (point-max)) 1))
+ (package-menu-clear-filter)
+ (should (= (count-lines (point-min) (point-max)) num-packages)))))
(ert-deftest package-test-update-archives ()
"Test updating package archives."