procyberian/emacs
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Improve robustness of 'package-vc-update'

Browse source 
* lisp/emacs-lisp/package-vc.el (package-vc-update): Ensure that the
command is only invoked with installed packages. that the hook is
always removed and that 'vc-pull' is always called in the right
directory.
This commit is contained in:
Philip Kaludercic 2022-11-15 10:20:01 +01:00
parent fd4da9151f
commit 7ab556b576
1 changed files with 12 additions and 17 deletions
Download patch file Download diff file Expand all files Collapse all files

29
lisp/emacs-lisp/package-vc.el
View file

@ -562,7 +562,7 @@ installed package."
(defun package-vc-update (pkg-desc)
"Attempt to update the package PKG-DESC."
(interactive (list (package-vc--read-package-desc "Update source package:")))
(interactive (list (package-vc--read-package-desc "Update source package: " t)))
;; HACK: To run `package-vc--unpack-1' after checking out the new
;; revision, we insert a hook into `vc-post-command-functions', and
;; remove it right after it ran. To avoid running the hook multiple
@ -577,28 +577,23 @@ installed package."
;; If there is a better way to do this, it should be done.
(cl-assert (package-vc-p pkg-desc))
(letrec ((pkg-dir (package-desc-dir pkg-desc))
(empty (make-symbol "empty"))
(args (list empty empty empty empty))
(vc-flags)
(vc-filter-command-function
(lambda (command file-or-list flags)
(setf (nth 0 args) command
(nth 1 args) file-or-list
(nth 2 args) flags
(nth 3 args) default-directory)
(setq vc-flags flags)
(list command file-or-list flags)))
(post-upgrade
(lambda (command file-or-list flags)
(when (and (memq (nth 0 args) (list command empty))
(memq (nth 1 args) (list file-or-list empty))
(memq (nth 2 args) (list flags empty))
(or (eq (nth 3 args) empty)
(file-equal-p (nth 3 args) default-directory)))
(with-demoted-errors "Failed to activate: %S"
(package-vc--unpack-1 pkg-desc pkg-dir))
(remove-hook 'vc-post-command-functions post-upgrade)))))
(lambda (_command _file-or-list flags)
(when (and (file-equal-p pkg-dir default-directory)
(eq flags vc-flags))
(unwind-protect
(with-demoted-errors "Failed to activate: %S"
(package-vc--unpack-1 pkg-desc pkg-dir))
(remove-hook 'vc-post-command-functions post-upgrade))))))
(add-hook 'vc-post-command-functions post-upgrade)
(with-demoted-errors "Failed to fetch: %S"
(vc-pull))))
(let ((default-directory pkg-dir))
(vc-pull)))))
(defun package-vc--archives-initialize ()
"Initialize package.el and fetch package specifications."