From 2c98f9ca12daaf40b35c86801fc0137975bde312 Mon Sep 17 00:00:00 2001 From: Stefan Kangas 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"))))))))) + ;;;; 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))))))) + +;;; 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