Delay running vc-checkin-hook for an async checkin

* lisp/vc/vc-git.el (vc-git-checkin):
* lisp/vc/vc-hg.el (vc-hg-checkin, vc-hg-checkin-patch): Run
vc-checkin-hook using vc-run-delayed.
* lisp/vc/vc.el (vc-checkin): Don't pass vc-checkin-hook to
vc-start-logentry when doing an async checkin.  That runs the
hook too early.

3 files changed, 61 insertions, 41 deletions

diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el
index 77f1f747d69..f460eafacbf 100644
--- a/lisp/vc/vc-git.el
+++ b/lisp/vc/vc-git.el
@@ -1125,7 +1125,8 @@ It is based on `log-edit-mode', and has Git-specific extensions."
        (delete-file ,temp))))
 
 (defun vc-git-checkin (files comment &optional _rev)
-  (let* ((file1 (or (car files) default-directory))
+  (let* ((parent (current-buffer))
+         (file1 (or (car files) default-directory))
          (root (vc-git-root file1))
          (default-directory (expand-file-name root))
          (only (or (cdr files)
@@ -1253,7 +1254,10 @@ It is based on `log-edit-mode', and has Git-specific extensions."
                  (with-current-buffer buffer
                    (vc-run-delayed
                      (vc-compilation-mode 'git)
-                     (funcall post)))
+                     (funcall post)
+                     (when (buffer-live-p parent)
+                       (with-current-buffer parent
+                         (run-hooks 'vc-checkin-hook)))))
                  (vc-set-async-update buffer))
         (apply #'vc-git-command nil 0 files args)
         (funcall post)))))
diff --git a/lisp/vc/vc-hg.el b/lisp/vc/vc-hg.el
index 490118ad0f3..e1527935861 100644
--- a/lisp/vc/vc-hg.el
+++ b/lisp/vc/vc-hg.el
@@ -1186,7 +1186,8 @@ It is based on `log-edit-mode', and has Hg-specific extensions.")
 (defun vc-hg-checkin (files comment &optional _rev)
   "Hg-specific version of `vc-backend-checkin'.
 REV is ignored."
-  (let ((args (nconc (list "commit" "-m")
+  (let ((parent (current-buffer))
+        (args (nconc (list "commit" "-m")
                      (vc-hg--extract-headers comment))))
     (if vc-async-checkin
         (let ((buffer (vc-hg--async-buffer)))
@@ -1195,12 +1196,16 @@ REV is ignored."
            "Finishing checking in files...")
           (with-current-buffer buffer
             (vc-run-delayed
-              (vc-compilation-mode 'hg)))
+              (vc-compilation-mode 'hg)
+              (when (buffer-live-p parent)
+                (with-current-buffer parent
+                  (run-hooks 'vc-checkin-hook)))))
           (vc-set-async-update buffer))
       (apply #'vc-hg-command nil 0 files args))))
 
 (defun vc-hg-checkin-patch (patch-string comment)
-  (let ((patch-file (make-temp-file "hg-patch")))
+  (let ((parent (current-buffer))
+        (patch-file (make-temp-file "hg-patch")))
     (write-region patch-string nil patch-file)
     (unwind-protect
         (let ((args (list "update"
@@ -1214,7 +1219,10 @@ REV is ignored."
                 (apply #'vc-hg--async-command buffer args)
                 (with-current-buffer buffer
                   (vc-run-delayed
-                    (vc-compilation-mode 'hg)))
+                    (vc-compilation-mode 'hg)
+                    (when (buffer-live-p parent)
+                       (with-current-buffer parent
+                         (run-hooks 'vc-checkin-hook)))))
                 (vc-set-async-update buffer))
             (apply #'vc-hg-command nil 0 nil args)))
       (delete-file patch-file))))
diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el
index 1fad73face1..64d58265816 100644
--- a/lisp/vc/vc.el
+++ b/lisp/vc/vc.el
@@ -1894,41 +1894,49 @@ The optional argument PATCH-STRING is a string to check in as a patch.
 
 Runs the normal hooks `vc-before-checkin-hook' and `vc-checkin-hook'."
   (run-hooks 'vc-before-checkin-hook)
-  (vc-start-logentry
-   files comment initial-contents
-   "Enter a change comment."
-   "*vc-log*"
-   (lambda ()
-     (vc-call-backend backend 'log-edit-mode))
-   (lambda (files comment)
-     ;; "This log message intentionally left almost blank".
-     ;; RCS 5.7 gripes about whitespace-only comments too.
-     (unless (and comment (string-match "[^\t\n ]" comment))
-       (setq comment "*** empty log message ***"))
-     (cl-labels ((do-it ()
-                   ;; We used to change buffers to get local value of
-                   ;; `vc-checkin-switches', but the (singular) local
-                   ;; buffer is not well defined for filesets.
-                   (if patch-string
-                       (vc-call-backend backend 'checkin-patch
-                                        patch-string comment)
-                     (vc-call-backend backend 'checkin
-                                      files comment rev))
-                   (mapc #'vc-delete-automatic-version-backups files)))
-       (if (and vc-async-checkin (memq backend vc-async-checkin-backends))
-           ;; Rely on `vc-set-async-update' to update properties.
-           (do-it)
-         (message "Checking in %s..." (vc-delistify files))
-         (with-vc-properties files (do-it)
-                             `((vc-state . up-to-date)
-                               (vc-checkout-time
-                                . ,(file-attribute-modification-time
-                                    (file-attributes file)))
-                               (vc-working-revision . nil)))
-         (message "Checking in %s...done" (vc-delistify files)))))
-   'vc-checkin-hook
-   backend
-   patch-string))
+  (let ((do-async (and vc-async-checkin
+                       (memq backend vc-async-checkin-backends))))
+   (vc-start-logentry
+    files comment initial-contents
+    "Enter a change comment."
+    "*vc-log*"
+    (lambda ()
+      (vc-call-backend backend 'log-edit-mode))
+    (lambda (files comment)
+      ;; "This log message intentionally left almost blank".
+      ;; RCS 5.7 gripes about whitespace-only comments too.
+      (unless (and comment (string-match "[^\t\n ]" comment))
+        (setq comment "*** empty log message ***"))
+      (cl-labels ((do-it ()
+                    ;; We used to change buffers to get local value of
+                    ;; `vc-checkin-switches', but the (singular) local
+                    ;; buffer is not well defined for filesets.
+                    (if patch-string
+                        (vc-call-backend backend 'checkin-patch
+                                         patch-string comment)
+                      (vc-call-backend backend 'checkin
+                                       files comment rev))
+                    (mapc #'vc-delete-automatic-version-backups files)))
+        (if do-async
+            ;; Rely on `vc-set-async-update' to update properties.
+            (do-it)
+          (message "Checking in %s..." (vc-delistify files))
+          (with-vc-properties files (do-it)
+                              `((vc-state . up-to-date)
+                                (vc-checkout-time
+                                 . ,(file-attribute-modification-time
+                                     (file-attributes file)))
+                                (vc-working-revision . nil)))
+          (message "Checking in %s...done" (vc-delistify files)))))
+
+    ;; FIXME: In the async case we need the hook to be added to the
+    ;; buffer with the checkin process, using `vc-run-delayed'.  Ideally
+    ;; the identity of that buffer would be exposed to this code,
+    ;; somehow, so we could always handle running the hook up here.
+    (and (not do-async) 'vc-checkin-hook)
+
+    backend
+    patch-string)))
 
 (defun vc-default-checkin-patch (_backend patch-string comment)
   (pcase-let* ((`(,backend ,files) (with-temp-buffer