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

vc-hg-checkin-patch: Fix on MS-Windows, make 'hg import' async

Browse source 
* lisp/vc/vc-hg.el (vc-hg--checkin): New function to do the work
of vc-hg-checkin and vc-hg-checkin-patch.
(vc-hg-checkin): Replace body with call to vc-hg--checkin.
(vc-hg-checkin-patch): Likewise.  As compared with the old
implementation, this change (i) fixes encoding issues when
checking in patches on MS-Windows; and (ii) when
vc-async-checkin is non-nil, runs 'hg import' asynchronously
instead of running 'hg update' asynchronously (bug#79235).
This commit is contained in:
Sean Whitton 2025-08-16 20:40:50 +01:00
parent f8cb751ac0
commit 72022459a9
1 changed files with 61 additions and 48 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

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

@ -1213,11 +1213,18 @@ It is based on `log-edit-mode', and has Hg-specific extensions.")
(defalias 'vc-hg-async-checkins #'always)
(defun vc-hg-checkin (files comment &optional _rev)
"Hg-specific version of `vc-BACKEND-checkin'.
REV is ignored."
(defun vc-hg--checkin (comment &optional files patch-string)
"Workhorse routine for `vc-hg-checkin' and `vc-hg-checkin-patch'.
COMMENT is the commit message.
For a regular checkin, FILES is the list of files to check in.
To check in a patch, PATCH-STRING is the patch text.
It is an error to supply both or neither."
(unless (xor files patch-string)
(error "Invalid call to `vc-hg--checkin'"))
(let* ((args (vc-hg--extract-headers comment))
(file1 (or (car files) default-directory))
(temps-dir (or (file-name-directory (or (car files)
default-directory))
default-directory))
(msg-file
;; On MS-Windows, pass the commit log message through a file,
;; to work around the limitation that command-line arguments
@ -1225,30 +1232,53 @@ REV is ignored."
;; support non-ASCII characters in the log message.
;; Also handle remote files.
(and (eq system-type 'windows-nt)
(let ((default-directory (or (file-name-directory file1)
default-directory)))
(make-nearby-temp-file "hg-msg")))))
(when msg-file
(let ((coding-system-for-write 'utf-8))
(write-region (car args) nil msg-file)))
(let ((coding-system-for-write
;; On MS-Windows, we must encode command-line arguments in
;; the system codepage.
(if (eq system-type 'windows-nt)
locale-coding-system
coding-system-for-write))
(args (if msg-file
(cl-list* "commit" "-A" "-l" (file-local-name msg-file)
(cdr args))
(cl-list* "commit" "-A" "-m" args)))
(post (lambda ()
(when (and msg-file (file-exists-p msg-file))
(delete-file msg-file)))))
(let ((default-directory temps-dir))
(make-nearby-temp-file "hg-msg"))))
(patch-file (and patch-string
(let ((default-directory temps-dir))
(make-nearby-temp-file "hg-patch")))))
(let ((coding-system-for-write 'utf-8))
(when msg-file
(write-region (car args) nil msg-file))
(when patch-file
(write-region patch-string nil patch-file)))
(let* ((coding-system-for-write
;; On MS-Windows, we must encode command-line arguments in
;; the system codepage.
(if (eq system-type 'windows-nt)
locale-coding-system
coding-system-for-write))
(args
(nconc (if patch-file
(list "import" "--bypass" patch-file)
(list "commit" "-A"))
(if msg-file
(cl-list* "-l" (file-local-name msg-file) (cdr args))
(cl-list* "-m" args))))
(post (lambda ()
(when (and msg-file (file-exists-p msg-file))
(delete-file msg-file))
(when (and patch-file (file-exists-p patch-file))
(delete-file patch-file))
;; When committing a patch we run 'hg import' and
;; then 'hg update'. We have 'hg update' here in the
;; always-synchronous `post' function because we
;; assume that 'hg import' is the one that might be
;; slow and so benefits most from `vc-async-checkin'.
;; If in fact both the 'hg import' and the 'hg
;; update' can be slow, then we need to make both of
;; them part of the async command, possibly by
;; writing out a tiny shell script (bug#79235).
(when patch-file
(vc-hg-command nil 0 nil "update" "--merge"
"--tool" "internal:local" "tip")))))
(if vc-async-checkin
(let ((buffer (vc-hg--async-buffer)))
(vc-wait-for-process-before-save
(apply #'vc-hg--async-command buffer (nconc args files))
"Finishing checking in files...")
(if patch-file
"Finishing checking in patch...."
"Finishing checking in files..."))
(with-current-buffer buffer
(vc-run-delayed
(vc-compilation-mode 'hg)
@ -1258,31 +1288,14 @@ REV is ignored."
(apply #'vc-hg-command nil 0 files args)
(funcall post)))))
;; FIXME: Needs MS-Windows encoding issues handling.
;; Possibly we want fix this by merging this function into the preceeding one.
;; Figure out resolution of #79235 first.
(defun vc-hg-checkin (files comment &optional _rev)
"Hg-specific version of `vc-BACKEND-checkin'.
REV is ignored."
(vc-hg--checkin comment files nil))
(defun vc-hg-checkin-patch (patch-string comment)
(let ((patch-file (make-nearby-temp-file "hg-patch")))
(write-region patch-string nil patch-file)
(unwind-protect
(let ((args (list "update"
"--merge" "--tool" "internal:local"
"tip")))
(apply #'vc-hg-command nil 0 nil
(nconc (list "import" "--bypass" patch-file "-m")
(vc-hg--extract-headers comment)))
(if vc-async-checkin
(let ((buffer (vc-hg--async-buffer)))
(vc-wait-for-process-before-save
(apply #'vc-hg--async-command buffer args)
"Finishing checking in patch....")
(with-current-buffer buffer
(vc-run-delayed
(vc-compilation-mode 'hg)))
(vc-set-async-update buffer)
(list 'async (get-buffer-process buffer)))
(apply #'vc-hg-command nil 0 nil args)))
(delete-file patch-file))))
"Hg-specific version of `vc-BACKEND-checkin-patch'."
(vc-hg--checkin comment nil patch-string))
(defun vc-hg--extract-headers (comment)
(log-edit-extract-headers `(("Author" . "--user")