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) + (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))) + ;; 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))) + ;; 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)))