;;; 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>
(declare-function lm-header "lisp-mnt" (header))
(declare-function lm-commentary "lisp-mnt" (&optional file))
(defvar url-http-end-of-headers)
+(declare-function url-recreate-url "url-parse" (urlobj))
+(defvar url-http-target-url)
(defcustom package-archives '(("gnu" . "http://elpa.gnu.org/packages/"))
"An alist of archives from which to fetch.
(unless (memq (car rest-plist) '(:kind :archive))
(let ((value (cadr rest-plist)))
(when value
- (push (cons (car rest-plist) value)
+ (push (cons (car rest-plist)
+ (if (eq (car-safe value) 'quote)
+ (cdr value)
+ value))
alist))))
(setq rest-plist (cddr rest-plist)))
alist)))))
(`tar ".tar")
(kind (error "Unknown package kind: %s" kind))))
+(defun package-desc--keywords (pkg-desc)
+ (let ((keywords (cdr (assoc :keywords (package-desc-extras pkg-desc)))))
+ (if (eq (car-safe keywords) 'quote)
+ (nth 1 keywords)
+ keywords)))
+
;; Package descriptor format used in finder-inf.el and package--builtins.
(cl-defstruct (package--bi-desc
(:constructor package-make-builtin (version summary))
"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)
";; End:\n"
";;; " (file-name-nondirectory file)
" ends here\n")
- nil file))
+ nil file nil 'silent))
file)
(defvar generated-autoload-file)
(package--alist-to-plist
(package-desc-extras pkg-desc))))
"\n")
- nil
- pkg-file))))
+ nil pkg-file nil 'silent))))
(defun package--alist-to-plist (alist)
(apply #'nconc (mapcar (lambda (pair) (list (car pair) (cdr pair))) alist)))
(defun package--write-file-no-coding (file-name)
(let ((buffer-file-coding-system 'no-conversion))
- (write-region (point-min) (point-max) file-name)))
+ (write-region (point-min) (point-max) file-name nil 'silent)))
(defmacro package--with-work-buffer (location file &rest body)
"Run BODY in a buffer containing the contents of FILE at LOCATION.
(require 'url-http)
(let ((response (url-http-parse-response)))
(when (or (< response 200) (>= response 300))
- (error "Error during download request:%s"
+ (error "Error downloading %s:%s"
+ (url-recreate-url url-http-target-url)
(buffer-substring-no-properties (point) (line-end-position))))))
(defun package--archive-file-exists-p (location file)
(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)))
+ (let* ((context (epg-make-context 'OpenPGP))
+ (homedir (expand-file-name "gnupg" package-user-dir))
+ (sig-file (concat file ".sig"))
+ (sig-content (package--with-work-buffer location sig-file
+ (buffer-string))))
(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)))
+ (let ((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."
(expand-file-name
(concat (package-desc-full-name pkg-desc)
".signed")
- package-user-dir))
+ package-user-dir)
+ nil 'silent)
;; 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.
"Return true if PACKAGE, of MIN-VERSION or newer, is installed.
MIN-VERSION should be a version list."
(unless package--initialized (error "package.el is not yet initialized!"))
- (or
- (let ((pkg-descs (cdr (assq package package-alist))))
- (and pkg-descs
- (version-list-<= min-version
- (package-desc-version (car pkg-descs)))))
- ;; Also check built-in packages.
- (package-built-in-p package min-version)))
+ (or
+ (let ((pkg-descs (cdr (assq package package-alist))))
+ (and pkg-descs
+ (version-list-<= min-version
+ (package-desc-version (car pkg-descs)))))
+ ;; Also check built-in packages.
+ (package-built-in-p package min-version)))
(defun package-compute-transaction (packages requirements)
"Return a list of packages to be installed, including PACKAGES.
(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.
"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))
+ (if requires-str
+ (package--prepare-dependencies
+ (package-read-from-string requires-str)))
:kind 'single
:url homepage))))
(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)))
+ (let* ((name (package-desc-name pkg-desc))
+ (pkgs (assq name package-alist)))
+ (delete pkg-desc pkgs)
+ (unless (cdr pkgs)
+ (setq package-alist (delq pkgs package-alist))))
(message "Package `%s' deleted." (package-desc-full-name pkg-desc)))))
(defun package-archive-base (desc)
;; 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)))))
+ (expand-file-name (concat file ".signed") dir)
+ nil 'silent))))
(declare-function epg-check-configuration "epg-config"
(config &optional minimum-version))
(archive (if desc (package-desc-archive desc)))
(extras (and desc (package-desc-extras desc)))
(homepage (cdr (assoc :url extras)))
- (keywords (cdr (assoc :keywords extras)))
+ (keywords (if desc (package-desc--keywords desc)))
(built-in (eq pkg-dir 'builtin))
(installable (and archive (not built-in)))
(status (if desc (package-desc-status desc) "orphan"))
(revert-buffer nil t)
(goto-char (point-min)))))
-(declare-function finder-list-matches "finder" (keyword))
(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 "]")))
(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)
(define-key map "~" 'package-menu-mark-obsolete-for-deletion)
(define-key map "x" 'package-menu-execute)
(define-key map "h" 'package-menu-quick-help)
'(menu-item "Mark Upgradable Packages" package-menu-mark-upgrades
:help "Mark packages that have a newer version for upgrading"))
(define-key menu-map [s3] '("--"))
+ (define-key menu-map [mf]
+ '(menu-item "Filter Package List..." package-menu-filter
+ :help "Filter package selection (q to go back)"))
(define-key menu-map [mg]
'(menu-item "Update Package List" revert-buffer
:help "Update the list of packages"))
Letters do not insert themselves; instead, they are commands.
\\<package-menu-mode-map>
\\{package-menu-mode-map}"
- (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-format
+ `[("Package" 18 package-menu--name-predicate)
+ ("Version" 12 nil)
+ ("Status" 10 package-menu--status-predicate)
+ ,@(if (cdr package-archives)
+ '(("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)
"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)
(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)))
(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* ((desc-keywords (and desc (package-desc--keywords desc))))
+ (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* ((desc-keywords (and desc (package-desc--keywords desc)))
+ 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)
(let* ((pkg-desc (car pkg))
(status (cdr pkg))
(face (pcase status
- (`"built-in" 'font-lock-builtin-face)
- (`"available" 'default)
- (`"new" 'bold)
- (`"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.
+ (`"built-in" 'font-lock-builtin-face)
+ (`"available" 'default)
+ (`"new" 'bold)
+ (`"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))
- 'face 'link
- 'follow-link t
- 'package-desc pkg-desc
- 'action 'package-menu-describe-package)
- (propertize (package-version-join
- (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)))))
+ `[,(list (symbol-name (package-desc-name pkg-desc))
+ 'face 'link
+ 'follow-link t
+ 'package-desc pkg-desc
+ 'action 'package-menu-describe-package)
+ ,(propertize (package-version-join
+ (package-desc-version pkg-desc))
+ 'font-lock-face face)
+ ,(propertize status 'font-lock-face face)
+ ,@(if (cdr package-archives)
+ (list (propertize (or (package-desc-archive pkg-desc) "")
+ 'font-lock-face face)))
+ ,(propertize (package-desc-summary pkg-desc)
+ 'font-lock-face face)])))
(defun package-menu-refresh ()
"Download the Emacs Lisp package archive.
(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)))
+;; package-menu--generate rebinds "q" on the fly, so we have to
+;; hard-code the binding in the doc-string here.
+(defun package-menu-filter (keyword)
+ "Filter the *Packages* buffer.
+Show only those items that relate to the specified KEYWORD.
+To restore the full package list, type `q'."
+ (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.