From: Sean Whitton Date: Fri, 30 May 2025 12:32:00 +0000 (+0100) Subject: Delay running vc-checkin-hook for an async checkin X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=7fb47bd1c45bacce8a018d6774fbb228705ef0b0;p=emacs.git 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. (cherry picked from commit 7d0a605a70215acd79f920d1c250d6ea4e40bb78) --- diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el index e751f49f636..c6e95ccd973 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 54e5ed37bbe..484cb1e048a 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -1889,41 +1889,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