;;; package.el --- Simple package system for Emacs -*- lexical-binding:t -*-
-;; Copyright (C) 2007-2015 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2016 Free Software Foundation, Inc.
;; Author: Tom Tromey <tromey@redhat.com>
;; Daniel Hackney <dan@haxney.org>
;; Created: 10 Mar 2007
-;; Version: 1.0.1
+;; Version: 1.1.0
;; Keywords: tools
;; Package-Requires: ((tabulated-list "1.0"))
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
-;;; Change Log:
-
-;; 2 Apr 2007 - now using ChangeLog file
-;; 15 Mar 2007 - updated documentation
-;; 14 Mar 2007 - Changed how obsolete packages are handled
-;; 13 Mar 2007 - Wrote package-install-from-buffer
-;; 12 Mar 2007 - Wrote package-menu mode
-
;;; Commentary:
;; The idea behind package.el is to be able to download packages and
;; * Download. Fetching the package from ELPA.
;; * Install. Untar the package, or write the .el file, into
;; ~/.emacs.d/elpa/ directory.
+;; * Autoload generation.
;; * Byte compile. Currently this phase is done during install,
;; but we may change this.
;; * Activate. Evaluate the autoloads for the package to make it
;; - "installed" instead of a blank in the status column
;; - tramp needs its files to be compiled in a certain order.
;; how to handle this? fix tramp?
-;; - on emacs 21 we don't kill the -autoloads.el buffer. what about 22?
;; - maybe we need separate .elc directories for various emacs versions
;; and also emacs-vs-xemacs. That way conditional compilation can
;; work. But would this break anything?
-;; - should store the package's keywords in archive-contents, then
-;; let the users filter the package-menu by keyword. See
-;; finder-by-keyword. (We could also let people view the
-;; Commentary, but it isn't clear how useful this is.)
;; - William Xu suggests being able to open a package file without
;; installing it
;; - Interface with desktop.el so that restarting after an install
;; private data dir, aka ".../etc". Or, maybe data-directory
;; needs to be a list (though this would be less nice)
;; a few packages want this, eg sokoban
-;; - package menu needs:
-;; ability to know which packages are built-in & thus not deletable
-;; it can sometimes print odd results, like 0.3 available but 0.4 active
-;; why is that?
-;; - Allow multiple versions on the server...?
-;; [ why bother? ]
-;; - Don't install a package which will invalidate dependencies overall
-;; - Allow something like (or (>= emacs 21.0) (>= xemacs 21.5))
-;; [ currently thinking, why bother.. KISS ]
+;; - Allow multiple versions on the server, so that if a user doesn't
+;; meet the requirements for the most recent version they can still
+;; install an older one.
;; - Allow optional package dependencies
;; then if we require 'bbdb', bbdb-specific lisp in lisp/bbdb
;; and just don't compile to add to load path ...?
(eval-when-compile (require 'subr-x))
(eval-when-compile (require 'cl-lib))
(eval-when-compile (require 'epg)) ;For setf accessors.
+(require 'seq)
(require 'tabulated-list)
(require 'macroexp)
Any other version, even if newer, is silently ignored.
Hence, the package is \"held\" at that version.
If VERSION is nil, the package is not loaded (it is \"disabled\")."
- :type '(repeat symbol)
+ :type '(repeat (choice (const all)
+ (list :tag "Specific package"
+ (symbol :tag "Package name")
+ (choice :tag "Version"
+ (const :tag "disable" nil)
+ (const :tag "most recent" t)
+ (string :tag "specific version")))))
:risky t
:version "24.1")
This variable has three possible values:
nil: no packages are hidden;
- `archive': only criteria (a) is used;
+ `archive': only criterion (a) is used;
t: both criteria are used.
This variable has no effect if `package-menu--hide-packages' is
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
+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.
To check if a package is contained in this list here, use
`package--user-selected-p', as it may populate the variable with
a sane initial value."
+ :version "25.1"
:type '(repeat symbol))
(defcustom package-menu-async t
(push (int-to-string num) str-list)
(push "." str-list))
((< num -4)
- (error "Invalid version list ‘%s’" vlist))
+ (error "Invalid version list `%s'" vlist))
(t
;; pre, or beta, or alpha
(cond ((equal "." (car str-list))
(pop str-list))
((not (string-match "[0-9]+" (car str-list)))
- (error "Invalid version list ‘%s’" vlist)))
+ (error "Invalid version list `%s'" vlist)))
(push (cond ((= num -1) "pre")
((= num -2) "beta")
((= num -3) "alpha")
((stringp force) ; held
(unless (version-list-= version (version-to-list force))
force))
- (t (error "Invalid element in ‘package-load-list’")))))
+ (t (error "Invalid element in `package-load-list'")))))
(defun package-built-in-p (package &optional min-version)
"Return true if PACKAGE is built-in to Emacs.
(require 'finder-inf nil t) ; For `package--builtins'.
(assq package package--builtins))))))
+(defun package--autoloads-file-name (pkg-desc)
+ "Return the absolute name of the autoloads file, sans extension.
+PKG-DESC is a `package-desc' object."
+ (expand-file-name
+ (format "%s-autoloads" (package-desc-name pkg-desc))
+ (package-desc-dir pkg-desc)))
+
+(defun package--activate-autoloads-and-load-path (pkg-desc)
+ "Load the autoloads file and add package dir to `load-path'.
+PKG-DESC is a `package-desc' object."
+ (let* ((old-lp load-path)
+ (pkg-dir (package-desc-dir pkg-desc))
+ (pkg-dir-dir (file-name-as-directory pkg-dir)))
+ (with-demoted-errors "Error loading autoloads: %s"
+ (load (package--autoloads-file-name pkg-desc) 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))))
+
(defvar Info-directory-list)
(declare-function info-initialize "info" ())
-(defun package-activate-1 (pkg-desc &optional reload)
+(defun package--load-files-for-activation (pkg-desc reload)
+ "Load files for activating a package given by PKG-DESC.
+Load the autoloads file, and ensure `load-path' is setup. If
+RELOAD is non-nil, also load all files in the package that
+correspond to previously loaded files."
+ (let* ((loaded-files-list (when reload
+ (package--list-loaded-files (package-desc-dir pkg-desc)))))
+ ;; Add to load path, add autoloads, and activate the package.
+ (package--activate-autoloads-and-load-path pkg-desc)
+ ;; Call `load' on all files in `package-desc-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--load-files-for-activation: %s"
+ (mapc (lambda (feature) (load feature nil t))
+ ;; Skip autoloads file since we already evaluated it above.
+ (remove (file-truename (package--autoloads-file-name pkg-desc))
+ loaded-files-list)))))
+
+(defun package-activate-1 (pkg-desc &optional reload deps)
"Activate package given by PKG-DESC, even if it was already active.
+If DEPS is non-nil, also activate its dependencies (unless they
+are already activated).
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)))
+ (pkg-dir (package-desc-dir pkg-desc)))
(unless pkg-dir
- (error "Internal error: unable to find directory for ‘%s’"
+ (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)
- (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))
- ;; 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))))
+ ;; Activate its dependencies recursively.
+ ;; FIXME: This doesn't check whether the activated version is the
+ ;; required version.
+ (when deps
+ (dolist (req (package-desc-reqs pkg-desc))
+ (unless (package-activate (car req))
+ (error "Unable to activate package `%s'.\nRequired package `%s-%s' is unavailable"
+ name (car req) (package-version-join (cadr req))))))
+ (package--load-files-for-activation pkg-desc reload)
;; Add info node.
(when (file-exists-p (expand-file-name "dir" pkg-dir))
;; FIXME: not the friendliest, but simple.
;; one was already activated. It also loads a features of this
;; package which were already loaded.
(defun package-activate (package &optional force)
- "Activate package PACKAGE.
+ "Activate the package named PACKAGE.
If FORCE is true, (re-)activate it if it's already activated.
Newer versions are always activated, regardless of FORCE."
(let ((pkg-descs (cdr (assq package package-alist))))
((and (memq package package-activated-list) (not force))
t)
;; Otherwise, proceed with activation.
- (t
- (let* ((pkg-vec (car pkg-descs))
- (fail (catch 'dep-failure
- ;; Activate its dependencies recursively.
- (dolist (req (package-desc-reqs pkg-vec))
- (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 force)))))))
+ (t (package-activate-1 (car pkg-descs) nil 'deps)))))
\f
;;; Installation -- Local operations
(package--make-autoloads-and-stuff pkg-desc pkg-dir)
;; Update package-alist.
(let ((new-desc (package-load-descriptor pkg-dir)))
- ;; FIXME: Check that `new-desc' matches `desc'!
+ (unless (equal (package-desc-full-name new-desc)
+ (package-desc-full-name pkg-desc))
+ (error "The retrieved package (`%s') doesn't match what the archive offered (`%s')"
+ (package-desc-full-name new-desc) (package-desc-full-name pkg-desc)))
+ ;; Activation has to be done before compilation, so that if we're
+ ;; upgrading and macros have changed we load the new definitions
+ ;; before compiling.
+ (package-activate-1 new-desc :reload :deps)
;; FIXME: Compilation should be done as a separate, optional, step.
;; E.g. for multi-package installs, we should first install all packages
;; and then compile them.
- (package--compile new-desc))
- ;; Try to activate it.
- (package-activate name 'force)
+ (package--compile new-desc)
+ ;; After compilation, load again any files loaded by
+ ;; `activate-1', so that we use the byte-compiled definitions.
+ (package--load-files-for-activation new-desc :reload))
pkg-dir))
(defun package-generate-description-file (pkg-desc pkg-file)
" --- automatically extracted autoloads\n"
";;\n"
";;; Code:\n"
- "(add-to-list 'load-path (or (file-name-directory #$) (car load-path)))\n"
+ ;; `load-path' should contain only directory names
+ "(add-to-list 'load-path (directory-file-name (or (file-name-directory #$) (car load-path))))\n"
"\f\n;; Local Variables:\n"
";; version-control: never\n"
";; no-byte-compile: t\n"
;;;; Compilation
(defvar warning-minimum-level)
(defun package--compile (pkg-desc)
- "Byte-compile installed package PKG-DESC."
+ "Byte-compile installed package PKG-DESC.
+This assumes that `pkg-desc' has already been activated with
+`package-activate-1'."
(let ((warning-minimum-level :error)
- (save-silently inhibit-message))
- (package-activate-1 pkg-desc)
+ (save-silently inhibit-message)
+ (load-path load-path))
(byte-recompile-directory (package-desc-dir pkg-desc) 0 t)))
;;;; Inferring package from current buffer
This macro retrieves FILE from LOCATION into a temporary buffer,
and evaluates BODY while that buffer is current. This work
buffer is killed afterwards. Return the last value in BODY."
- (declare (indent 2) (debug t))
+ (declare (indent 2) (debug t)
+ (obsolete package--with-response-buffer "25.1"))
`(with-temp-buffer
(if (string-match-p "\\`https?:" ,location)
(url-insert-file-contents (concat ,location ,file))
(insert-file-contents (expand-file-name ,file ,location)))
,@body))
-(defmacro package--with-work-buffer-async (location file async &rest body)
- "Run BODY in a buffer containing the contents of FILE at LOCATION.
-If ASYNC is non-nil, and if it is possible, run BODY
-asynchronously. If an error is encountered and ASYNC is a
-function, call it with no arguments (instead of executing BODY).
-If it returns non-nil, or if it wasn't a function, propagate the
-error.
-
-For a description of the other arguments see
-`package--with-work-buffer'."
- (declare (indent 3) (debug t))
- (macroexp-let2* macroexp-copyable-p
- ((async-1 async)
- (file-1 file)
- (location-1 location))
- `(if (or (not ,async-1)
- (not (string-match-p "\\`https?:" ,location-1)))
- (package--with-work-buffer ,location-1 ,file-1 ,@body)
- ;; This `condition-case' is to catch connection errors.
- (condition-case error-signal
- (url-retrieve (concat ,location-1 ,file-1)
- ;; This is to catch execution errors.
- (lambda (status)
- (condition-case error-signal
- (progn
- (when-let ((er (plist-get status :error)))
- (error "Error retrieving: %s %S" (concat ,location-1 ,file-1) er))
- (goto-char (point-min))
- (unless (search-forward "\n\n" nil 'noerror)
- (error "Invalid url response in buffer %s"
- (current-buffer)))
- (delete-region (point-min) (point))
- ,@body
- (kill-buffer (current-buffer)))
- (error (when (if (functionp ,async-1) (funcall ,async-1) t)
- (signal (car error-signal) (cdr error-signal))))))
- nil
- 'silent)
- (error (when (if (functionp ,async-1) (funcall ,async-1) t)
- (message "Error contacting: %s" (concat ,location-1 ,file-1))
- (signal (car error-signal) (cdr error-signal))))))))
+(cl-defmacro package--with-response-buffer (url &rest body &key async file error-form noerror &allow-other-keys)
+ "Access URL and run BODY in a buffer containing the response.
+Point is after the headers when BODY runs.
+FILE, if provided, is added to URL.
+URL can be a local file name, which must be absolute.
+ASYNC, if non-nil, runs the request asynchronously.
+ERROR-FORM is run only if a connection error occurs. If NOERROR
+is non-nil, don't propagate connection errors (does not apply to
+errors signaled by ERROR-FORM or by BODY).
+
+\(fn URL &key ASYNC FILE ERROR-FORM NOERROR &rest BODY)"
+ (declare (indent defun) (debug t))
+ (while (keywordp (car body))
+ (setq body (cdr (cdr body))))
+ (macroexp-let2* nil ((url-1 url)
+ (url-sym (make-symbol "url"))
+ (b-sym (make-symbol "b-sym"))
+ (noerror-1 noerror))
+ `(cl-macrolet ((unless-error (body-2 &rest before-body)
+ (let ((err (make-symbol "err")))
+ `(with-temp-buffer
+ (when (condition-case ,err
+ (progn ,@before-body t)
+ ,(list 'error ',error-form
+ (list 'unless ',noerror-1
+ `(signal (car ,err) (cdr ,err)))))
+ ,@body-2)))))
+ (if (string-match-p "\\`https?:" ,url-1)
+ (let ((,url-sym (concat ,url-1 ,file)))
+ (if ,async
+ (unless-error nil
+ (url-retrieve ,url-sym
+ (lambda (status)
+ (let ((,b-sym (current-buffer)))
+ (require 'url-handlers)
+ (unless-error ,body
+ (when-let ((er (plist-get status :error)))
+ (error "Error retrieving: %s %S" ,url-sym er))
+ (with-current-buffer ,b-sym
+ (goto-char (point-min))
+ (unless (search-forward-regexp "^\r?\n\r?" nil 'noerror)
+ (error "Error retrieving: %s %S" ,url-sym "incomprehensible buffer")))
+ (url-insert-buffer-contents ,b-sym ,url-sym)
+ (kill-buffer ,b-sym)
+ (goto-char (point-min)))))
+ nil
+ 'silent))
+ (unless-error ,body (url-insert-file-contents ,url-sym))))
+ (unless-error ,body
+ (let ((url (expand-file-name ,file ,url-1)))
+ (unless (file-name-absolute-p url)
+ (error "Location %s is not a url nor an absolute file name" url))
+ (insert-file-contents url)))))))
+
+(define-error 'bad-signature "Failed to verify signature")
(defun package--check-signature-content (content string &optional sig-file)
"Check signature CONTENT against STRING.
(condition-case error
(epg-verify-string context content string)
(error (package--display-verify-error context sig-file)
- (signal (car error) (cdr error))))
+ (signal 'bad-signature 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))))
- (when (and (null good-signatures) had-fatal-error)
+ (when (or (null good-signatures) had-fatal-error)
(package--display-verify-error context sig-file)
- (error "Failed to verify signature %s" sig-file))
+ (signal 'bad-signature (list sig-file)))
good-signatures)))
-(defun package--check-signature (location file &optional string async callback)
+(defun package--check-signature (location file &optional string async callback unwind)
"Check signature of the current buffer.
Download the signature file from LOCATION by appending \".sig\"
to FILE.
If ASYNC is non-nil, the download of the signature file is
done asynchronously.
-If the signature is verified and CALLBACK was provided, CALLBACK
-is `funcall'ed with the list of good signatures as argument (the
-list can be empty). If the signatures file is not found,
-CALLBACK is called with no arguments."
+If the signature does not verify, signal an error.
+If the signature is verified and CALLBACK was provided, `funcall'
+CALLBACK with the list of good signatures as argument (the list
+can be empty).
+If no signatures file is found, and `package-check-signature' is
+`allow-unsigned', call CALLBACK with a nil argument.
+Otherwise, an error is signaled.
+
+UNWIND, if provided, is a function to be called after everything
+else, even if an error is signaled."
(let ((sig-file (concat file ".sig"))
(string (or string (buffer-string))))
- (condition-case nil
- (package--with-work-buffer-async
- location sig-file (when async (or callback t))
- (let ((sig (package--check-signature-content
- (buffer-string) string sig-file)))
+ (package--with-response-buffer location :file sig-file
+ :async async :noerror t
+ ;; Connection error is assumed to mean "no sig-file".
+ :error-form (let ((allow-unsigned (eq package-check-signature 'allow-unsigned)))
+ (when (and callback allow-unsigned)
+ (funcall callback nil))
+ (when unwind (funcall unwind))
+ (unless allow-unsigned
+ (error "Unsigned file `%s' at %s" file location)))
+ ;; OTOH, an error here means "bad signature", which we never
+ ;; suppress. (Bug#22089)
+ (unwind-protect
+ (let ((sig (package--check-signature-content (buffer-substring (point) (point-max))
+ string sig-file)))
(when callback (funcall callback sig))
- sig))
- (file-error (funcall callback)))))
-
+ sig)
+ (when unwind (funcall unwind))))))
\f
;;; Packages on Archives
;; The following variables store information about packages available
(dolist (package contents)
(package--add-to-archive-contents package archive)))))
+(defvar package--old-archive-priorities nil
+ "Store currently used `package-archive-priorities'.
+This is the value of `package-archive-priorities' last time
+`package-read-all-archive-contents' was called. It can be used
+by arbitrary functions to decide whether it is necessary to call
+it again.")
+
(defun package-read-all-archive-contents ()
"Re-read `archive-contents', if it exists.
If successful, set `package-archive-contents'."
(setq package-archive-contents nil)
+ (setq package--old-archive-priorities package-archive-priorities)
(dolist (archive package-archives)
(package-read-archive-contents (car archive))))
The variable `package-load-list' controls which packages to load.
If optional arg NO-ACTIVATE is non-nil, don't activate packages.
If `user-init-file' does not mention `(package-initialize)', add
-it to the file."
+it to the file.
+If called as part of loading `user-init-file', set
+`package-enable-at-startup' to nil, to prevent accidentally
+loading packages twice.
+It is not necessary to adjust `load-path' or `require' the
+individual packages after calling `package-initialize' -- this is
+taken care of by `package-initialize'."
(interactive)
(setq package-alist nil)
(if (equal user-init-file load-file-name)
;; If `package-initialize' is being called as part of loading
;; the init file, it's obvious we don't need to ensure-init.
- (setq package--init-file-ensured t)
+ (setq package--init-file-ensured t
+ ;; And likely we don't need to run it again after init.
+ package-enable-at-startup nil)
(package--ensure-init-file))
(package-load-all-descriptors)
(package-read-all-archive-contents)
(defvar package--downloads-in-progress nil
"List of in-progress asynchronous downloads.")
-(declare-function epg-check-configuration "epg-config"
- (config &optional minimum-version))
-(declare-function epg-configuration "epg-config" ())
+(declare-function epg-find-configuration "epg-config"
+ (protocol &optional force))
(declare-function epg-import-keys-from-file "epg" (context keys))
;;;###autoload
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/FILE\" in `package-user-dir'."
- (package--with-work-buffer-async (cdr archive) file async
+ (package--with-response-buffer (cdr archive) :file file
+ :async async
+ :error-form (package--update-downloads-in-progress archive)
(let* ((location (cdr archive))
(name (car archive))
(content (buffer-string))
location file content async
;; This function will be called after signature checking.
(lambda (&optional good-sigs)
- (unless (or good-sigs (eq package-check-signature 'allow-unsigned))
- ;; Even if the sig fails, this download is done, so
- ;; remove it from the in-progress list.
- (package--update-downloads-in-progress archive)
- (error "Unsigned archive ‘%s’" name))
- ;; Write out the archives file.
(write-region content nil local-file nil 'silent)
;; Write out good signatures into archive-contents.signed file.
(when good-sigs
(write-region (mapconcat #'epg-signature-to-string good-sigs "\n")
- nil (concat local-file ".signed") nil 'silent))
- (package--update-downloads-in-progress archive)
- ;; If we got this far, either everything worked or we don't mind
- ;; not signing, so tell `package--with-work-buffer-async' to not
- ;; propagate errors.
- nil)))))))
+ nil (concat local-file ".signed") nil 'silent)))
+ (lambda () (package--update-downloads-in-progress archive))))))))
(defun package--download-and-read-archives (&optional async)
"Download descriptions of all `package-archives' and read them.
:test #'equal))
(dolist (archive package-archives)
(condition-case-unless-debug nil
- (package--download-one-archive
- archive "archive-contents"
- ;; Called if the async download fails
- (when async
- ;; The t at the end means to propagate connection errors.
- (lambda () (package--update-downloads-in-progress archive) t)))
- (error (message "Failed to download ‘%s’ archive."
+ (package--download-one-archive archive "archive-contents" async)
+ (error (message "Failed to download `%s' archive."
(car archive))))))
;;;###autoload
(let ((default-keyring (expand-file-name "package-keyring.gpg"
data-directory))
(inhibit-message async))
+ (if (get 'package-check-signature 'saved-value)
+ (when package-check-signature
+ (epg-find-configuration 'OpenPGP))
+ (setq package-check-signature
+ (if (epg-find-configuration 'OpenPGP)
+ 'allow-unsigned)))
(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))
+ (package-import-keyring default-keyring)
(error (message "Cannot import default keyring: %S" (cdr error))))))
(package--download-and-read-archives async))
(package-desc-full-name already))
(setq packages (delq already packages))
(setq already nil))
- (error "Need package ‘%s-%s’, but only %s is being installed"
+ (error "Need package `%s-%s', but only %s is being installed"
next-pkg (package-version-join next-version)
(package-version-join (package-desc-version already)))))
(cond
(setq problem
(if (stringp disabled)
(format-message
- "Package ‘%s’ held at version %s, but version %s required"
+ "Package `%s' held at version %s, but version %s required"
next-pkg disabled
(package-version-join next-version))
- (format-message "Required package ‘%s’ is disabled"
+ (format-message "Required package `%s' is disabled"
next-pkg)))))
(t (setq found pkg-desc)))))
(unless found
(cond
(problem (error "%s" problem))
(found-something
- (error "Need package ‘%s-%s’, but only %s is available"
+ (error "Need package `%s-%s', but only %s is available"
next-pkg (package-version-join next-version)
found-something))
- (t (error "Package ‘%s-%s’ is unavailable"
+ (t (error "Package `%s-%s' is unavailable"
next-pkg (package-version-join next-version)))))
(setq packages
(package-compute-transaction (cons found packages)
(let* ((location (package-archive-base pkg-desc))
(file (concat (package-desc-full-name pkg-desc)
(package-desc-suffix pkg-desc))))
- (package--with-work-buffer location file
+ (package--with-response-buffer location :file file
(if (or (not package-check-signature)
(member (package-desc-archive pkg-desc)
package-unsigned-archives))
location file content nil
;; This function will be called after signature checking.
(lambda (&optional good-sigs)
- (unless (or good-sigs (eq package-check-signature 'allow-unsigned))
- ;; Even if the sig fails, this download is done, so
- ;; remove it from the in-progress list.
- (error "Unsigned package: ‘%s’"
- (package-desc-name pkg-desc)))
;; Signature checked, unpack now.
(with-temp-buffer (insert content)
(let ((save-silently t))
(save-restriction
(widen)
(goto-char (point-min))
- (search-forward "(package-initialize)" nil 'noerror))))
+ (re-search-forward "(package-initialize\\_>" nil 'noerror))))
;; Don't visit the file if we don't have to.
(with-temp-buffer
(insert-file-contents user-init-file)
(goto-char (point-min))
- (search-forward "(package-initialize)" nil 'noerror)))))
+ (re-search-forward "(package-initialize\\_>" nil 'noerror)))))
(unless contains-init
(with-current-buffer (or buffer
(let ((delay-mode-hooks t))
;;;###autoload
(defun package-install (pkg &optional dont-select)
"Install the package PKG.
-PKG can be a package-desc or the package name of one the available packages
+PKG can be a package-desc or a symbol naming one of the available packages
in an archive in `package-archives'. Interactively, prompt for its name.
If called interactively or if DONT-SELECT nil, add PKG to
pkg)))
(unless (or dont-select (package--user-selected-p name))
(package--save-selected-packages
- (cons name package-selected-packages))))
- (if-let ((transaction
- (if (package-desc-p pkg)
- (unless (package-installed-p pkg)
- (package-compute-transaction (list pkg)
- (package-desc-reqs pkg)))
- (package-compute-transaction () (list (list pkg))))))
- (package-download-transaction transaction)
- (message "‘%s’ is already installed" (package-desc-full-name pkg))))
+ (cons name package-selected-packages)))
+ (if-let ((transaction
+ (if (package-desc-p pkg)
+ (unless (package-installed-p pkg)
+ (package-compute-transaction (list pkg)
+ (package-desc-reqs pkg)))
+ (package-compute-transaction () (list (list pkg))))))
+ (package-download-transaction transaction)
+ (message "`%s' is already installed" name))))
(defun package-strip-rcs-id (str)
"Strip RCS version ID from the version string STR.
((derived-mode-p 'tar-mode)
(package-tar-file-info))
(t
- (package-buffer-info))))
+ (save-excursion
+ (package-buffer-info)))))
(name (package-desc-name pkg-desc)))
;; Download and install the dependencies.
(let* ((requires (package-desc-reqs pkg-desc))
;; using here, because the outcome is the same either way (nothing
;; gets installed).
(if (not package-selected-packages)
- (message "‘package-selected-packages’ is empty, nothing to install")
- (cl-loop for p in package-selected-packages
- unless (package-installed-p p)
- collect p into lst
- finally
- (if lst
- (when (y-or-n-p
- (format "%s packages will be installed:\n%s, proceed?"
- (length lst)
- (mapconcat #'symbol-name lst ", ")))
- (mapc #'package-install lst))
- (message "All your packages are already installed")))))
+ (message "`package-selected-packages' is empty, nothing to install")
+ (let* ((not-installed (seq-remove #'package-installed-p package-selected-packages))
+ (available (seq-filter (lambda (p) (assq p package-archive-contents)) not-installed))
+ (difference (- (length not-installed) (length available))))
+ (cond
+ (available
+ (when (y-or-n-p
+ (format "%s packages will be installed:\n%s, proceed?"
+ (length available)
+ (mapconcat #'symbol-name available ", ")))
+ (mapc (lambda (p) (package-install p 'dont-select)) available)))
+ ((> difference 0)
+ (message "%s packages are not available (the rest already installed), maybe you need to `M-x package-refresh-contents'"
+ difference))
+ (t
+ (message "All your packages are already installed"))))))
\f
;;; Package Deletion
(expand-file-name package-user-dir))
(expand-file-name dir)))
;; Don't delete "system" packages.
- (error "Package ‘%s’ is a system package, not deleting"
+ (error "Package `%s' is a system package, not deleting"
(package-desc-full-name pkg-desc)))
((and (null force)
(setq pkg-used-elsewhere-by
(package--used-elsewhere-p pkg-desc)))
;; Don't delete packages used as dependency elsewhere.
- (error "Package ‘%s’ is used by ‘%s’ as dependency, not deleting"
+ (error "Package `%s' is used by `%s' as dependency, not deleting"
(package-desc-full-name pkg-desc)
(package-desc-name pkg-used-elsewhere-by)))
(t
(delete pkg-desc pkgs)
(unless (cdr pkgs)
(setq package-alist (delq pkgs package-alist))))
- (message "Package ‘%s’ deleted." (package-desc-full-name pkg-desc))))))
+ (message "Package `%s' deleted." (package-desc-full-name pkg-desc))))))
;;;###autoload
(defun package-reinstall (pkg)
;; do absolutely nothing.
(when (or package-selected-packages
(yes-or-no-p
- "‘package-selected-packages’ is empty! Really remove ALL packages? "))
+ (format-message
+ "`package-selected-packages' is empty! Really remove ALL packages? ")))
(let ((removable (package--removable-packages)))
(if removable
(when (y-or-n-p
"Installed"
(capitalize status))
'font-lock-face 'package-status-builtin-face))
- (insert (substitute-command-keys " in ‘"))
+ (insert (substitute-command-keys " in `"))
(let ((dir (abbreviate-file-name
(file-name-as-directory
(if (file-in-directory-p pkg-dir package-user-dir)
(if (and (package-built-in-p name)
(not (package-built-in-p name version)))
(insert (substitute-command-keys
- "’,\n shadowing a ")
+ "',\n shadowing a ")
(propertize "built-in package"
'font-lock-face 'package-status-builtin-face))
- (insert (substitute-command-keys "’")))
+ (insert (substitute-command-keys "'")))
(if signed
(insert ".")
(insert " (unsigned)."))
(replace-match ""))
(while (re-search-forward "^\\(;+ ?\\)" nil t)
(replace-match ""))))
- (let ((readme (expand-file-name (format "%s-readme.txt" name)
- package-user-dir))
- readme-string)
+ (let* ((basename (format "%s-readme.txt" name))
+ (readme (expand-file-name basename 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
- (save-excursion
- (package--with-work-buffer
- (package-archive-base desc)
- (format "%s-readme.txt" name)
- (save-excursion
- (goto-char (point-max))
- (unless (bolp)
- (insert ?\n)))
- (write-region nil nil
- (expand-file-name readme package-user-dir)
- nil 'silent)
- (setq readme-string (buffer-string))
- t))
- (error nil))
+ (cond ((and (package-desc-archive desc)
+ (package--with-response-buffer (package-archive-base desc)
+ :file basename :noerror t
+ (save-excursion
+ (goto-char (point-max))
+ (unless (bolp)
+ (insert ?\n)))
+ (write-region nil nil
+ (expand-file-name readme package-user-dir)
+ nil 'silent)
+ (setq readme-string (buffer-string))
+ t))
(insert readme-string))
((file-readable-p readme)
(insert-file-contents readme)
(defun package-install-button-action (button)
(let ((pkg-desc (button-get button 'package-desc)))
- (when (y-or-n-p (format-message "Install package ‘%s’? "
+ (when (y-or-n-p (format-message "Install package `%s'? "
(package-desc-full-name pkg-desc)))
(package-install pkg-desc nil)
(revert-buffer nil t)
(defun package-delete-button-action (button)
(let ((pkg-desc (button-get button 'package-desc)))
- (when (y-or-n-p (format-message "Delete package ‘%s’? "
+ (when (y-or-n-p (format-message "Delete package `%s'? "
(package-desc-full-name pkg-desc)))
(package-delete pkg-desc)
(revert-buffer nil t)
Values can be interactively added to this list by typing
\\[package-menu-hide-package] on a package"
+ :version "25.1"
:type '(repeat (regexp :tag "Hide packages with name matching")))
(defun package-menu--refresh (&optional packages keywords)
(push pkg info-list)))))
;; Available and disabled packages:
+ (unless (equal package--old-archive-priorities package-archive-priorities)
+ (package-read-all-archive-contents))
(dolist (elt package-archive-contents)
(let ((name (car elt)))
;; To be displayed it must be in PACKAGES;
(cl-remove-if-not (lambda (e) (string-match re (symbol-name (car e))))
package-archive-contents)))
(message (substitute-command-keys
- (concat "Hiding %s packages, type ‘\\[package-menu-toggle-hiding]’"
- " to toggle or ‘\\[customize-variable] RET package-hidden-regexps’"
+ (concat "Hiding %s packages, type `\\[package-menu-toggle-hiding]'"
+ " to toggle or `\\[customize-variable] RET package-hidden-regexps'"
" to customize it"))
(length hidden)))))
(length packages)
(mapconcat #'package-desc-full-name packages ", ")))
;; Exactly 1
- (t (format-message "package ‘%s’"
+ (t (format-message "package `%s'"
(package-desc-full-name (car packages))))))
(defun package-menu--prompt-transaction-p (delete install upgrade)
(condition-case-unless-debug err
(let ((inhibit-message package-menu-async))
(package-delete elt nil 'nosave))
- (error (message "Error trying to delete ‘%s’: %S"
+ (error (message "Error trying to delete `%s': %S"
(package-desc-full-name elt)
err))))))
(defun package-menu--find-and-notify-upgrades ()
"Notify the user of upgradable packages."
(when-let ((upgrades (package-menu--find-upgrades)))
- (message "%d package%s can be upgraded; type ‘%s’ to mark %s for upgrading."
+ (message "%d package%s can be upgraded; type `%s' to mark %s for upgrading."
(length upgrades)
(if (= (length upgrades) 1) "" "s")
(substitute-command-keys "\\[package-menu-mark-upgrades]")