* bug#38424: [PATCH] Add new filter functions to Package Menu
@ 2019-11-29 12:31 Stefan Kangas
2019-11-30 12:18 ` Eli Zaretskii
0 siblings, 1 reply; 9+ messages in thread
From: Stefan Kangas @ 2019-11-29 12:31 UTC (permalink / raw)
To: 38424
[-- Attachment #1: Type: text/plain, Size: 373 bytes --]
The attached patches adds new commands to filter the "*Packages*"
buffer by version, status and archive. (The first patch only adds new
version list comparison predicates, something I needed to simplify the
second patch.)
I meant to sent this earlier, but got too busy with real life. I hope
that it's not too late to make it into Emacs 27.
Best regards,
Stefan Kangas
[-- Attachment #2: 0001-Add-version-comparison-predicates-for-and.patch --]
[-- Type: text/x-patch, Size: 5845 bytes --]
From a27410cd2ef7558fc66842dab3454be44d816b62 Mon Sep 17 00:00:00 2001
From: Stefan Kangas <stefankangas@gmail.com>
Date: Tue, 12 Nov 2019 02:01:22 +0100
Subject: [PATCH 1/2] Add version comparison predicates for > and >=
* lisp/subr.el (version-list->, version-list->=, version>)
(version>=): New functions.
* test/lisp/subr-tests.el (subr-test-version-list-<)
(subr-test-version-list->, subr-test-version-list-=)
(subr-test-version-list-<=, subr-test-version-list->=): New tests.
---
lisp/subr.el | 39 +++++++++++++++++++++++++++++++++++++--
test/lisp/subr-tests.el | 36 ++++++++++++++++++++++++++++++++++++
2 files changed, 73 insertions(+), 2 deletions(-)
diff --git a/lisp/subr.el b/lisp/subr.el
index c1614c2e03..0e03392561 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -5568,6 +5568,14 @@ version-list-<
;; l1 null and l2 not null ==> l2 length > l1 length
(t (< 0 (version-list-not-zero l2)))))
+(defun version-list-> (l1 l2)
+ "Return t if L1, a list specification of a version, is higher than L2.
+
+Note that a version specified by the list (1) is equal to (1 0),
+\(1 0 0), (1 0 0 0), etc. That is, the trailing zeros are insignificant.
+Also, a version given by the list (1) is higher than (1 -1), which in
+turn is higher than (1 -2), which is higher than (1 -3)."
+ (not (version-list-<= l1 l2)))
(defun version-list-= (l1 l2)
"Return t if L1, a list specification of a version, is equal to L2.
@@ -5589,7 +5597,6 @@ version-list-=
;; l1 null and l2 not null ==> l2 length > l1 length
(t (zerop (version-list-not-zero l2)))))
-
(defun version-list-<= (l1 l2)
"Return t if L1, a list specification of a version, is lower or equal to L2.
@@ -5610,6 +5617,15 @@ version-list-<=
;; l1 null and l2 not null ==> l2 length > l1 length
(t (<= 0 (version-list-not-zero l2)))))
+(defun version-list->= (l1 l2)
+ "Return t if L1, a list specification of a version, is higher or equal to L2.
+
+Note that a version specified by the list (1) is equal to (1 0),
+\(1 0 0), (1 0 0 0), etc. That is, the trailing zeros are insignificant.
+Also, a version given by the list (1) is higher than (1 -1), which in
+turn is higher than (1 -2), which is higher than (1 -3)."
+ (not (version-list-< l1 l2)))
+
(defun version-list-not-zero (lst)
"Return the first non-zero element of LST, which is a list of integers.
@@ -5621,7 +5637,6 @@ version-list-not-zero
;; there is no element different of zero
0))
-
(defun version< (v1 v2)
"Return t if version V1 is lower (older) than V2.
@@ -5652,6 +5667,26 @@ version=
Also, \"-GIT\", \"-CVS\" and \"-NNN\" are treated as snapshot versions."
(version-list-= (version-to-list v1) (version-to-list v2)))
+(defun version> (v1 v2)
+ "Return t if version V1 is higher than V2.
+
+Note that version string \"1\" is equal to \"1.0\", \"1.0.0\", \"1.0.0.0\",
+etc. That is, the trailing \".0\"s are insignificant. Also, version
+string \"1\" is higher (newer) than \"1pre\", which is higher than \"1beta\",
+which is higher than \"1alpha\", which is higher than \"1snapshot\".
+Also, \"-GIT\", \"-CVS\" and \"-NNN\" are treated as snapshot versions."
+ (not (version-list-<= (version-to-list v1) (version-to-list v2))))
+
+(defun version>= (v1 v2)
+ "Return t if version V1 is higher or equal to V2.
+
+Note that version string \"1\" is equal to \"1.0\", \"1.0.0\", \"1.0.0.0\",
+etc. That is, the trailing \".0\"s are insignificant. Also, version
+string \"1\" is higher (newer) than \"1pre\", which is higher than \"1beta\",
+which is higher than \"1alpha\", which is higher than \"1snapshot\".
+Also, \"-GIT\", \"-CVS\" and \"-NNN\" are treated as snapshot versions."
+ (not (version-list-< (version-to-list v1) (version-to-list v2))))
+
(defvar package--builtin-versions
;; Mostly populated by loaddefs.el via autoload-builtin-package-versions.
(purecopy `((emacs . ,(version-to-list emacs-version))))
diff --git a/test/lisp/subr-tests.el b/test/lisp/subr-tests.el
index b3c04cdc9a..f9cdcc4a8b 100644
--- a/test/lisp/subr-tests.el
+++ b/test/lisp/subr-tests.el
@@ -244,6 +244,42 @@ subr-test-version-parsing
(error-message-string (should-error (version-to-list "beta22_8alpha3")))
"Invalid version syntax: `beta22_8alpha3' (must start with a number)"))))
+(ert-deftest subr-test-version-list-< ()
+ (should (version-list-< '(0) '(1)))
+ (should (version-list-< '(0 9) '(1 0)))
+ (should (version-list-< '(1 -1) '(1 0)))
+ (should (version-list-< '(1 -2) '(1 -1)))
+ (should (not (version-list-< '(1) '(0))))
+ (should (not (version-list-< '(1 1) '(1 0))))
+ (should (not (version-list-< '(1) '(1 0))))
+ (should (not (version-list-< '(1 0) '(1 0 0)))))
+
+(ert-deftest subr-test-version-list-> ()
+ (should (version-list-> '(1 0) '(0 9)))
+ (should (version-list-> '(1) '(1 -1)))
+ (should (version-list-> '(1) '(0)))
+ (should (version-list-> '(1 1) '(1 0)))
+ (should (not (version-list-> '(0) '(1))))
+ (should (not (version-list-> '(1) '(1 0))))
+ (should (not (version-list-> '(1 0) '(1 0 0)))))
+
+(ert-deftest subr-test-version-list-= ()
+ (should (version-list-= '(1) '(1)))
+ (should (version-list-= '(1 0) '(1)))
+ (should (not (version-list-= '(0) '(1)))))
+
+(ert-deftest subr-test-version-list-<= ()
+ (should (version-list-<= '(0) '(1)))
+ (should (version-list-<= '(1) '(1)))
+ (should (version-list-<= '(1 0) '(1)))
+ (should (not (version-list-<= '(1) '(0)))))
+
+(ert-deftest subr-test-version-list->= ()
+ (should (version-list->= '(1) '(0)))
+ (should (version-list->= '(1) '(1)))
+ (should (version-list->= '(1 0) '(1)))
+ (should (not (version-list->= '(0) '(1)))))
+
(defun subr-test--backtrace-frames-with-backtrace-frame (base)
"Reference implementation of `backtrace-frames'."
(let ((idx 0)
--
2.20.1
[-- Attachment #3: 0002-Add-new-filter-functions-to-Package-Menu.patch --]
[-- Type: text/x-patch, Size: 27756 bytes --]
From 2c98f9ca12daaf40b35c86801fc0137975bde312 Mon Sep 17 00:00:00 2001
From: Stefan Kangas <stefankangas@gmail.com>
Date: Tue, 5 Nov 2019 15:48:48 +0100
Subject: [PATCH 2/2] Add new filter functions to Package Menu
* lisp/emacs-lisp/package.el (package-menu-filter-by-version)
(package-menu-filter-by-status, package-menu-filter-by-archive):
New filter functions.
(package-menu--filter-by): New helper function.
(package-menu-filter-by-keyword, package-menu-filter-by-name): Use
above helper function.
(package-menu-mode-menu):
(package-menu-mode-map): Update menu to include new filter functions.
* doc/emacs/package.texi (Package Menu): Document it.
* etc/NEWS: Announce it.
(package-menu--refresh): Remove t as synonym for nil in first
argument. Doc fix.
(list-packages, package-menu-mode, package-keyword-button-action):
Update calls to above.
(package-menu-filter-clear): Update calls to above and rename from
'package-menu-clear-filter'.
(package-menu--display): New function.
(package-menu--generate): Simplify.
* test/lisp/emacs-lisp/package-tests.el (with-package-menu-test):
New macro.
(package-test-update-listing, package-test-list-filter-by-name):
Use above macro.
(package-test-list-filter-clear): Rename from
'package-test-list-clear-filter' and 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): New tests.
---
doc/emacs/package.texi | 63 ++++---
etc/NEWS | 23 ++-
lisp/emacs-lisp/package.el | 249 +++++++++++++++++++-------
test/lisp/emacs-lisp/package-tests.el | 103 +++++++----
4 files changed, 319 insertions(+), 119 deletions(-)
diff --git a/doc/emacs/package.texi b/doc/emacs/package.texi
index 1c0f853427..afc18e5611 100644
--- a/doc/emacs/package.texi
+++ b/doc/emacs/package.texi
@@ -157,27 +157,6 @@ Package Menu
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
@@ -189,6 +168,48 @@ Package Menu
@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 cb73e46358..2a3b6f2c1e 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -1199,14 +1199,21 @@ early init file.
*** New function 'package-activate-all'.
+++
-*** New functions for filtering packages list.
-A new function has been added which allows users to filter the
-packages list by name: 'package-menu-filter-by-name'. By default, it
-is bound to '/ n'. Additionally, the function
-'package-menu-fiter-by-keyword' has been renamed from
-'package-menu-filter'. Its keybinding has also been changed to '/ k'
-(from 'f'). To clear any of the two filters, the user can now call
-the 'package-menu-clear-filter' function, bound to '/ /' by default.
+*** New functions for filtering the package list.
+The new 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
+
+The function that was previously named 'package-menu-filter' has been
+renamed to 'package-menu-filter-by-keyword'. It is no longer bound to
+'f' in the package buffer, but instead to '/ n' as shown above.
---
*** Imenu support has been added to 'package-menu-mode'.
diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el
index 56e160232d..6274766ef7 100644
--- a/lisp/emacs-lisp/package.el
+++ b/lisp/emacs-lisp/package.el
@@ -2644,7 +2644,7 @@ package-keyword-button-action
Used for the `action' property of buttons in the buffer created by
`describe-package'."
(let ((pkg-keyword (button-get button 'package-keyword)))
- (package-show-package-list t (list pkg-keyword))))
+ (package-show-package-list nil (list pkg-keyword))))
(defun package-make-button (text &rest properties)
"Insert button labeled TEXT with button PROPERTIES at point.
@@ -2690,15 +2690,18 @@ package-menu-mode-map
(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-filter-clear)
+ (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.")
@@ -2725,9 +2728,12 @@ package-menu-mode-menu
"--"
("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"]
- ["Clear Filter" package-menu-clear-filter :help "Clear package list filter"])
+ ["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-filter-clear :help "Clear package list filter"])
["Hide by Regexp" package-menu-hide-package :help "Permanently hide all packages matching a regexp"]
["Display Older Versions" package-menu-toggle-hiding
@@ -2761,7 +2767,7 @@ package-menu-mode
("Description" 0 package-menu--description-predicate)])
(setq tabulated-list-padding 2)
(setq tabulated-list-sort-key (cons "Status" nil))
- (add-hook 'tabulated-list-revert-hook #'package-menu--refresh nil t)
+ (add-hook 'tabulated-list-revert-hook #'package-menu--refresh)
(tabulated-list-init-header)
(setq revert-buffer-function 'package-menu--refresh-contents)
(setf imenu-prev-index-position-function
@@ -2927,17 +2933,19 @@ package-hidden-regexps
:type '(repeat (regexp :tag "Hide packages with name matching")))
(defun package-menu--refresh (&optional packages keywords)
- "Re-populate the `tabulated-list-entries'.
-PACKAGES should be nil or t, which means to display all known packages.
-KEYWORDS should be nil or a list of keywords."
+ "Re-populate `tabulated-list-entries' with all known packages.
+With optional argument PACKAGES, a list of package
+names (symbols), add only packages with matching names.
+
+With optional argument KEYWORDS, a list of keywords as symbols,
+add only packages with matching keywords."
;; Construct list of (PKG-DESC . STATUS).
- (unless packages (setq packages t))
(let ((hidden-names (mapconcat #'identity package-hidden-regexps "\\|"))
info-list)
;; Installed packages:
(dolist (elt package-alist)
(let ((name (car elt)))
- (when (or (eq packages t) (memq name packages))
+ (when (or (not packages) (memq name packages))
(dolist (pkg (cdr elt))
(when (package--has-keyword-p pkg keywords)
(push pkg info-list))))))
@@ -2950,7 +2958,7 @@ package-menu--refresh
(when (and (package--has-keyword-p pkg keywords)
(or package-list-unversioned
(package--bi-desc-version (cdr elt)))
- (or (eq packages t) (memq name packages)))
+ (or (not packages) (memq name packages)))
(push pkg info-list)))))
;; Available and disabled packages:
@@ -2959,7 +2967,7 @@ package-menu--refresh
(dolist (elt package-archive-contents)
(let ((name (car elt)))
;; To be displayed it must be in PACKAGES;
- (when (and (or (eq packages t) (memq name packages))
+ (when (and (or (not packages) (memq name packages))
;; and we must either not be hiding anything,
(or (not package-menu--hide-packages)
(not package-hidden-regexps)
@@ -2970,7 +2978,7 @@ package-menu--refresh
(when (package--has-keyword-p pkg keywords)
(push pkg info-list))))))
- ;; Print the result.
+ ;; Set `tabulated-list-entries'.
(tabulated-list-init-header)
(setq tabulated-list-entries
(mapcar #'package-menu--print-info-simple info-list))))
@@ -3031,23 +3039,30 @@ package--has-keyword-p
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.
-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)
+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 keywords
- (let ((filters (mapconcat #'identity keywords ",")))
- (concat "Package[" filters "]"))
+ (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.
+If REMEMBER-POS is non-nil, keep point on the same entry.
+
+Arguments PACKAGES and KEYWORDS are like `package-menu--refresh'."
+ (package-menu--refresh packages keywords)
+ (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'.
PKG has the form (PKG-DESC . STATUS).
@@ -3655,7 +3670,7 @@ list-packages
;; If we're not async, this would be redundant.
(when package-menu-async
- (package-menu--generate nil t)))
+ (package-menu--generate nil)))
;; The package menu buffer has keybindings. If the user types
;; `M-x list-packages', that suggests it should become current.
(switch-to-buffer buf)))
@@ -3683,51 +3698,164 @@ package-show-package-list
(select-window win)
(switch-to-buffer buf))))
+(defun package-menu--filter-by (predicate suffix)
+ "Filter \"*Packages*\" buffer by PREDICATE, and add DESC 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)
+ (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)
+ (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")))))
-
-(defun package-menu-clear-filter ()
+ (package-menu--generate 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)
+ (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 ("
+ (cond ((eq choice '=) "= equal to")
+ ((eq choice '<) "< less than")
+ ((eq choice '>) "> greater than"))
+ "): "))
+ choice))))
+ (unless (equal predicate 'quit)
+ (if (or (not version) (string-empty-p version))
+ (package-menu--generate t)
+ (package-menu--filter-by
+ (let ((fun (cond ((eq predicate '=) 'version-list-=)
+ ((eq predicate '<) 'version-list-<)
+ ((eq predicate '>) 'version-list->)
+ (t (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-filter-clear ()
"Clear any filter currently applied to the \"*Packages*\" buffer."
(interactive)
(package--ensure-package-menu-mode)
- (package-menu--generate t t))
+ (package-menu--generate t))
(defun package-list-packages-no-fetch ()
"Display a list of packages.
@@ -3770,6 +3898,7 @@ package-get-version
(or (lm-header "package-version")
(lm-header "version")))))))))
+\f
;;;; 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 828c456842..07f772d730 100644
--- a/test/lisp/emacs-lisp/package-tests.el
+++ b/test/lisp/emacs-lisp/package-tests.el
@@ -349,43 +349,86 @@ package-test-install-multifile
(goto-char (point-min))
(should (re-search-forward re nil t)))))))
+\f
+;;; 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)))
+ (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 ()
+ "Ensure package list is filtered correctly by package version."
+ (with-package-menu-test
+ (package-menu-filter-by-version "1.1" '=)
+ (goto-char (point-min))
+ (should (looking-at "^\\s-+simple-two-depend"))
+ (should (= (count-lines (point-min) (point-max)) 2))))
+
+(ert-deftest package-test-list-filter-clear ()
+ "Ensure package list filter is cleared correctly."
+ (with-package-menu-test
+ (let ((num-packages (count-lines (point-min) (point-max))))
(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))))
-
-(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))))
+ (package-menu-filter-clear)
+ (should (= (count-lines (point-min) (point-max)) num-packages)))))
(ert-deftest package-test-update-archives ()
"Test updating package archives."
--
2.20.1
^ permalink raw reply related [flat|nested] 9+ messages in thread
* bug#38424: [PATCH] Add new filter functions to Package Menu
2019-11-29 12:31 bug#38424: [PATCH] Add new filter functions to Package Menu Stefan Kangas
@ 2019-11-30 12:18 ` Eli Zaretskii
2019-12-01 11:12 ` Stefan Kangas
0 siblings, 1 reply; 9+ messages in thread
From: Eli Zaretskii @ 2019-11-30 12:18 UTC (permalink / raw)
To: Stefan Kangas; +Cc: 38424
> From: Stefan Kangas <stefan@marxist.se>
> Date: Fri, 29 Nov 2019 13:31:10 +0100
>
> The attached patches adds new commands to filter the "*Packages*"
> buffer by version, status and archive. (The first patch only adds new
> version list comparison predicates, something I needed to simplify the
> second patch.)
We deliberately didn't define the functions you are now adding, since
they are just one 'not' away. Do they really simplify the callers so
much that we now want to add them?
> * doc/emacs/package.texi (Package Menu): Document it.
This tells nothing about the changes which aren't "documenting it".
(And, btw, what is "it" here is not clear at all.)
> - (when (or (eq packages t) (memq name packages))
> + (when (or (not packages) (memq name packages))
> (dolist (pkg (cdr elt))
> (when (package--has-keyword-p pkg keywords)
> (push pkg info-list))))))
> @@ -2950,7 +2958,7 @@ package-menu--refresh
> (when (and (package--has-keyword-p pkg keywords)
> (or package-list-unversioned
> (package--bi-desc-version (cdr elt)))
> - (or (eq packages t) (memq name packages)))
> + (or (not packages) (memq name packages)))
> (push pkg info-list)))))
>
> ;; Available and disabled packages:
> @@ -2959,7 +2967,7 @@ package-menu--refresh
> (dolist (elt package-archive-contents)
> (let ((name (car elt)))
> ;; To be displayed it must be in PACKAGES;
> - (when (and (or (eq packages t) (memq name packages))
> + (when (and (or (not packages) (memq name packages))
Does the above mean you are suggesting a backward-incompatible API
change?
> +Arguments PACKAGES and KEYWORDS are like `package-menu--refresh'."
Arguments cannot be "like" a function. Suggest to say "like in
`package-menu--refresh'" instead.
I don't use package.el, so I'd like someone who does or knows the code
well to review the patch.
Thanks.
^ permalink raw reply [flat|nested] 9+ messages in thread
* bug#38424: [PATCH] Add new filter functions to Package Menu
2019-11-30 12:18 ` Eli Zaretskii
@ 2019-12-01 11:12 ` Stefan Kangas
2019-12-01 11:16 ` Stefan Kangas
2019-12-01 18:11 ` Eli Zaretskii
0 siblings, 2 replies; 9+ messages in thread
From: Stefan Kangas @ 2019-12-01 11:12 UTC (permalink / raw)
To: Eli Zaretskii; +Cc: 38424
Eli Zaretskii <eliz@gnu.org> writes:
>> From: Stefan Kangas <stefan@marxist.se>
>> Date: Fri, 29 Nov 2019 13:31:10 +0100
>>
>> The attached patches adds new commands to filter the "*Packages*"
>> buffer by version, status and archive. (The first patch only adds new
>> version list comparison predicates, something I needed to simplify the
>> second patch.)
>
> We deliberately didn't define the functions you are now adding, since
> they are just one 'not' away. Do they really simplify the callers so
> much that we now want to add them?
I don't know, but I'm also not sure I understand the benefit of not
adding them.
In this case, it let me do this:
+ (let ((fun (cond ((eq predicate '=) 'version-list-=)
+ ((eq predicate '<) 'version-list-<)
+ ((eq predicate '>) 'version-list->)
I could of course use a lambda here instead, but it makes the code a
bit uglier. Let me know if that's preferable.
>> * doc/emacs/package.texi (Package Menu): Document it.
>
> This tells nothing about the changes which aren't "documenting it".
> (And, btw, what is "it" here is not clear at all.)
Thanks. I thought that was how we usually wrote.
Is "Document the new commands." better?
>> - (when (or (eq packages t) (memq name packages))
>> + (when (or (not packages) (memq name packages))
>> (dolist (pkg (cdr elt))
>> (when (package--has-keyword-p pkg keywords)
>> (push pkg info-list))))))
>> @@ -2950,7 +2958,7 @@ package-menu--refresh
>> (when (and (package--has-keyword-p pkg keywords)
>> (or package-list-unversioned
>> (package--bi-desc-version (cdr elt)))
>> - (or (eq packages t) (memq name packages)))
>> + (or (not packages) (memq name packages)))
>> (push pkg info-list)))))
>>
>> ;; Available and disabled packages:
>> @@ -2959,7 +2967,7 @@ package-menu--refresh
>> (dolist (elt package-archive-contents)
>> (let ((name (car elt)))
>> ;; To be displayed it must be in PACKAGES;
>> - (when (and (or (eq packages t) (memq name packages))
>> + (when (and (or (not packages) (memq name packages))
>
> Does the above mean you are suggesting a backward-incompatible API
> change?
AFAIU, this does not change the API since this is an internal
function.
>> +Arguments PACKAGES and KEYWORDS are like `package-menu--refresh'."
>
> Arguments cannot be "like" a function. Suggest to say "like in
> `package-menu--refresh'" instead.
Right, I'll fix that.
> I don't use package.el, so I'd like someone who does or knows the code
> well to review the patch.
I'll wait for that review. Thank you for taking a look.
Best regards,
Stefan Kangas
^ permalink raw reply [flat|nested] 9+ messages in thread
* bug#38424: [PATCH] Add new filter functions to Package Menu
2019-12-01 11:12 ` Stefan Kangas
@ 2019-12-01 11:16 ` Stefan Kangas
2019-12-01 18:12 ` Eli Zaretskii
2019-12-01 18:11 ` Eli Zaretskii
1 sibling, 1 reply; 9+ messages in thread
From: Stefan Kangas @ 2019-12-01 11:16 UTC (permalink / raw)
To: Eli Zaretskii; +Cc: 38424
Stefan Kangas <stefan@marxist.se> writes:
>>> * doc/emacs/package.texi (Package Menu): Document it.
>>
>> This tells nothing about the changes which aren't "documenting it".
>> (And, btw, what is "it" here is not clear at all.)
>
> Thanks. I thought that was how we usually wrote.
>
> Is "Document the new commands." better?
Wait, do you mean to also comment on moving the old commands around?
If so, I'd suggest the following: "Document the new commands and move
the fitering commands to follow a better sorting order."
Does that sound better?
Best regards,
Stefan Kangas
^ permalink raw reply [flat|nested] 9+ messages in thread
* bug#38424: [PATCH] Add new filter functions to Package Menu
2019-12-01 11:12 ` Stefan Kangas
2019-12-01 11:16 ` Stefan Kangas
@ 2019-12-01 18:11 ` Eli Zaretskii
2020-01-25 1:37 ` Stefan Kangas
1 sibling, 1 reply; 9+ messages in thread
From: Eli Zaretskii @ 2019-12-01 18:11 UTC (permalink / raw)
To: Stefan Kangas; +Cc: 38424
> From: Stefan Kangas <stefan@marxist.se>
> Cc: 38424@debbugs.gnu.org
> Date: Sun, 01 Dec 2019 12:12:58 +0100
>
> > We deliberately didn't define the functions you are now adding, since
> > they are just one 'not' away. Do they really simplify the callers so
> > much that we now want to add them?
>
> I don't know, but I'm also not sure I understand the benefit of not
> adding them.
The same reason why we don't have string-greater-p: keep Emacs from
becoming larger without a good reason.
> In this case, it let me do this:
>
> + (let ((fun (cond ((eq predicate '=) 'version-list-=)
> + ((eq predicate '<) 'version-list-<)
> + ((eq predicate '>) 'version-list->)
>
> I could of course use a lambda here instead, but it makes the code a
> bit uglier.
Or you could use a defsubst or an inline function.
> >> * doc/emacs/package.texi (Package Menu): Document it.
> >
> > This tells nothing about the changes which aren't "documenting it".
> > (And, btw, what is "it" here is not clear at all.)
>
> Thanks. I thought that was how we usually wrote.
We do, but in a different situation. Like this:
* lisp/foo.el (foo-bar-quux-func): New function.
* doc/lispref/foo-docs.texi (Foo Bar): Document it.
In this case, it's immediately clear what "it" refers to. But in your
case:
* lisp/emacs-lisp/package.el (package-menu-filter-by-version)
(package-menu-filter-by-status, package-menu-filter-by-archive):
New filter functions.
(package-menu--filter-by): New helper function.
(package-menu-filter-by-keyword, package-menu-filter-by-name): Use
above helper function.
(package-menu-mode-menu):
(package-menu-mode-map): Update menu to include new filter functions.
* doc/emacs/package.texi (Package Menu): Document it.
* etc/NEWS: Announce it.
it is much less clear, because there are many "its" above.
> >> - (when (or (eq packages t) (memq name packages))
> >> + (when (or (not packages) (memq name packages))
> >> (dolist (pkg (cdr elt))
> >> (when (package--has-keyword-p pkg keywords)
> >> (push pkg info-list))))))
> >> @@ -2950,7 +2958,7 @@ package-menu--refresh
> >> (when (and (package--has-keyword-p pkg keywords)
> >> (or package-list-unversioned
> >> (package--bi-desc-version (cdr elt)))
> >> - (or (eq packages t) (memq name packages)))
> >> + (or (not packages) (memq name packages)))
> >> (push pkg info-list)))))
> >>
> >> ;; Available and disabled packages:
> >> @@ -2959,7 +2967,7 @@ package-menu--refresh
> >> (dolist (elt package-archive-contents)
> >> (let ((name (car elt)))
> >> ;; To be displayed it must be in PACKAGES;
> >> - (when (and (or (eq packages t) (memq name packages))
> >> + (when (and (or (not packages) (memq name packages))
> >
> > Does the above mean you are suggesting a backward-incompatible API
> > change?
>
> AFAIU, this does not change the API since this is an internal
> function.
But doesn't it change the API of that internal function in
incompatible ways? If it does, was that really necessary?
^ permalink raw reply [flat|nested] 9+ messages in thread
* bug#38424: [PATCH] Add new filter functions to Package Menu
2019-12-01 11:16 ` Stefan Kangas
@ 2019-12-01 18:12 ` Eli Zaretskii
0 siblings, 0 replies; 9+ messages in thread
From: Eli Zaretskii @ 2019-12-01 18:12 UTC (permalink / raw)
To: Stefan Kangas; +Cc: 38424
> From: Stefan Kangas <stefan@marxist.se>
> Cc: 38424@debbugs.gnu.org
> Date: Sun, 01 Dec 2019 12:16:43 +0100
>
> Stefan Kangas <stefan@marxist.se> writes:
>
> >>> * doc/emacs/package.texi (Package Menu): Document it.
> >>
> >> This tells nothing about the changes which aren't "documenting it".
> >> (And, btw, what is "it" here is not clear at all.)
> >
> > Thanks. I thought that was how we usually wrote.
> >
> > Is "Document the new commands." better?
>
> Wait, do you mean to also comment on moving the old commands around?
Yes.
> If so, I'd suggest the following: "Document the new commands and move
> the fitering commands to follow a better sorting order."
Much better, thanks. Bonus points for saying what sorting order is
that, to make your motivation clear.
^ permalink raw reply [flat|nested] 9+ messages in thread
* bug#38424: [PATCH] Add new filter functions to Package Menu
2019-12-01 18:11 ` Eli Zaretskii
@ 2020-01-25 1:37 ` Stefan Kangas
2020-01-31 13:54 ` Eli Zaretskii
0 siblings, 1 reply; 9+ messages in thread
From: Stefan Kangas @ 2020-01-25 1:37 UTC (permalink / raw)
To: Eli Zaretskii; +Cc: 38424
[-- Attachment #1: Type: text/plain, Size: 1076 bytes --]
Eli Zaretskii <eliz@gnu.org> writes:
>> > We deliberately didn't define the functions you are now adding, since
>> > they are just one 'not' away. Do they really simplify the callers so
>> > much that we now want to add them?
>>
>> I don't know, but I'm also not sure I understand the benefit of not
>> adding them.
>
> The same reason why we don't have string-greater-p: keep Emacs from
> becoming larger without a good reason.
I've rewritten the patch to not add such functions.
>> > This tells nothing about the changes which aren't "documenting it".
>> > (And, btw, what is "it" here is not clear at all.)
Fixed.
> But doesn't it change the API of that internal function in
> incompatible ways? If it does, was that really necessary?
I've changed the patch to no longer do that change. The change is in
any case orthogonal to what I'm trying to achieve here and better to
make separately. (I might later suggest that change in a separate
patch.)
Please find attached an updated patch. I hope it's more
straightforward to review.
Best regards,
Stefan Kangas
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Add-new-filter-functions-to-Package-Menu.patch --]
[-- Type: text/x-diff, Size: 23746 bytes --]
From 69c048a68cfe9cce14b6aa141bea770187496aec Mon Sep 17 00:00:00 2001
From: Stefan Kangas <stefankangas@gmail.com>
Date: Tue, 5 Nov 2019 15:48:48 +0100
Subject: [PATCH] Add new filter functions to Package Menu
* lisp/emacs-lisp/package.el (package-menu-filter-by-version)
(package-menu-filter-by-status, package-menu-filter-by-archive):
New filter functions.
(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 functions.
* 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 | 15 ++
lisp/emacs-lisp/package.el | 219 ++++++++++++++++++++------
test/lisp/emacs-lisp/package-tests.el | 117 ++++++++++----
4 files changed, 320 insertions(+), 94 deletions(-)
diff --git a/doc/emacs/package.texi b/doc/emacs/package.texi
index 1cac7f9b4b..360fc980e4 100644
--- a/doc/emacs/package.texi
+++ b/doc/emacs/package.texi
@@ -151,27 +151,6 @@ Package Menu
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 @@ Package Menu
@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 5395f2ccfb..f9cdfbcca9 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -103,6 +103,21 @@ supplied error message.
*** New connection method "media", which allows accessing media devices
like cell phones, tablets or cameras.
+** 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
+
\f
* New Modes and Packages in Emacs 28.1
diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el
index a9508c1bdc..f14ef7919e 100644
--- a/lisp/emacs-lisp/package.el
+++ b/lisp/emacs-lisp/package.el
@@ -2679,15 +2679,18 @@ package-menu-mode-map
(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 @@ package-menu-mode-menu
"--"
("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 @@ package--has-keyword-p
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 @@ package-show-package-list
(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 @@ package-get-version
(or (lm-header "package-version")
(lm-header "version")))))))))
+\f
;;;; 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 7d354d6ecd..adf917aef4 100644
--- a/test/lisp/emacs-lisp/package-tests.el
+++ b/test/lisp/emacs-lisp/package-tests.el
@@ -349,43 +349,102 @@ package-test-install-multifile
(goto-char (point-min))
(should (re-search-forward re nil t)))))))
+\f
+;;; 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."
--
2.20.1
^ permalink raw reply related [flat|nested] 9+ messages in thread
* bug#38424: [PATCH] Add new filter functions to Package Menu
2020-01-25 1:37 ` Stefan Kangas
@ 2020-01-31 13:54 ` Eli Zaretskii
2020-02-05 12:36 ` Stefan Kangas
0 siblings, 1 reply; 9+ messages in thread
From: Eli Zaretskii @ 2020-01-31 13:54 UTC (permalink / raw)
To: Stefan Kangas; +Cc: 38424
> From: Stefan Kangas <stefan@marxist.se>
> Cc: 38424@debbugs.gnu.org
> Date: Sat, 25 Jan 2020 02:37:57 +0100
>
> Please find attached an updated patch. I hope it's more
> straightforward to review.
Thanks, since no one of those who use package.el and know more than I
do about its internals voice any objections, I guess this is good to
go.
^ permalink raw reply [flat|nested] 9+ messages in thread
* bug#38424: [PATCH] Add new filter functions to Package Menu
2020-01-31 13:54 ` Eli Zaretskii
@ 2020-02-05 12:36 ` Stefan Kangas
0 siblings, 0 replies; 9+ messages in thread
From: Stefan Kangas @ 2020-02-05 12:36 UTC (permalink / raw)
To: Eli Zaretskii; +Cc: 38424
close 38424 28.1
thanks
Eli Zaretskii <eliz@gnu.org> writes:
> Thanks, since no one of those who use package.el and know more than I
> do about its internals voice any objections, I guess this is good to
> go.
Thanks. Pushed to master as commit aea12d4903.
Best regards,
Stefan Kangas
^ permalink raw reply [flat|nested] 9+ messages in thread
end of thread, other threads:[~2020-02-05 12:36 UTC | newest]
Thread overview: 9+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2019-11-29 12:31 bug#38424: [PATCH] Add new filter functions to Package Menu Stefan Kangas
2019-11-30 12:18 ` Eli Zaretskii
2019-12-01 11:12 ` Stefan Kangas
2019-12-01 11:16 ` Stefan Kangas
2019-12-01 18:12 ` Eli Zaretskii
2019-12-01 18:11 ` Eli Zaretskii
2020-01-25 1:37 ` Stefan Kangas
2020-01-31 13:54 ` Eli Zaretskii
2020-02-05 12:36 ` Stefan Kangas
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/emacs.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).