From 6d4cbe80844a56e0b469fd6304ab7f24daa3d3af Mon Sep 17 00:00:00 2001 From: Sam Steingold Date: Fri, 3 Nov 2017 12:00:35 -0400 Subject: [PATCH] Finish the Bug#11728 work: hg & git * lisp/vc/vc-git.el (vc-git--pushpull): Make `extra-args' a list. Do not set `compilation-error-regexp-alist', this is done in `vc-compilation-mode'. (vc-git-error-regexp-alist): Tweak the regexp. * lisp/vc/vc-hg.el (vc-hg-error-regexp-alist): Make non-trivial. (vc-hg--pushpull): Accept `post-processing' argument. Call them after the `command'. (vc-hg-pull): Pass the `post-processing' commands that show which are to be modified by the `update', and then run `update'. --- lisp/vc/vc-git.el | 13 ++++++------- lisp/vc/vc-hg.el | 40 ++++++++++++++++++++++++---------------- 2 files changed, 30 insertions(+), 23 deletions(-) diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el index 6650c5d764a..c6b08e942f3 100644 --- a/lisp/vc/vc-git.el +++ b/lisp/vc/vc-git.el @@ -860,7 +860,7 @@ It is based on `log-edit-mode', and has Git-specific extensions.") (vc-git-command nil nil file "checkout" "-q" "--"))) (defvar vc-git-error-regexp-alist - '(("^ \\(.+\\) |" 1 nil nil 0)) + '(("^ \\(.+\\)\\> *|" 1 nil nil 0)) "Value of `compilation-error-regexp-alist' in *vc-git* buffers.") ;; To be called via vc-pull from vc.el, which requires vc-dispatcher. @@ -885,17 +885,16 @@ If PROMPT is non-nil, prompt for the Git command to run." (setq git-program (car args) command (cadr args) args (cddr args))) + (setq args (nconc args extra-args)) (require 'vc-dispatcher) (apply 'vc-do-async-command buffer root git-program command args) (with-current-buffer buffer (vc-run-delayed (vc-compilation-mode 'git) (setq-local compile-command - (concat git-program " " command " " extra-args " " - (if args (mapconcat 'identity args " ") ""))) + (concat git-program " " command " " + (mapconcat 'identity args " "))) (setq-local compilation-directory root) - (setq-local compilation-error-regexp-alist - vc-git-error-regexp-alist) ;; Either set `compilation-buffer-name-function' locally to nil ;; or use `compilation-arguments' to set `name-function'. ;; See `compilation-buffer-name'. @@ -909,13 +908,13 @@ If PROMPT is non-nil, prompt for the Git command to run." "Pull changes into the current Git branch. Normally, this runs \"git pull\". If PROMPT is non-nil, prompt for the Git command to run." - (vc-git--pushpull "pull" prompt "--stat")) + (vc-git--pushpull "pull" prompt '("--stat"))) (defun vc-git-push (prompt) "Push changes from the current Git branch. Normally, this runs \"git push\". If PROMPT is non-nil, prompt for the Git command to run." - (vc-git--pushpull "push" prompt "")) + (vc-git--pushpull "push" prompt nil)) (defun vc-git-merge-branch () "Merge changes into the current Git branch. diff --git a/lisp/vc/vc-hg.el b/lisp/vc/vc-hg.el index 2deac2aae27..08b1be8f6d3 100644 --- a/lisp/vc/vc-hg.el +++ b/lisp/vc/vc-hg.el @@ -1296,12 +1296,8 @@ REV is the revision to check out into WORKFILE." (vc-hg-command buffer 1 nil "outgoing" "-n" (unless (string= remote-location "") remote-location))) -(defvar vc-hg-error-regexp-alist nil - ;; 'hg pull' does not list modified files, so, for now, the only - ;; benefit of `vc-compilation-mode' is that one can get rid of - ;; *vc-hg* buffer with 'q' or 'z'. - ;; TODO: call 'hg incoming' before pull/merge to get the list of - ;; modified files +(defvar vc-hg-error-regexp-alist + '(("^M \\(.+\\)" 1 nil nil 0)) "Value of `compilation-error-regexp-alist' in *vc-hg* buffers.") (autoload 'vc-do-async-command "vc-dispatcher") @@ -1309,9 +1305,10 @@ REV is the revision to check out into WORKFILE." (defvar compilation-directory) (defvar compilation-arguments) ; defined in compile.el -(defun vc-hg--pushpull (command prompt &optional obsolete) +(defun vc-hg--pushpull (command prompt post-processing &optional obsolete) "Run COMMAND (a string; either push or pull) on the current Hg branch. If PROMPT is non-nil, prompt for the Hg command to run. +POST-PROCESSING is a list of commands to execute after the command. If OBSOLETE is non-nil, behave like the old versions of the Hg push/pull commands, which only operated on marked files." (let (marked-list) @@ -1327,18 +1324,14 @@ commands, which only operated on marked files." (let* ((root (vc-hg-root default-directory)) (buffer (format "*vc-hg : %s*" (expand-file-name root))) (hg-program vc-hg-program) - ;; Fixme: before updating the working copy to the latest - ;; state, should check if it's visiting an old revision. - (args (if (equal command "pull") '("-u")))) + args) ;; If necessary, prompt for the exact command. ;; TODO if pushing, prompt if no default push location - cf bzr. (when prompt (setq args (split-string (read-shell-command (format "Hg %s command: " command) - (format "%s %s%s" hg-program command - (if (not args) "" - (concat " " (mapconcat 'identity args " ")))) + (format "%s %s" hg-program command) 'vc-hg-history) " " t)) (setq hg-program (car args) @@ -1347,10 +1340,17 @@ commands, which only operated on marked files." (apply 'vc-do-async-command buffer root hg-program command args) (with-current-buffer buffer (vc-run-delayed + (dolist (cmd post-processing) + (apply 'vc-do-command buffer nil hg-program nil cmd)) (vc-compilation-mode 'hg) (setq-local compile-command (concat hg-program " " command " " - (if args (mapconcat 'identity args " ") ""))) + (mapconcat 'identity args " ") + (mapconcat (lambda (args) + (concat " && " hg-program " " + (mapconcat 'identity + args " "))) + post-processing ""))) (setq-local compilation-directory root) ;; Either set `compilation-buffer-name-function' locally to nil ;; or use `compilation-arguments' to set `name-function'. @@ -1371,7 +1371,15 @@ specific Mercurial pull command. The default is \"hg pull -u\", which fetches changesets from the default remote repository and then attempts to update the working directory." (interactive "P") - (vc-hg--pushpull "pull" prompt (called-interactively-p 'interactive))) + (vc-hg--pushpull "pull" prompt + ;; Fixme: before updating the working copy to the latest + ;; state, should check if it's visiting an old revision. + ;; post-processing: list modified files and update + ;; NB: this will not work with "pull = --rebase" + ;; or "pull = --update" in hgrc. + '(("--pager" "no" "status" "--rev" "." "--rev" "tip") + ("update")) + (called-interactively-p 'interactive))) (defun vc-hg-push (prompt) "Push changes from the current Mercurial branch. @@ -1381,7 +1389,7 @@ for the Hg command to run. If called interactively with a set of marked Log View buffers, call \"hg push -r REVS\" to push the specified revisions REVS." (interactive "P") - (vc-hg--pushpull "push" prompt (called-interactively-p 'interactive))) + (vc-hg--pushpull "push" prompt nil (called-interactively-p 'interactive))) (defun vc-hg-merge-branch () "Merge incoming changes into the current working directory. -- 2.39.2