-;;; package.el --- Simple package system for Emacs
+;;; package.el --- Simple package system for Emacs -*- lexical-binding:t -*-
-;; Copyright (C) 2007-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2014 Free Software Foundation, Inc.
;; Author: Tom Tromey <tromey@redhat.com>
+;; Daniel Hackney <dan@haxney.org>
;; Created: 10 Mar 2007
;; Version: 1.0.1
;; Keywords: tools
(defvar Info-directory-list)
(declare-function info-initialize "info" ())
(declare-function url-http-parse-response "url-http" ())
+(declare-function url-http-file-exists-p "url-http" (url))
(declare-function lm-header "lisp-mnt" (header))
(declare-function lm-commentary "lisp-mnt" (&optional file))
(defvar url-http-end-of-headers)
Each element has the form (SYM . ID).
SYM is a package, as a symbol.
- ID is an archive name, as a string. This should correspond to an
+ ID is an archive name. This should correspond to an
entry in `package-archives'.
If the archive of name ID does not contain the package SYM, no
"Version number of the package archive understood by this file.
Lower version numbers than this will probably be understood as well.")
-(defconst package-el-version "1.0.1"
- "Version of package.el.")
-
;; We don't prime the cache since it tends to get out of date.
(defvar package-archive-contents nil
"Cache of the contents of the Emacs Lisp Package Archive.
This is an alist mapping package names (symbols) to
-`package-desc' structures.")
+non-empty lists of `package-desc' structures.")
(put 'package-archive-contents 'risky-local-variable t)
(defcustom package-user-dir (locate-user-emacs-file "elpa")
:group 'package
:version "24.1")
+(defcustom package-check-signature 'allow-unsigned
+ "Whether to check package signatures when installing."
+ :type '(choice (const nil :tag "Never")
+ (const allow-unsigned :tag "Allow unsigned")
+ (const t :tag "Check always"))
+ :risky t
+ :group 'package
+ :version "24.1")
+
+(defcustom package-unsigned-archives nil
+ "A list of archives which do not use package signature."
+ :type '(repeat (string :tag "Archive name"))
+ :risky t
+ :group 'package
+ :version "24.1")
+
(defvar package--default-summary "No description available.")
(cl-defstruct (package-desc
(:constructor
package-desc-from-define
(name-string version-string &optional summary requirements
- &key kind archive
+ &rest rest-plist
&aux
(name (intern name-string))
(version (version-to-list version-string))
(version-to-list (cadr elt))))
(if (eq 'quote (car requirements))
(nth 1 requirements)
- requirements))))))
+ requirements)))
+ (kind (plist-get rest-plist :kind))
+ (archive (plist-get rest-plist :archive))
+ (extras (let (alist)
+ (while rest-plist
+ (unless (memq (car rest-plist) '(:kind :archive))
+ (let ((value (cadr rest-plist)))
+ (when value
+ (push (cons (car rest-plist) value)
+ alist))))
+ (setq rest-plist (cddr rest-plist)))
+ alist)))))
"Structure containing information about an individual package.
-
Slots:
-`name' Name of the package, as a symbol.
+`name' Name of the package, as a symbol.
`version' Version of the package, as a version list.
`summary' Short description of the package, typically taken from
-the first line of the file.
+ the first line of the file.
-`reqs' Requirements of the package. A list of (PACKAGE
-VERSION-LIST) naming the dependent package and the minimum
-required version.
+`reqs' Requirements of the package. A list of (PACKAGE
+ VERSION-LIST) naming the dependent package and the minimum
+ required version.
-`kind' The distribution format of the package. Currently, it is
-either `single' or `tar'.
+`kind' The distribution format of the package. Currently, it is
+ either `single' or `tar'.
`archive' The name of the archive (as a string) whence this
-package came.
+ package came.
+
+`dir' The directory where the package is installed (if installed),
+ `builtin' if it is built-in, or nil otherwise.
-`dir' The directory where the package is installed (if installed)."
+`extras' Optional alist of additional keyword-value pairs.
+
+`signed' Flag to indicate that the package is signed by provider."
name
version
(summary package--default-summary)
reqs
kind
archive
- dir)
+ dir
+ extras
+ signed)
;; Pseudo fields.
(defun package-desc-full-name (pkg-desc)
((>= num 0)
(push (int-to-string num) str-list)
(push "." str-list))
- ((< num -3)
+ ((< num -4)
(error "Invalid version list `%s'" vlist))
(t
;; pre, or beta, or alpha
(error "Invalid version list `%s'" vlist)))
(push (cond ((= num -1) "pre")
((= num -2) "beta")
- ((= num -3) "alpha"))
+ ((= num -3) "alpha")
+ ((= num -4) "snapshot"))
str-list))))
(if (equal "." (car str-list))
(pop str-list))
(defun package-load-descriptor (pkg-dir)
"Load the description file in directory PKG-DIR."
(let ((pkg-file (expand-file-name (package--description-file pkg-dir)
- pkg-dir)))
+ pkg-dir))
+ (signed-file (concat pkg-dir ".signed")))
(when (file-exists-p pkg-file)
(with-temp-buffer
(insert-file-contents pkg-file)
(let ((pkg-desc (package-process-define-package
(read (current-buffer)) pkg-file)))
(setf (package-desc-dir pkg-desc) pkg-dir)
+ (if (file-exists-p signed-file)
+ (setf (package-desc-signed pkg-desc) t))
pkg-desc)))))
(defun package-load-all-descriptors ()
(defun package-activate-1 (pkg-desc)
(let* ((name (package-desc-name pkg-desc))
- (pkg-dir (package-desc-dir pkg-desc)))
+ (pkg-dir (package-desc-dir pkg-desc))
+ (pkg-dir-dir (file-name-as-directory pkg-dir)))
(unless pkg-dir
(error "Internal error: unable to find directory for `%s'"
(package-desc-full-name pkg-desc)))
+ ;; Add to load path, add autoloads, and activate the package.
+ (let ((old-lp load-path))
+ (with-demoted-errors
+ (load (expand-file-name (format "%s-autoloads" name) pkg-dir) nil t))
+ (when (and (eq old-lp load-path)
+ (not (or (member pkg-dir load-path)
+ (member pkg-dir-dir load-path))))
+ ;; Old packages don't add themselves to the `load-path', so we have to
+ ;; do it ourselves.
+ (push pkg-dir load-path)))
;; Add info node.
(when (file-exists-p (expand-file-name "dir" pkg-dir))
;; FIXME: not the friendliest, but simple.
(require 'info)
(info-initialize)
(push pkg-dir Info-directory-list))
- ;; Add to load path, add autoloads, and activate the package.
- (push pkg-dir load-path)
- (load (expand-file-name (format "%s-autoloads" name) pkg-dir) nil t)
(push name package-activated-list)
;; Don't return nil.
t))
"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)
:version (package--bi-desc-version bi-desc)
- :summary (package--bi-desc-summary bi-desc)))
+ :summary (package--bi-desc-summary bi-desc)
+ :dir 'builtin))
;; This function goes ahead and activates a newer version of a package
;; if an older one was already activated. This is not ideal; we'd at
;; If there's no old package, just add this to `package-alist'.
(push (list name new-pkg-desc) package-alist)
;; If there is, insert the new package at the right place in the list.
- (while old-pkgs
- (cond
- ((null (cdr old-pkgs)) (push new-pkg-desc (cdr old-pkgs)))
- ((version-list-< (package-desc-version (cadr old-pkgs)) version)
- (push new-pkg-desc (cdr old-pkgs))
- (setq old-pkgs nil)))
- (setq old-pkgs (cdr old-pkgs))))
+ (while
+ (if (and (cdr old-pkgs)
+ (version-list-< version
+ (package-desc-version (cadr old-pkgs))))
+ (setq old-pkgs (cdr old-pkgs))
+ (push new-pkg-desc (cdr old-pkgs))
+ nil)))
new-pkg-desc))
;; From Emacs 22, but changed so it adds to load-path.
nil file))
file)
+(defvar generated-autoload-file)
+(defvar version-control)
+
(defun package-generate-autoloads (name pkg-dir)
- (require 'autoload) ;Load before we let-bind generated-autoload-file!
(let* ((auto-name (format "%s-autoloads.el" name))
;;(ignore-name (concat name "-pkg.el"))
(generated-autoload-file (expand-file-name auto-name pkg-dir))
(write-region
(concat
(prin1-to-string
- (list 'define-package
- (symbol-name name)
- (package-version-join (package-desc-version pkg-desc))
- (package-desc-summary pkg-desc)
- (let ((requires (package-desc-reqs pkg-desc)))
- (list 'quote
- ;; Turn version lists into string form.
- (mapcar
- (lambda (elt)
- (list (car elt)
- (package-version-join (cadr elt))))
- requires)))))
+ (nconc
+ (list 'define-package
+ (symbol-name name)
+ (package-version-join (package-desc-version pkg-desc))
+ (package-desc-summary pkg-desc)
+ (let ((requires (package-desc-reqs pkg-desc)))
+ (list 'quote
+ ;; Turn version lists into string form.
+ (mapcar
+ (lambda (elt)
+ (list (car elt)
+ (package-version-join (cadr elt))))
+ requires))))
+ (package--alist-to-plist
+ (package-desc-extras pkg-desc))))
"\n")
nil
pkg-file))))
+(defun package--alist-to-plist (alist)
+ (apply #'nconc (mapcar (lambda (pair) (list (car pair) (cdr pair))) alist)))
+
(defun package-unpack (pkg-desc)
"Install the contents of the current buffer as a package."
(let* ((name (package-desc-name pkg-desc))
(error "Error during download request:%s"
(buffer-substring-no-properties (point) (line-end-position))))))
+(defun package--archive-file-exists-p (location file)
+ (let ((http (string-match "\\`https?:" location)))
+ (if http
+ (progn
+ (require 'url-http)
+ (url-http-file-exists-p (concat location file)))
+ (file-exists-p (expand-file-name file location)))))
+
+(declare-function epg-make-context "epg"
+ (&optional protocol armor textmode include-certs
+ cipher-algorithm
+ digest-algorithm
+ compress-algorithm))
+(declare-function epg-context-set-home-directory "epg" (context directory))
+(declare-function epg-verify-string "epg" (context signature
+ &optional signed-text))
+(declare-function epg-context-result-for "epg" (context name))
+(declare-function epg-signature-status "epg" (signature))
+(declare-function epg-signature-to-string "epg" (signature))
+
+(defun package--check-signature (location file)
+ "Check signature of the current buffer.
+GnuPG keyring is located under \"gnupg\" in `package-user-dir'."
+ (let ((context (epg-make-context 'OpenPGP))
+ (homedir (expand-file-name "gnupg" package-user-dir))
+ (sig-file (concat file ".sig"))
+ sig-content
+ good-signatures)
+ (condition-case-unless-debug error
+ (setq sig-content (package--with-work-buffer location sig-file
+ (buffer-string)))
+ (error "Failed to download %s: %S" sig-file (cdr error)))
+ (epg-context-set-home-directory context homedir)
+ (epg-verify-string context sig-content (buffer-string))
+ ;; The .sig file may contain multiple signatures. Success if one
+ ;; of the signatures is good.
+ (setq good-signatures
+ (delq nil (mapcar (lambda (sig)
+ (if (eq (epg-signature-status sig) 'good)
+ sig))
+ (epg-context-result-for context 'verify))))
+ (if (null good-signatures)
+ (error "Failed to verify signature %s: %S"
+ sig-file
+ (mapcar #'epg-signature-to-string
+ (epg-context-result-for context 'verify)))
+ good-signatures)))
+
(defun package-install-from-archive (pkg-desc)
"Download and install a tar package."
- (let ((location (package-archive-base pkg-desc))
- (file (concat (package-desc-full-name pkg-desc)
- (package-desc-suffix pkg-desc))))
+ (let* ((location (package-archive-base pkg-desc))
+ (file (concat (package-desc-full-name pkg-desc)
+ (package-desc-suffix pkg-desc)))
+ (sig-file (concat file ".sig"))
+ good-signatures pkg-descs)
(package--with-work-buffer location file
- (package-unpack pkg-desc))))
+ (if (and package-check-signature
+ (not (member (package-desc-archive pkg-desc)
+ package-unsigned-archives)))
+ (if (package--archive-file-exists-p location sig-file)
+ (setq good-signatures (package--check-signature location file))
+ (unless (eq package-check-signature 'allow-unsigned)
+ (error "Unsigned package: `%s'"
+ (package-desc-name pkg-desc)))))
+ (package-unpack pkg-desc))
+ ;; Here the package has been installed successfully, mark it as
+ ;; signed if appropriate.
+ (when good-signatures
+ ;; Write out good signatures into NAME-VERSION.signed file.
+ (write-region (mapconcat #'epg-signature-to-string good-signatures "\n")
+ nil
+ (expand-file-name
+ (concat (package-desc-full-name pkg-desc)
+ ".signed")
+ package-user-dir))
+ ;; Update the old pkg-desc which will be shown on the description buffer.
+ (setf (package-desc-signed pkg-desc) t)
+ ;; Update the new (activated) pkg-desc as well.
+ (setq pkg-descs (cdr (assq (package-desc-name pkg-desc) package-alist)))
+ (if pkg-descs
+ (setf (package-desc-signed (car pkg-descs)) t)))))
(defvar package--initialized nil)
;; Also check built-in packages.
(package-built-in-p package min-version)))
-(defun package-compute-transaction (package-list requirements)
- "Return a list of packages to be installed, including PACKAGE-LIST.
-PACKAGE-LIST should be a list of package names (symbols).
+(defun package-compute-transaction (packages requirements)
+ "Return a list of packages to be installed, including PACKAGES.
+PACKAGES should be a list of `package-desc'.
REQUIREMENTS should be a list of additional requirements; each
element in this list should have the form (PACKAGE VERSION-LIST),
packages in REQUIREMENTS, and returns a list of all the packages
that must be installed. Packages that are already installed are
not included in this list."
+ ;; FIXME: We really should use backtracking to explore the whole
+ ;; search space (e.g. if foo require bar-1.3, and bar-1.4 requires toto-1.1
+ ;; whereas bar-1.3 requires toto-1.0 and the user has put a hold on toto-1.0:
+ ;; the current code might fail to see that it could install foo by using the
+ ;; older bar-1.3).
(dolist (elt requirements)
(let* ((next-pkg (car elt))
- (next-version (cadr elt)))
- (unless (package-installed-p next-pkg next-version)
+ (next-version (cadr elt))
+ (already ()))
+ (dolist (pkg packages)
+ (if (eq next-pkg (package-desc-name pkg))
+ (setq already pkg)))
+ (cond
+ (already
+ (if (version-list-< next-version (package-desc-version already))
+ ;; Move to front, so it gets installed early enough (bug#14082).
+ (setq packages (cons already (delq already packages)))
+ (error "Need package `%s-%s', but only %s is available"
+ next-pkg (package-version-join next-version)
+ (package-version-join (package-desc-version already)))))
+
+ ((package-installed-p next-pkg next-version) nil)
+
+ (t
;; A package is required, but not installed. It might also be
;; blocked via `package-load-list'.
- (let ((pkg-desc (cdr (assq next-pkg package-archive-contents)))
- ;; FIXME: package-disabled-p needs to use a <= test!
- (disabled (package-disabled-p next-pkg next-version)))
- (when disabled
- (if (stringp disabled)
- (error "Package `%s' held at version %s, \
+ (let ((pkg-descs (cdr (assq next-pkg package-archive-contents)))
+ (found nil)
+ (problem nil))
+ (while (and pkg-descs (not found))
+ (let* ((pkg-desc (pop pkg-descs))
+ (version (package-desc-version pkg-desc))
+ (disabled (package-disabled-p next-pkg version)))
+ (cond
+ ((version-list-< version next-version)
+ (error
+ "Need package `%s-%s', but only %s is available"
+ next-pkg (package-version-join next-version)
+ (package-version-join version)))
+ (disabled
+ (unless problem
+ (setq problem
+ (if (stringp disabled)
+ (format "Package `%s' held at version %s, \
but version %s required"
- (symbol-name next-pkg) disabled
- (package-version-join next-version))
- (error "Required package '%s' is disabled"
- (symbol-name next-pkg))))
- (unless pkg-desc
- (error "Package `%s-%s' is unavailable"
- (symbol-name next-pkg)
- (package-version-join next-version)))
- (unless (version-list-<= next-version
- (package-desc-version pkg-desc))
- (error
- "Need package `%s-%s', but only %s is available"
- (symbol-name next-pkg) (package-version-join next-version)
- (package-version-join (package-desc-version pkg-desc))))
- ;; Move to front, so it gets installed early enough (bug#14082).
- (setq package-list (cons next-pkg (delq next-pkg package-list)))
- (setq package-list
- (package-compute-transaction package-list
- (package-desc-reqs
- pkg-desc)))))))
- package-list)
+ next-pkg disabled
+ (package-version-join next-version))
+ (format "Required package '%s' is disabled"
+ next-pkg)))))
+ (t (setq found pkg-desc)))))
+ (unless found
+ (if problem
+ (error problem)
+ (error "Package `%s-%s' is unavailable"
+ next-pkg (package-version-join next-version))))
+ (setq packages
+ (package-compute-transaction (cons found packages)
+ (package-desc-reqs found))))))))
+ packages)
(defun package-read-from-string (str)
"Read a Lisp expression from STR.
;; Changing this defstruct implies changing the format of the
;; "archive-contents" files.
(cl-defstruct (package--ac-desc
- (:constructor package-make-ac-desc (version reqs summary kind))
+ (:constructor package-make-ac-desc (version reqs summary kind extras))
(:copier nil)
(:type vector))
- version reqs summary kind)
+ version reqs summary kind extras)
(defun package--add-to-archive-contents (package archive)
"Add the PACKAGE from the given ARCHIVE if necessary.
:reqs (package--ac-desc-reqs (cdr package))
:summary (package--ac-desc-summary (cdr package))
:kind (package--ac-desc-kind (cdr package))
- :archive archive))
- (entry (cons name pkg-desc))
- (existing-package (assq name package-archive-contents))
+ :archive archive
+ :extras (and (> (length (cdr package)) 4)
+ ;; Older archive-contents files have only 4
+ ;; elements here.
+ (package--ac-desc-extras (cdr package)))))
+ (existing-packages (assq name package-archive-contents))
(pinned-to-archive (assoc name package-pinned-packages)))
(cond
- ;; Skip entirely if pinned to another archive or if no more recent
- ;; than what we already have installed.
+ ;; Skip entirely if pinned to another archive or already installed.
((or (and pinned-to-archive
(not (equal (cdr pinned-to-archive) archive)))
(let ((bi (assq name package--builtin-versions)))
- (and bi (version-list-<= version (cdr bi))))
+ (and bi (version-list-= version (cdr bi))))
(let ((ins (cdr (assq name package-alist))))
- (and ins (version-list-<= version
- (package-desc-version (car ins))))))
+ (and ins (version-list-= version
+ (package-desc-version (car ins))))))
nil)
- ((not existing-package)
- (push entry package-archive-contents))
- ((version-list-< (package-desc-version (cdr existing-package))
- version)
- ;; Replace the entry with this one.
- (setq package-archive-contents
- (cons entry
- (delq existing-package
- package-archive-contents)))))))
-
-(defun package-download-transaction (package-list)
- "Download and install all the packages in PACKAGE-LIST.
-PACKAGE-LIST should be a list of package names (symbols).
+ ((not existing-packages)
+ (push (list name pkg-desc) package-archive-contents))
+ (t
+ (while
+ (if (and (cdr existing-packages)
+ (version-list-<
+ version (package-desc-version (cadr existing-packages))))
+ (setq existing-packages (cdr existing-packages))
+ (push pkg-desc (cdr existing-packages))
+ nil))))))
+
+(defun package-download-transaction (packages)
+ "Download and install all the packages in PACKAGES.
+PACKAGES should be a list of package-desc.
This function assumes that all package requirements in
-PACKAGE-LIST are satisfied, i.e. that PACKAGE-LIST is computed
+PACKAGES are satisfied, i.e. that PACKAGES is computed
using `package-compute-transaction'."
- ;; FIXME: make package-list a list of pkg-desc.
- (dolist (elt package-list)
- (let ((desc (cdr (assq elt package-archive-contents))))
- (package-install-from-archive desc))))
+ (mapc #'package-install-from-archive packages))
;;;###autoload
-(defun package-install (pkg-desc)
- "Install the package PKG-DESC.
-PKG-DESC should be one of the available packages in an
-archive in `package-archives'. Interactively, prompt for its name."
+(defun package-install (pkg)
+ "Install the package PKG.
+PKG can be a package-desc or the package name of one the available packages
+in an archive in `package-archives'. Interactively, prompt for its name."
(interactive
(progn
;; Initialize the package system to get the list of package
(package-initialize t))
(unless package-archive-contents
(package-refresh-contents))
- (let* ((name (intern (completing-read
- "Install package: "
- (mapcar (lambda (elt)
- (cons (symbol-name (car elt))
- nil))
- package-archive-contents)
- nil t)))
- (pkg-desc (cdr (assq name package-archive-contents))))
- (unless pkg-desc
- (error "Package `%s' is not available for installation"
- name))
- (list pkg-desc))))
+ (list (intern (completing-read
+ "Install package: "
+ (mapcar (lambda (elt) (symbol-name (car elt)))
+ package-archive-contents)
+ nil t)))))
(package-download-transaction
- ;; FIXME: Use (list pkg-desc) instead of just the name.
- (package-compute-transaction (list (package-desc-name pkg-desc))
- (package-desc-reqs pkg-desc))))
+ (if (package-desc-p pkg)
+ (package-compute-transaction (list pkg)
+ (package-desc-reqs pkg))
+ (package-compute-transaction ()
+ (list (list pkg))))))
(defun package-strip-rcs-id (str)
"Strip RCS version ID from the version string STR.
str)
(error nil))))
+(declare-function lm-homepage "lisp-mnt" (&optional file))
+
+(defun package--prepare-dependencies (deps)
+ "Turn DEPS into an acceptable list of dependencies.
+
+Any parts missing a version string get a default version string
+of \"0\" (meaning any version) and an appropriate level of lists
+is wrapped around any parts requiring it."
+ (cond
+ ((not (listp deps))
+ (error "Invalid requirement specifier: %S" deps))
+ (t (mapcar (lambda (dep)
+ (cond
+ ((symbolp dep) `(,dep "0"))
+ ((stringp dep)
+ (error "Invalid requirement specifier: %S" dep))
+ (t dep)))
+ deps))))
+
(defun package-buffer-info ()
"Return a `package-desc' describing the package in the current buffer.
boundaries."
(goto-char (point-min))
(unless (re-search-forward "^;;; \\([^ ]*\\)\\.el ---[ \t]*\\(.*?\\)[ \t]*\\(-\\*-.*-\\*-[ \t]*\\)?$" nil t)
- (error "Packages lacks a file header"))
+ (error "Package lacks a file header"))
(let ((file-name (match-string-no-properties 1))
(desc (match-string-no-properties 2))
(start (line-beginning-position)))
;; probably wants us to use it. Otherwise try Version.
(pkg-version
(or (package-strip-rcs-id (lm-header "package-version"))
- (package-strip-rcs-id (lm-header "version")))))
+ (package-strip-rcs-id (lm-header "version"))))
+ (homepage (lm-homepage)))
(unless pkg-version
(error
"Package lacks a \"Version\" or \"Package-Version\" header"))
(package-desc-from-define
file-name pkg-version desc
- (if requires-str (package-read-from-string requires-str))
- :kind 'single))))
+ (if requires-str
+ (package--prepare-dependencies
+ (package-read-from-string requires-str)))
+ :kind 'single
+ :url homepage))))
(declare-function tar-get-file-descriptor "tar-mode" (file))
(declare-function tar--extract "tar-mode" (descriptor))
(defun package-delete (pkg-desc)
(let ((dir (package-desc-dir pkg-desc)))
- (if (string-equal (file-name-directory dir)
- (file-name-as-directory
- (expand-file-name package-user-dir)))
- (progn
- (delete-directory dir t t)
- (message "Package `%s' deleted." (package-desc-full-name pkg-desc)))
- ;; Don't delete "system" packages
- (error "Package `%s' is a system package, not deleting"
- (package-desc-full-name pkg-desc)))))
+ (if (not (string-prefix-p (file-name-as-directory
+ (expand-file-name package-user-dir))
+ (expand-file-name dir)))
+ ;; Don't delete "system" packages.
+ (error "Package `%s' is a system package, not deleting"
+ (package-desc-full-name pkg-desc))
+ (delete-directory dir t t)
+ ;; Remove NAME-VERSION.signed file.
+ (let ((signed-file (concat dir ".signed")))
+ (if (file-exists-p signed-file)
+ (delete-file signed-file)))
+ ;; Update package-alist.
+ (let* ((name (package-desc-name pkg-desc)))
+ (delete pkg-desc (assq name package-alist)))
+ (message "Package `%s' deleted." (package-desc-full-name pkg-desc)))))
(defun package-archive-base (desc)
"Return the archive containing the package NAME."
ARCHIVE should be a cons cell of the form (NAME . LOCATION),
similar to an entry in `package-alist'. Save the cached copy to
\"archives/NAME/archive-contents\" in `package-user-dir'."
- (let* ((dir (expand-file-name (format "archives/%s" (car archive))
- package-user-dir)))
+ (let ((dir (expand-file-name (format "archives/%s" (car archive))
+ package-user-dir))
+ (sig-file (concat file ".sig"))
+ good-signatures)
(package--with-work-buffer (cdr archive) file
+ ;; Check signature of archive-contents, if desired.
+ (if (and package-check-signature
+ (not (member archive package-unsigned-archives)))
+ (if (package--archive-file-exists-p (cdr archive) sig-file)
+ (setq good-signatures (package--check-signature (cdr archive)
+ file))
+ (unless (eq package-check-signature 'allow-unsigned)
+ (error "Unsigned archive `%s'"
+ (car archive)))))
;; Read the retrieved buffer to make sure it is valid (e.g. it
;; may fetch a URL redirect page).
(when (listp (read buffer))
(make-directory dir t)
(setq buffer-file-name (expand-file-name file dir))
- (let ((version-control 'never))
- (save-buffer))))))
+ (let ((version-control 'never)
+ (require-final-newline nil))
+ (save-buffer))))
+ (when good-signatures
+ ;; Write out good signatures into archive-contents.signed file.
+ (write-region (mapconcat #'epg-signature-to-string good-signatures "\n")
+ nil
+ (expand-file-name (concat file ".signed") dir)))))
+
+(declare-function epg-check-configuration "epg-config"
+ (config &optional minimum-version))
+(declare-function epg-configuration "epg-config" ())
+(declare-function epg-import-keys-from-file "epg" (context keys))
+
+;;;###autoload
+(defun package-import-keyring (&optional file)
+ "Import keys from FILE."
+ (interactive "fFile: ")
+ (setq file (expand-file-name file))
+ (let ((context (epg-make-context 'OpenPGP))
+ (homedir (expand-file-name "gnupg" package-user-dir)))
+ (make-directory homedir t)
+ (epg-context-set-home-directory context homedir)
+ (message "Importing %s..." (file-name-nondirectory file))
+ (epg-import-keys-from-file context file)
+ (message "Importing %s...done" (file-name-nondirectory file))))
;;;###autoload
(defun package-refresh-contents ()
This informs Emacs about the latest versions of all packages, and
makes them available for download."
(interactive)
+ ;; FIXME: Do it asynchronously.
(unless (file-exists-p package-user-dir)
(make-directory package-user-dir t))
+ (let ((default-keyring (expand-file-name "package-keyring.gpg"
+ data-directory)))
+ (if (file-exists-p default-keyring)
+ (condition-case-unless-debug error
+ (progn
+ (epg-check-configuration (epg-configuration))
+ (package-import-keyring default-keyring))
+ (error (message "Cannot import default keyring: %S" (cdr error))))))
(dolist (archive package-archives)
(condition-case-unless-debug nil
(package--download-one-archive archive "archive-contents")
(defun describe-package (package)
"Display the full documentation of PACKAGE (a symbol)."
(interactive
- (let* ((guess (function-called-at-point))
- packages val)
+ (let* ((guess (function-called-at-point)))
(require 'finder-inf nil t)
;; Load the package list if necessary (but don't activate them).
(unless package--initialized
(package-initialize t))
- (setq packages (append (mapcar 'car package-alist)
- (mapcar 'car package-archive-contents)
- (mapcar 'car package--builtins)))
- (unless (memq guess packages)
- (setq guess nil))
- (setq packages (mapcar 'symbol-name packages))
- (setq val
- (completing-read (if guess
- (format "Describe package (default %s): "
- guess)
- "Describe package: ")
- packages nil t nil nil guess))
- (list (if (equal val "") guess (intern val)))))
- (if (not (and package (symbolp package)))
+ (let ((packages (append (mapcar 'car package-alist)
+ (mapcar 'car package-archive-contents)
+ (mapcar 'car package--builtins))))
+ (unless (memq guess packages)
+ (setq guess nil))
+ (setq packages (mapcar 'symbol-name packages))
+ (let ((val
+ (completing-read (if guess
+ (format "Describe package (default %s): "
+ guess)
+ "Describe package: ")
+ packages nil t nil nil guess)))
+ (list (intern val))))))
+ (if (not (or (package-desc-p package) (and package (symbolp package))))
(message "No package specified")
(help-setup-xref (list #'describe-package package)
(called-interactively-p 'interactive))
(with-current-buffer standard-output
(describe-package-1 package)))))
-(defun describe-package-1 (package)
+(defun describe-package-1 (pkg)
(require 'lisp-mnt)
- (let ((package-name (symbol-name package))
- (built-in (assq package package--builtins))
- desc pkg-dir reqs version installable archive)
- (prin1 package)
+ (let* ((desc (or
+ (if (package-desc-p pkg) pkg)
+ (cadr (assq pkg package-alist))
+ (let ((built-in (assq pkg package--builtins)))
+ (if built-in
+ (package--from-builtin built-in)
+ (cadr (assq pkg package-archive-contents))))))
+ (name (if desc (package-desc-name desc) pkg))
+ (pkg-dir (if desc (package-desc-dir desc)))
+ (reqs (if desc (package-desc-reqs desc)))
+ (version (if desc (package-desc-version desc)))
+ (archive (if desc (package-desc-archive desc)))
+ (extras (and desc (package-desc-extras desc)))
+ (homepage (cdr (assoc :url extras)))
+ (keywords (cdr (assoc :keywords extras)))
+ (built-in (eq pkg-dir 'builtin))
+ (installable (and archive (not built-in)))
+ (status (if desc (package-desc-status desc) "orphan"))
+ (signed (if desc (package-desc-signed desc))))
+ (prin1 name)
(princ " is ")
- (cond
- ;; Loaded packages are in `package-alist'.
- ((setq desc (cadr (assq package package-alist)))
- (setq version (package-version-join (package-desc-version desc)))
- (if (setq pkg-dir (package-desc-dir desc))
- (insert "an installed package.\n\n")
- ;; This normally does not happen.
- (insert "a deleted package.\n\n")))
- ;; Available packages are in `package-archive-contents'.
- ((setq desc (cdr (assq package package-archive-contents)))
- (setq version (package-version-join (package-desc-version desc))
- archive (package-desc-archive desc)
- installable t)
- (if built-in
- (insert "a built-in package.\n\n")
- (insert "an uninstalled package.\n\n")))
- (built-in
- (setq desc (package--from-builtin built-in)
- version (package-version-join (package-desc-version desc)))
- (insert "a built-in package.\n\n"))
- (t
- (insert "an orphan package.\n\n")))
+ (princ (if (memq (aref status 0) '(?a ?e ?i ?o ?u)) "an " "a "))
+ (princ status)
+ (princ " package.\n\n")
(insert " " (propertize "Status" 'font-lock-face 'bold) ": ")
- (cond (pkg-dir
- (insert (propertize "Installed"
+ (cond (built-in
+ (insert (propertize (capitalize status)
+ 'font-lock-face 'font-lock-builtin-face)
+ "."))
+ (pkg-dir
+ (insert (propertize (if (equal status "unsigned")
+ "Installed"
+ (capitalize status)) ;FIXME: Why comment-face?
'font-lock-face 'font-lock-comment-face))
(insert " in `")
;; Todo: Add button for uninstalling.
- (help-insert-xref-button (file-name-as-directory pkg-dir)
+ (help-insert-xref-button (abbreviate-file-name
+ (file-name-as-directory pkg-dir))
'help-package-def pkg-dir)
- (if built-in
+ (if (and (package-built-in-p name)
+ (not (package-built-in-p name version)))
(insert "',\n shadowing a "
(propertize "built-in package"
- 'font-lock-face 'font-lock-builtin-face)
- ".")
- (insert "'.")))
+ 'font-lock-face 'font-lock-builtin-face))
+ (insert "'"))
+ (if signed
+ (insert ".")
+ (insert " (unsigned).")))
(installable
- (if built-in
- (insert (propertize "Built-in."
- 'font-lock-face 'font-lock-builtin-face)
- " Alternate version available")
- (insert "Available"))
- (insert " from " archive)
+ (insert (capitalize status))
+ (insert " from " (format "%s" archive))
(insert " -- ")
- (let ((button-text (if (display-graphic-p) "Install" "[Install]"))
- (button-face (if (display-graphic-p)
- '(:box (:line-width 2 :color "dark grey")
- :background "light grey"
- :foreground "black")
- 'link)))
- (insert-text-button button-text 'face button-face 'follow-link t
- 'package-desc desc
- 'action 'package-install-button-action)))
- (built-in
- (insert (propertize "Built-in."
- 'font-lock-face 'font-lock-builtin-face)))
- (t (insert "Deleted.")))
+ (package-make-button
+ "Install"
+ 'action 'package-install-button-action
+ 'package-desc desc))
+ (t (insert (capitalize status) ".")))
(insert "\n")
- (and version (> (length version) 0)
+ (insert " " (propertize "Archive" 'font-lock-face 'bold)
+ ": " (or archive "n/a") "\n")
+ (and version
(insert " "
- (propertize "Version" 'font-lock-face 'bold) ": " version "\n"))
+ (propertize "Version" 'font-lock-face 'bold) ": "
+ (package-version-join version) "\n"))
(setq reqs (if desc (package-desc-reqs desc)))
(when reqs
(help-insert-xref-button text 'help-package name))
(insert "\n")))
(insert " " (propertize "Summary" 'font-lock-face 'bold)
- ": " (if desc (package-desc-summary desc)) "\n\n")
+ ": " (if desc (package-desc-summary desc)) "\n")
+ (when homepage
+ (insert " " (propertize "Homepage" 'font-lock-face 'bold) ": ")
+ (help-insert-xref-button homepage 'help-url homepage)
+ (insert "\n"))
+ (when keywords
+ (insert " " (propertize "Keywords" 'font-lock-face 'bold) ": ")
+ (dolist (k keywords)
+ (package-make-button
+ k
+ 'package-keyword k
+ 'action 'package-keyword-button-action)
+ (insert " "))
+ (insert "\n"))
+ (let* ((all-pkgs (append (cdr (assq name package-alist))
+ (cdr (assq name package-archive-contents))
+ (let ((bi (assq name package--builtins)))
+ (if bi (list (package--from-builtin bi))))))
+ (other-pkgs (delete desc all-pkgs)))
+ (when other-pkgs
+ (insert " " (propertize "Other versions" 'font-lock-face 'bold) ": "
+ (mapconcat
+ (lambda (opkg)
+ (let* ((ov (package-desc-version opkg))
+ (dir (package-desc-dir opkg))
+ (from (or (package-desc-archive opkg)
+ (if (stringp dir) "installed" dir))))
+ (if (not ov) (format "%s" from)
+ (format "%s (%s)"
+ (make-text-button (package-version-join ov) nil
+ 'face 'link
+ 'follow-link t
+ 'action
+ (lambda (_button)
+ (describe-package opkg)))
+ from))))
+ other-pkgs ", ")
+ ".\n")))
+
+ (insert "\n")
(if built-in
;; For built-in packages, insert the commentary.
- (let ((fn (locate-file (concat package-name ".el") load-path
+ (let ((fn (locate-file (format "%s.el" name) load-path
load-file-rep-suffixes))
(opoint (point)))
(insert (or (lm-commentary fn) ""))
(replace-match ""))
(while (re-search-forward "^\\(;+ ?\\)" nil t)
(replace-match ""))))
- (let ((readme (expand-file-name (concat package-name "-readme.txt")
+ (let ((readme (expand-file-name (format "%s-readme.txt" name)
package-user-dir))
readme-string)
;; For elpa packages, try downloading the commentary. If that
;; fails, try an existing readme file in `package-user-dir'.
(cond ((condition-case nil
- (package--with-work-buffer (package-archive-base desc)
- (concat package-name "-readme.txt")
- (setq buffer-file-name
- (expand-file-name readme package-user-dir))
- (let ((version-control 'never))
- (save-buffer))
- (setq readme-string (buffer-string))
- t)
+ (save-excursion
+ (package--with-work-buffer
+ (package-archive-base desc)
+ (format "%s-readme.txt" name)
+ (setq buffer-file-name
+ (expand-file-name readme package-user-dir))
+ (let ((version-control 'never)
+ (require-final-newline t))
+ (save-buffer))
+ (setq readme-string (buffer-string))
+ t))
(error nil))
(insert readme-string))
((file-readable-p readme)
(revert-buffer nil t)
(goto-char (point-min)))))
+(defun package-keyword-button-action (button)
+ (let ((pkg-keyword (button-get button 'package-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 "]")))
+ (button-face (if (display-graphic-p)
+ '(:box (:line-width 2 :color "dark grey")
+ :background "light grey"
+ :foreground "black")
+ 'link)))
+ (apply 'insert-text-button button-text 'face button-face 'follow-link t
+ props)))
+
\f
;;;; Package menu mode.
(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)
(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
(setq tabulated-list-format [("Package" 18 package-menu--name-predicate)
("Version" 12 nil)
("Status" 10 package-menu--status-predicate)
+ ("Archive" 10 package-menu--archive-predicate)
("Description" 0 nil)])
(setq tabulated-list-padding 2)
(setq tabulated-list-sort-key (cons "Status" nil))
+ (add-hook 'tabulated-list-revert-hook 'package-menu--refresh nil t)
(tabulated-list-init-header))
(defmacro package--push (pkg-desc status listname)
(defvar package-list-unversioned nil
"If non-nil include packages that don't have a version in `list-package'.")
-(defun package-menu--generate (remember-pos packages)
- "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."
+(defun package-desc-status (pkg-desc)
+ (let* ((name (package-desc-name pkg-desc))
+ (dir (package-desc-dir pkg-desc))
+ (lle (assq name package-load-list))
+ (held (cadr lle))
+ (version (package-desc-version pkg-desc))
+ (signed (package-desc-signed pkg-desc)))
+ (cond
+ ((eq dir 'builtin) "built-in")
+ ((and lle (null held)) "disabled")
+ ((stringp held)
+ (let ((hv (if (stringp held) (version-to-list held))))
+ (cond
+ ((version-list-= version hv) "held")
+ ((version-list-< version hv) "obsolete")
+ (t "disabled"))))
+ ((package-built-in-p name version) "obsolete")
+ (dir ;One of the installed packages.
+ (cond
+ ((not (file-exists-p (package-desc-dir pkg-desc))) "deleted")
+ ((eq pkg-desc (cadr (assq name package-alist))) (if signed
+ "installed"
+ "unsigned"))
+ (t "obsolete")))
+ (t
+ (let* ((ins (cadr (assq name package-alist)))
+ (ins-v (if ins (package-desc-version ins))))
+ (cond
+ ((or (null ins) (version-list-< ins-v version))
+ (if (memq name package-menu--new-package-list)
+ "new" "available"))
+ ((version-list-< version ins-v) "obsolete")
+ ((version-list-= version ins-v) (if signed
+ "installed"
+ "unsigned"))))))))
+
+(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."
;; Construct list of (PKG-DESC . STATUS).
+ (unless packages (setq packages t))
(let (info-list name)
;; Installed packages:
(dolist (elt package-alist)
(setq name (car elt))
(when (or (eq packages t) (memq name packages))
- (let* ((lle (assq name package-load-list))
- (held (cadr lle))
- (hv (if (stringp held) (version-to-list held))))
- (dolist (pkg (cdr elt))
- (let ((version (package-desc-version pkg)))
- (package--push pkg
- (cond
- ((and lle (null held)) "disabled")
- (hv
- (cond
- ((version-list-= version hv) "held")
- ((version-list-< version hv) "obsolete")
- (t "disabled")))
- ((package-built-in-p name version) "obsolete")
- ((eq pkg (cadr elt)) "installed")
- (t "obsolete"))
- info-list))))))
+ (dolist (pkg (cdr elt))
+ (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)))
(dolist (elt package-archive-contents)
(setq name (car elt))
(when (or (eq packages t) (memq name packages))
- (let ((hold (assq name package-load-list)))
- (package--push (cdr elt)
- (cond
- ((and hold (null (cadr hold))) "disabled")
- ((memq name package-menu--new-package-list) "new")
- (t "available"))
- info-list))))
+ (dolist (pkg (cdr elt))
+ ;; Hide obsolete packages.
+ (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))
- (tabulated-list-print remember-pos)))
+ (setq tabulated-list-entries
+ (mapcar #'package-menu--print-info info-list))))
+
+(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.
+
+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)
"Return a package entry suitable for `tabulated-list-entries'.
(`"held" 'font-lock-constant-face)
(`"disabled" 'font-lock-warning-face)
(`"installed" 'font-lock-comment-face)
+ (`"unsigned" 'font-lock-warning-face)
(_ 'font-lock-warning-face)))) ; obsolete.
(list pkg-desc
(vector (list (symbol-name (package-desc-name pkg-desc))
(package-desc-version pkg-desc))
'font-lock-face face)
(propertize status 'font-lock-face face)
+ (propertize (or (package-desc-archive pkg-desc) "")
+ 'font-lock-face face)
(propertize (package-desc-summary pkg-desc)
'font-lock-face face)))))
`package-archives', and then refreshes the package menu."
(interactive)
(unless (derived-mode-p 'package-menu-mode)
- (error "The current buffer is not a Package Menu"))
+ (user-error "The current buffer is not a Package Menu"))
(package-refresh-contents)
(package-menu--generate t t))
(let ((pkg-desc (if button (button-get button 'package-desc)
(tabulated-list-get-id))))
(if pkg-desc
- ;; FIXME: We could actually describe this particular pkg-desc.
- (describe-package (package-desc-name pkg-desc)))))
+ (describe-package pkg-desc)
+ (user-error "No package here"))))
;; fixme numeric argument
(defun package-menu-mark-delete (&optional _num)
"Mark a package for deletion and move to the next line."
(interactive "p")
- (if (member (package-menu-get-status) '("installed" "obsolete"))
+ (if (member (package-menu-get-status) '("installed" "obsolete" "unsigned"))
(tabulated-list-put-tag "D" t)
(forward-line)))
;; ENTRY is (PKG-DESC [NAME VERSION STATUS DOC])
(let ((pkg-desc (car entry))
(status (aref (cadr entry) 2)))
- (cond ((equal status "installed")
+ (cond ((member status '("installed" "unsigned"))
(push pkg-desc installed))
((member status '("available" "new"))
(push (cons (package-desc-name pkg-desc) pkg-desc)
(package-delete elt)
(error (message (cadr err)))))
(error "Aborted")))
- ;; If we deleted anything, regenerate `package-alist'. This is done
- ;; automatically if we installed a package.
- (and delete-list (null install-list)
- (package-initialize))
(if (or delete-list install-list)
(package-menu--generate t t)
(message "No operations specified."))))
((string= sB "available") nil)
((string= sA "installed") t)
((string= sB "installed") nil)
+ ((string= sA "unsigned") t)
+ ((string= sB "unsigned") nil)
((string= sA "held") t)
((string= sB "held") nil)
((string= sA "built-in") t)
(string< (symbol-name (package-desc-name (car A)))
(symbol-name (package-desc-name (car B)))))
+(defun package-menu--archive-predicate (A B)
+ (string< (or (package-desc-archive (car A)) "")
+ (or (package-desc-archive (car B)) "")))
+
;;;###autoload
(defun list-packages (&optional no-fetch)
"Display a list of 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.