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.

(cherry picked from commit 6c0c985cee4e1ce4798a4ab192e8ca36013e7fa1)

diff --git a/lisp/vc/vc-dispatcher.el b/lisp/vc/vc-dispatcher.el
index 486e07ac93d066590b73ee88bacdce5a9548d6eb..b644d8916e1ebe2a3c112c820aaf3e2dac5751c5 100644 (file)
--- 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 9075ceed63479f18f48a7b885ef358a70e27af34..306e92b69237f176babc842f796ba505301bfc5f 100644 (file)
--- 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 e5a7c10ed964ad2dbc3c4ebd05d3982bcfe53510..b5556cfb3ba81bbdde98ca74412ea89aea2e86f7 100644 (file)
--- 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 18f2bb1fd8b097d8f60ac748efdf96a2846f6a00..8e8d708f36a7b9be197a32519e8c92d2b787915b 100644 (file)
--- a/lisp/vc/vc.el
+++ b/lisp/vc/vc.el
@@ -1078,24 +1078,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
 
@@ -2000,34 +2001,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)))