TakeV/spacemacs
Archived
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

Fix two important bugs in Update/Rollback

Browse source 
- correctly detect package dependencies to update
- rollback is now an idempotent action
This commit is contained in:
syl20bnr 2015-04-07 23:51:08 -04:00
parent fcfe1c2c7b
commit 3107d5d9f8
1 changed files with 56 additions and 29 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

85
core/core-configuration-layer.el
View file

@ -432,8 +432,8 @@ If PRE is non nil then `layer-pre-extensions' is read instead of
(defun configuration-layer//install-packages () (defun configuration-layer//install-packages ()
"Install the packages all the packages if there are not currently installed." "Install the packages all the packages if there are not currently installed."
(interactive) (interactive)
(let* ((not-installed (remove-if 'package-installed-p (let* ((not-installed (configuration-layer//get-packages-to-install
configuration-layer-all-packages-sorted)) configuration-layer-all-packages-sorted))
(not-installed-count (length not-installed))) (not-installed-count (length not-installed)))
;; installation ;; installation
(if not-installed (if not-installed
@ -448,10 +448,11 @@ If PRE is non nil then `layer-pre-extensions' is read instead of
(setq installed-count 0) (setq installed-count 0)
(dolist (pkg not-installed) (dolist (pkg not-installed)
(setq installed-count (1+ installed-count)) (setq installed-count (1+ installed-count))
(spacemacs/replace-last-line-of-buffer (let ((layer (ht-get configuration-layer-all-packages pkg)))
(format "--> installing %s:%s... [%s/%s]" (spacemacs/replace-last-line-of-buffer
(ht-get configuration-layer-all-packages pkg) (format "--> installing %s%s... [%s/%s]"
pkg installed-count not-installed-count) t) (if layer (format "%s:" layer) "")
pkg installed-count not-installed-count) t))
(unless (package-installed-p pkg) (unless (package-installed-p pkg)
(condition-case err (condition-case err
(if (not (assq pkg package-archive-contents)) (if (not (assq pkg package-archive-contents))
@ -470,30 +471,49 @@ If PRE is non nil then `layer-pre-extensions' is read instead of
(spacemacs//redisplay)) (spacemacs//redisplay))
(spacemacs/append-to-buffer "\n"))))) (spacemacs/append-to-buffer "\n")))))
(defun configuration-layer//get-packages-to-update (packages) (defun configuration-layer//filter-packages-with-deps (packages filter)
"Return a list of packages to update given a list of PACKAGES." "Filter a PACKAGES list according to a FILTER predicate.
(when packages
FILTER is a function applied to each element of PACKAGES, if FILTER returns
non nil then element is removed from the list otherwise element is kept in
the list.
This function also processed recursively the package dependencies."
(when packages
(let (result) (let (result)
(dolist (pkg packages) (dolist (pkg packages)
;; recursively check dependencies ;; recursively check dependencies
(let* ((deps (let* ((deps
(configuration-layer//get-package-dependencies-from-archive pkg)) (configuration-layer//get-package-dependencies-from-archive pkg))
(update-deps (install-deps
(when deps (configuration-layer//get-packages-to-update (when deps (configuration-layer//filter-packages-with-deps
(mapcar 'car deps))))) (mapcar 'car deps) filter))))
(when update-deps (when install-deps
(setq result (append update-deps result)))) (setq result (append install-deps result))))
(let ((installed-version (configuration-layer//get-package-version-string pkg)) (unless (apply filter `(,pkg))
(newest-version (configuration-layer//get-latest-package-version-string (add-to-list 'result pkg t)))
pkg)))
;; (message "package - %s" pkg)
;; (message "installed - %s" installed-version)
;; (message "latest - %s" newest-version)
(unless (or (null installed-version)
(version<= newest-version installed-version))
(add-to-list 'result pkg t))))
(delete-dups result)))) (delete-dups result))))
(defun configuration-layer//get-packages-to-install (packages)
"Return a list of packages to install given a list of PACKAGES."
(configuration-layer//filter-packages-with-deps
packages
(lambda (x)
;; the package is already installed
(package-installed-p x))))
(defun configuration-layer//get-packages-to-update (packages)
"Return a list of packages to update given a list of PACKAGES."
(configuration-layer//filter-packages-with-deps
packages
(lambda (x)
;; the package is a built-in package
;; or a newest version is available
(let ((installed-ver (configuration-layer//get-package-version-string x)))
(or (null installed-ver)
(version<= (configuration-layer//get-latest-package-version-string x)
installed-ver))))))
(defun configuration-layer/update-packages () (defun configuration-layer/update-packages ()
"Upgrade elpa packages" "Upgrade elpa packages"
(interactive) (interactive)
@ -599,6 +619,8 @@ to select one."
(dolist (apkg update-packages-alist) (dolist (apkg update-packages-alist)
(let* ((pkg (car apkg)) (let* ((pkg (car apkg))
(pkg-dir-name (cdr apkg)) (pkg-dir-name (cdr apkg))
(installed-ver
(configuration-layer//get-package-version-string pkg))
(elpa-dir (concat user-emacs-directory "elpa/")) (elpa-dir (concat user-emacs-directory "elpa/"))
(src-dir (expand-file-name (src-dir (expand-file-name
(concat rollback-dir (file-name-as-directory (concat rollback-dir (file-name-as-directory
@ -607,12 +629,17 @@ to select one."
(concat elpa-dir (file-name-as-directory (concat elpa-dir (file-name-as-directory
pkg-dir-name))))) pkg-dir-name)))))
(setq rollbacked-count (1+ rollbacked-count)) (setq rollbacked-count (1+ rollbacked-count))
(spacemacs/replace-last-line-of-buffer (if (string-equal (format "%S-%s" pkg installed-ver) pkg-dir-name)
(format "--> rollbacking package %s... [%s/%s]" (spacemacs/replace-last-line-of-buffer
pkg rollbacked-count rollback-count) t) (format "--> package %s already rollbacked! [%s/%s]"
(spacemacs//redisplay) pkg rollbacked-count rollback-count) t)
(configuration-layer//package-delete pkg) ;; rollback the package
(copy-directory src-dir dest-dir 'keeptime 'create 'copy-content))) (spacemacs/replace-last-line-of-buffer
(format "--> rollbacking package %s... [%s/%s]"
pkg rollbacked-count rollback-count) t)
(configuration-layer//package-delete pkg)
(copy-directory src-dir dest-dir 'keeptime 'create 'copy-content))
(spacemacs//redisplay)))
(spacemacs/append-to-buffer (spacemacs/append-to-buffer
(format "\n--> %s packages rollbacked.\n" rollbacked-count)) (format "\n--> %s packages rollbacked.\n" rollbacked-count))
(spacemacs/append-to-buffer (spacemacs/append-to-buffer