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'.

diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el
index 6650c5d764af359dddc9ccc01068138efb9e1a44..c6b08e942f3bb9e2a7494d057e206c68d0cb0de1 100644 (file)
--- 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 2deac2aae27a97fdd21f0b50718affa50d9780b4..08b1be8f6d3b9e90bcb874711b3af57ed6d10ed0 100644 (file)
--- 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.