Commit 6d4cbe80 authored by Sam Steingold's avatar Sam Steingold Committed by Alan Third

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'.
parent 66a491fb
......@@ -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.
......
......@@ -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.
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment