;;; 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."
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
nil pkg-file nil 'silent))))
(defun package--alist-to-plist-args (alist)
- (mapcar (lambda (x)
- (if (and (not (consp x))
- (or (keywordp x)
- (not (symbolp x))
- (memq x '(nil t))))
- x `',x))
+ (mapcar 'macroexp-quote
(apply #'nconc
(mapcar (lambda (pair) (list (car pair) (cdr pair))) alist))))
(defun package-unpack (pkg-desc)
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."
(homedir (expand-file-name "gnupg" package-user-dir)))
(with-file-modes 448
(make-directory homedir t))
- (epg-context-set-home-directory context homedir)
+ (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))))
\\{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)))