;;; package.el --- Simple package system for Emacs -*- lexical-binding:t -*-
-;; Copyright (C) 2007-2014 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2015 Free Software Foundation, Inc.
;; Author: Tom Tromey <tromey@redhat.com>
;; Daniel Hackney <dan@haxney.org>
;;; Code:
(eval-when-compile (require 'cl-lib))
+(eval-when-compile (require 'epg)) ;For setf accessors.
(require 'tabulated-list)
+(require 'macroexp)
(defgroup package nil
"Manager for Emacs Lisp packages."
:group 'package
:version "24.1")
+(defcustom package-archive-priorities nil
+ "An alist of priorities for packages.
+
+Each element has the form (ARCHIVE-ID . PRIORITY).
+
+When installing packages, the package with the highest version
+number from the archive with the highest priority is
+selected. When higher versions are available from archives with
+lower priorities, the user has to select those manually.
+
+Archives not in this list have the priority 0."
+ :type '(alist :key-type (string :tag "Archive name")
+ :value-type (integer :tag "Priority (default is 0)"))
+ :risky t
+ :group 'package
+ :version "25.1")
+
(defcustom package-pinned-packages nil
"An alist of packages that are pinned to specific archives.
This can be useful if you have multiple package archives enabled,
:group 'package
:version "24.1")
-(defcustom package-check-signature 'allow-unsigned
+(defvar epg-gpg-program)
+
+(defcustom package-check-signature
+ (if (progn (require 'epg-config) (executable-find epg-gpg-program))
+ 'allow-unsigned)
"Non-nil means to check package signatures when installing.
The value `allow-unsigned' means to still install a package even if
it is unsigned.
(pcase (package-desc-kind pkg-desc)
(`single ".el")
(`tar ".tar")
+ (`dir "")
(kind (error "Unknown package kind: %s" kind))))
(defun package-desc--keywords (pkg-desc)
force))
(t (error "Invalid element in `package-load-list'")))))
-(defun package-activate-1 (pkg-desc)
+(defun package-activate-1 (pkg-desc &optional reload)
+ "Activate package given by PKG-DESC, even if it was already active.
+If RELOAD is non-nil, also `load' any files inside the package which
+correspond to previously loaded files (those returned by
+`package--list-loaded-files')."
(let* ((name (package-desc-name pkg-desc))
(pkg-dir (package-desc-dir pkg-desc))
(pkg-dir-dir (file-name-as-directory 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))
+ (let* ((old-lp load-path)
+ (autoloads-file (expand-file-name
+ (format "%s-autoloads" name) pkg-dir))
+ (loaded-files-list (and reload (package--list-loaded-files pkg-dir))))
+ (with-demoted-errors "Error in package-activate-1: %s"
+ (load autoloads-file 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)))
+ (push pkg-dir load-path))
+ ;; Call `load' on all files in `pkg-dir' already present in
+ ;; `load-history'. This is done so that macros in these files are updated
+ ;; to their new definitions. If another package is being installed which
+ ;; depends on this new definition, not doing this update would cause
+ ;; compilation errors and break the installation.
+ (with-demoted-errors "Error in package-activate-1: %s"
+ (mapc (lambda (feature) (load feature nil t))
+ ;; Skip autoloads file since we already evaluated it above.
+ (remove (file-truename autoloads-file) loaded-files-list))))
;; Add info node.
(when (file-exists-p (expand-file-name "dir" pkg-dir))
;; FIXME: not the friendliest, but simple.
;; Don't return nil.
t))
+(declare-function find-library-name "find-func" (library))
+(defun package--list-loaded-files (dir)
+ "Recursively list all files in DIR which correspond to loaded features.
+Returns the `file-name-sans-extension' of each file, relative to
+DIR, sorted by most recently loaded last."
+ (let* ((history (delq nil
+ (mapcar (lambda (x)
+ (let ((f (car x)))
+ (and f (file-name-sans-extension f))))
+ load-history)))
+ (dir (file-truename dir))
+ ;; List all files that have already been loaded.
+ (list-of-conflicts
+ (delq
+ nil
+ (mapcar
+ (lambda (x) (let* ((file (file-relative-name x dir))
+ ;; Previously loaded file, if any.
+ (previous
+ (ignore-errors
+ (file-name-sans-extension
+ (file-truename (find-library-name file)))))
+ (pos (when previous (member previous history))))
+ ;; Return (RELATIVE-FILENAME . HISTORY-POSITION)
+ (when pos
+ (cons (file-name-sans-extension file) (length pos)))))
+ (directory-files-recursively dir "\\`[^\\.].*\\.el\\'")))))
+ ;; Turn the list of (FILENAME . POS) back into a list of features. Files in
+ ;; subdirectories are returned relative to DIR (so not actually features).
+ (let ((default-directory (file-name-as-directory dir)))
+ (mapcar (lambda (x) (file-truename (car x)))
+ (sort list-of-conflicts
+ ;; Sort the files by ascending HISTORY-POSITION.
+ (lambda (x y) (< (cdr x) (cdr y))))))))
+
(defun package-built-in-p (package &optional min-version)
"Return true if PACKAGE is built-in to Emacs.
Optional arg MIN-VERSION, if non-nil, should be a version list
(fail (catch 'dep-failure
;; Activate its dependencies recursively.
(dolist (req (package-desc-reqs pkg-vec))
- (unless (package-activate (car req) (cadr req))
+ (unless (package-activate (car req))
(throw 'dep-failure req))))))
(if fail
(warn "Unable to activate package `%s'.
Required package `%s-%s' is unavailable"
package (car fail) (package-version-join (cadr fail)))
;; If all goes well, activate the package itself.
- (package-activate-1 pkg-vec)))))))
+ (package-activate-1 pkg-vec force)))))))
(defun define-package (_name-string _version-string
&optional _docstring _requirements
(let* ((auto-name (format "%s-autoloads.el" name))
;;(ignore-name (concat name "-pkg.el"))
(generated-autoload-file (expand-file-name auto-name pkg-dir))
+ (backup-inhibited t)
(version-control 'never))
(package-autoload-ensure-default-file generated-autoload-file)
(update-directory-autoloads pkg-dir)
(error "Package does not untar cleanly into directory %s/" dir)))))
(tar-untar-buffer))
-(defun package-generate-description-file (pkg-desc pkg-dir)
+(defun package-generate-description-file (pkg-desc pkg-file)
"Create the foo-pkg.el file for single-file packages."
- (let* ((name (package-desc-name pkg-desc))
- (pkg-file (expand-file-name (package--description-file pkg-dir)
- pkg-dir)))
+ (let* ((name (package-desc-name pkg-desc)))
(let ((print-level nil)
(print-quoted t)
(print-length nil))
(write-region
(concat
+ ";;; -*- no-byte-compile: t -*-\n"
(prin1-to-string
(nconc
(list 'define-package
(list (car elt)
(package-version-join (cadr elt))))
requires))))
- (package--alist-to-plist
+ (package--alist-to-plist-args
(package-desc-extras pkg-desc))))
"\n")
nil pkg-file nil 'silent))))
-(defun package--alist-to-plist (alist)
- (apply #'nconc (mapcar (lambda (pair) (list (car pair) (cdr pair))) alist)))
-
+(defun package--alist-to-plist-args (alist)
+ (mapcar 'macroexp-quote
+ (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))
(dirname (package-desc-full-name pkg-desc))
(pkg-dir (expand-file-name dirname package-user-dir)))
(pcase (package-desc-kind pkg-desc)
+ (`dir
+ (make-directory pkg-dir t)
+ (let ((file-list
+ (directory-files
+ default-directory 'full "\\`[^.].*\\.el\\'" 'nosort)))
+ (dolist (source-file file-list)
+ (let ((target-el-file
+ (expand-file-name (file-name-nondirectory source-file) pkg-dir)))
+ (copy-file source-file target-el-file t)))
+ ;; Now that the files have been installed, this package is
+ ;; indistinguishable from a `tar' or a `single'. Let's make
+ ;; things simple by ensuring we're one of them.
+ (setf (package-desc-kind pkg-desc)
+ (if (> (length file-list) 1) 'tar 'single))))
(`tar
(make-directory package-user-dir t)
;; FIXME: should we delete PKG-DIR if it exists?
(defun package--make-autoloads-and-stuff (pkg-desc pkg-dir)
"Generate autoloads, description file, etc.. for PKG-DESC installed at PKG-DIR."
(package-generate-autoloads (package-desc-name pkg-desc) pkg-dir)
- (let ((desc-file (package--description-file pkg-dir)))
+ (let ((desc-file (expand-file-name (package--description-file pkg-dir)
+ pkg-dir)))
(unless (file-exists-p desc-file)
- (package-generate-description-file pkg-desc pkg-dir)))
+ (package-generate-description-file pkg-desc desc-file)))
;; FIXME: Create foo.info and dir file from foo.texi?
)
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--display-verify-error (context sig-file)
+ (unless (equal (epg-context-error-output context) "")
+ (with-output-to-temp-buffer "*Error*"
+ (with-current-buffer standard-output
+ (if (epg-context-result-for context 'verify)
+ (insert (format "Failed to verify signature %s:\n" sig-file)
+ (mapconcat #'epg-signature-to-string
+ (epg-context-result-for context 'verify)
+ "\n"))
+ (insert (format "Error while verifying signature %s:\n" sig-file)))
+ (insert "\nCommand output:\n" (epg-context-error-output context))))))
+
(defun package--check-signature (location file)
"Check signature of the current buffer.
GnuPG keyring is located under \"gnupg\" in `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))
+ (setf (epg-context-home-directory context) homedir)
+ (condition-case error
+ (epg-verify-string context sig-content (buffer-string))
+ (error
+ (package--display-verify-error context sig-file)
+ (signal (car error) (cdr error))))
(let (good-signatures had-fatal-error)
;; The .sig file may contain multiple signatures. Success if one
;; of the signatures is good.
(unless (and (eq package-check-signature 'allow-unsigned)
(eq (epg-signature-status sig) 'no-pubkey))
(setq had-fatal-error t))))
- (if (and (null good-signatures) had-fatal-error)
- (error "Failed to verify signature %s: %S"
- sig-file
- (mapcar #'epg-signature-to-string
- (epg-context-result-for context 'verify)))
- good-signatures))))
+ (when (and (null good-signatures) had-fatal-error)
+ (package--display-verify-error context sig-file)
+ (error "Failed to verify signature %s" sig-file))
+ good-signatures)))
(defun package-install-from-archive (pkg-desc)
"Download and install a tar package."
+ ;; This won't happen, unless the archive is doing something wrong.
+ (when (eq (package-desc-kind pkg-desc) 'dir)
+ (error "Can't install directory package from archive"))
(let* ((location (package-archive-base pkg-desc))
(file (concat (package-desc-full-name pkg-desc)
(package-desc-suffix pkg-desc)))
;; 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.
- ((and pinned-to-archive
- (not (equal (cdr pinned-to-archive) archive)))
- nil)
- ((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))))))
+ ;; Skip entirely if pinned to another archive.
+ (when (not (and pinned-to-archive
+ (not (equal (cdr pinned-to-archive) archive))))
+ (setq package-archive-contents
+ (package--append-to-alist pkg-desc package-archive-contents)))))
+
+(defun package--append-to-alist (pkg-desc alist)
+ "Append an entry for PKG-DESC to the start of ALIST and return it.
+This entry takes the form (`package-desc-name' PKG-DESC).
+
+If ALIST already has an entry with this name, destructively add
+PKG-DESC to the cdr of this entry instead, sorted by version
+number."
+ (let* ((name (package-desc-name pkg-desc))
+ (priority-version (package-desc-priority-version pkg-desc))
+ (existing-packages (assq name alist)))
+ (if (not existing-packages)
+ (cons (list name pkg-desc)
+ alist)
+ (while (if (and (cdr existing-packages)
+ (version-list-< priority-version
+ (package-desc-priority-version
+ (cadr existing-packages))))
+ (setq existing-packages (cdr existing-packages))
+ (push pkg-desc (cdr existing-packages))
+ nil))
+ alist)))
(defun package-download-transaction (packages)
"Download and install all the packages in PACKAGES.
(unless tar-desc
(error "No package descriptor file found"))
(with-current-buffer (tar--extract tar-desc)
- (goto-char (point-min))
(unwind-protect
- (let* ((pkg-def-parsed (read (current-buffer)))
- (pkg-desc
- (if (not (eq (car pkg-def-parsed) 'define-package))
- (error "Can't find define-package in %s"
- (tar-header-name tar-desc))
- (apply #'package-desc-from-define
- (append (cdr pkg-def-parsed))))))
- (setf (package-desc-kind pkg-desc) 'tar)
- pkg-desc)
+ (package--read-pkg-desc 'tar)
(kill-buffer (current-buffer))))))
+(defun package-dir-info ()
+ "Find package information for a directory.
+The return result is a `package-desc'."
+ (cl-assert (derived-mode-p 'dired-mode))
+ (let* ((desc-file (package--description-file default-directory)))
+ (if (file-readable-p desc-file)
+ (with-temp-buffer
+ (insert-file-contents desc-file)
+ (package--read-pkg-desc 'dir))
+ (let ((files (directory-files default-directory t "\\.el\\'" t))
+ info)
+ (while files
+ (with-temp-buffer
+ (insert-file-contents (pop files))
+ ;; When we find the file with the data,
+ (when (setq info (ignore-errors (package-buffer-info)))
+ ;; stop looping,
+ (setq files nil)
+ ;; set the 'dir kind,
+ (setf (package-desc-kind info) 'dir))))
+ ;; and return the info.
+ info))))
+
+(defun package--read-pkg-desc (kind)
+ "Read a `define-package' form in current buffer.
+Return the pkg-desc, with desc-kind set to KIND."
+ (goto-char (point-min))
+ (unwind-protect
+ (let* ((pkg-def-parsed (read (current-buffer)))
+ (pkg-desc
+ (if (not (eq (car pkg-def-parsed) 'define-package))
+ (error "Can't find define-package in %s"
+ (tar-header-name tar-desc))
+ (apply #'package-desc-from-define
+ (append (cdr pkg-def-parsed))))))
+ (setf (package-desc-kind pkg-desc) kind)
+ pkg-desc)))
+
;;;###autoload
(defun package-install-from-buffer ()
"Install a package from the current buffer.
-The current buffer is assumed to be a single .el or .tar file that follows the
-packaging guidelines; see info node `(elisp)Packaging'.
+The current buffer is assumed to be a single .el or .tar file or
+a directory. These must follow the packaging guidelines (see
+info node `(elisp)Packaging').
+
+Specially, if current buffer is a directory, the -pkg.el
+description file is not mandatory, in which case the information
+is derived from the main .el file in the directory.
+
Downloads and installs required packages as needed."
(interactive)
- (let ((pkg-desc (if (derived-mode-p 'tar-mode)
- (package-tar-file-info)
- (package-buffer-info))))
+ (let ((pkg-desc
+ (cond
+ ((derived-mode-p 'dired-mode)
+ ;; This is the only way a package-desc object with a `dir'
+ ;; desc-kind can be created. Such packages can't be
+ ;; uploaded or installed from archives, they can only be
+ ;; installed from local buffers or directories.
+ (package-dir-info))
+ ((derived-mode-p 'tar-mode)
+ (package-tar-file-info))
+ (t
+ (package-buffer-info)))))
;; Download and install the dependencies.
(let* ((requires (package-desc-reqs pkg-desc))
(transaction (package-compute-transaction nil requires)))
The file can either be a tar file or an Emacs Lisp file."
(interactive "fPackage file name: ")
(with-temp-buffer
- (insert-file-contents-literally file)
- (when (string-match "\\.tar\\'" file) (tar-mode))
+ (if (file-directory-p file)
+ (progn
+ (setq default-directory file)
+ (dired-mode))
+ (insert-file-contents-literally file)
+ (when (string-match "\\.tar\\'" file) (tar-mode)))
(package-install-from-buffer)))
(defun package-delete (pkg-desc)
"Return the archive containing the package NAME."
(cdr (assoc (package-desc-archive desc) package-archives)))
+(defun package-archive-priority (archive)
+ "Return the priority of ARCHIVE.
+
+The archive priorities are specified in
+`package-archive-priorities'. If not given there, the priority
+defaults to 0."
+ (or (cdr (assoc archive package-archive-priorities))
+ 0))
+
+(defun package-desc-priority-version (pkg-desc)
+ "Return the version PKG-DESC with the archive priority prepended.
+
+This allows for easy comparison of package versions from
+different archives if archive priorities are meant to be taken in
+consideration."
+ (cons (package-archive-priority
+ (package-desc-archive pkg-desc))
+ (package-desc-version pkg-desc)))
+
(defun package--download-one-archive (archive file)
"Retrieve an archive file FILE from ARCHIVE, and cache it.
ARCHIVE should be a cons cell of the form (NAME . LOCATION),
(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)
+ (with-file-modes 448
+ (make-directory homedir t))
+ (setf (epg-context-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))))
(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))))))
+ (when (and package-check-signature (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")
\\{package-menu-mode-map}"
(setq tabulated-list-format
`[("Package" 18 package-menu--name-predicate)
- ("Version" 12 nil)
+ ("Version" 13 nil)
("Status" 10 package-menu--status-predicate)
,@(if (cdr package-archives)
'(("Archive" 10 package-menu--archive-predicate)))
;; ENTRY is (PKG-DESC [NAME VERSION STATUS DOC])
(let ((pkg-desc (car entry))
(status (aref (cadr entry) 2)))
- (cond ((member status '("installed" "unsigned"))
- (push pkg-desc installed))
- ((member status '("available" "new"))
- (push (cons (package-desc-name pkg-desc) pkg-desc)
- available)))))
+ (cond ((member status '("installed" "unsigned"))
+ (push pkg-desc installed))
+ ((member status '("available" "new"))
+ (setq available (package--append-to-alist pkg-desc available))))))
;; Loop through list of installed packages, finding upgrades.
(dolist (pkg-desc installed)
- (let ((avail-pkg (assq (package-desc-name pkg-desc) available)))
- (and avail-pkg
- (version-list-< (package-desc-version pkg-desc)
- (package-desc-version (cdr avail-pkg)))
- (push avail-pkg upgrades))))
+ (let* ((name (package-desc-name pkg-desc))
+ (avail-pkg (cadr (assq name available))))
+ (and avail-pkg
+ (version-list-< (package-desc-priority-version pkg-desc)
+ (package-desc-priority-version avail-pkg))
+ (push (cons name avail-pkg) upgrades))))
upgrades))
(defun package-menu-mark-upgrades ()