Function: vc-hg--checkin

vc-hg--checkin is a byte-compiled function defined in vc-hg.el.gz.

Signature

(vc-hg--checkin COMMENT &optional FILES PATCH-STRING)

Documentation

Workhorse routine for vc-hg-checkin and vc-hg-checkin-patch.

COMMENT is the commit message; nil if it should come from PATCH-STRING. 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.

Source Code

;; Defined in /usr/src/emacs/lisp/vc/vc-hg.el.gz
(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; nil if it should come from PATCH-STRING.
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 (and comment (vc-hg--extract-headers comment)))
         (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
          ;; must be in the system codepage, and therefore might not
          ;; support non-ASCII characters in the log message.
          ;; Also handle remote files.
          (and args (eq system-type 'windows-nt)
               (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"))
                  (cond (msg-file (cl-list* "-l" (file-local-name msg-file)
                                            (cdr args)))
                        (args (cons "-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))
             ;; If PATCH-STRING didn't come from C-x v = or C-x v D, we
             ;; now need to update the working tree to include the
             ;; changes from the commit we just created.
             ;; If there are conflicts we want to favor the working
             ;; tree's version and the version from the commit will just
             ;; show up in the diff of uncommitted changes.
             ;;
             ;; When committing a patch we run two commands, '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
               (let ((bmark (vc-hg--active-bookmark-internal ".")))
                 (when bmark
                   (vc-hg-command nil 0 nil "bookmark" "-f" "-r" "tip" bmark))
                 (vc-hg-command nil 0 nil "update" "--merge"
                                "--tool" "internal:local" (or bmark "tip")))))))
      (if vc-async-checkin
          (let* ((buffer (vc-hg--async-buffer))
                 (proc (apply #'vc-hg--async-command buffer
                              (nconc args files))))
            (set-process-query-on-exit-flag proc t)
            (vc-wait-for-process-before-save
             proc
             (if patch-file
                 "Finishing checking in patch...."
               "Finishing checking in files..."))
            (with-current-buffer buffer
              (vc-run-delayed
                (vc-compilation-mode 'hg)
                (funcall post)))
            (vc-set-async-update buffer)
            (list 'async (get-buffer-process buffer)))
        (apply #'vc-hg-command nil 0 files args)
        (funcall post)))))