]> code.delx.au - gnu-emacs/blobdiff - lisp/vc/vc-hg.el
Fix last commit
[gnu-emacs] / lisp / vc / vc-hg.el
index c841dfcdf54c00e73a93e63dc4052e88a182d7e7..556174a38219d33b5fc81853720396d24d92eb31 100644 (file)
@@ -373,7 +373,7 @@ Optional arg REVISION is a revision to annotate from."
         (append (vc-switches 'hg 'annotate)
                  (if revision (list (concat "-r" revision))))))
 
-(declare-function vc-annotate-convert-time "vc-annotate" (time))
+(declare-function vc-annotate-convert-time "vc-annotate" (&optional time))
 
 ;; The format for one line output by "hg annotate -d -n" looks like this:
 ;;215 Wed Jun 20 21:22:58 2007 -0700: CONTENTS
@@ -659,20 +659,6 @@ REV is the revision to check out into WORKFILE."
   (vc-hg-command buffer 1 nil "outgoing" "-n" (unless (string= remote-location "")
                                                remote-location)))
 
-(declare-function log-view-get-marked "log-view" ())
-
-;; XXX maybe also add key bindings for these functions.
-(defun vc-hg-push ()
-  (interactive)
-  (let ((marked-list (log-view-get-marked)))
-    (if marked-list
-        (apply #'vc-hg-command
-               nil 0 nil
-               "push"
-               (apply 'nconc
-                      (mapcar (lambda (arg) (list "-r" arg)) marked-list)))
-      (error "No log entries selected for push"))))
-
 (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
@@ -682,51 +668,70 @@ REV is the revision to check out into WORKFILE."
   "Value of `compilation-error-regexp-alist' in *vc-hg* buffers.")
 
 (autoload 'vc-do-async-command "vc-dispatcher")
+(autoload 'log-view-get-marked "log-view")
 
-(defun vc-hg-pull (prompt)
-  "Issue a Mercurial pull command.
-If called interactively with a set of marked Log View buffers,
-call \"hg pull -r REVS\" to pull in the specified revisions REVS.
-
-With a prefix argument or if PROMPT is non-nil, prompt for a
-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")
+(defun vc-hg--pushpull (command prompt &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.
+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)
-    ;; The `vc-hg-pull' command existed before the `pull' VC action
-    ;; was implemented.  Keep it for backward compatibility.
-    (if (and (called-interactively-p 'interactive)
-            (setq marked-list (log-view-get-marked)))
+    ;; The `vc-hg-pull' and `vc-hg-push' commands existed before the
+    ;; `pull'/`push' VC actions were implemented.
+    ;; The following is for backwards compatibility.
+    (if (and obsolete (setq marked-list (log-view-get-marked)))
        (apply #'vc-hg-command
               nil 0 nil
-              "pull"
+              command
               (apply 'nconc
-                     (mapcar (lambda (arg) (list "-r" arg))
-                             marked-list)))
+                     (mapcar (lambda (arg) (list "-r" arg)) marked-list)))
       (let* ((root (vc-hg-root default-directory))
             (buffer (format "*vc-hg : %s*" (expand-file-name root)))
-            (command "pull")
             (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 '("-u")))
+            (args (if (equal command "pull") '("-u"))))
        ;; 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 "Run Hg (like this): "
-                                         (format "%s pull -u" hg-program)
-                                         'vc-hg-history)
+                     (read-shell-command
+                       (format "Hg %s command: " command)
+                       (format "%s %s%s" hg-program command
+                               (if (not args) ""
+                                 (concat " " (mapconcat 'identity args " "))))
+                       'vc-hg-history)
                      " " t))
          (setq hg-program (car  args)
                command    (cadr args)
                args       (cddr args)))
-       (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
           (vc-run-delayed (vc-compilation-mode 'hg)))
        (vc-set-async-update buffer)))))
 
+(defun vc-hg-pull (prompt)
+  "Issue a Mercurial pull command.
+If called interactively with a set of marked Log View buffers,
+call \"hg pull -r REVS\" to pull in the specified revisions REVS.
+
+With a prefix argument or if PROMPT is non-nil, prompt for a
+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)))
+
+(defun vc-hg-push (prompt)
+  "Push changes from the current Mercurial branch.
+Normally, this runs \"hg push\".  If PROMPT is non-nil, prompt
+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)))
+
 (defun vc-hg-merge-branch ()
   "Merge incoming changes into the current working directory.
 This runs the command \"hg merge\"."