[bpt/emacs.git] / lisp / vc-hg.el

;;; 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 2, 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
;; * 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 (file &optional rev comment)     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 (file rev comment)                OK
;; * find-version (file rev buffer)            OK
;; * checkout (file &optional editable rev)    OK
;; * revert (file &optional contents-done)     OK
;; - cancel-version (file editable)            ?? PROBABLY NOT NEEDED   
;; - merge (file rev1 rev2)                    NEEDED
;; - merge-news (file)                         NEEDED
;; - steal-lock (file &optional version)       NOT NEEDED
;; HISTORY FUNCTIONS
;; * print-log (file &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 (file &optional rev1 rev2 buffer)    OK
;; - revision-completion-table (file)          OK
;; - 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)

;;; 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-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(file &optional buffer)
  "Get change log associated with FILE."
  ;; `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))
    (with-current-buffer
	buffer
      (insert "File:        " (file-name-nondirectory file) "\n")))
  (vc-hg-command
   buffer
   (if (and (vc-stay-local-p file) (fboundp 'start-process)) 'async 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 faces add-log
  ;; Don't have file markers, so use impossible regexp.
  (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 (file &optional oldvers newvers buffer)
  "Get a difference report using hg between two versions of FILE."
  (let ((working (vc-workfile-version file)))
    (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
	   (file-name-nondirectory file)
	   "--cwd" (file-name-directory file) 
	   "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))

(defalias 'vc-hg-diff-tree 'vc-hg-diff)

(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 (file &optional rev comment)
  "Register FILE under hg.
REV is ignored.
COMMENT is ignored."
  (vc-hg-command nil 0 file "add"))

(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 (file 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"))))

;;; Internal functions

(defun vc-hg-command (buffer okstatus file &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
         (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
Commit	Line	Data
8b69ba6c DN	1	;;; vc-hg.el --- VC backend for the mercurial version control system
	2
	3	;; Copyright (C) 2006, 2007 Free Software Foundation, Inc.
	4
	5	;; Author: Ivan Kanis
	6	;; Keywords: tools
8b69ba6c DN	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 2, 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	;; * registered (file) OK
	42	;; * state (file) OK
	43	;; - state-heuristic (file) ?? PROBABLY NOT NEEDED
908265fc	44	;; - dir-state (dir) OK
8b69ba6c DN	45	;; * workfile-version (file) OK
	46	;; - latest-on-branch-p (file) ??
	47	;; * checkout-model (file) OK
727bdea1	48	;; - workfile-unchanged-p (file) OK
8b69ba6c	49	;; - mode-line-string (file) NOT NEEDED
908265fc	50	;; - dired-state-info (file) OK
8b69ba6c DN	51	;; STATE-CHANGING FUNCTIONS
	52	;; * register (file &optional rev comment) OK
	53	;; - init-version () NOT NEEDED
	54	;; - responsible-p (file) OK
	55	;; - could-register (file) OK
	56	;; - receive-file (file rev) ?? PROBABLY NOT NEEDED
	57	;; - unregister (file) COMMENTED OUT, MAY BE INCORRECT
	58	;; * checkin (file rev comment) OK
	59	;; * find-version (file rev buffer) OK
908265fc	60	;; * checkout (file &optional editable rev) OK
8b69ba6c DN	61	;; * revert (file &optional contents-done) OK
	62	;; - cancel-version (file editable) ?? PROBABLY NOT NEEDED
	63	;; - merge (file rev1 rev2) NEEDED
	64	;; - merge-news (file) NEEDED
	65	;; - steal-lock (file &optional version) NOT NEEDED
	66	;; HISTORY FUNCTIONS
	67	;; * print-log (file &optional buffer) OK
	68	;; - log-view-mode () OK
	69	;; - show-log-entry (version) NOT NEEDED, DEFAULT IS GOOD
	70	;; - wash-log (file) ??
	71	;; - logentry-check () NOT NEEDED
	72	;; - comment-history (file) NOT NEEDED
	73	;; - update-changelog (files) NOT NEEDED
	74	;; * diff (file &optional rev1 rev2 buffer) OK
0c3b8cc4	75	;; - revision-completion-table (file) OK
8b69ba6c DN	76	;; - diff-tree (dir &optional rev1 rev2) TEST IT
	77	;; - annotate-command (file buf &optional rev) OK
	78	;; - annotate-time () OK
	79	;; - annotate-current-time () ?? NOT NEEDED
	80	;; - annotate-extract-revision-at-line () OK
	81	;; SNAPSHOT SYSTEM
	82	;; - create-snapshot (dir name branchp) NEEDED (probably branch?)
	83	;; - assign-name (file name) NOT NEEDED
	84	;; - retrieve-snapshot (dir name update) ?? NEEDED??
	85	;; MISCELLANEOUS
	86	;; - make-version-backups-p (file) ??
	87	;; - repository-hostname (dirname) ??
	88	;; - previous-version (file rev) OK
	89	;; - next-version (file rev) OK
	90	;; - check-headers () ??
	91	;; - clear-headers () ??
	92	;; - delete-file (file) TEST IT
	93	;; - rename-file (old new) OK
	94	;; - find-file-hook () PROBABLY NOT NEEDED
	95	;; - find-file-not-found-hook () PROBABLY NOT NEEDED
	96
	97	;; Implement Stefan Monnier's advice:
	98	;; vc-hg-registered and vc-hg-state
	99	;; Both of those functions should be super extra careful to fail gracefully in
	100	;; unexpected circumstances. The reason this is important is that any error
	101	;; there will prevent the user from even looking at the file :-(
	102	;; Ideally, just like in vc-arch and vc-cvs, checking that the file is under
	103	;; mercurial's control and extracting the current revision should be done
	104	;; without even using `hg' (this way even if you don't have `hg' installed,
	105	;; Emacs is able to tell you this file is under mercurial's control).
	106
	107	;;; History:
	108	;;
	109
	110	;;; Code:
	111
	112	(eval-when-compile
0c3b8cc4	113	(require 'cl)
8b69ba6c DN	114	(require 'vc))
8b69ba6c DN	115
8b69ba6c DN	116	;;; Customization options
	117
	118	(defcustom vc-hg-global-switches nil
	119	"*Global switches to pass to any Hg command."
	120	:type '(choice (const :tag "None" nil)
	121	(string :tag "Argument String")
	122	(repeat :tag "Argument List"
	123	:value ("")
	124	string))
	125	:version "22.2"
	126	:group 'vc)
	127
	128	;;; State querying functions
	129
	130	;;;###autoload (defun vc-hg-registered (file)
	131	;;;###autoload "Return non-nil if FILE is registered with hg."
	132	;;;###autoload (if (vc-find-root file ".hg") ; short cut
	133	;;;###autoload (progn
	134	;;;###autoload (load "vc-hg")
	135	;;;###autoload (vc-hg-registered file))))
	136
	137	;; Modelled after the similar function in vc-bzr.el
	138	(defun vc-hg-registered (file)
	139	"Return non-nil if FILE is registered with hg."
ad546929 DN	140	(when (vc-hg-root file) ; short cut
ad546929 DN	141	(vc-hg-state file))) ; expensive
8b69ba6c DN	142
	143	(defun vc-hg-state (file)
	144	"Hg-specific version of `vc-state'."
	145	(let*
	146	((status nil)
	147	(out
	148	(with-output-to-string
	149	(with-current-buffer
	150	standard-output
	151	(setq status
	152	(condition-case nil
	153	;; Ignore all errors.
	154	(call-process
	155	"hg" nil t nil "--cwd" (file-name-directory file)
	156	"status" (file-name-nondirectory file))
	157	;; Some problem happened. E.g. We can't find an `hg'
	158	;; executable.
	159	(error nil)))))))
	160	(when (eq 0 status)
	161	(if (eq 0 (length out)) 'up-to-date
ad546929 DN	162	(when (null (string-match ".*: No such file or directory$" out))
	163	(let ((state (aref out 0)))
	164	(cond
	165	((eq state ?A) 'edited)
	166	((eq state ?M) 'edited)
	167	((eq state ?R) nil)
	168	((eq state ??) nil)
	169	(t 'up-to-date))))))))
8b69ba6c	170
908265fc DN	171	(defun vc-hg-dir-state (dir)
	172	(with-temp-buffer
	173	(vc-hg-command (current-buffer) nil nil "status")
	174	(goto-char (point-min))
	175	(let ((status-char nil)
	176	(file nil))
0c3b8cc4	177	(while (not (eobp))
908265fc DN	178	(setq status-char (char-after))
	179	(setq file
	180	(expand-file-name
0c3b8cc4 DN	181	(buffer-substring-no-properties (+ (point) 2)
0c3b8cc4 DN	182	(line-end-position))))
908265fc DN	183	(cond
	184	;; The rest of the possible states in "hg status" output:
	185	;; R = removed
	186	;; ! = deleted, but still tracked
	187	;; ? = not tracked
	188	;; should not show up in vc-dired, so don't deal with them
	189	;; here.
	190	((eq status-char ?A)
	191	(vc-file-setprop file 'vc-workfile-version "0")
	192	(vc-file-setprop file 'vc-state 'edited))
	193	((eq status-char ?M)
	194	(vc-file-setprop file 'vc-state 'edited))
	195	((eq status-char ??)
	196	(vc-file-setprop file 'vc-backend 'none)
0c3b8cc4 DN	197	(vc-file-setprop file 'vc-state 'nil)))
0c3b8cc4 DN	198	(forward-line)))))
908265fc	199
8b69ba6c DN	200	(defun vc-hg-workfile-version (file)
	201	"Hg-specific version of `vc-workfile-version'."
	202	(let*
	203	((status nil)
	204	(out
	205	(with-output-to-string
	206	(with-current-buffer
	207	standard-output
	208	(setq status
	209	(condition-case nil
	210	;; Ignore all errors.
	211	(call-process
	212	"hg" nil t nil "--cwd" (file-name-directory file)
	213	"log" "-l1" (file-name-nondirectory file))
	214	;; Some problem happened. E.g. We can't find an `hg'
	215	;; executable.
	216	(error nil)))))))
	217	(when (eq 0 status)
	218	(if (string-match "changeset: \\([0-9]\\)" out)
	219	(match-string 1 out)
	220	"0"))))
	221
	222	;;; History functions
	223
	224	(defun vc-hg-print-log(file &optional buffer)
	225	"Get change log associated with FILE."
	226	;; `log-view-mode' needs to have the file name in order to function
	227	;; correctly. "hg log" does not print it, so we insert it here by
	228	;; hand.
	229
	230	;; `vc-do-command' creates the buffer, but we need it before running
	231	;; the command.
	232	(vc-setup-buffer buffer)
	233	;; If the buffer exists from a previous invocation it might be
	234	;; read-only.
	235	(let ((inhibit-read-only t))
	236	(with-current-buffer
	237	buffer
	238	(insert "File: " (file-name-nondirectory file) "\n")))
	239	(vc-hg-command
	240	buffer
	241	(if (and (vc-stay-local-p file) (fboundp 'start-process)) 'async 0)
	242	file "log"))
	243
	244	(defvar log-view-message-re)
	245	(defvar log-view-file-re)
	246	(defvar log-view-font-lock-keywords)
	247
	248	(define-derived-mode vc-hg-log-view-mode log-view-mode "HG-Log-View"
	249	(require 'add-log) ;; we need the faces add-log
	250	;; Don't have file markers, so use impossible regexp.
	251	(set (make-local-variable 'log-view-file-re) "^File:[ \t]+\\(.+\\)")
	252	(set (make-local-variable 'log-view-message-re)
	253	"^changeset:[ \t]*\\([0-9]+\\):\\(.+\\)")
	254	(set (make-local-variable 'log-view-font-lock-keywords)
	255	(append
	256	log-view-font-lock-keywords
	257	;; Handle the case:
	258	;; user: foo@bar
	259	'(("^user:[ \t]+\\([A-Za-z0-9_.+-]+@[A-Za-z0-9_.-]+\\)"
	260	(1 'change-log-email))
	261	;; Handle the case:
	262	;; user: FirstName LastName <foo@bar>
	263	("^user:[ \t]+\\([^<(]+?\\)[ \t]*[(<]\\([A-Za-z0-9_.+-]+@[A-Za-z0-9_.-]+\\)[>)]"
264	(1 'change-log-name)
265	(2 'change-log-email))
266	("^date: \\(.+\\)" (1 'change-log-date))
267	("^summary:[ \t]+\\(.+\\)" (1 'log-view-message))))))
268
269	(defun vc-hg-diff (file &optional oldvers newvers buffer)
270	"Get a difference report using hg between two versions of FILE."
271	(let ((working (vc-workfile-version file)))
272	(if (and (equal oldvers working) (not newvers))
273	(setq oldvers nil))
274	(if (and (not oldvers) newvers)
275	(setq oldvers working))
0c3b8cc4 DN	276	(apply #'vc-hg-command (or buffer "vc-diff") nil
	277	(file-name-nondirectory file)
	278	"--cwd" (file-name-directory file)
	279	"diff"
8b69ba6c DN	280	(append
	281	(if oldvers
	282	(if newvers
	283	(list "-r" oldvers "-r" newvers)
	284	(list "-r" oldvers))
0c3b8cc4 DN	285	(list ""))))))
	286
	287	(defun vc-hg-revision-table (file)
	288	(let ((default-directory (file-name-directory file)))
	289	(with-temp-buffer
	290	(vc-hg-command t nil file "log" "--template" "{rev} ")
	291	(split-string
	292	(buffer-substring-no-properties (point-min) (point-max))))))
	293
	294	;; Modelled after the similar function in vc-cvs.el
	295	(defun vc-hg-revision-completion-table (file)
	296	(lexical-let ((file file)
	297	table)
	298	(setq table (lazy-completion-table
	299	table (lambda () (vc-hg-revision-table file))))
	300	table))
8b69ba6c DN	301
	302	(defalias 'vc-hg-diff-tree 'vc-hg-diff)
	303
	304	(defun vc-hg-annotate-command (file buffer &optional version)
	305	"Execute \"hg annotate\" on FILE, inserting the contents in BUFFER.
	306	Optional arg VERSION is a version to annotate from."
	307	(vc-hg-command buffer 0 file "annotate" "-d" "-n" (if version (concat "-r" version)))
	308	(with-current-buffer buffer
	309	(goto-char (point-min))
	310	(re-search-forward "^[0-9]")
	311	(delete-region (point-min) (1- (point)))))
	312
	313
	314	;; The format for one line output by "hg annotate -d -n" looks like this:
	315	;;215 Wed Jun 20 21:22:58 2007 -0700: CONTENTS
	316	;; i.e: VERSION_NUMBER DATE: CONTENTS
	317	(defconst vc-hg-annotate-re "^[ \t]*\\([0-9]+\\) \\(.\\{30\\}\\): ")
	318
	319	(defun vc-hg-annotate-time ()
	320	(when (looking-at vc-hg-annotate-re)
	321	(goto-char (match-end 0))
	322	(vc-annotate-convert-time
	323	(date-to-time (match-string-no-properties 2)))))
	324
	325	(defun vc-hg-annotate-extract-revision-at-line ()
	326	(save-excursion
	327	(beginning-of-line)
	328	(if (looking-at vc-hg-annotate-re) (match-string-no-properties 1))))
	329
	330	(defun vc-hg-previous-version (file rev)
	331	(let ((newrev (1- (string-to-number rev))))
	332	(when (>= newrev 0)
	333	(number-to-string newrev))))
	334
	335	(defun vc-hg-next-version (file rev)
	336	(let ((newrev (1+ (string-to-number rev)))
	337	(tip-version
	338	(with-temp-buffer
0c3b8cc4	339	(vc-hg-command t 0 nil "tip")
8b69ba6c DN	340	(goto-char (point-min))
	341	(re-search-forward "^changeset:[ \t]*\\([0-9]+\\):")
	342	(string-to-number (match-string-no-properties 1)))))
	343	;; We don't want to exceed the maximum possible version number, ie
	344	;; the tip version.
	345	(when (<= newrev tip-version)
	346	(number-to-string newrev))))
	347
	348	;; Modelled after the similar function in vc-bzr.el
	349	(defun vc-hg-delete-file (file)
	350	"Delete FILE and delete it in the hg repository."
	351	(condition-case ()
	352	(delete-file file)
	353	(file-error nil))
0c3b8cc4	354	(vc-hg-command nil 0 file "remove" "--after" "--force"))
8b69ba6c DN	355
	356	;; Modelled after the similar function in vc-bzr.el
	357	(defun vc-hg-rename-file (old new)
	358	"Rename file from OLD to NEW using `hg mv'."
0c3b8cc4	359	(vc-hg-command nil 0 new old "mv"))
8b69ba6c DN	360
	361	(defun vc-hg-register (file &optional rev comment)
	362	"Register FILE under hg.
	363	REV is ignored.
	364	COMMENT is ignored."
0c3b8cc4	365	(vc-hg-command nil 0 file "add"))
8b69ba6c DN	366
	367	(defalias 'vc-hg-responsible-p 'vc-hg-root)
	368
	369	;; Modelled after the similar function in vc-bzr.el
	370	(defun vc-hg-could-register (file)
	371	"Return non-nil if FILE could be registered under hg."
	372	(and (vc-hg-responsible-p file) ; shortcut
	373	(condition-case ()
	374	(with-temp-buffer
	375	(vc-hg-command t nil file "add" "--dry-run"))
	376	;; The command succeeds with no output if file is
	377	;; registered.
	378	(error))))
	379
	380	;; XXX This would remove the file. Is that correct?
	381	;; (defun vc-hg-unregister (file)
	382	;; "Unregister FILE from hg."
	383	;; (vc-hg-command nil nil file "remove"))
	384
	385	(defun vc-hg-checkin (file rev comment)
	386	"HG-specific version of `vc-backend-checkin'.
	387	REV is ignored."
0c3b8cc4	388	(vc-hg-command nil 0 files "commit" "-m" comment))
8b69ba6c DN	389
	390	(defun vc-hg-find-version (file rev buffer)
	391	(let ((coding-system-for-read 'binary)
	392	(coding-system-for-write 'binary))
	393	(if rev
0c3b8cc4 DN	394	(vc-hg-command buffer 0 file "cat" "-r" rev)
0c3b8cc4 DN	395	(vc-hg-command buffer 0 file "cat"))))
8b69ba6c DN	396
8b69ba6c DN	397	;; Modelled after the similar function in vc-bzr.el
908265fc DN	398	(defun vc-hg-checkout (file &optional editable rev)
	399	"Retrieve a revision of FILE.
	400	EDITABLE is ignored.
	401	REV is the revision to check out into WORKFILE."
	402	(let ((coding-system-for-read 'binary)
	403	(coding-system-for-write 'binary))
	404	(with-current-buffer (or (get-file-buffer file) (current-buffer))
	405	(if rev
0c3b8cc4 DN	406	(vc-hg-command t 0 file "cat" "-r" rev)
0c3b8cc4 DN	407	(vc-hg-command t 0 file "cat")))))
8b69ba6c DN	408
	409	(defun vc-hg-checkout-model (file)
	410	'implicit)
	411
727bdea1 DN	412	;; Modelled after the similar function in vc-bzr.el
	413	(defun vc-hg-workfile-unchanged-p (file)
	414	(eq 'up-to-date (vc-hg-state file)))
	415
908265fc DN	416	(defun vc-hg-dired-state-info (file)
	417	"Hg-specific version of `vc-dired-state-info'."
	418	(let ((hg-state (vc-state file)))
	419	(if (eq hg-state 'edited)
	420	(if (equal (vc-workfile-version file) "0")
	421	"(added)" "(modified)")
	422	;; fall back to the default VC representation
	423	(vc-default-dired-state-info 'HG file))))
	424
8b69ba6c DN	425	;; Modelled after the similar function in vc-bzr.el
	426	(defun vc-hg-revert (file &optional contents-done)
	427	(unless contents-done
0c3b8cc4	428	(with-temp-buffer (vc-hg-command t 0 file "revert"))))
8b69ba6c DN	429
	430	;;; Internal functions
	431
	432	(defun vc-hg-command (buffer okstatus file &rest flags)
	433	"A wrapper around `vc-do-command' for use in vc-hg.el.
	434	The difference to vc-do-command is that this function always invokes `hg',
	435	and that it passes `vc-hg-global-switches' to it before FLAGS."
	436	(apply 'vc-do-command buffer okstatus "hg" file
	437	(if (stringp vc-hg-global-switches)
	438	(cons vc-hg-global-switches flags)
	439	(append vc-hg-global-switches
	440	flags))))
	441
	442	(defun vc-hg-root (file)
	443	(vc-find-root file ".hg"))
	444
	445	(provide 'vc-hg)
	446
300e5e22	447	;; arch-tag: bd094dc5-715a-434f-a331-37b9fb7cd954
8b69ba6c	448	;;; vc-hg.el ends here