Commit 0060c0d7 authored by Artur Malabarba's avatar Artur Malabarba

* lisp/emacs-lisp/package.el: Revert async package transactions

(package-menu-async): Update doc.
(package-install-from-archive, package-download-transaction)
(package-install, package-menu--perform-transaction)
(package-menu-execute): Remove asynchronous functionality.
parent 6f4b0e81
...@@ -350,8 +350,9 @@ a sane initial value." ...@@ -350,8 +350,9 @@ a sane initial value."
(defcustom package-menu-async t (defcustom package-menu-async t
"If non-nil, package-menu will use async operations when possible. "If non-nil, package-menu will use async operations when possible.
This includes refreshing archive contents as well as installing Currently, only the refreshing of archive contents supports
packages." asynchronous operations. Package transactions are still done
synchronously."
:type 'boolean :type 'boolean
:version "25.1") :version "25.1")
...@@ -1712,31 +1713,26 @@ if all the in-between dependencies are also in PACKAGE-LIST." ...@@ -1712,31 +1713,26 @@ if all the in-between dependencies are also in PACKAGE-LIST."
"Return the archive containing the package NAME." "Return the archive containing the package NAME."
(cdr (assoc (package-desc-archive desc) package-archives))) (cdr (assoc (package-desc-archive desc) package-archives)))
(defun package-install-from-archive (pkg-desc &optional async callback) (defun package-install-from-archive (pkg-desc)
"Download and install a tar package. "Download and install a tar package."
If ASYNC is non-nil, perform the download asynchronously.
If CALLBACK is non-nil, call it with no arguments once the
operation is done."
;; This won't happen, unless the archive is doing something wrong. ;; This won't happen, unless the archive is doing something wrong.
(when (eq (package-desc-kind pkg-desc) 'dir) (when (eq (package-desc-kind pkg-desc) 'dir)
(error "Can't install directory package from archive")) (error "Can't install directory package from archive"))
(let* ((location (package-archive-base pkg-desc)) (let* ((location (package-archive-base pkg-desc))
(file (concat (package-desc-full-name pkg-desc) (file (concat (package-desc-full-name pkg-desc)
(package-desc-suffix pkg-desc)))) (package-desc-suffix pkg-desc))))
(package--with-work-buffer-async location file async (package--with-work-buffer location file
(if (or (not package-check-signature) (if (or (not package-check-signature)
(member (package-desc-archive pkg-desc) (member (package-desc-archive pkg-desc)
package-unsigned-archives)) package-unsigned-archives))
;; If we don't care about the signature, unpack and we're ;; If we don't care about the signature, unpack and we're
;; done. ;; done.
(progn (let ((save-silently async) (let ((save-silently t))
(inhibit-message async)) (package-unpack pkg-desc))
(package-unpack pkg-desc))
(funcall callback))
;; If we care, check it and *then* write the file. ;; If we care, check it and *then* write the file.
(let ((content (buffer-string))) (let ((content (buffer-string)))
(package--check-signature (package--check-signature
location file content async location file content nil
;; This function will be called after signature checking. ;; This function will be called after signature checking.
(lambda (&optional good-sigs) (lambda (&optional good-sigs)
(unless (or good-sigs (eq package-check-signature 'allow-unsigned)) (unless (or good-sigs (eq package-check-signature 'allow-unsigned))
...@@ -1746,8 +1742,7 @@ operation is done." ...@@ -1746,8 +1742,7 @@ operation is done."
(package-desc-name pkg-desc))) (package-desc-name pkg-desc)))
;; Signature checked, unpack now. ;; Signature checked, unpack now.
(with-temp-buffer (insert content) (with-temp-buffer (insert content)
(let ((save-silently async) (let ((save-silently t))
(inhibit-message async))
(package-unpack pkg-desc))) (package-unpack pkg-desc)))
;; Here the package has been installed successfully, mark it as ;; Here the package has been installed successfully, mark it as
;; signed if appropriate. ;; signed if appropriate.
...@@ -1763,9 +1758,7 @@ operation is done." ...@@ -1763,9 +1758,7 @@ operation is done."
(setf (package-desc-signed pkg-desc) t) (setf (package-desc-signed pkg-desc) t)
;; Update the new (activated) pkg-desc as well. ;; Update the new (activated) pkg-desc as well.
(when-let ((pkg-descs (cdr (assq (package-desc-name pkg-desc) package-alist)))) (when-let ((pkg-descs (cdr (assq (package-desc-name pkg-desc) package-alist))))
(setf (package-desc-signed (car pkg-descs)) t))) (setf (package-desc-signed (car pkg-descs)) t))))))))))
(when (functionp callback)
(funcall callback)))))))))
(defun package-installed-p (package &optional min-version) (defun package-installed-p (package &optional min-version)
"Return true if PACKAGE, of MIN-VERSION or newer, is installed. "Return true if PACKAGE, of MIN-VERSION or newer, is installed.
...@@ -1786,25 +1779,13 @@ If PACKAGE is a package-desc object, MIN-VERSION is ignored." ...@@ -1786,25 +1779,13 @@ If PACKAGE is a package-desc object, MIN-VERSION is ignored."
;; Also check built-in packages. ;; Also check built-in packages.
(package-built-in-p package min-version)))) (package-built-in-p package min-version))))
(defun package-download-transaction (packages &optional async callback) (defun package-download-transaction (packages)
"Download and install all the packages in PACKAGES. "Download and install all the packages in PACKAGES.
PACKAGES should be a list of package-desc. PACKAGES should be a list of package-desc.
If ASYNC is non-nil, perform the downloads asynchronously.
If CALLBACK is non-nil, call it with no arguments once the
entire operation is done.
This function assumes that all package requirements in This function assumes that all package requirements in
PACKAGES are satisfied, i.e. that PACKAGES is computed PACKAGES are satisfied, i.e. that PACKAGES is computed
using `package-compute-transaction'." using `package-compute-transaction'."
(cond (mapc #'package-install-from-archive packages))
(packages (package-install-from-archive
(car packages)
async
(lambda ()
(package-download-transaction (cdr packages))
(when (functionp callback)
(funcall callback)))))
(callback (funcall callback))))
(defun package--ensure-init-file () (defun package--ensure-init-file ()
"Ensure that the user's init file has `package-initialize'. "Ensure that the user's init file has `package-initialize'.
...@@ -1857,16 +1838,13 @@ add a call to it along with some explanatory comments." ...@@ -1857,16 +1838,13 @@ add a call to it along with some explanatory comments."
(setq package--init-file-ensured t)) (setq package--init-file-ensured t))
;;;###autoload ;;;###autoload
(defun package-install (pkg &optional dont-select async callback) (defun package-install (pkg &optional dont-select)
"Install the package PKG. "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 the package name of one the available packages
in an archive in `package-archives'. Interactively, prompt for its name. in an archive in `package-archives'. Interactively, prompt for its name.
If called interactively or if DONT-SELECT nil, add PKG to If called interactively or if DONT-SELECT nil, add PKG to
`package-selected-packages'. `package-selected-packages'.
If ASYNC is non-nil, perform the downloads asynchronously.
If CALLBACK is non-nil, call it with no arguments once the
entire operation is done.
If PKG is a package-desc and it is already installed, don't try If PKG is a package-desc and it is already installed, don't try
to install it but still mark it as selected." to install it but still mark it as selected."
...@@ -1899,9 +1877,8 @@ to install it but still mark it as selected." ...@@ -1899,9 +1877,8 @@ to install it but still mark it as selected."
(package-compute-transaction (list pkg) (package-compute-transaction (list pkg)
(package-desc-reqs pkg))) (package-desc-reqs pkg)))
(package-compute-transaction () (list (list pkg)))))) (package-compute-transaction () (list (list pkg))))))
(package-download-transaction transaction async callback) (package-download-transaction transaction)
(message "`%s' is already installed" (package-desc-full-name pkg)) (message "`%s' is already installed" (package-desc-full-name pkg))))
(funcall callback)))
(defun package-strip-rcs-id (str) (defun package-strip-rcs-id (str)
"Strip RCS version ID from the version string STR. "Strip RCS version ID from the version string STR.
...@@ -2938,30 +2915,23 @@ nil, but not both." ...@@ -2938,30 +2915,23 @@ nil, but not both."
(package-menu--list-to-prompt upg) (package-menu--list-to-prompt upg)
"? ")))) "? "))))
(defun package-menu--perform-transaction (install-list delete-list &optional async) (defun package-menu--perform-transaction (install-list delete-list)
"Install packages in INSTALL-LIST and delete DELETE-LIST. "Install packages in INSTALL-LIST and delete DELETE-LIST."
If ASYNC is non-nil, perform the installation downloads
asynchronously."
;; While there are packages to install, call `package-install' on
;; the next one and defer deletion to the callback function.
(if install-list (if install-list
(let* ((pkg (car install-list)) (dolist (pkg install-list)
(rest (cdr install-list))
;; Don't mark as selected if it's a new version of an
;; installed package.
(dont-mark (and (not (package-installed-p pkg))
(package-installed-p
(package-desc-name pkg)))))
(package-install (package-install
pkg dont-mark async ;; Don't mark as selected if it's a new version of an
(lambda () (package-menu--perform-transaction rest delete-list async)))) ;; installed package.
(let ((inhibit-message async)) pkg (and (not (package-installed-p pkg))
;; Once there are no more packages to install, proceed to (package-installed-p
;; deletion. (package-desc-name pkg)))))
(dolist (elt (package--sort-by-dependence delete-list)) ;; Once there are no more packages to install, proceed to
(condition-case-unless-debug err ;; deletion.
(package-delete elt) (dolist (elt (package--sort-by-dependence delete-list))
(error (message (cadr err)))))) (condition-case-unless-debug err
(let ((inhibit-message t))
(package-delete elt))
(error (message (cadr err)))))
(message "Transaction done") (message "Transaction done")
(when package-selected-packages (when package-selected-packages
(when-let ((removable (package--removable-packages))) (when-let ((removable (package--removable-packages)))
...@@ -2997,8 +2967,7 @@ Optional argument NOQUERY non-nil means do not ask the user to confirm." ...@@ -2997,8 +2967,7 @@ Optional argument NOQUERY non-nil means do not ask the user to confirm."
(package-menu--prompt-transaction-p install-list delete-list)) (package-menu--prompt-transaction-p install-list delete-list))
(message "Transaction started") (message "Transaction started")
;; This calls `package-menu--generate' after everything's done. ;; This calls `package-menu--generate' after everything's done.
(package-menu--perform-transaction (package-menu--perform-transaction install-list delete-list))))
install-list delete-list package-menu-async))))
(defun package-menu--version-predicate (A B) (defun package-menu--version-predicate (A B)
(let ((vA (or (aref (cadr A) 1) '(0))) (let ((vA (or (aref (cadr A) 1) '(0)))
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment