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 ;; - dired-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) 'edited)
 177              ((eq state ?M) 'edited)
 178              ((eq state ?I) 'ignored)
 179              ((eq state ?R) 'unregistered)
 180              ((eq state ??) 'unregistered)
 181              ((eq state ?C) 'up-to-date) ;; Older mercurials use this
 182              (t 'up-to-date)))))))
 183
 184 (defun vc-hg-dir-state (dir)
 185   (with-temp-buffer
 186     (buffer-disable-undo)               ;; Because these buffers can get huge
 187     (vc-hg-command (current-buffer) nil dir "status" "-A")
 188     (goto-char (point-min))
 189     (let ((status-char nil)
 190           (file nil))
 191       (while (not (eobp))
 192         (setq status-char (char-after))
 193         (setq file
 194               (expand-file-name
 195                (buffer-substring-no-properties (+ (point) 2)
 196                                                (line-end-position))))
 197         (cond
 198          ;; State flag for a clean file is now C, might change to =.
 199          ;; The rest of the possible states in "hg status" output:
 200          ;;      ! = deleted, but still tracked
 201          ;; should not show up in vc-dired, so don't deal with them
 202          ;; here.
 203
 204          ;; Mercurial up to 0.9.5 used C, = is used now.
 205          ((or (eq status-char ?=) (eq status-char ?C))
 206           (vc-file-setprop file 'vc-backend 'Hg)
 207           (vc-file-setprop file 'vc-state 'up-to-date))
 208          ((eq status-char ?A)
 209           (vc-file-setprop file 'vc-backend 'Hg)
 210           (vc-file-setprop file 'vc-working-revision "0")
 211           (vc-file-setprop file 'vc-state 'added))
 212          ((eq status-char ?R)
 213           (vc-file-setprop file 'vc-backend 'Hg)
 214           (vc-file-setprop file 'vc-state 'removed))
 215          ((eq status-char ?M)
 216           (vc-file-setprop file 'vc-backend 'Hg)
 217           (vc-file-setprop file 'vc-state 'edited))
 218          ((eq status-char ?I)
 219           (vc-file-setprop file 'vc-backend 'Hg)
 220           (vc-file-setprop file 'vc-state 'ignored))
 221          ((eq status-char ??)
 222           (vc-file-setprop file 'vc-backend 'none)
 223           (vc-file-setprop file 'vc-state 'unregistered))
 224          ((eq status-char ?!)
 225           nil)
 226          (t     ;; Presently C, might change to = in 0.9.6
 227           (vc-file-setprop file 'vc-backend 'Hg)
 228           (vc-file-setprop file 'vc-state 'up-to-date)))
 229         (forward-line)))))
 230
 231 (defun vc-hg-working-revision (file)
 232   "Hg-specific version of `vc-working-revision'."
 233   (let*
 234       ((status nil)
 235        (out
 236         (with-output-to-string
 237           (with-current-buffer
 238               standard-output
 239             (setq status
 240                   (condition-case nil
 241                       ;; Ignore all errors.
 242                       (call-process
 243                        "hg" nil t nil "--cwd" (file-name-directory file)
 244                        "log" "-l1" (file-name-nondirectory file))
 245                     ;; Some problem happened.  E.g. We can't find an `hg'
 246                     ;; executable.
 247                     (error nil)))))))
 248     (when (eq 0 status)
 249       (if (string-match "changeset: *\\([0-9]*\\)" out)
 250           (match-string 1 out)
 251         "0"))))
 252
 253 ;;; History functions
 254
 255 (defun vc-hg-print-log (files &optional buffer)
 256   "Get change log associated with FILES."
 257   ;; `log-view-mode' needs to have the file names in order to function
 258   ;; correctly. "hg log" does not print it, so we insert it here by
 259   ;; hand.
 260
 261   ;; `vc-do-command' creates the buffer, but we need it before running
 262   ;; the command.
 263   (vc-setup-buffer buffer)
 264   ;; If the buffer exists from a previous invocation it might be
 265   ;; read-only.
 266   (let ((inhibit-read-only t))
 267     ;; We need to loop and call "hg log" on each file separately.
 268     ;; "hg log" with multiple file arguments mashes all the logs
 269     ;; together.  Ironically enough, this puts us back near CVS
 270     ;; which can't generate proper fileset logs either.
 271     (dolist (file files)
 272       (with-current-buffer
 273           buffer
 274         (insert "Working file: " file "\n"))    ;; Like RCS/CVS.
 275       (vc-hg-command buffer 0 file "log"))))
 276
 277 (defvar log-view-message-re)
 278 (defvar log-view-file-re)
 279 (defvar log-view-font-lock-keywords)
 280
 281 (define-derived-mode vc-hg-log-view-mode log-view-mode "Hg-Log-View"
 282   (require 'add-log) ;; we need the add-log faces
 283   (set (make-local-variable 'log-view-file-re) "^Working file:[ \t]+\\(.+\\)")
 284   (set (make-local-variable 'log-view-message-re)
 285        "^changeset:[ \t]*\\([0-9]+\\):\\(.+\\)")
 286   (set (make-local-variable 'log-view-font-lock-keywords)
 287        (append
 288         log-view-font-lock-keywords
 289         '(
 290           ;; Handle the case:
 291           ;; user: FirstName LastName <foo@bar>
 292           ("^user:[ \t]+\\([^<(]+?\\)[ \t]*[(<]\\([A-Za-z0-9_.+-]+@[A-Za-z0-9_.-]+\\)[>)]"
 293            (1 'change-log-name)
 294            (2 'change-log-email))
 295           ;; Handle the cases:
 296           ;; user: foo@bar
 297           ;; and
 298           ;; user: foo
 299           ("^user:[ \t]+\\([A-Za-z0-9_.+-]+\\(?:@[A-Za-z0-9_.-]+\\)?\\)"
 300            (1 'change-log-email))
 301           ("^date: \\(.+\\)" (1 'change-log-date))
 302           ("^summary:[ \t]+\\(.+\\)" (1 'log-view-message))))))
 303
 304 (defun vc-hg-diff (files &optional oldvers newvers buffer)
 305   "Get a difference report using hg between two revisions of FILES."
 306   (let ((working (vc-working-revision (car files))))
 307     (if (and (equal oldvers working) (not newvers))
 308         (setq oldvers nil))
 309     (if (and (not oldvers) newvers)
 310         (setq oldvers working))
 311     (apply #'vc-hg-command (or buffer "*vc-diff*") nil
 312            (mapcar (lambda (file) (file-name-nondirectory file)) files)
 313            "--cwd" (file-name-directory (car files))
 314            "diff"
 315            (append
 316             (if oldvers
 317                 (if newvers
 318                     (list "-r" oldvers "-r" newvers)
 319                   (list "-r" oldvers)))))))
 320
 321 (defun vc-hg-revision-table (files)
 322   (let ((default-directory (file-name-directory (car files))))
 323     (with-temp-buffer
 324       (vc-hg-command t nil files "log" "--template" "{rev} ")
 325       (split-string
 326        (buffer-substring-no-properties (point-min) (point-max))))))
 327
 328 ;; Modelled after the similar function in vc-cvs.el
 329 (defun vc-hg-revision-completion-table (files)
 330   (lexical-let ((files files)
 331                 table)
 332     (setq table (lazy-completion-table
 333                  table (lambda () (vc-hg-revision-table files))))
 334     table))
 335
 336 (defun vc-hg-annotate-command (file buffer &optional revision)
 337   "Execute \"hg annotate\" on FILE, inserting the contents in BUFFER.
 338 Optional arg REVISION is a revision to annotate from."
 339   (vc-hg-command buffer 0 file "annotate" "-d" "-n" (if revision (concat "-r" revision)))
 340   (with-current-buffer buffer
 341     (goto-char (point-min))
 342     (re-search-forward "^[0-9]")
 343     (delete-region (point-min) (1- (point)))))
 344
 345
 346 ;; The format for one line output by "hg annotate -d -n" looks like this:
 347 ;;215 Wed Jun 20 21:22:58 2007 -0700: CONTENTS
 348 ;; i.e: VERSION_NUMBER DATE: CONTENTS
 349 (defconst vc-hg-annotate-re "^[ \t]*\\([0-9]+\\) \\(.\\{30\\}\\): ")
 350
 351 (defun vc-hg-annotate-time ()
 352   (when (looking-at vc-hg-annotate-re)
 353     (goto-char (match-end 0))
 354     (vc-annotate-convert-time
 355      (date-to-time (match-string-no-properties 2)))))
 356
 357 (defun vc-hg-annotate-extract-revision-at-line ()
 358   (save-excursion
 359     (beginning-of-line)
 360     (if (looking-at vc-hg-annotate-re) (match-string-no-properties 1))))
 361
 362 (defun vc-hg-previous-revision (file rev)
 363   (let ((newrev (1- (string-to-number rev))))
 364     (when (>= newrev 0)
 365       (number-to-string newrev))))
 366
 367 (defun vc-hg-next-revision (file rev)
 368   (let ((newrev (1+ (string-to-number rev)))
 369         (tip-revision
 370          (with-temp-buffer
 371            (vc-hg-command t 0 nil "tip")
 372            (goto-char (point-min))
 373            (re-search-forward "^changeset:[ \t]*\\([0-9]+\\):")
 374            (string-to-number (match-string-no-properties 1)))))
 375     ;; We don't want to exceed the maximum possible revision number, ie
 376     ;; the tip revision.
 377     (when (<= newrev tip-revision)
 378       (number-to-string newrev))))
 379
 380 ;; Modelled after the similar function in vc-bzr.el
 381 (defun vc-hg-delete-file (file)
 382   "Delete FILE and delete it in the hg repository."
 383   (condition-case ()
 384       (delete-file file)
 385     (file-error nil))
 386   (vc-hg-command nil 0 file "remove" "--after" "--force"))
 387
 388 ;; Modelled after the similar function in vc-bzr.el
 389 (defun vc-hg-rename-file (old new)
 390   "Rename file from OLD to NEW using `hg mv'."
 391   (vc-hg-command nil 0 new old "mv"))
 392
 393 (defun vc-hg-register (files &optional rev comment)
 394   "Register FILES under hg.
 395 REV is ignored.
 396 COMMENT is ignored."
 397   (vc-hg-command nil 0 files "add"))
 398
 399 (defun vc-hg-create-repo ()
 400   "Create a new Mercurial repository."
 401   (vc-hg-command nil 0 nil "init"))
 402
 403 (defalias 'vc-hg-responsible-p 'vc-hg-root)
 404
 405 ;; Modelled after the similar function in vc-bzr.el
 406 (defun vc-hg-could-register (file)
 407   "Return non-nil if FILE could be registered under hg."
 408   (and (vc-hg-responsible-p file)      ; shortcut
 409        (condition-case ()
 410            (with-temp-buffer
 411              (vc-hg-command t nil file "add" "--dry-run"))
 412              ;; The command succeeds with no output if file is
 413              ;; registered.
 414          (error))))
 415
 416 ;; XXX This would remove the file. Is that correct?
 417 ;; (defun vc-hg-unregister (file)
 418 ;;   "Unregister FILE from hg."
 419 ;;   (vc-hg-command nil nil file "remove"))
 420
 421 (defun vc-hg-checkin (files rev comment)
 422   "Hg-specific version of `vc-backend-checkin'.
 423 REV is ignored."
 424   (vc-hg-command nil 0 files  "commit" "-m" comment))
 425
 426 (defun vc-hg-find-revision (file rev buffer)
 427   (let ((coding-system-for-read 'binary)
 428         (coding-system-for-write 'binary))
 429     (if rev
 430         (vc-hg-command buffer 0 file "cat" "-r" rev)
 431       (vc-hg-command buffer 0 file "cat"))))
 432
 433 ;; Modelled after the similar function in vc-bzr.el
 434 (defun vc-hg-checkout (file &optional editable rev)
 435   "Retrieve a revision of FILE.
 436 EDITABLE is ignored.
 437 REV is the revision to check out into WORKFILE."
 438   (let ((coding-system-for-read 'binary)
 439         (coding-system-for-write 'binary))
 440   (with-current-buffer (or (get-file-buffer file) (current-buffer))
 441     (if rev
 442         (vc-hg-command t 0 file "cat" "-r" rev)
 443       (vc-hg-command t 0 file "cat")))))
 444
 445 (defun vc-hg-checkout-model (file)
 446   'implicit)
 447
 448 ;; Modelled after the similar function in vc-bzr.el
 449 (defun vc-hg-workfile-unchanged-p (file)
 450   (eq 'up-to-date (vc-hg-state file)))
 451
 452 (defun vc-hg-dired-state-info (file)
 453   "Hg-specific version of `vc-dired-state-info'."
 454   (let ((hg-state (vc-state file)))
 455     (if (eq hg-state 'edited)
 456         (if (equal (vc-working-revision file) "0")
 457             "(added)" "(modified)")
 458       ;; fall back to the default VC representation
 459       (vc-default-dired-state-info 'Hg file))))
 460
 461 ;; Modelled after the similar function in vc-bzr.el
 462 (defun vc-hg-revert (file &optional contents-done)
 463   (unless contents-done
 464     (with-temp-buffer (vc-hg-command t 0 file "revert"))))
 465
 466 ;;; Hg specific functionality.
 467
 468 ;;; XXX This functionality is experimental/work in progress. It might
 469 ;;; change without notice.
 470 (defvar vc-hg-extra-menu-map
 471   (let ((map (make-sparse-keymap)))
 472     (define-key map [incoming] '(menu-item "Show incoming" vc-hg-incoming))
 473     (define-key map [outgoing] '(menu-item "Show outgoing" vc-hg-outgoing))
 474     map))
 475
 476 (defun vc-hg-extra-menu () vc-hg-extra-menu-map)
 477
 478 (defun vc-hg-extra-status-menu () vc-hg-extra-menu-map)
 479
 480 (define-derived-mode vc-hg-outgoing-mode vc-hg-log-view-mode "Hg-Outgoing")
 481
 482 (define-derived-mode vc-hg-incoming-mode vc-hg-log-view-mode "Hg-Incoming")
 483
 484 ;; XXX Experimental function for the vc-dired replacement.
 485 (defun vc-hg-after-dir-status (update-function status-buffer)
 486   (let ((status-char nil)
 487         (file nil)
 488         (translation '((?= . up-to-date)
 489                        (?C . up-to-date)
 490                        (?A . added)
 491                        (?R . removed)
 492                        (?M . edited)
 493                        (?I . ignored)
 494                        (?! . deleted)
 495                        (?? . unregistered)))
 496         (translated nil)
 497           (result nil))
 498       (goto-char (point-min))
 499       (while (not (eobp))
 500         (setq status-char (char-after))
 501         (setq file
 502               (buffer-substring-no-properties (+ (point) 2)
 503                                               (line-end-position)))
 504         (setq translated (assoc status-char translation))
 505         (when (and translated (not (eq (cdr translated) 'up-to-date)))
 506           (push (cons file (cdr translated)) result))
 507         (forward-line))
 508       ;; Remove the temporary buffer.
 509       (kill-buffer (current-buffer))
 510       (funcall update-function result status-buffer)))
 511
 512 ;; XXX Experimental function for the vc-dired replacement.
 513 (defun vc-hg-dir-status (dir update-function status-buffer)
 514   "Return a list of conses (file . state) for DIR."
 515   (with-current-buffer
 516       (get-buffer-create
 517        (expand-file-name " *VC-hg* tmp status" dir))
 518     (erase-buffer)
 519     (vc-hg-command (current-buffer) 'async dir "status")
 520     (vc-exec-after
 521      `(vc-hg-after-dir-status (quote ,update-function) ,status-buffer))
 522     (current-buffer)))
 523
 524 ;; XXX this adds another top level menu, instead figure out how to
 525 ;; replace the Log-View menu.
 526 (easy-menu-define log-view-mode-menu vc-hg-outgoing-mode-map
 527   "Hg-outgoing Display Menu"
 528   `("Hg-outgoing"
 529     ["Push selected"  vc-hg-push]))
 530
 531 (easy-menu-define log-view-mode-menu vc-hg-incoming-mode-map
 532   "Hg-incoming Display Menu"
 533   `("Hg-incoming"
 534     ["Pull selected"  vc-hg-pull]))
 535
 536 (defun vc-hg-outgoing ()
 537   (interactive)
 538   (let ((bname "*Hg outgoing*"))
 539     (vc-hg-command bname 0 nil "outgoing" "-n")
 540     (pop-to-buffer bname)
 541     (vc-hg-outgoing-mode)))
 542
 543 (defun vc-hg-incoming ()
 544   (interactive)
 545   (let ((bname "*Hg incoming*"))
 546     (vc-hg-command bname 0 nil "incoming" "-n")
 547     (pop-to-buffer bname)
 548     (vc-hg-incoming-mode)))
 549
 550 (declare-function log-view-get-marked "log-view" ())
 551
 552 ;; XXX maybe also add key bindings for these functions.
 553 (defun vc-hg-push ()
 554   (interactive)
 555   (let ((marked-list (log-view-get-marked)))
 556     (if marked-list
 557         (vc-hg-command
 558          nil 0 nil
 559          (cons "push"
 560                (apply 'nconc
 561                       (mapcar (lambda (arg) (list "-r" arg)) marked-list))))
 562          (error "No log entries selected for push"))))
 563
 564 (defun vc-hg-pull ()
 565   (interactive)
 566   (let ((marked-list (log-view-get-marked)))
 567     (if marked-list
 568         (vc-hg-command
 569          nil 0 nil
 570          (cons "pull"
 571                (apply 'nconc
 572                       (mapcar (lambda (arg) (list "-r" arg)) marked-list))))
 573       (error "No log entries selected for pull"))))
 574
 575 ;;; Internal functions
 576
 577 (defun vc-hg-command (buffer okstatus file-or-list &rest flags)
 578   "A wrapper around `vc-do-command' for use in vc-hg.el.
 579 The difference to vc-do-command is that this function always invokes `hg',
 580 and that it passes `vc-hg-global-switches' to it before FLAGS."
 581   (apply 'vc-do-command buffer okstatus "hg" file-or-list
 582          (if (stringp vc-hg-global-switches)
 583              (cons vc-hg-global-switches flags)
 584            (append vc-hg-global-switches
 585                    flags))))
 586
 587 (defun vc-hg-root (file)
 588   (vc-find-root file ".hg"))
 589
 590 (provide 'vc-hg)
 591
 592 ;; arch-tag: bd094dc5-715a-434f-a331-37b9fb7cd954
 593 ;;; vc-hg.el ends here