Github/emacs
2
0
Fork 1
mirror of git://git.sv.gnu.org/emacs.git synced 2026-02-16 09:14:18 +00:00
Code Issues Projects Releases Packages Wiki Activity

Delay running vc-checkin-hook for an async checkin

Browse source 
* 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.
This commit is contained in:
Sean Whitton 2025-05-30 13:32:00 +01:00
parent 6d0a71af9a
commit 7d0a605a70
3 changed files with 61 additions and 41 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

8
lisp/vc/vc-git.el
View file

@ -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)))))

16
lisp/vc/vc-hg.el
View file

@ -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))))

78
lisp/vc/vc.el
View file

@ -1894,41 +1894,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