From: Stefan Kangas <stefan@marxist.se>
To: 38424@debbugs.gnu.org
Subject: bug#38424: [PATCH] Add new filter functions to Package Menu
Date: Fri, 29 Nov 2019 13:31:10 +0100 [thread overview]
Message-ID: <CADwFkm=RD6NTEFebDr1f4JLpwkvQC26Wty14ELXLwR7p7hx6WA@mail.gmail.com> (raw)
[-- 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
next reply other threads:[~2019-11-29 12:31 UTC|newest]
Thread overview: 9+ messages / expand[flat|nested] mbox.gz Atom feed top
2019-11-29 12:31 Stefan Kangas [this message]
2019-11-30 12:18 ` bug#38424: [PATCH] Add new filter functions to Package Menu 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
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to='CADwFkm=RD6NTEFebDr1f4JLpwkvQC26Wty14ELXLwR7p7hx6WA@mail.gmail.com' \
--to=stefan@marxist.se \
--cc=38424@debbugs.gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this external index
https://git.savannah.gnu.org/cgit/emacs.git
https://git.savannah.gnu.org/cgit/emacs/org-mode.git
This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.