From 5ae811ddef14ea1989088c259a9ed2d14d5332b4 Mon Sep 17 00:00:00 2001 From: Ted Zlatanov Date: Sat, 14 Dec 2013 14:55:19 -0500 Subject: [PATCH] Support filtering by keywords in package listings. * emacs-lisp/package.el (package-built-in-p): Support both built-in and the package.el converted package descriptions. (package-show-package-list): Allow keywords. (package-keyword-button-action): Use it instead of `finder-list-matches'. (package-menu-filter-interactive): Interactive filtering (by keyword) function. (package-menu--generate): Support keywords and change keymappings and headers when they are given. (package--has-keyword-p): Helper function. (package-menu--refresh): Use it. (package--mapc): Helper function. (package-all-keywords): Use it. (package-menu-mode-map): Set up menu items and keybindings to provide a filtering UI. --- lisp/ChangeLog | 18 ++++++ lisp/emacs-lisp/package.el | 126 +++++++++++++++++++++++++++++++------ 2 files changed, 124 insertions(+), 20 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 246b7ae5b5f..0eabdf86ffa 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,21 @@ +2013-12-14 Teodor Zlatanov + + * emacs-lisp/package.el (package-built-in-p): Support both + built-in and the package.el converted package descriptions. + (package-show-package-list): Allow keywords. + (package-keyword-button-action): Use it instead of + `finder-list-matches'. + (package-menu-filter-interactive): Interactive filtering (by + keyword) function. + (package-menu--generate): Support keywords and change keymappings + and headers when they are given. + (package--has-keyword-p): Helper function. + (package-menu--refresh): Use it. + (package--mapc): Helper function. + (package-all-keywords): Use it. + (package-menu-mode-map): Set up menu items and keybindings to + provide a filtering UI. + 2013-12-14 Teodor Zlatanov * net/gnutls.el (gnutls-verify-error): New defcustom to control diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index b8c21e0386b..407b277fa9f 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -524,13 +524,15 @@ Return the max version (as a string) if the package is held at a lower version." "Return true if PACKAGE is built-in to Emacs. Optional arg MIN-VERSION, if non-nil, should be a version list specifying the minimum acceptable version." - (let ((bi (assq package package--builtin-versions))) - (cond - (bi (version-list-<= min-version (cdr bi))) - (min-version nil) - (t - (require 'finder-inf nil t) ; For `package--builtins'. - (assq package package--builtins))))) + (if (package-desc-p package) ;; was built-in and then was converted + (eq 'builtin (package-desc-dir package)) + (let ((bi (assq package package--builtin-versions))) + (cond + (bi (version-list-<= min-version (cdr bi))) + (min-version nil) + (t + (require 'finder-inf nil t) ; For `package--builtins'. + (assq package package--builtins)))))) (defun package--from-builtin (bi-desc) (package-desc-create :name (pop bi-desc) @@ -1528,10 +1530,9 @@ If optional arg NO-ACTIVATE is non-nil, don't activate packages." (revert-buffer nil t) (goto-char (point-min))))) -(autoload 'finder-list-matches "finder") (defun package-keyword-button-action (button) (let ((pkg-keyword (button-get button 'package-keyword))) - (finder-list-matches pkg-keyword))) + (package-show-package-list t (list pkg-keyword)))) (defun package-make-button (text &rest props) (let ((button-text (if (display-graphic-p) text (concat "[" text "]"))) @@ -1557,6 +1558,7 @@ If optional arg NO-ACTIVATE is non-nil, don't activate packages." (define-key map "i" 'package-menu-mark-install) (define-key map "U" 'package-menu-mark-upgrades) (define-key map "r" 'package-menu-refresh) + (define-key map "f" 'package-menu-filter-interactive) (define-key map "~" 'package-menu-mark-obsolete-for-deletion) (define-key map "x" 'package-menu-execute) (define-key map "h" 'package-menu-quick-help) @@ -1565,6 +1567,9 @@ If optional arg NO-ACTIVATE is non-nil, don't activate packages." (define-key menu-map [mq] '(menu-item "Quit" quit-window :help "Quit package selection")) + (define-key menu-map [mf] + '(menu-item "Filter" package-menu-filter-interactive + :help "Filter package selection (q to go back)")) (define-key menu-map [s1] '("--")) (define-key menu-map [mn] '(menu-item "Next" next-line @@ -1677,9 +1682,10 @@ package PKG-DESC, add one. The alist is keyed with PKG-DESC." "installed" "unsigned")))))))) -(defun package-menu--refresh (&optional packages) +(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." +PACKAGES should be nil or t, which means to display all known packages. +KEYWORDS should be nil or a list of keywords." ;; Construct list of (PKG-DESC . STATUS). (unless packages (setq packages t)) (let (info-list name) @@ -1688,12 +1694,14 @@ PACKAGES should be nil or t, which means to display all known packages." (setq name (car elt)) (when (or (eq packages t) (memq name packages)) (dolist (pkg (cdr elt)) - (package--push pkg (package-desc-status pkg) info-list)))) + (when (package--has-keyword-p pkg keywords) + (package--push pkg (package-desc-status pkg) info-list))))) ;; Built-in packages: (dolist (elt package--builtins) (setq name (car elt)) (when (and (not (eq name 'emacs)) ; Hide the `emacs' package. + (package--has-keyword-p (package--from-builtin elt) keywords) (or package-list-unversioned (package--bi-desc-version (cdr elt))) (or (eq packages t) (memq name packages))) @@ -1705,20 +1713,89 @@ PACKAGES should be nil or t, which means to display all known packages." (when (or (eq packages t) (memq name packages)) (dolist (pkg (cdr elt)) ;; Hide obsolete packages. - (unless (package-installed-p (package-desc-name pkg) - (package-desc-version pkg)) + (when (and (not (package-installed-p (package-desc-name pkg) + (package-desc-version pkg))) + (package--has-keyword-p pkg keywords)) (package--push pkg (package-desc-status pkg) info-list))))) ;; Print the result. (setq tabulated-list-entries (mapcar #'package-menu--print-info info-list)))) -(defun package-menu--generate (remember-pos packages) +(defun package-all-keywords () + "Collect all package keywords" + (let (keywords) + (package--mapc (lambda (desc) + (let* ((extras (and desc (package-desc-extras desc))) + (desc-keywords (cdr (assoc :keywords extras)))) + (setq keywords (append keywords desc-keywords))))) + keywords)) + +(defun package--mapc (function &optional packages) + "Call FUNCTION for all known PACKAGES. +PACKAGES can be nil or t, which means to display all known +packages, or a list of packages. + +Built-in packages are converted with `package--from-builtin'." + (unless packages (setq packages t)) + (let (name) + ;; Installed packages: + (dolist (elt package-alist) + (setq name (car elt)) + (when (or (eq packages t) (memq name packages)) + (mapc function (cdr elt)))) + + ;; Built-in packages: + (dolist (elt package--builtins) + (setq name (car elt)) + (when (and (not (eq name 'emacs)) ; Hide the `emacs' package. + (or package-list-unversioned + (package--bi-desc-version (cdr elt))) + (or (eq packages t) (memq name packages))) + (funcall function (package--from-builtin elt)))) + + ;; Available and disabled packages: + (dolist (elt package-archive-contents) + (setq name (car elt)) + (when (or (eq packages t) (memq name packages)) + (dolist (pkg (cdr elt)) + ;; Hide obsolete packages. + (unless (package-installed-p (package-desc-name pkg) + (package-desc-version pkg)) + (funcall function pkg))))))) + +(defun package--has-keyword-p (desc &optional keywords) + "Test if package DESC has any of the given KEYWORDS. +When none are given, the package matches." + (if keywords + (let* ((extras (and desc (package-desc-extras desc))) + (desc-keywords (cdr (assoc :keywords extras))) + found) + (dolist (k keywords) + (when (and (not found) + (member k desc-keywords)) + (setq found t))) + found) + t)) + +(defun package-menu--generate (remember-pos packages &optional keywords) "Populate 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." - (package-menu--refresh 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")) + (if keywords + (define-key package-menu-mode-map "q" 'package-show-package-list) + (define-key package-menu-mode-map "q" 'quit-window)) + (tabulated-list-init-header) (tabulated-list-print remember-pos)) (defun package-menu--print-info (pkg) @@ -2014,18 +2091,27 @@ The list is displayed in a buffer named `*Packages*'." (defalias 'package-list-packages 'list-packages) ;; Used in finder.el -(defun package-show-package-list (packages) +(defun package-show-package-list (&optional packages keywords) "Display PACKAGES in a *Packages* buffer. This is similar to `list-packages', but it does not fetch the updated list of packages, and it only displays packages with -names in PACKAGES (which should be a list of symbols)." +names in PACKAGES (which should be a list of symbols). + +When KEYWORDS are given, only packages with those KEYWORDS are +shown." + (interactive) (require 'finder-inf nil t) (let ((buf (get-buffer-create "*Packages*"))) (with-current-buffer buf (package-menu-mode) - (package-menu--generate nil packages)) + (package-menu--generate nil packages keywords)) (switch-to-buffer buf))) +(defun package-menu-filter-interactive (keyword) + "Filter the *Packages* buffer." + (interactive (list (completing-read "Keyword: " (package-all-keywords)))) + (package-show-package-list t (list keyword))) + (defun package-list-packages-no-fetch () "Display a list of packages. Does not fetch the updated list of packages before displaying. -- 2.39.2