From f1124256ecd858897235cb1de0ca901a9b604690 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Mon, 7 Jul 2025 15:44:34 +0100 Subject: [PATCH] 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 . #), 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 . #) 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) --- lisp/vc/vc-dispatcher.el | 55 ++++++++++++++++++----------- lisp/vc/vc-git.el | 8 ++--- lisp/vc/vc-hg.el | 8 ++--- lisp/vc/vc.el | 75 +++++++++++++++++++--------------------- 4 files changed, 76 insertions(+), 70 deletions(-) diff --git a/lisp/vc/vc-dispatcher.el b/lisp/vc/vc-dispatcher.el index 486e07ac93d..b644d8916e1 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 9075ceed634..306e92b6923 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 18f2bb1fd8b..8e8d708f36a 100644 --- 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))) -- 2.39.5