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.") ...@@ -860,7 +860,7 @@ It is based on `log-edit-mode', and has Git-specific extensions.")
(vc-git-command nil nil file "checkout" "-q" "--"))) (vc-git-command nil nil file "checkout" "-q" "--")))
(defvar vc-git-error-regexp-alist (defvar vc-git-error-regexp-alist
'(("^ \\(.+\\) |" 1 nil nil 0)) '(("^ \\(.+\\)\\> *|" 1 nil nil 0))
"Value of `compilation-error-regexp-alist' in *vc-git* buffers.") "Value of `compilation-error-regexp-alist' in *vc-git* buffers.")
;; To be called via vc-pull from vc.el, which requires vc-dispatcher. ;; 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." ...@@ -885,17 +885,16 @@ If PROMPT is non-nil, prompt for the Git command to run."
(setq git-program (car args) (setq git-program (car args)
command (cadr args) command (cadr args)
args (cddr args))) args (cddr args)))
(setq args (nconc args extra-args))
(require 'vc-dispatcher) (require 'vc-dispatcher)
(apply 'vc-do-async-command buffer root git-program command args) (apply 'vc-do-async-command buffer root git-program command args)
(with-current-buffer buffer (with-current-buffer buffer
(vc-run-delayed (vc-run-delayed
(vc-compilation-mode 'git) (vc-compilation-mode 'git)
(setq-local compile-command (setq-local compile-command
(concat git-program " " command " " extra-args " " (concat git-program " " command " "
(if args (mapconcat 'identity args " ") ""))) (mapconcat 'identity args " ")))
(setq-local compilation-directory root) (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 ;; Either set `compilation-buffer-name-function' locally to nil
;; or use `compilation-arguments' to set `name-function'. ;; or use `compilation-arguments' to set `name-function'.
;; See `compilation-buffer-name'. ;; See `compilation-buffer-name'.
...@@ -909,13 +908,13 @@ If PROMPT is non-nil, prompt for the Git command to run." ...@@ -909,13 +908,13 @@ If PROMPT is non-nil, prompt for the Git command to run."
"Pull changes into the current Git branch. "Pull changes into the current Git branch.
Normally, this runs \"git pull\". If PROMPT is non-nil, prompt Normally, this runs \"git pull\". If PROMPT is non-nil, prompt
for the Git command to run." for the Git command to run."
(vc-git--pushpull "pull" prompt "--stat")) (vc-git--pushpull "pull" prompt '("--stat")))
(defun vc-git-push (prompt) (defun vc-git-push (prompt)
"Push changes from the current Git branch. "Push changes from the current Git branch.
Normally, this runs \"git push\". If PROMPT is non-nil, prompt Normally, this runs \"git push\". If PROMPT is non-nil, prompt
for the Git command to run." for the Git command to run."
(vc-git--pushpull "push" prompt "")) (vc-git--pushpull "push" prompt nil))
(defun vc-git-merge-branch () (defun vc-git-merge-branch ()
"Merge changes into the current Git branch. "Merge changes into the current Git branch.
......
...@@ -1296,12 +1296,8 @@ REV is the revision to check out into WORKFILE." ...@@ -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 "") (vc-hg-command buffer 1 nil "outgoing" "-n" (unless (string= remote-location "")
remote-location))) remote-location)))
(defvar vc-hg-error-regexp-alist nil (defvar vc-hg-error-regexp-alist
;; 'hg pull' does not list modified files, so, for now, the only '(("^M \\(.+\\)" 1 nil nil 0))
;; 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
"Value of `compilation-error-regexp-alist' in *vc-hg* buffers.") "Value of `compilation-error-regexp-alist' in *vc-hg* buffers.")
(autoload 'vc-do-async-command "vc-dispatcher") (autoload 'vc-do-async-command "vc-dispatcher")
...@@ -1309,9 +1305,10 @@ REV is the revision to check out into WORKFILE." ...@@ -1309,9 +1305,10 @@ REV is the revision to check out into WORKFILE."
(defvar compilation-directory) (defvar compilation-directory)
(defvar compilation-arguments) ; defined in compile.el (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. "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. 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 If OBSOLETE is non-nil, behave like the old versions of the Hg push/pull
commands, which only operated on marked files." commands, which only operated on marked files."
(let (marked-list) (let (marked-list)
...@@ -1327,18 +1324,14 @@ commands, which only operated on marked files." ...@@ -1327,18 +1324,14 @@ commands, which only operated on marked files."
(let* ((root (vc-hg-root default-directory)) (let* ((root (vc-hg-root default-directory))
(buffer (format "*vc-hg : %s*" (expand-file-name root))) (buffer (format "*vc-hg : %s*" (expand-file-name root)))
(hg-program vc-hg-program) (hg-program vc-hg-program)
;; Fixme: before updating the working copy to the latest args)
;; state, should check if it's visiting an old revision.
(args (if (equal command "pull") '("-u"))))
;; If necessary, prompt for the exact command. ;; If necessary, prompt for the exact command.
;; TODO if pushing, prompt if no default push location - cf bzr. ;; TODO if pushing, prompt if no default push location - cf bzr.
(when prompt (when prompt
(setq args (split-string (setq args (split-string
(read-shell-command (read-shell-command
(format "Hg %s command: " command) (format "Hg %s command: " command)
(format "%s %s%s" hg-program command (format "%s %s" hg-program command)
(if (not args) ""
(concat " " (mapconcat 'identity args " "))))
'vc-hg-history) 'vc-hg-history)
" " t)) " " t))
(setq hg-program (car args) (setq hg-program (car args)
...@@ -1347,10 +1340,17 @@ commands, which only operated on marked files." ...@@ -1347,10 +1340,17 @@ commands, which only operated on marked files."
(apply 'vc-do-async-command buffer root hg-program command args) (apply 'vc-do-async-command buffer root hg-program command args)
(with-current-buffer buffer (with-current-buffer buffer
(vc-run-delayed (vc-run-delayed
(dolist (cmd post-processing)
(apply 'vc-do-command buffer nil hg-program nil cmd))
(vc-compilation-mode 'hg) (vc-compilation-mode 'hg)
(setq-local compile-command (setq-local compile-command
(concat hg-program " " 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) (setq-local compilation-directory root)
;; Either set `compilation-buffer-name-function' locally to nil ;; Either set `compilation-buffer-name-function' locally to nil
;; or use `compilation-arguments' to set `name-function'. ;; or use `compilation-arguments' to set `name-function'.
...@@ -1371,7 +1371,15 @@ specific Mercurial pull command. The default is \"hg pull -u\", ...@@ -1371,7 +1371,15 @@ specific Mercurial pull command. The default is \"hg pull -u\",
which fetches changesets from the default remote repository and which fetches changesets from the default remote repository and
then attempts to update the working directory." then attempts to update the working directory."
(interactive "P") (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) (defun vc-hg-push (prompt)
"Push changes from the current Mercurial branch. "Push changes from the current Mercurial branch.
...@@ -1381,7 +1389,7 @@ for the Hg command to run. ...@@ -1381,7 +1389,7 @@ for the Hg command to run.
If called interactively with a set of marked Log View buffers, If called interactively with a set of marked Log View buffers,
call \"hg push -r REVS\" to push the specified revisions REVS." call \"hg push -r REVS\" to push the specified revisions REVS."
(interactive "P") (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 () (defun vc-hg-merge-branch ()
"Merge incoming changes into the current working directory. "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