view lisp/vc-hg.el @ 84063:d7859f97871f

Move here from ../../lispref

+
鐃緒申;;; vc-hg.el --- VC backend for the mercurial version control system
+
鐃緒申
+
鐃緒申;; Copyright (C) 2006, 2007 Free Software Foundation, Inc.
+
鐃緒申
+
鐃緒申;; Author: Ivan Kanis
+
鐃緒申;; Keywords: tools
+
鐃緒申
+
鐃緒申;; This file is part of GNU Emacs.
+
鐃緒申
+
鐃緒申;; GNU Emacs is free software; you can redistribute it and/or modify
+
鐃緒申;; it under the terms of the GNU General Public License as published by
+
鐃緒申;; the Free Software Foundation; either version 3, or (at your option)
+
鐃緒申;; any later version.
+
鐃緒申
+
鐃緒申;; GNU Emacs is distributed in the hope that it will be useful,
+
鐃緒申;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+
鐃緒申;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+
鐃緒申;; GNU General Public License for more details.
+
鐃緒申
+
鐃緒申;; You should have received a copy of the GNU General Public License
+
鐃緒申;; along with GNU Emacs; see the file COPYING.  If not, write to the
+
鐃緒申;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+
鐃緒申;; Boston, MA 02110-1301, USA.
+
鐃緒申
+
鐃緒申;;; Commentary:
+
鐃緒申
+
鐃緒申;; This is a mercurial version control backend
+
鐃緒申
+
鐃緒申;;; Thanks:
+
鐃緒申
+
鐃緒申;;; Bugs:
+
鐃緒申
+
鐃緒申;;; Installation:
+
鐃緒申
+
鐃緒申;;; Todo:
+
鐃緒申
+
鐃緒申;; Implement the rest of the vc interface. See the comment at the
+
鐃緒申;; beginning of vc.el. The current status is:
+
鐃緒申
+
鐃緒申;; FUNCTION NAME                               STATUS
+
鐃緒申;; BACKEND PROPERTIES
+
鐃緒申;; * revision-granularity                      OK
+
鐃緒申;; STATE-QUERYING FUNCTIONS
+
鐃緒申;; * registered (file)                         OK
+
鐃緒申;; * state (file)                              OK
+
鐃緒申;; - state-heuristic (file)                    ?? PROBABLY NOT NEEDED
+
鐃緒申;; - dir-state (dir)                           OK
+
鐃緒申;; * workfile-version (file)                   OK
+
鐃緒申;; - latest-on-branch-p (file)                 ??
+
鐃緒申;; * checkout-model (file)                     OK
+
鐃緒申;; - workfile-unchanged-p (file)               OK
+
鐃緒申;; - mode-line-string (file)                   NOT NEEDED
+
鐃緒申;; - dired-state-info (file)                   OK
+
鐃緒申;; STATE-CHANGING FUNCTIONS
+
鐃緒申;; * register (files &optional rev comment)    OK
+
鐃緒申;; * create-repo ()                            OK
+
鐃緒申;; - init-version ()                           NOT NEEDED
+
鐃緒申;; - responsible-p (file)                      OK
+
鐃緒申;; - could-register (file)                     OK
+
鐃緒申;; - receive-file (file rev)                   ?? PROBABLY NOT NEEDED
+
鐃緒申;; - unregister (file)                         COMMENTED OUT, MAY BE INCORRECT
+
鐃緒申;; * checkin (files rev comment)               OK
+
鐃緒申;; * find-version (file rev buffer)            OK
+
鐃緒申;; * checkout (file &optional editable rev)    OK
+
鐃緒申;; * revert (file &optional contents-done)     OK
+
鐃緒申;; - rollback (files)                          ?? PROBABLY NOT NEEDED   
+
鐃緒申;; - merge (file rev1 rev2)                    NEEDED
+
鐃緒申;; - merge-news (file)                         NEEDED
+
鐃緒申;; - steal-lock (file &optional version)       NOT NEEDED
+
鐃緒申;; HISTORY FUNCTIONS
+
鐃緒申;; * print-log (files &optional buffer)        OK
+
鐃緒申;; - log-view-mode ()                          OK
+
鐃緒申;; - show-log-entry (version)                  NOT NEEDED, DEFAULT IS GOOD
+
鐃緒申;; - wash-log (file)                           ??
+
鐃緒申;; - logentry-check ()                         NOT NEEDED
+
鐃緒申;; - comment-history (file)                    NOT NEEDED
+
鐃緒申;; - update-changelog (files)                  NOT NEEDED
+
鐃緒申;; * diff (files &optional rev1 rev2 buffer)   OK
+
鐃緒申;; - revision-completion-table (file)          COMMENTED OUT AS A WORKAROUND FOR A BUG
+
鐃緒申;; - diff-tree (dir &optional rev1 rev2)       TEST IT
+
鐃緒申;; - annotate-command (file buf &optional rev) OK
+
鐃緒申;; - annotate-time ()                          OK
+
鐃緒申;; - annotate-current-time ()                  ?? NOT NEEDED
+
鐃緒申;; - annotate-extract-revision-at-line ()      OK
+
鐃緒申;; SNAPSHOT SYSTEM
+
鐃緒申;; - create-snapshot (dir name branchp)        NEEDED (probably branch?)
+
鐃緒申;; - assign-name (file name)                   NOT NEEDED
+
鐃緒申;; - retrieve-snapshot (dir name update)       ?? NEEDED??
+
鐃緒申;; MISCELLANEOUS
+
鐃緒申;; - make-version-backups-p (file)             ??
+
鐃緒申;; - repository-hostname (dirname)             ?? 
+
鐃緒申;; - previous-version (file rev)               OK
+
鐃緒申;; - next-version (file rev)                   OK
+
鐃緒申;; - check-headers ()                          ??
+
鐃緒申;; - clear-headers ()                          ??
+
鐃緒申;; - delete-file (file)                        TEST IT
+
鐃緒申;; - rename-file (old new)                     OK
+
鐃緒申;; - find-file-hook ()                         PROBABLY NOT NEEDED
+
鐃緒申;; - find-file-not-found-hook ()               PROBABLY NOT NEEDED
+
鐃緒申
+
鐃緒申;; Implement Stefan Monnier's advice:
+
鐃緒申;; vc-hg-registered and vc-hg-state
+
鐃緒申;; Both of those functions should be super extra careful to fail gracefully in
+
鐃緒申;; unexpected circumstances. The reason this is important is that any error
+
鐃緒申;; there will prevent the user from even looking at the file :-(
+
鐃緒申;; Ideally, just like in vc-arch and vc-cvs, checking that the file is under
+
鐃緒申;; mercurial's control and extracting the current revision should be done
+
鐃緒申;; without even using `hg' (this way even if you don't have `hg' installed,
+
鐃緒申;; Emacs is able to tell you this file is under mercurial's control).
+
鐃緒申
+
鐃緒申;;; History:
+
鐃緒申;;
+
鐃緒申
+
鐃緒申;;; Code:
+
鐃緒申
+
鐃緒申(eval-when-compile
+
鐃緒申  (require 'cl)
+
鐃緒申  (require 'vc))
+
鐃緒申
+
鐃緒申;;; Customization options
+
鐃緒申
+
鐃緒申(defcustom vc-hg-global-switches nil
+
鐃緒申  "*Global switches to pass to any Hg command."
+
鐃緒申  :type '(choice (const :tag "None" nil)
+
鐃緒申         (string :tag "Argument String")
+
鐃緒申         (repeat :tag "Argument List"
+
鐃緒申             :value ("")
+
鐃緒申             string))
+
鐃緒申  :version "22.2"
+
鐃緒申  :group 'vc)
+
鐃緒申
+
鐃緒申
+
鐃緒申;;; Properties of the backend
+
鐃緒申
+
鐃緒申(defun vc-hg-revision-granularity ()
+
鐃緒申     'repository)
+
鐃緒申
+
鐃緒申;;; State querying functions
+
鐃緒申
+
鐃緒申;;;###autoload (defun vc-hg-registered (file)
+
鐃緒申;;;###autoload   "Return non-nil if FILE is registered with hg."
+
鐃緒申;;;###autoload   (if (vc-find-root file ".hg")       ; short cut
+
鐃緒申;;;###autoload       (progn
+
鐃緒申;;;###autoload         (load "vc-hg")
+
鐃緒申;;;###autoload         (vc-hg-registered file))))
+
鐃緒申
+
鐃緒申;; Modelled after the similar function in vc-bzr.el
+
鐃緒申(defun vc-hg-registered (file)
+
鐃緒申  "Return non-nil if FILE is registered with hg."
+
鐃緒申  (when (vc-hg-root file)           ; short cut
+
鐃緒申    (vc-file-setprop file 'vc-state (vc-hg-state file)))) ; expensive
+
鐃緒申
+
鐃緒申(defun vc-hg-state (file)
+
鐃緒申  "Hg-specific version of `vc-state'."
+
鐃緒申  (let* 
+
鐃緒申      ((status nil)
+
鐃緒申       (out
+
鐃緒申	(with-output-to-string
+
鐃緒申	  (with-current-buffer
+
鐃緒申	      standard-output
+
鐃緒申	    (setq status
+
鐃緒申		  (condition-case nil
+
鐃緒申		      ;; Ignore all errors.
+
鐃緒申		      (call-process
+
鐃緒申		       "hg" nil t nil "--cwd" (file-name-directory file)
+
鐃緒申		       "status" (file-name-nondirectory file))
+
鐃緒申		    ;; Some problem happened.  E.g. We can't find an `hg'
+
鐃緒申		    ;; executable.
+
鐃緒申		    (error nil)))))))
+
鐃緒申    (when (eq 0 status)
+
鐃緒申      (if (eq 0 (length out)) 'up-to-date
+
鐃緒申	(when (null (string-match ".*: No such file or directory$" out))
+
鐃緒申	  (let ((state (aref out 0)))
+
鐃緒申	    (cond
+
鐃緒申	     ((eq state ?A) 'edited)
+
鐃緒申	     ((eq state ?M) 'edited)
+
鐃緒申	     ((eq state ?R) nil)
+
鐃緒申	     ((eq state ??) nil)
+
鐃緒申	     (t 'up-to-date))))))))
+
鐃緒申
+
鐃緒申(defun vc-hg-dir-state (dir)
+
鐃緒申  (with-temp-buffer
+
鐃緒申    (vc-hg-command (current-buffer) nil nil "status")
+
鐃緒申    (goto-char (point-min))
+
鐃緒申    (let ((status-char nil)
+
鐃緒申	  (file nil))
+
鐃緒申      (while (not (eobp))
+
鐃緒申	(setq status-char (char-after))
+
鐃緒申	(setq file 
+
鐃緒申	      (expand-file-name
+
鐃緒申	       (buffer-substring-no-properties (+ (point) 2) 
+
鐃緒申					       (line-end-position))))
+
鐃緒申	(cond
+
鐃緒申	 ;; The rest of the possible states in "hg status" output:
+
鐃緒申	 ;; 	 R = removed
+
鐃緒申	 ;; 	 ! = deleted, but still tracked
+
鐃緒申	 ;; 	 ? = not tracked
+
鐃緒申	 ;; should not show up in vc-dired, so don't deal with them
+
鐃緒申	 ;; here.
+
鐃緒申	 ((eq status-char ?A)
+
鐃緒申	  (vc-file-setprop file 'vc-workfile-version "0")
+
鐃緒申	  (vc-file-setprop file 'vc-state 'edited))
+
鐃緒申	 ((eq status-char ?M)
+
鐃緒申	  (vc-file-setprop file 'vc-state 'edited))
+
鐃緒申	 ((eq status-char ??)
+
鐃緒申	  (vc-file-setprop file 'vc-backend 'none)
+
鐃緒申	  (vc-file-setprop file 'vc-state 'nil)))
+
鐃緒申	(forward-line)))))
+
鐃緒申
+
鐃緒申(defun vc-hg-workfile-version (file)
+
鐃緒申  "Hg-specific version of `vc-workfile-version'."
+
鐃緒申  (let* 
+
鐃緒申      ((status nil)
+
鐃緒申       (out
+
鐃緒申	(with-output-to-string
+
鐃緒申	  (with-current-buffer
+
鐃緒申	      standard-output
+
鐃緒申	    (setq status
+
鐃緒申		  (condition-case nil
+
鐃緒申		      ;; Ignore all errors.
+
鐃緒申		      (call-process
+
鐃緒申		       "hg" nil t nil "--cwd" (file-name-directory file)
+
鐃緒申		       "log" "-l1" (file-name-nondirectory file))
+
鐃緒申		    ;; Some problem happened.  E.g. We can't find an `hg'
+
鐃緒申		    ;; executable.
+
鐃緒申		    (error nil)))))))
+
鐃緒申    (when (eq 0 status)
+
鐃緒申      (if (string-match "changeset: *\\([0-9]*\\)" out)
+
鐃緒申	  (match-string 1 out)
+
鐃緒申	"0"))))
+
鐃緒申
+
鐃緒申;;; History functions
+
鐃緒申
+
鐃緒申(defun vc-hg-print-log(files &optional buffer)
+
鐃緒申  "Get change log associated with FILES."
+
鐃緒申  ;; `log-view-mode' needs to have the file name in order to function
+
鐃緒申  ;; correctly. "hg log" does not print it, so we insert it here by
+
鐃緒申  ;; hand.
+
鐃緒申
+
鐃緒申  ;; `vc-do-command' creates the buffer, but we need it before running
+
鐃緒申  ;; the command.
+
鐃緒申  (vc-setup-buffer buffer)
+
鐃緒申  ;; If the buffer exists from a previous invocation it might be
+
鐃緒申  ;; read-only.
+
鐃緒申  (let ((inhibit-read-only t))
+
鐃緒申    ;; We need to loop and call "hg log" on each file separately. 
+
鐃緒申    ;; "hg log" with multiple file arguments mashes all the logs
+
鐃緒申    ;; together.
+
鐃緒申    (dolist (file files)
+
鐃緒申      (with-current-buffer
+
鐃緒申	  buffer
+
鐃緒申	(insert "File:        " (file-name-nondirectory file) "\n"))
+
鐃緒申      (vc-hg-command buffer 0 file "log"))))
+
鐃緒申
+
鐃緒申(defvar log-view-message-re)
+
鐃緒申(defvar log-view-file-re)
+
鐃緒申(defvar log-view-font-lock-keywords)
+
鐃緒申
+
鐃緒申(define-derived-mode vc-hg-log-view-mode log-view-mode "Hg-Log-View"
+
鐃緒申  (require 'add-log) ;; we need the add-log faces
+
鐃緒申  (set (make-local-variable 'log-view-file-re) "^File:[ \t]+\\(.+\\)")
+
鐃緒申  (set (make-local-variable 'log-view-message-re)
+
鐃緒申       "^changeset:[ \t]*\\([0-9]+\\):\\(.+\\)")
+
鐃緒申  (set (make-local-variable 'log-view-font-lock-keywords)
+
鐃緒申       (append
+
鐃緒申	log-view-font-lock-keywords
+
鐃緒申	;; Handle the case:
+
鐃緒申	;; user: foo@bar
+
鐃緒申	'(("^user:[ \t]+\\([A-Za-z0-9_.+-]+@[A-Za-z0-9_.-]+\\)"
+
鐃緒申	   (1 'change-log-email))
+
鐃緒申	  ;; Handle the case:
+
鐃緒申	  ;; user: FirstName LastName <foo@bar>
+
鐃緒申	  ("^user:[ \t]+\\([^<(]+?\\)[ \t]*[(<]\\([A-Za-z0-9_.+-]+@[A-Za-z0-9_.-]+\\)[>)]"
+
鐃緒申	   (1 'change-log-name)
+
鐃緒申	   (2 'change-log-email))
+
鐃緒申	  ("^date: \\(.+\\)" (1 'change-log-date))
+
鐃緒申	  ("^summary:[ \t]+\\(.+\\)" (1 'log-view-message))))))
+
鐃緒申
+
鐃緒申(defun vc-hg-diff (files &optional oldvers newvers buffer)
+
鐃緒申  "Get a difference report using hg between two versions of FILES."
+
鐃緒申  (let ((working (vc-workfile-version (car files))))
+
鐃緒申    (if (and (equal oldvers working) (not newvers))
+
鐃緒申	(setq oldvers nil))
+
鐃緒申    (if (and (not oldvers) newvers)
+
鐃緒申	(setq oldvers working))
+
鐃緒申    (apply #'vc-hg-command (or buffer "*vc-diff*") nil
+
鐃緒申	   (mapcar (lambda (file) (file-name-nondirectory file)) files)
+
鐃緒申	   "--cwd" (file-name-directory (car files))
+
鐃緒申	   "diff"
+
鐃緒申	   (append
+
鐃緒申	    (if oldvers
+
鐃緒申		(if newvers
+
鐃緒申		    (list "-r" oldvers "-r" newvers)
+
鐃緒申		  (list "-r" oldvers))
+
鐃緒申	      (list ""))))))
+
鐃緒申
+
鐃緒申(defun vc-hg-revision-table (file)
+
鐃緒申  (let ((default-directory (file-name-directory file)))
+
鐃緒申    (with-temp-buffer
+
鐃緒申      (vc-hg-command t nil file "log" "--template" "{rev} ")
+
鐃緒申      (split-string 
+
鐃緒申       (buffer-substring-no-properties (point-min) (point-max))))))
+
鐃緒申
+
鐃緒申;; Modelled after the similar function in vc-cvs.el
+
鐃緒申(defun vc-hg-revision-completion-table (file)
+
鐃緒申  (lexical-let ((file file)
+
鐃緒申                table)
+
鐃緒申    (setq table (lazy-completion-table
+
鐃緒申                 table (lambda () (vc-hg-revision-table file))))
+
鐃緒申    table))
+
鐃緒申
+
鐃緒申(defun vc-hg-diff-tree (file &optional oldvers newvers buffer)
+
鐃緒申  (vc-hg-diff (list file) oldvers newvers buffer))
+
鐃緒申
+
鐃緒申(defun vc-hg-annotate-command (file buffer &optional version)
+
鐃緒申  "Execute \"hg annotate\" on FILE, inserting the contents in BUFFER.
+
鐃緒申Optional arg VERSION is a version to annotate from."
+
鐃緒申  (vc-hg-command buffer 0 file "annotate" "-d" "-n" (if version (concat "-r" version)))
+
鐃緒申  (with-current-buffer buffer
+
鐃緒申    (goto-char (point-min))
+
鐃緒申    (re-search-forward "^[0-9]")
+
鐃緒申    (delete-region (point-min) (1- (point)))))
+
鐃緒申
+
鐃緒申
+
鐃緒申;; The format for one line output by "hg annotate -d -n" looks like this:
+
鐃緒申;;215 Wed Jun 20 21:22:58 2007 -0700: CONTENTS
+
鐃緒申;; i.e: VERSION_NUMBER DATE: CONTENTS
+
鐃緒申(defconst vc-hg-annotate-re "^[ \t]*\\([0-9]+\\) \\(.\\{30\\}\\): ")
+
鐃緒申
+
鐃緒申(defun vc-hg-annotate-time ()
+
鐃緒申  (when (looking-at vc-hg-annotate-re)
+
鐃緒申    (goto-char (match-end 0))
+
鐃緒申    (vc-annotate-convert-time
+
鐃緒申     (date-to-time (match-string-no-properties 2)))))
+
鐃緒申
+
鐃緒申(defun vc-hg-annotate-extract-revision-at-line ()
+
鐃緒申  (save-excursion
+
鐃緒申    (beginning-of-line)
+
鐃緒申    (if (looking-at vc-hg-annotate-re) (match-string-no-properties 1))))
+
鐃緒申
+
鐃緒申(defun vc-hg-previous-version (file rev)
+
鐃緒申  (let ((newrev (1- (string-to-number rev))))
+
鐃緒申    (when (>= newrev 0)
+
鐃緒申      (number-to-string newrev))))
+
鐃緒申
+
鐃緒申(defun vc-hg-next-version (file rev)
+
鐃緒申  (let ((newrev (1+ (string-to-number rev)))
+
鐃緒申	(tip-version 
+
鐃緒申	 (with-temp-buffer
+
鐃緒申	   (vc-hg-command t 0 nil "tip")
+
鐃緒申	   (goto-char (point-min))
+
鐃緒申	   (re-search-forward "^changeset:[ \t]*\\([0-9]+\\):")
+
鐃緒申	   (string-to-number (match-string-no-properties 1)))))
+
鐃緒申    ;; We don't want to exceed the maximum possible version number, ie
+
鐃緒申    ;; the tip version.
+
鐃緒申    (when (<= newrev tip-version)
+
鐃緒申      (number-to-string newrev))))
+
鐃緒申
+
鐃緒申;; Modelled after the similar function in vc-bzr.el
+
鐃緒申(defun vc-hg-delete-file (file)
+
鐃緒申  "Delete FILE and delete it in the hg repository."
+
鐃緒申  (condition-case ()
+
鐃緒申      (delete-file file)
+
鐃緒申    (file-error nil))
+
鐃緒申  (vc-hg-command nil 0 file "remove" "--after" "--force"))
+
鐃緒申
+
鐃緒申;; Modelled after the similar function in vc-bzr.el
+
鐃緒申(defun vc-hg-rename-file (old new)
+
鐃緒申  "Rename file from OLD to NEW using `hg mv'."
+
鐃緒申  (vc-hg-command nil 0 new old "mv"))
+
鐃緒申
+
鐃緒申(defun vc-hg-register (files &optional rev comment)
+
鐃緒申  "Register FILES under hg.
+
鐃緒申REV is ignored.
+
鐃緒申COMMENT is ignored."
+
鐃緒申  (vc-hg-command nil 0 files "add"))
+
鐃緒申
+
鐃緒申(defun vc-hg-create-repo ()
+
鐃緒申  "Create a new Mercurial repository."
+
鐃緒申  (vc-hg-command nil 0 nil "init"))
+
鐃緒申
+
鐃緒申(defalias 'vc-hg-responsible-p 'vc-hg-root)
+
鐃緒申
+
鐃緒申;; Modelled after the similar function in vc-bzr.el
+
鐃緒申(defun vc-hg-could-register (file)
+
鐃緒申  "Return non-nil if FILE could be registered under hg."
+
鐃緒申  (and (vc-hg-responsible-p file)      ; shortcut
+
鐃緒申       (condition-case ()
+
鐃緒申           (with-temp-buffer
+
鐃緒申             (vc-hg-command t nil file "add" "--dry-run"))
+
鐃緒申             ;; The command succeeds with no output if file is
+
鐃緒申             ;; registered.
+
鐃緒申         (error))))
+
鐃緒申
+
鐃緒申;; XXX This would remove the file. Is that correct?
+
鐃緒申;; (defun vc-hg-unregister (file)
+
鐃緒申;;   "Unregister FILE from hg."
+
鐃緒申;;   (vc-hg-command nil nil file "remove"))
+
鐃緒申
+
鐃緒申(defun vc-hg-checkin (files rev comment)
+
鐃緒申  "Hg-specific version of `vc-backend-checkin'.
+
鐃緒申REV is ignored."
+
鐃緒申  (vc-hg-command nil 0 files  "commit" "-m" comment))
+
鐃緒申
+
鐃緒申(defun vc-hg-find-version (file rev buffer)
+
鐃緒申  (let ((coding-system-for-read 'binary)
+
鐃緒申        (coding-system-for-write 'binary))
+
鐃緒申    (if rev
+
鐃緒申	(vc-hg-command buffer 0 file "cat" "-r" rev)
+
鐃緒申      (vc-hg-command buffer 0 file "cat"))))
+
鐃緒申
+
鐃緒申;; Modelled after the similar function in vc-bzr.el
+
鐃緒申(defun vc-hg-checkout (file &optional editable rev)
+
鐃緒申  "Retrieve a revision of FILE.
+
鐃緒申EDITABLE is ignored.
+
鐃緒申REV is the revision to check out into WORKFILE."
+
鐃緒申  (let ((coding-system-for-read 'binary)
+
鐃緒申        (coding-system-for-write 'binary))
+
鐃緒申  (with-current-buffer (or (get-file-buffer file) (current-buffer))
+
鐃緒申    (if rev
+
鐃緒申        (vc-hg-command t 0 file "cat" "-r" rev)
+
鐃緒申      (vc-hg-command t 0 file "cat")))))
+
鐃緒申
+
鐃緒申(defun vc-hg-checkout-model (file)
+
鐃緒申  'implicit)
+
鐃緒申
+
鐃緒申;; Modelled after the similar function in vc-bzr.el
+
鐃緒申(defun vc-hg-workfile-unchanged-p (file)
+
鐃緒申  (eq 'up-to-date (vc-hg-state file)))
+
鐃緒申
+
鐃緒申(defun vc-hg-dired-state-info (file)
+
鐃緒申  "Hg-specific version of `vc-dired-state-info'."
+
鐃緒申  (let ((hg-state (vc-state file)))
+
鐃緒申    (if (eq hg-state 'edited)
+
鐃緒申	(if (equal (vc-workfile-version file) "0")
+
鐃緒申	    "(added)" "(modified)")
+
鐃緒申      ;; fall back to the default VC representation
+
鐃緒申      (vc-default-dired-state-info 'Hg file))))
+
鐃緒申
+
鐃緒申;; Modelled after the similar function in vc-bzr.el
+
鐃緒申(defun vc-hg-revert (file &optional contents-done)
+
鐃緒申  (unless contents-done
+
鐃緒申    (with-temp-buffer (vc-hg-command t 0 file "revert"))))
+
鐃緒申
+
鐃緒申;;; Hg specific functionality.
+
鐃緒申
+
鐃緒申;;; XXX This functionality is experimental/work in progress. It might
+
鐃緒申;;; change without notice.
+
鐃緒申(defvar vc-hg-extra-menu-map
+
鐃緒申  (let ((map (make-sparse-keymap)))
+
鐃緒申    (define-key map [incoming] '(menu-item "Show incoming" vc-hg-incoming))
+
鐃緒申    (define-key map [outgoing] '(menu-item "Show outgoing" vc-hg-outgoing))
+
鐃緒申    map))
+
鐃緒申
+
鐃緒申(defun vc-hg-extra-menu () vc-hg-extra-menu-map)
+
鐃緒申
+
鐃緒申(define-derived-mode vc-hg-outgoing-mode vc-hg-log-view-mode "Hg-Outgoing")
+
鐃緒申
+
鐃緒申(define-derived-mode vc-hg-incoming-mode vc-hg-log-view-mode "Hg-Incoming")
+
鐃緒申
+
鐃緒申;; XXX this adds another top level menu, instead figure out how to
+
鐃緒申;; replace the Log-View menu.
+
鐃緒申(easy-menu-define log-view-mode-menu vc-hg-outgoing-mode-map
+
鐃緒申  "Hg-outgoing Display Menu"
+
鐃緒申  `("Hg-outgoing"
+
鐃緒申    ["Push selected"  vc-hg-push]))
+
鐃緒申
+
鐃緒申(easy-menu-define log-view-mode-menu vc-hg-incoming-mode-map
+
鐃緒申  "Hg-incoming Display Menu"
+
鐃緒申  `("Hg-incoming"
+
鐃緒申    ["Pull selected"  vc-hg-pull]))
+
鐃緒申
+
鐃緒申(defun vc-hg-outgoing ()
+
鐃緒申  (interactive)
+
鐃緒申  (let ((bname "*Hg outgoing*"))
+
鐃緒申    (vc-hg-command bname 0 nil "outgoing" "-n")
+
鐃緒申    (pop-to-buffer bname)
+
鐃緒申    (vc-hg-outgoing-mode)))
+
鐃緒申
+
鐃緒申(defun vc-hg-incoming ()
+
鐃緒申  (interactive)
+
鐃緒申  (let ((bname "*Hg incoming*"))
+
鐃緒申    (vc-hg-command bname 0 nil "incoming" "-n")
+
鐃緒申    (pop-to-buffer bname)
+
鐃緒申    (vc-hg-incoming-mode)))
+
鐃緒申
+
鐃緒申;; XXX maybe also add key bindings for these functions.
+
鐃緒申(defun vc-hg-push ()
+
鐃緒申  (interactive)
+
鐃緒申  (let ((marked-list (log-view-get-marked)))
+
鐃緒申    (if marked-list
+
鐃緒申	(vc-hg-command 
+
鐃緒申	 nil 0 nil
+
鐃緒申	 (cons "push"
+
鐃緒申	       (apply 'nconc
+
鐃緒申		      (mapcar (lambda (arg) (list "-r" arg)) marked-list))))
+
鐃緒申	 (error "No log entries selected for push"))))
+
鐃緒申
+
鐃緒申(defun vc-hg-pull ()
+
鐃緒申  (interactive)
+
鐃緒申  (let ((marked-list (log-view-get-marked)))
+
鐃緒申    (if marked-list
+
鐃緒申	(vc-hg-command 
+
鐃緒申	 nil 0 nil
+
鐃緒申	 (cons "pull"
+
鐃緒申	       (apply 'nconc
+
鐃緒申		      (mapcar (lambda (arg) (list "-r" arg)) marked-list))))
+
鐃緒申      (error "No log entries selected for pull"))))
+
鐃緒申
+
鐃緒申;;; Internal functions
+
鐃緒申
+
鐃緒申(defun vc-hg-command (buffer okstatus file-or-list &rest flags)
+
鐃緒申  "A wrapper around `vc-do-command' for use in vc-hg.el.
+
鐃緒申The difference to vc-do-command is that this function always invokes `hg',
+
鐃緒申and that it passes `vc-hg-global-switches' to it before FLAGS."
+
鐃緒申  (apply 'vc-do-command buffer okstatus "hg" file-or-list
+
鐃緒申         (if (stringp vc-hg-global-switches)
+
鐃緒申             (cons vc-hg-global-switches flags)
+
鐃緒申           (append vc-hg-global-switches
+
鐃緒申                   flags))))
+
鐃緒申
+
鐃緒申(defun vc-hg-root (file)
+
鐃緒申  (vc-find-root file ".hg"))
+
鐃緒申
+
鐃緒申(provide 'vc-hg)
+
鐃緒申
+
鐃緒申;; arch-tag: bd094dc5-715a-434f-a331-37b9fb7cd954
+
鐃緒申;;; vc-hg.el ends here