scratch/package-vc-fixes bc9c7aee30 34/48: Improve robustness of 'package-vc-update'

[Philip Kaludercic]

branch: scratch/package-vc-fixes
commit bc9c7aee306c63755d9a16b60334715e2f99cb69
Author: Philip Kaludercic <philipk@posteo.net>
Commit: Philip Kaludercic <philipk@posteo.net>

    Improve robustness of 'package-vc-update'
    
    * 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.
---
 lisp/emacs-lisp/package-vc.el | 29 ++++++++++++-----------------
 1 file changed, 12 insertions(+), 17 deletions(-)

diff --git a/lisp/emacs-lisp/package-vc.el b/lisp/emacs-lisp/package-vc.el
index 156e7576f6..f025a963a4 100644
--- a/lisp/emacs-lisp/package-vc.el
+++ b/lisp/emacs-lisp/package-vc.el
@@ -544,7 +544,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
@@ -558,28 +558,23 @@ installed package."
   ;;
   ;; If there is a better way to do this, it should be done.
   (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."