vc-hg.el 8.89 KB
Newer Older
Dan Nicolaescu's avatar
Dan Nicolaescu committed
1 2
;;; vc-hg.el --- VC backend for the mercurial version control system

3 4
;; Copyright (C) 2006, 2007 Free Software Foundation, Inc.

Dan Nicolaescu's avatar
Dan Nicolaescu committed
5
;; Author: Ivan Kanis
6 7
;; Keywords: tools
;; Version: 1889
8 9 10 11

;; This file is part of GNU Emacs.

;; GNU Emacs is free software; you can redistribute it and/or modify
Dan Nicolaescu's avatar
Dan Nicolaescu committed
12
;; it under the terms of the GNU General Public License as published by
13 14 15 16 17 18 19 20
;; 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.

Dan Nicolaescu's avatar
Dan Nicolaescu committed
21
;; You should have received a copy of the GNU General Public License
22 23 24
;; 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.
Dan Nicolaescu's avatar
Dan Nicolaescu committed
25 26 27 28 29

;;; Commentary:

;; This is a mercurial version control backend

30 31 32 33 34 35 36 37
;;; Thanks:

;;; Bugs:

;;; Installation:

;;; Todo:

Dan Nicolaescu's avatar
Dan Nicolaescu committed
38 39 40
;; Implement the rest of the vc interface:
;; - dired
;; - snapshot?
Dan Nicolaescu's avatar
Dan Nicolaescu committed
41

42
;; Implement Stefan Monnier's advice:
43 44 45 46 47 48 49 50 51
;; vc-hg-registered and vc-hg-state
;; Both of those functions should be super extra careful to fail gracefully in
;; unexpected circumstances.  The most important such case is when the `hg'
;; executable is not available.  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).
Dan Nicolaescu's avatar
Dan Nicolaescu committed
52

53
;;; History:
54
;;
Dan Nicolaescu's avatar
Dan Nicolaescu committed
55 56 57 58 59 60 61 62 63 64 65 66 67 68 69

;;; Code:

(eval-when-compile
  (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))
70
;;  :version "22.2"
Dan Nicolaescu's avatar
Dan Nicolaescu committed
71 72 73 74
  :group 'vc)

;;; State querying functions

75 76 77 78 79 80 81 82
;;;###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
Dan Nicolaescu's avatar
Dan Nicolaescu committed
83
(defun vc-hg-registered (file)
84 85 86
  "Return non-nil if FILE is registered with hg."
  (if (vc-find-root file ".hg")       ; short cut
      (vc-hg-state file)))            ; expensive
Dan Nicolaescu's avatar
Dan Nicolaescu committed
87 88

(defun vc-hg-state (file)
89
  "Hg-specific version of `vc-state'."
90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113
  (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
	(let ((state (aref out 0)))
	  (cond
	   ((eq state ?M) 'edited)
	   ((eq state ?A) 'edited)
	   ((eq state ?P) 'needs-patch)
	   ((eq state ??) nil)
	   (t 'up-to-date)))))))
Dan Nicolaescu's avatar
Dan Nicolaescu committed
114 115

(defun vc-hg-workfile-version (file)
116
  "Hg-specific version of `vc-workfile-version'."
117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135
  (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"))))
Dan Nicolaescu's avatar
Dan Nicolaescu committed
136 137 138 139 140

;;; History functions

(defun vc-hg-print-log(file &optional buffer)
  "Get change log associated with FILE."
141 142 143 144 145 146 147 148 149 150 151 152 153
  ;; `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")))
Dan Nicolaescu's avatar
Dan Nicolaescu committed
154 155 156 157 158
  (vc-hg-command
   buffer
   (if (and (vc-stay-local-p file) (fboundp 'start-process)) 'async 0)
   file "log"))

159 160 161 162 163 164 165
(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.
166
  (set (make-local-variable 'log-view-file-re) "^File:[ \t]+\\(.+\\)")
167 168 169
  (set (make-local-variable 'log-view-message-re)
       "^changeset:[ \t]*\\([0-9]+\\):\\(.+\\)")
  (set (make-local-variable 'log-view-font-lock-keywords)
170
       (append
171
	log-view-font-lock-keywords
172 173 174 175 176 177 178 179 180 181
	;; 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))
182
	  ("^summary:[ \t]+\\(.+\\)" (1 'log-view-message))))))
183

Dan Nicolaescu's avatar
Dan Nicolaescu committed
184
(defun vc-hg-diff (file &optional oldvers newvers buffer)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
185
  "Get a difference report using hg between two versions of FILE."
Dan Nicolaescu's avatar
Dan Nicolaescu committed
186 187 188 189 190 191
  (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 'call-process "hg" nil (or buffer "*vc-diff*") nil
192 193
	   "--cwd" (file-name-directory file) "diff"
	   (append
Dan Nicolaescu's avatar
Dan Nicolaescu committed
194 195 196 197 198
	    (if oldvers
		(if newvers
		    (list "-r" oldvers "-r" newvers)
		  (list "-r" oldvers))
	      (list ""))
199
            (list (file-name-nondirectory file))))))
Dan Nicolaescu's avatar
Dan Nicolaescu committed
200 201 202 203 204 205 206 207 208 209 210

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


211 212 213
;; 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
Dan Nicolaescu's avatar
Dan Nicolaescu committed
214 215 216 217 218
(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))
219
    (vc-annotate-convert-time
Dan Nicolaescu's avatar
Dan Nicolaescu committed
220 221 222 223 224 225 226 227 228 229 230
     (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))))
Dan Nicolaescu's avatar
Dan Nicolaescu committed
231

232 233 234 235 236 237
(defun vc-hg-register (file &optional rev comment)
  "Register FILE under hg.
REV is ignored.
COMMENT is ignored."
  (vc-hg-command nil nil file "add"))

Dan Nicolaescu's avatar
Dan Nicolaescu committed
238 239 240 241 242
(defun vc-hg-checkin (file rev comment)
  "HG-specific version of `vc-backend-checkin'.
REV is ignored."
  (vc-hg-command nil nil file  "commit" "-m" comment))

243
;; Modelled after the similar function in vc-bzr.el
244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259
(defun vc-hg-checkout (file &optional editable rev workfile)
  "Retrieve a revision of FILE into a WORKFILE.
EDITABLE is ignored.
REV is the revision to check out into WORKFILE."
  (unless workfile
    (setq workfile (vc-version-backup-file-name file rev)))
  (let ((coding-system-for-read 'binary)
        (coding-system-for-write 'binary))
  (with-temp-file workfile
    (if rev
        (vc-hg-command t nil file "cat" "-r" rev)
      (vc-hg-command t nil file "cat")))))

(defun vc-hg-checkout-model (file)
  'implicit)

260 261 262 263 264
;; 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 nil file "revert"))))

Dan Nicolaescu's avatar
Dan Nicolaescu committed
265 266 267 268 269 270 271 272 273 274 275 276 277 278
;;; 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))))

(provide 'vc-hg)

279
;;; vc-hg.el ends here