Resolve FIXME regarding running vc-checkin-hook

Running vc-checkin-hook needs to be delayed in the case of an
async checkin.  As a quick fix we had been relying on the
backend checkin functions to run the hook in the async case.
This restores handling running the hook in generic code even for
the async case.

* lisp/vc/vc.el (vc-checkin): Always pass vc-checkin-hook to
vc-start-logentry.  Return the result of calling the backend
'checkin-patch' or 'checkin' function to vc-finish-logentry.
* lisp/vc/vc-dispatcher.el (vc-finish-logentry): If the log
operation returns a cons of the form (async . #<process ...>),
use vc-exec-after to delay vc-resynch-buffer and hooks until the
async process completes.  Approach suggested by Dmitry Gutov.
* lisp/vc/vc-git.el (vc-git-checkin):
* lisp/vc/vc-hg.el (vc-hg-checkin): For an async checkin, return
a cons (async . #<process ...>) containing the async checkin
process.  No longer run vc-checkin-hook.

* lisp/vc/vc.el (with-vc-properties): Return the result of
evaluating FORM.
* lisp/vc/vc-dispatcher.el (vc-exec-after): Change to PROC's
buffer before calling vc-set-mode-line-busy-indicator.

4 files changed, 76 insertions, 70 deletions

diff --git a/lisp/vc/vc-dispatcher.el b/lisp/vc/vc-dispatcher.el
index 97f1971dd1d..97c58ca9ea2 100644
--- a/lisp/vc/vc-dispatcher.el
+++ b/lisp/vc/vc-dispatcher.el
@@ -276,7 +276,10 @@ Only run CODE if the SUCCESS process has a zero exit code."
         (if (functionp code) (funcall code) (eval code t))))
      ;; If a process is running, add CODE to the sentinel
      ((eq (process-status proc) 'run)
-      (vc-set-mode-line-busy-indicator)
+      (let ((buf (process-buffer proc)))
+        (when (buffer-live-p buf)
+          (with-current-buffer buf
+            (vc-set-mode-line-busy-indicator))))
       (letrec ((fun (lambda (p _msg)
                       (remove-function (process-sentinel p) fun)
                       (vc--process-sentinel p code success))))
@@ -863,26 +866,38 @@ the buffer contents as a comment."
 
   ;; save the parameters held in buffer-local variables
   (let ((logbuf (current-buffer))
-        (log-operation vc-log-operation)
-        (log-fileset vc-log-fileset)
-        (log-entry (buffer-string))
-        (after-hook vc-log-after-operation-hook))
+        (log-operation vc-log-operation)
+        (log-fileset vc-log-fileset)
+        (log-entry (buffer-string))
+        (after-hook vc-log-after-operation-hook)
+        (parent vc-parent-buffer))
     ;; OK, do it to it
-    (with-current-buffer vc-parent-buffer
-      (funcall log-operation log-fileset log-entry))
-    (pop-to-buffer vc-parent-buffer)
-    (setq vc-log-operation nil)
-
-    ;; Quit windows on logbuf.
-    (cond ((not logbuf))
-          (vc-delete-logbuf-window
-           (quit-windows-on logbuf t (selected-frame)))
-          (t
-           (quit-windows-on logbuf nil 0)))
-
-    ;; Now make sure we see the expanded headers
-    (mapc (lambda (file) (vc-resynch-buffer file t t)) log-fileset)
-    (run-hooks after-hook 'vc-finish-logentry-hook)))
+    (let ((log-operation-ret
+           (with-current-buffer parent
+             (funcall log-operation log-fileset log-entry))))
+      (pop-to-buffer parent)
+      (setq vc-log-operation nil)
+
+      ;; Quit windows on logbuf.
+      (cond ((not logbuf))
+            (vc-delete-logbuf-window
+             (quit-windows-on logbuf t (selected-frame)))
+            (t
+             (quit-windows-on logbuf nil 0)))
+
+      ;; Now make sure we see the expanded headers.
+      ;; If the `vc-log-operation' started an async operation then we
+      ;; need to delay running the hooks.  It tells us whether it did
+      ;; that with a special return value.
+      (cl-flet ((resynch-and-hooks ()
+                  (when (buffer-live-p parent)
+                    (with-current-buffer parent
+                      (mapc (lambda (file) (vc-resynch-buffer file t t))
+                            log-fileset)
+                      (run-hooks after-hook 'vc-finish-logentry-hook)))))
+        (if (eq (car-safe log-operation-ret) 'async)
+            (vc-exec-after #'resynch-and-hooks nil (cadr log-operation-ret))
+          (resynch-and-hooks))))))
 
 (defun vc-dispatcher-browsing ()
   "Are we in a directory browser buffer?"
diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el
index 6a8e5924198..958f3f7e6d1 100644
--- a/lisp/vc/vc-git.el
+++ b/lisp/vc/vc-git.el
@@ -1273,11 +1273,9 @@ 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)
-                     (when (buffer-live-p parent)
-                       (with-current-buffer parent
-                         (run-hooks 'vc-checkin-hook)))))
-                 (vc-set-async-update buffer))
+                     (funcall post)))
+                 (vc-set-async-update buffer)
+                 (list 'async (get-buffer-process 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 e5a7c10ed96..b5556cfb3ba 100644
--- a/lisp/vc/vc-hg.el
+++ b/lisp/vc/vc-hg.el
@@ -1229,11 +1229,9 @@ REV is ignored."
            "Finishing checking in files...")
           (with-current-buffer buffer
             (vc-run-delayed
-              (vc-compilation-mode 'hg)
-              (when (buffer-live-p parent)
-                (with-current-buffer parent
-                  (run-hooks 'vc-checkin-hook)))))
-          (vc-set-async-update buffer))
+              (vc-compilation-mode 'hg)))
+          (vc-set-async-update buffer)
+          (list 'async (get-buffer-process buffer)))
       (apply #'vc-hg-command nil 0 files args))))
 
 (defun vc-hg-checkin-patch (patch-string comment)
diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el
index a6a4aa50579..b20cadc94cc 100644
--- a/lisp/vc/vc.el
+++ b/lisp/vc/vc.el
@@ -1081,24 +1081,25 @@ If any of FILES is actually a directory, then do the same for all
 buffers for files in that directory.
 SETTINGS is an association list of property/value pairs.  After
 executing FORM, set those properties from SETTINGS that have not yet
-been updated to their corresponding values."
+been updated to their corresponding values.
+Return the result of evaluating FORM."
   (declare (debug t))
   `(let ((vc-touched-properties (list t))
          (flist nil))
-     (dolist (file ,files)
-       (if (file-directory-p file)
-           (dolist (buffer (buffer-list))
-             (let ((fname (buffer-file-name buffer)))
-               (when (and fname (string-prefix-p file fname))
-                 (push fname flist))))
-         (push file flist)))
-     ,form
-     (dolist (file flist)
-       (dolist (setting ,settings)
-         (let ((property (car setting)))
-           (unless (memq property vc-touched-properties)
-             (put (intern file vc-file-prop-obarray)
-                  property (cdr setting))))))))
+     (prog2 (dolist (file ,files)
+              (if (file-directory-p file)
+                  (dolist (buffer (buffer-list))
+                    (let ((fname (buffer-file-name buffer)))
+                      (when (and fname (string-prefix-p file fname))
+                        (push fname flist))))
+                (push file flist)))
+         ,form
+       (dolist (file flist)
+         (dolist (setting ,settings)
+           (let ((property (car setting)))
+             (unless (memq property vc-touched-properties)
+               (put (intern file vc-file-prop-obarray)
+                    property (cdr setting)))))))))
 
 ;;; Code for deducing what fileset and backend to assume
 
@@ -2005,34 +2006,28 @@ have changed; continue with old fileset?" (current-buffer))))
         ;; NOQUERY parameter non-nil.
         (vc-buffer-sync-fileset (list backend files)))
       (when register (vc-register (list backend register)))
-      (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)))
+      (cl-flet ((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.
+                  (prog1 (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)
-
+          (prog2 (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)))