lisp/vc-hg.el

   1 ;;; vc-hg.el --- VC backend for the mercurial version control system
   2
   3 ;; Copyright (C) 2006, 2007, 2008 Free Software Foundation, Inc.
   4
   5 ;; Author: Ivan Kanis
   6 ;; Keywords: tools
   7
   8 ;; This file is part of GNU Emacs.
   9
  10 ;; GNU Emacs is free software; you can redistribute it and/or modify
  11 ;; it under the terms of the GNU General Public License as published by
  12 ;; the Free Software Foundation; either version 3, or (at your option)
  13 ;; any later version.
  14
  15 ;; GNU Emacs is distributed in the hope that it will be useful,
  16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;; GNU General Public License for more details.
  19
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  22 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  23 ;; Boston, MA 02110-1301, USA.
  24
  25 ;;; Commentary:
  26
  27 ;; This is a mercurial version control backend
  28
  29 ;;; Thanks:
  30
  31 ;;; Bugs:
  32
  33 ;;; Installation:
  34
  35 ;;; Todo:
  36
  37 ;; Implement the rest of the vc interface. See the comment at the
  38 ;; beginning of vc.el. The current status is:
  39
  40 ;; FUNCTION NAME                               STATUS
  41 ;; BACKEND PROPERTIES
  42 ;; * revision-granularity                      OK
  43 ;; STATE-QUERYING FUNCTIONS
  44 ;; * registered (file)                         OK
  45 ;; * state (file)                              OK
  46 ;; - state-heuristic (file)                    ?? PROBABLY NOT NEEDED
  47 ;; - dir-state (dir)                           OK
  48 ;; * working-revision (file)                   OK
  49 ;; - latest-on-branch-p (file)                 ??
  50 ;; * checkout-model (file)                     OK
  51 ;; - workfile-unchanged-p (file)               OK
  52 ;; - mode-line-string (file)                   NOT NEEDED
  53 ;; - prettify-state-info (file)                OK
  54 ;; STATE-CHANGING FUNCTIONS
  55 ;; * register (files &optional rev comment)    OK
  56 ;; * create-repo ()                            OK
  57 ;; - init-revision ()                           NOT NEEDED
  58 ;; - responsible-p (file)                      OK
  59 ;; - could-register (file)                     OK
  60 ;; - receive-file (file rev)                   ?? PROBABLY NOT NEEDED
  61 ;; - unregister (file)                         COMMENTED OUT, MAY BE INCORRECT
  62 ;; * checkin (files rev comment)               OK
  63 ;; * find-revision (file rev buffer)            OK
  64 ;; * checkout (file &optional editable rev)    OK
  65 ;; * revert (file &optional contents-done)     OK
  66 ;; - rollback (files)                          ?? PROBABLY NOT NEEDED
  67 ;; - merge (file rev1 rev2)                    NEEDED
  68 ;; - merge-news (file)                         NEEDED
  69 ;; - steal-lock (file &optional revision)       NOT NEEDED
  70 ;; HISTORY FUNCTIONS
  71 ;; * print-log (files &optional buffer)        OK
  72 ;; - log-view-mode ()                          OK
  73 ;; - show-log-entry (revision)                  NOT NEEDED, DEFAULT IS GOOD
  74 ;; - wash-log (file)                           ??
  75 ;; - logentry-check ()                         NOT NEEDED
  76 ;; - comment-history (file)                    NOT NEEDED
  77 ;; - update-changelog (files)                  NOT NEEDED
  78 ;; * diff (files &optional rev1 rev2 buffer)   OK
  79 ;; - revision-completion-table (files)         OK?
  80 ;; - annotate-command (file buf &optional rev) OK
  81 ;; - annotate-time ()                          OK
  82 ;; - annotate-current-time ()                  ?? NOT NEEDED
  83 ;; - annotate-extract-revision-at-line ()      OK
  84 ;; SNAPSHOT SYSTEM
  85 ;; - create-snapshot (dir name branchp)        NEEDED (probably branch?)
  86 ;; - assign-name (file name)                   NOT NEEDED
  87 ;; - retrieve-snapshot (dir name update)       ?? NEEDED??
  88 ;; MISCELLANEOUS
  89 ;; - make-version-backups-p (file)             ??
  90 ;; - repository-hostname (dirname)             ??
  91 ;; - previous-revision (file rev)               OK
  92 ;; - next-revision (file rev)                   OK
  93 ;; - check-headers ()                          ??
  94 ;; - clear-headers ()                          ??
  95 ;; - delete-file (file)                        TEST IT
  96 ;; - rename-file (old new)                     OK
  97 ;; - find-file-hook ()                         PROBABLY NOT NEEDED
  98 ;; - find-file-not-found-hook ()               PROBABLY NOT NEEDED
  99
 100 ;; Implement Stefan Monnier's advice:
 101 ;; vc-hg-registered and vc-hg-state
 102 ;; Both of those functions should be super extra careful to fail gracefully in
 103 ;; unexpected circumstances. The reason this is important is that any error
 104 ;; there will prevent the user from even looking at the file :-(
 105 ;; Ideally, just like in vc-arch and vc-cvs, checking that the file is under
 106 ;; mercurial's control and extracting the current revision should be done
 107 ;; without even using `hg' (this way even if you don't have `hg' installed,
 108 ;; Emacs is able to tell you this file is under mercurial's control).
 109
 110 ;;; History:
 111 ;;
 112
 113 ;;; Code:
 114
 115 (eval-when-compile
 116   (require 'cl)
 117   (require 'vc))
 118
 119 ;;; Customization options
 120
 121 (defcustom vc-hg-global-switches nil
 122   "*Global switches to pass to any Hg command."
 123   :type '(choice (const :tag "None" nil)
 124          (string :tag "Argument String")
 125          (repeat :tag "Argument List"
 126              :value ("")
 127              string))
 128   :version "22.2"
 129   :group 'vc)
 130
 131 \f
 132 ;;; Properties of the backend
 133
 134 (defun vc-hg-revision-granularity ()
 135      'repository)
 136
 137 ;;; State querying functions
 138
 139 ;;;###autoload (defun vc-hg-registered (file)
 140 ;;;###autoload   "Return non-nil if FILE is registered with hg."
 141 ;;;###autoload   (if (vc-find-root file ".hg")       ; short cut
 142 ;;;###autoload       (progn
 143 ;;;###autoload         (load "vc-hg")
 144 ;;;###autoload         (vc-hg-registered file))))
 145
 146 ;; Modelled after the similar function in vc-bzr.el
 147 (defun vc-hg-registered (file)
 148   "Return non-nil if FILE is registered with hg."
 149   (when (vc-hg-root file)           ; short cut
 150     (let ((state (vc-hg-state file)))  ; expensive
 151       (vc-file-setprop file 'vc-state state)
 152       (and state (not (memq state '(ignored unregistered)))))))
 153
 154 (defun vc-hg-state (file)
 155   "Hg-specific version of `vc-state'."
 156   (let*
 157       ((status nil)
 158        (out
 159         (with-output-to-string
 160           (with-current-buffer
 161               standard-output
 162             (setq status
 163                   (condition-case nil
 164                       ;; Ignore all errors.
 165                       (call-process
 166                        "hg" nil t nil "--cwd" (file-name-directory file)
 167                        "status" "-A" (file-name-nondirectory file))
 168                     ;; Some problem happened.  E.g. We can't find an `hg'
 169                     ;; executable.
 170                     (error nil)))))))
 171     (when (eq 0 status)
 172         (when (null (string-match ".*: No such file or directory$" out))
 173           (let ((state (aref out 0)))
 174             (cond
 175              ((eq state ?=) 'up-to-date)
 176              ((eq state ?A) 'added)
 177              ((eq state ?M) 'edited)
 178              ((eq state ?I) 'ignored)
 179              ((eq state ?R) 'removed)
 180              ((eq state ?!) 'missing)
 181              ((eq state ??) 'unregistered)
 182              ((eq state ?C) 'up-to-date) ;; Older mercurials use this
 183              (t 'up-to-date)))))))
 184
 185 (defun vc-hg-dir-state (dir)
 186   (with-temp-buffer
 187     (buffer-disable-undo)               ;; Because these buffers can get huge
 188     (vc-hg-command (current-buffer) nil dir "status" "-A")
 189     (goto-char (point-min))
 190     (let ((status-char nil)
 191           (file nil))
 192       (while (not (eobp))
 193         (setq status-char (char-after))
 194         (setq file
 195               (expand-file-name
 196                (buffer-substring-no-properties (+ (point) 2)
 197                                                (line-end-position))))
 198         (cond
 199          ;; State flag for a clean file is now C, might change to =.
 200          ;; The rest of the possible states in "hg status" output:
 201          ;;      ! = deleted, but still tracked
 202          ;; should not show up in VC directory buffers, so don't deal with them
 203          ;; here.
 204
 205          ;; Mercurial up to 0.9.5 used C, = is used now.
 206          ((or (eq status-char ?=) (eq status-char ?C))
 207           (vc-file-setprop file 'vc-backend 'Hg)
 208           (vc-file-setprop file 'vc-state 'up-to-date))
 209          ((eq status-char ?A)
 210           (vc-file-setprop file 'vc-backend 'Hg)
 211           (vc-file-setprop file 'vc-working-revision "0")
 212           (vc-file-setprop file 'vc-state 'added))
 213          ((eq status-char ?R)
 214           (vc-file-setprop file 'vc-backend 'Hg)
 215           (vc-file-setprop file 'vc-state 'removed))
 216          ((eq status-char ?M)
 217           (vc-file-setprop file 'vc-backend 'Hg)
 218           (vc-file-setprop file 'vc-state 'edited))
 219          ((eq status-char ?I)
 220           (vc-file-setprop file 'vc-backend 'Hg)
 221           (vc-file-setprop file 'vc-state 'ignored))
 222          ((eq status-char ??)
 223           (vc-file-setprop file 'vc-backend 'none)
 224           (vc-file-setprop file 'vc-state 'unregistered))
 225          ((eq status-char ?!)
 226           (vc-file-setprop file 'vc-backend 'Hg)
 227           (vc-file-setprop file 'vc-state 'missing))
 228          (t     ;; Presently C, might change to = in 0.9.6
 229           (vc-file-setprop file 'vc-backend 'Hg)
 230           (vc-file-setprop file 'vc-state 'up-to-date)))
 231         (forward-line)))))
 232
 233 (defun vc-hg-working-revision (file)
 234   "Hg-specific version of `vc-working-revision'."
 235   (let*
 236       ((status nil)
 237        (out
 238         (with-output-to-string
 239           (with-current-buffer
 240               standard-output
 241             (setq status
 242                   (condition-case nil
 243                       ;; Ignore all errors.
 244                       (call-process
 245                        "hg" nil t nil "--cwd" (file-name-directory file)
 246                        "log" "-l1" (file-name-nondirectory file))
 247                     ;; Some problem happened.  E.g. We can't find an `hg'
 248                     ;; executable.
 249                     (error nil)))))))
 250     (when (eq 0 status)
 251       (if (string-match "changeset: *\\([0-9]*\\)" out)
 252           (match-string 1 out)
 253         "0"))))
 254
 255 ;;; History functions
 256
 257 (defun vc-hg-print-log (files &optional buffer)
 258   "Get change log associated with FILES."
 259   ;; `log-view-mode' needs to have the file names in order to function
 260   ;; correctly. "hg log" does not print it, so we insert it here by
 261   ;; hand.
 262
 263   ;; `vc-do-command' creates the buffer, but we need it before running
 264   ;; the command.
 265   (vc-setup-buffer buffer)
 266   ;; If the buffer exists from a previous invocation it might be
 267   ;; read-only.
 268   (let ((inhibit-read-only t))
 269     ;; We need to loop and call "hg log" on each file separately.
 270     ;; "hg log" with multiple file arguments mashes all the logs
 271     ;; together.  Ironically enough, this puts us back near CVS
 272     ;; which can't generate proper fileset logs either.
 273     (dolist (file files)
 274       (with-current-buffer
 275           buffer
 276         (insert "Working file: " file "\n"))    ;; Like RCS/CVS.
 277       (vc-hg-command buffer 0 file "log"))))
 278
 279 (defvar log-view-message-re)
 280 (defvar log-view-file-re)
 281 (defvar log-view-font-lock-keywords)
 282
 283 (define-derived-mode vc-hg-log-view-mode log-view-mode "Hg-Log-View"
 284   (require 'add-log) ;; we need the add-log faces
 285   (set (make-local-variable 'log-view-file-re) "^Working file:[ \t]+\\(.+\\)")
 286   (set (make-local-variable 'log-view-message-re)
 287        "^changeset:[ \t]*\\([0-9]+\\):\\(.+\\)")
 288   (set (make-local-variable 'log-view-font-lock-keywords)
 289        (append
 290         log-view-font-lock-keywords
 291         '(
 292           ;; Handle the case:
 293           ;; user: FirstName LastName <foo@bar>
 294           ("^user:[ \t]+\\([^<(]+?\\)[ \t]*[(<]\\([A-Za-z0-9_.+-]+@[A-Za-z0-9_.-]+\\)[>)]"
 295            (1 'change-log-name)
 296            (2 'change-log-email))
 297           ;; Handle the cases:
 298           ;; user: foo@bar
 299           ;; and
 300           ;; user: foo
 301           ("^user:[ \t]+\\([A-Za-z0-9_.+-]+\\(?:@[A-Za-z0-9_.-]+\\)?\\)"
 302            (1 'change-log-email))
 303           ("^date: \\(.+\\)" (1 'change-log-date))
 304           ("^summary:[ \t]+\\(.+\\)" (1 'log-view-message))))))
 305
 306 (defun vc-hg-diff (files &optional oldvers newvers buffer)
 307   "Get a difference report using hg between two revisions of FILES."
 308   (let ((working (vc-working-revision (car files))))
 309     (if (and (equal oldvers working) (not newvers))
 310         (setq oldvers nil))
 311     (if (and (not oldvers) newvers)
 312         (setq oldvers working))
 313     (apply #'vc-hg-command (or buffer "*vc-diff*") nil
 314            (mapcar (lambda (file) (file-name-nondirectory file)) files)
 315            "--cwd" (file-name-directory (car files))
 316            "diff"
 317            (append
 318             (if oldvers
 319                 (if newvers
 320                     (list "-r" oldvers "-r" newvers)
 321                   (list "-r" oldvers)))))))
 322
 323 (defun vc-hg-revision-table (files)
 324   (let ((default-directory (file-name-directory (car files))))
 325     (with-temp-buffer
 326       (vc-hg-command t nil files "log" "--template" "{rev} ")
 327       (split-string
 328        (buffer-substring-no-properties (point-min) (point-max))))))
 329
 330 ;; Modelled after the similar function in vc-cvs.el
 331 (defun vc-hg-revision-completion-table (files)
 332   (lexical-let ((files files)
 333                 table)
 334     (setq table (lazy-completion-table
 335                  table (lambda () (vc-hg-revision-table files))))
 336     table))
 337
 338 (defun vc-hg-annotate-command (file buffer &optional revision)
 339   "Execute \"hg annotate\" on FILE, inserting the contents in BUFFER.
 340 Optional arg REVISION is a revision to annotate from."
 341   (vc-hg-command buffer 0 file "annotate" "-d" "-n" (if revision (concat "-r" revision)))
 342   (with-current-buffer buffer
 343     (goto-char (point-min))
 344     (re-search-forward "^[0-9]")
 345     (delete-region (point-min) (1- (point)))))
 346
 347
 348 ;; The format for one line output by "hg annotate -d -n" looks like this:
 349 ;;215 Wed Jun 20 21:22:58 2007 -0700: CONTENTS
 350 ;; i.e: VERSION_NUMBER DATE: CONTENTS
 351 (defconst vc-hg-annotate-re "^[ \t]*\\([0-9]+\\) \\(.\\{30\\}\\): ")
 352
 353 (defun vc-hg-annotate-time ()
 354   (when (looking-at vc-hg-annotate-re)
 355     (goto-char (match-end 0))
 356     (vc-annotate-convert-time
 357      (date-to-time (match-string-no-properties 2)))))
 358
 359 (defun vc-hg-annotate-extract-revision-at-line ()
 360   (save-excursion
 361     (beginning-of-line)
 362     (if (looking-at vc-hg-annotate-re) (match-string-no-properties 1))))
 363
 364 (defun vc-hg-previous-revision (file rev)
 365   (let ((newrev (1- (string-to-number rev))))
 366     (when (>= newrev 0)
 367       (number-to-string newrev))))
 368
 369 (defun vc-hg-next-revision (file rev)
 370   (let ((newrev (1+ (string-to-number rev)))
 371         (tip-revision
 372          (with-temp-buffer
 373            (vc-hg-command t 0 nil "tip")
 374            (goto-char (point-min))
 375            (re-search-forward "^changeset:[ \t]*\\([0-9]+\\):")
 376            (string-to-number (match-string-no-properties 1)))))
 377     ;; We don't want to exceed the maximum possible revision number, ie
 378     ;; the tip revision.
 379     (when (<= newrev tip-revision)
 380       (number-to-string newrev))))
 381
 382 ;; Modelled after the similar function in vc-bzr.el
 383 (defun vc-hg-delete-file (file)
 384   "Delete FILE and delete it in the hg repository."
 385   (condition-case ()
 386       (delete-file file)
 387     (file-error nil))
 388   (vc-hg-command nil 0 file "remove" "--after" "--force"))
 389
 390 ;; Modelled after the similar function in vc-bzr.el
 391 (defun vc-hg-rename-file (old new)
 392   "Rename file from OLD to NEW using `hg mv'."
 393   (vc-hg-command nil 0 new "mv" old))
 394
 395 (defun vc-hg-register (files &optional rev comment)
 396   "Register FILES under hg.
 397 REV is ignored.
 398 COMMENT is ignored."
 399   (vc-hg-command nil 0 files "add"))
 400
 401 (defun vc-hg-create-repo ()
 402   "Create a new Mercurial repository."
 403   (vc-hg-command nil 0 nil "init"))
 404
 405 (defalias 'vc-hg-responsible-p 'vc-hg-root)
 406
 407 ;; Modelled after the similar function in vc-bzr.el
 408 (defun vc-hg-could-register (file)
 409   "Return non-nil if FILE could be registered under hg."
 410   (and (vc-hg-responsible-p file)      ; shortcut
 411        (condition-case ()
 412            (with-temp-buffer
 413              (vc-hg-command t nil file "add" "--dry-run"))
 414              ;; The command succeeds with no output if file is
 415              ;; registered.
 416          (error))))
 417
 418 ;; XXX This would remove the file. Is that correct?
 419 ;; (defun vc-hg-unregister (file)
 420 ;;   "Unregister FILE from hg."
 421 ;;   (vc-hg-command nil nil file "remove"))
 422
 423 (defun vc-hg-checkin (files rev comment)
 424   "Hg-specific version of `vc-backend-checkin'.
 425 REV is ignored."
 426   (vc-hg-command nil 0 files  "commit" "-m" comment))
 427
 428 (defun vc-hg-find-revision (file rev buffer)
 429   (let ((coding-system-for-read 'binary)
 430         (coding-system-for-write 'binary))
 431     (if rev
 432         (vc-hg-command buffer 0 file "cat" "-r" rev)
 433       (vc-hg-command buffer 0 file "cat"))))
 434
 435 ;; Modelled after the similar function in vc-bzr.el
 436 (defun vc-hg-checkout (file &optional editable rev)
 437   "Retrieve a revision of FILE.
 438 EDITABLE is ignored.
 439 REV is the revision to check out into WORKFILE."
 440   (let ((coding-system-for-read 'binary)
 441         (coding-system-for-write 'binary))
 442   (with-current-buffer (or (get-file-buffer file) (current-buffer))
 443     (if rev
 444         (vc-hg-command t 0 file "cat" "-r" rev)
 445       (vc-hg-command t 0 file "cat")))))
 446
 447 (defun vc-hg-checkout-model (files) 'implicit)
 448
 449 ;; Modelled after the similar function in vc-bzr.el
 450 (defun vc-hg-workfile-unchanged-p (file)
 451   (eq 'up-to-date (vc-hg-state file)))
 452
 453 ;; Modelled after the similar function in vc-bzr.el
 454 (defun vc-hg-revert (file &optional contents-done)
 455   (unless contents-done
 456     (with-temp-buffer (vc-hg-command t 0 file "revert"))))
 457
 458 ;;; Hg specific functionality.
 459
 460 (defvar vc-hg-extra-menu-map
 461   (let ((map (make-sparse-keymap)))
 462     (define-key map [incoming] '(menu-item "Show incoming" vc-hg-incoming))
 463     (define-key map [outgoing] '(menu-item "Show outgoing" vc-hg-outgoing))
 464     map))
 465
 466 (defun vc-hg-extra-menu () vc-hg-extra-menu-map)
 467
 468 (defun vc-hg-extra-status-menu () vc-hg-extra-menu-map)
 469
 470 (define-derived-mode vc-hg-outgoing-mode vc-hg-log-view-mode "Hg-Outgoing")
 471
 472 (define-derived-mode vc-hg-incoming-mode vc-hg-log-view-mode "Hg-Incoming")
 473
 474 (defstruct (vc-hg-extra-fileinfo
 475             (:copier nil)
 476             (:constructor vc-hg-create-extra-fileinfo (rename-state extra-name))
 477             (:conc-name vc-hg-extra-fileinfo->))
 478   rename-state        ;; rename or copy state
 479   extra-name)         ;; original name for copies and rename targets, new name for
 480
 481 (defun vc-hg-status-printer (info)
 482   "Pretty-printer for the vc-dir-fileinfo structure."
 483   (let ((extra (vc-dir-fileinfo->extra info)))
 484     (vc-default-status-printer 'Hg info)
 485     (when extra
 486       (insert (propertize
 487                (format "   (%s %s)"
 488                        (case (vc-hg-extra-fileinfo->rename-state extra)
 489                          ('copied "copied from")
 490                          ('renamed-from "renamed from")
 491                          ('renamed-to "renamed to"))
 492                        (vc-hg-extra-fileinfo->extra-name extra))
 493                'face 'font-lock-comment-face)))))
 494
 495 (defun vc-hg-after-dir-status (update-function)
 496   (let ((status-char nil)
 497         (file nil)
 498         (translation '((?= . up-to-date)
 499                        (?C . up-to-date)
 500                        (?A . added)
 501                        (?R . removed)
 502                        (?M . edited)
 503                        (?I . ignored)
 504                        (?! . missing)
 505                        (?  . copy-rename-line)
 506                        (?? . unregistered)))
 507         (translated nil)
 508         (result nil)
 509         (last-added nil)
 510         (last-line-copy nil))
 511       (goto-char (point-min))
 512       (while (not (eobp))
 513         (setq translated (cdr (assoc (char-after) translation)))
 514         (setq file
 515               (buffer-substring-no-properties (+ (point) 2)
 516                                               (line-end-position)))
 517         (cond ((not translated)
 518                (setq last-line-copy nil))
 519               ((eq translated 'up-to-date)
 520                (setq last-line-copy nil))
 521               ((eq translated 'copy-rename-line)
 522                ;; For copied files the output looks like this:
 523                ;; A COPIED_FILE_NAME
 524                ;;   ORIGINAL_FILE_NAME
 525                (setf (nth 2 last-added)
 526                      (vc-hg-create-extra-fileinfo 'copied file))
 527                (setq last-line-copy t))
 528               ((and last-line-copy (eq translated 'removed))
 529                ;; For renamed files the output looks like this:
 530                ;; A NEW_FILE_NAME
 531                ;;   ORIGINAL_FILE_NAME
 532                ;; R ORIGINAL_FILE_NAME
 533                ;; We need to adjust the previous entry to not think it is a copy.
 534                (setf (vc-hg-extra-fileinfo->rename-state (nth 2 last-added))
 535                      'renamed-from)
 536                (push (list file translated
 537                            (vc-hg-create-extra-fileinfo
 538                             'renamed-to (nth 0 last-added))) result)
 539                (setq last-line-copy nil))
 540               (t
 541                (setq last-added (list file translated nil))
 542                (push last-added result)
 543                (setq last-line-copy nil)))
 544         (forward-line))
 545       (funcall update-function result)))
 546
 547 (defun vc-hg-dir-status (dir update-function)
 548   (vc-hg-command (current-buffer) 'async dir "status" "-C")
 549   (vc-exec-after
 550    `(vc-hg-after-dir-status (quote ,update-function))))
 551
 552 ;; XXX this adds another top level menu, instead figure out how to
 553 ;; replace the Log-View menu.
 554 (easy-menu-define log-view-mode-menu vc-hg-outgoing-mode-map
 555   "Hg-outgoing Display Menu"
 556   `("Hg-outgoing"
 557     ["Push selected"  vc-hg-push]))
 558
 559 (easy-menu-define log-view-mode-menu vc-hg-incoming-mode-map
 560   "Hg-incoming Display Menu"
 561   `("Hg-incoming"
 562     ["Pull selected"  vc-hg-pull]))
 563
 564 (defun vc-hg-outgoing ()
 565   (interactive)
 566   (let ((bname "*Hg outgoing*"))
 567     (vc-hg-command bname 0 nil "outgoing" "-n")
 568     (pop-to-buffer bname)
 569     (vc-hg-outgoing-mode)))
 570
 571 (defun vc-hg-incoming ()
 572   (interactive)
 573   (let ((bname "*Hg incoming*"))
 574     (vc-hg-command bname 0 nil "incoming" "-n")
 575     (pop-to-buffer bname)
 576     (vc-hg-incoming-mode)))
 577
 578 (declare-function log-view-get-marked "log-view" ())
 579
 580 ;; XXX maybe also add key bindings for these functions.
 581 (defun vc-hg-push ()
 582   (interactive)
 583   (let ((marked-list (log-view-get-marked)))
 584     (if marked-list
 585         (vc-hg-command
 586          nil 0 nil
 587          (cons "push"
 588                (apply 'nconc
 589                       (mapcar (lambda (arg) (list "-r" arg)) marked-list))))
 590          (error "No log entries selected for push"))))
 591
 592 (defun vc-hg-pull ()
 593   (interactive)
 594   (let ((marked-list (log-view-get-marked)))
 595     (if marked-list
 596         (vc-hg-command
 597          nil 0 nil
 598          (cons "pull"
 599                (apply 'nconc
 600                       (mapcar (lambda (arg) (list "-r" arg)) marked-list))))
 601       (error "No log entries selected for pull"))))
 602
 603 ;;; Internal functions
 604
 605 (defun vc-hg-command (buffer okstatus file-or-list &rest flags)
 606   "A wrapper around `vc-do-command' for use in vc-hg.el.
 607 The difference to vc-do-command is that this function always invokes `hg',
 608 and that it passes `vc-hg-global-switches' to it before FLAGS."
 609   (apply 'vc-do-command buffer okstatus "hg" file-or-list
 610          (if (stringp vc-hg-global-switches)
 611              (cons vc-hg-global-switches flags)
 612            (append vc-hg-global-switches
 613                    flags))))
 614
 615 (defun vc-hg-root (file)
 616   (vc-find-root file ".hg"))
 617
 618 (provide 'vc-hg)
 619
 620 ;; arch-tag: bd094dc5-715a-434f-a331-37b9fb7cd954
 621 ;;; vc-hg.el ends here