Tom Tromey <tromey at redhat.com>
[emacs.git] / lisp / vc-git.el
blob19e5272618de45dc96aef11abe95efb91505bb88
1 ;;; vc-git.el --- VC backend for the git version control system
3 ;; Copyright (C) 2006, 2007, 2008 Free Software Foundation, Inc.
5 ;; Author: Alexandre Julliard <julliard@winehq.org>
6 ;; Keywords: tools
8 ;; This file is part of GNU Emacs.
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.
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.
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.
25 ;;; Commentary:
27 ;; This file contains a VC backend for the git version control
28 ;; system.
31 ;;; Installation:
33 ;; To install: put this file on the load-path and add Git to the list
34 ;; of supported backends in `vc-handled-backends'; the following line,
35 ;; placed in your ~/.emacs, will accomplish this:
37 ;; (add-to-list 'vc-handled-backends 'Git)
39 ;;; Todo:
40 ;; - check if more functions could use vc-git-command instead
41 ;; of start-process.
42 ;; - changelog generation
44 ;; Implement the rest of the vc interface. See the comment at the
45 ;; beginning of vc.el. The current status is:
46 ;; ("??" means: "figure out what to do about it")
48 ;; FUNCTION NAME STATUS
49 ;; BACKEND PROPERTIES
50 ;; * revision-granularity OK
51 ;; STATE-QUERYING FUNCTIONS
52 ;; * registered (file) OK
53 ;; * state (file) OK
54 ;; - state-heuristic (file) NOT NEEDED
55 ;; - dir-state (dir) OK
56 ;; * working-revision (file) OK
57 ;; - latest-on-branch-p (file) NOT NEEDED
58 ;; * checkout-model (file) OK
59 ;; - workfile-unchanged-p (file) OK
60 ;; - mode-line-string (file) OK
61 ;; - dired-state-info (file) OK
62 ;; STATE-CHANGING FUNCTIONS
63 ;; * create-repo () OK
64 ;; * register (files &optional rev comment) OK
65 ;; - init-revision (file) NOT NEEDED
66 ;; - responsible-p (file) OK
67 ;; - could-register (file) NOT NEEDED, DEFAULT IS GOOD
68 ;; - receive-file (file rev) NOT NEEDED
69 ;; - unregister (file) OK
70 ;; * checkin (files rev comment) OK
71 ;; * find-revision (file rev buffer) OK
72 ;; * checkout (file &optional editable rev) OK
73 ;; * revert (file &optional contents-done) OK
74 ;; - rollback (files) COULD BE SUPPORTED
75 ;; - merge (file rev1 rev2) It would be possible to merge changes into
76 ;; a single file, but when committing they
77 ;; wouldn't be identified as a merge by git,
78 ;; so it's probably not a good idea.
79 ;; - merge-news (file) see `merge'
80 ;; - steal-lock (file &optional revision) NOT NEEDED
81 ;; HISTORY FUNCTIONS
82 ;; * print-log (files &optional buffer) OK
83 ;; - log-view-mode () OK
84 ;; - show-log-entry (revision) OK
85 ;; - wash-log (file) COULD BE SUPPORTED
86 ;; - logentry-check () NOT NEEDED
87 ;; - comment-history (file) ??
88 ;; - update-changelog (files) COULD BE SUPPORTED
89 ;; * diff (file &optional rev1 rev2 buffer) OK
90 ;; - revision-completion-table (files) OK
91 ;; - annotate-command (file buf &optional rev) OK
92 ;; - annotate-time () OK
93 ;; - annotate-current-time () NOT NEEDED
94 ;; - annotate-extract-revision-at-line () OK
95 ;; SNAPSHOT SYSTEM
96 ;; - create-snapshot (dir name branchp) OK
97 ;; - assign-name (file name) NOT NEEDED
98 ;; - retrieve-snapshot (dir name update) OK, needs to update buffers
99 ;; MISCELLANEOUS
100 ;; - make-version-backups-p (file) NOT NEEDED
101 ;; - repository-hostname (dirname) NOT NEEDED
102 ;; - previous-revision (file rev) OK
103 ;; - next-revision (file rev) OK
104 ;; - check-headers () COULD BE SUPPORTED
105 ;; - clear-headers () NOT NEEDED
106 ;; - delete-file (file) OK
107 ;; - rename-file (old new) OK
108 ;; - find-file-hook () NOT NEEDED
109 ;; - find-file-not-found-hook () NOT NEEDED
111 (eval-when-compile
112 (require 'cl)
113 (require 'vc)
114 (require 'grep))
116 (defvar git-commits-coding-system 'utf-8
117 "Default coding system for git commits.")
119 ;;; BACKEND PROPERTIES
121 (defun vc-git-revision-granularity ()
122 'repository)
124 ;;; STATE-QUERYING FUNCTIONS
126 ;;;###autoload (defun vc-git-registered (file)
127 ;;;###autoload "Return non-nil if FILE is registered with git."
128 ;;;###autoload (if (vc-find-root file ".git") ; short cut
129 ;;;###autoload (progn
130 ;;;###autoload (load "vc-git")
131 ;;;###autoload (vc-git-registered file))))
133 (defun vc-git-registered (file)
134 "Check whether FILE is registered with git."
135 (when (vc-git-root file)
136 (with-temp-buffer
137 (let* ((dir (file-name-directory file))
138 (name (file-relative-name file dir)))
139 (and (ignore-errors
140 (when dir (cd dir))
141 (vc-git--out-ok "ls-files" "-c" "-z" "--" name))
142 (let ((str (buffer-string)))
143 (and (> (length str) (length name))
144 (string= (substring str 0 (1+ (length name)))
145 (concat name "\0")))))))))
147 (defun vc-git--state-code (code)
148 "Convert from a string to a added/deleted/modified state."
149 (case (string-to-char code)
150 (?M 'edited)
151 (?A 'added)
152 (?D 'removed)
153 (?U 'edited) ;; FIXME
154 (?T 'edited))) ;; FIXME
156 (defun vc-git-state (file)
157 "Git-specific version of `vc-state'."
158 ;; FIXME: This can't set 'ignored yet
159 (vc-git--call nil "add" "--refresh" "--" (file-relative-name file))
160 (let ((diff (vc-git--run-command-string file "diff-index" "-z" "HEAD" "--")))
161 (if (and diff (string-match ":[0-7]\\{6\\} [0-7]\\{6\\} [0-9a-f]\\{40\\} [0-9a-f]\\{40\\} \\([ADMUT]\\)\0[^\0]+\0"
162 diff))
163 (vc-git--state-code (match-string 1 diff))
164 (if (vc-git--empty-db-p) 'added 'up-to-date))))
166 (defun vc-git--ls-files-state (state &rest args)
167 "Set state to STATE on all files found with git-ls-files ARGS."
168 (with-temp-buffer
169 (apply 'vc-git-command (current-buffer) nil nil "ls-files" "-z" args)
170 (goto-char (point-min))
171 (let ((start (point)))
172 (while (search-forward "\0" nil t)
173 (let ((file (expand-file-name
174 (buffer-substring-no-properties start (1- (point))))))
175 (vc-file-setprop file 'vc-backend (if state 'Git 'none))
176 (vc-file-setprop file 'vc-state state))
177 (setq start (point))))))
179 (defun vc-git-dir-state (dir)
180 "Git-specific version of `dir-state'."
181 (vc-git--ls-files-state 'up-to-date "-c")
182 (vc-git--ls-files-state 'edited "-m")
183 (vc-git--ls-files-state 'removed "-d")
184 (vc-git--ls-files-state 'ignored "-o" "-i" "--exclude-standard")
185 (vc-git--ls-files-state nil "-o" "--exclude-standard"))
187 (defun vc-git-working-revision (file)
188 "Git-specific version of `vc-working-revision'."
189 (let ((str (with-output-to-string
190 (with-current-buffer standard-output
191 (vc-git--out-ok "symbolic-ref" "HEAD")))))
192 (if (string-match "^\\(refs/heads/\\)?\\(.+\\)$" str)
193 (match-string 2 str)
194 str)))
196 (defun vc-git-checkout-model (file)
197 'implicit)
199 (defun vc-git-workfile-unchanged-p (file)
200 (eq 'up-to-date (vc-git-state file)))
202 (defun vc-git-mode-line-string (file)
203 "Return string for placement into the modeline for FILE."
204 (let* ((branch (vc-git-working-revision file))
205 (def-ml (vc-default-mode-line-string 'Git file))
206 (help-echo (get-text-property 0 'help-echo def-ml)))
207 (if (zerop (length branch))
208 (propertize
209 (concat def-ml "!")
210 'help-echo (concat help-echo "\nNo current branch (detached HEAD)"))
211 (propertize def-ml
212 'help-echo (concat help-echo "\nCurrent branch: " branch)))))
214 (defstruct (vc-git-extra-fileinfo
215 (:copier nil)
216 (:constructor vc-git-create-extra-fileinfo (old-perm new-perm &optional rename-state orig-name))
217 (:conc-name vc-git-extra-fileinfo->))
218 old-perm new-perm ;; permission flags
219 rename-state ;; rename or copy state
220 orig-name) ;; original name for renames or copies
222 (defun vc-git-escape-file-name (name)
223 "Escape a file name if necessary."
224 (if (string-match "[\n\t\"\\]" name)
225 (concat "\""
226 (mapconcat (lambda (c)
227 (case c
228 (?\n "\\n")
229 (?\t "\\t")
230 (?\\ "\\\\")
231 (?\" "\\\"")
232 (t (char-to-string c))))
233 name "")
234 "\"")
235 name))
237 (defun vc-git-file-type-as-string (old-perm new-perm)
238 "Return a string describing the file type based on its permissions."
239 (let* ((old-type (lsh (or old-perm 0) -9))
240 (new-type (lsh (or new-perm 0) -9))
241 (str (case new-type
242 (?\100 ;; file
243 (case old-type
244 (?\100 nil)
245 (?\120 " (type change symlink -> file)")
246 (?\160 " (type change subproject -> file)")))
247 (?\120 ;; symlink
248 (case old-type
249 (?\100 " (type change file -> symlink)")
250 (?\160 " (type change subproject -> symlink)")
251 (t " (symlink)")))
252 (?\160 ;; subproject
253 (case old-type
254 (?\100 " (type change file -> subproject)")
255 (?\120 " (type change symlink -> subproject)")
256 (t " (subproject)")))
257 (?\110 nil) ;; directory (internal, not a real git state)
258 (?\000 ;; deleted or unknown
259 (case old-type
260 (?\120 " (symlink)")
261 (?\160 " (subproject)")))
262 (t (format " (unknown type %o)" new-type)))))
263 (cond (str (propertize str 'face 'font-lock-comment-face))
264 ((eq new-type ?\110) "/")
265 (t ""))))
267 (defun vc-git-rename-as-string (state extra)
268 "Return a string describing the copy or rename associated with INFO, or an empty string if none."
269 (let ((rename-state (when extra
270 (vc-git-extra-fileinfo->rename-state extra))))
271 (if rename-state
272 (propertize
273 (concat " ("
274 (if (eq rename-state 'copy) "copied from "
275 (if (eq state 'added) "renamed from "
276 "renamed to "))
277 (vc-git-escape-file-name (vc-git-extra-fileinfo->orig-name extra))
278 ")") 'face 'font-lock-comment-face)
279 "")))
281 (defun vc-git-permissions-as-string (old-perm new-perm)
282 "Format a permission change as string."
283 (propertize
284 (if (or (not old-perm)
285 (not new-perm)
286 (eq 0 (logand ?\111 (logxor old-perm new-perm))))
288 (if (eq 0 (logand ?\111 old-perm)) "+x" "-x"))
289 'face 'font-lock-type-face))
291 (defun vc-git-status-printer (info)
292 "Pretty-printer for the vc-dir-fileinfo structure."
293 (let* ((state (if (vc-dir-fileinfo->directory info)
294 'DIRECTORY
295 (vc-dir-fileinfo->state info)))
296 (extra (vc-dir-fileinfo->extra info))
297 (old-perm (when extra (vc-git-extra-fileinfo->old-perm extra)))
298 (new-perm (when extra (vc-git-extra-fileinfo->new-perm extra))))
299 (insert
301 (propertize (format "%c" (if (vc-dir-fileinfo->marked info) ?* ? ))
302 'face 'font-lock-type-face)
304 (propertize
305 (format "%-12s" state)
306 'face (cond ((eq state 'up-to-date) 'font-lock-builtin-face)
307 ((eq state 'missing) 'font-lock-warning-face)
308 (t 'font-lock-variable-name-face))
309 'mouse-face 'highlight)
310 " " (vc-git-permissions-as-string old-perm new-perm)
312 (propertize (vc-git-escape-file-name (vc-dir-fileinfo->name info))
313 'face 'font-lock-function-name-face
314 'mouse-face 'highlight)
315 (vc-git-file-type-as-string old-perm new-perm)
316 (vc-git-rename-as-string state extra))))
318 (defun vc-git-after-dir-status-stage (stage files update-function)
319 "Process sentinel for the various dir-status stages."
320 (let (remaining next-stage result)
321 (goto-char (point-min))
322 (case stage
323 ('update-index
324 (setq next-stage (if (vc-git--empty-db-p) 'ls-files-added
325 (if files 'ls-files-up-to-date 'diff-index))))
326 ('ls-files-added
327 (setq next-stage 'ls-files-unknown)
328 (while (re-search-forward "\\([0-7]\\{6\\}\\) [0-9a-f]\\{40\\} 0\t\\([^\0]+\\)\0" nil t)
329 (let ((new-perm (string-to-number (match-string 1) 8))
330 (name (match-string 2)))
331 (push (list name 'added (vc-git-create-extra-fileinfo 0 new-perm)) result))))
332 ('ls-files-up-to-date
333 (setq next-stage 'diff-index)
334 (while (re-search-forward "\\([0-7]\\{6\\}\\) [0-9a-f]\\{40\\} 0\t\\([^\0]+\\)\0" nil t)
335 (let ((perm (string-to-number (match-string 1) 8))
336 (name (match-string 2)))
337 (push (list name 'up-to-date (vc-git-create-extra-fileinfo perm perm)) result))))
338 ('ls-files-unknown
339 (when files (setq next-stage 'ls-files-ignored))
340 (while (re-search-forward "\\([^\0]*?\\)\0" nil t 1)
341 (push (list (match-string 1) 'unregistered (vc-git-create-extra-fileinfo 0 0)) result)))
342 ('ls-files-ignored
343 (while (re-search-forward "\\([^\0]*?\\)\0" nil t 1)
344 (push (list (match-string 1) 'ignored (vc-git-create-extra-fileinfo 0 0)) result)))
345 ('diff-index
346 (setq next-stage 'ls-files-unknown)
347 (while (re-search-forward
348 ":\\([0-7]\\{6\\}\\) \\([0-7]\\{6\\}\\) [0-9a-f]\\{40\\} [0-9a-f]\\{40\\} \\(\\([ADMUT]\\)\0\\([^\0]+\\)\\|\\([CR]\\)[0-9]*\0\\([^\0]+\\)\0\\([^\0]+\\)\\)\0"
349 nil t 1)
350 (let ((old-perm (string-to-number (match-string 1) 8))
351 (new-perm (string-to-number (match-string 2) 8))
352 (state (or (match-string 4) (match-string 6)))
353 (name (or (match-string 5) (match-string 7)))
354 (new-name (match-string 8)))
355 (if new-name ; copy or rename
356 (if (eq ?C (string-to-char state))
357 (push (list new-name 'added (vc-git-create-extra-fileinfo old-perm new-perm 'copy name)) result)
358 (push (list name 'removed (vc-git-create-extra-fileinfo 0 0 'rename new-name)) result)
359 (push (list new-name 'added (vc-git-create-extra-fileinfo old-perm new-perm 'rename name)) result))
360 (push (list name (vc-git--state-code state) (vc-git-create-extra-fileinfo old-perm new-perm)) result))))))
361 (when result
362 (setq result (nreverse result))
363 (when files
364 (dolist (entry result) (setq files (delete (car entry) files)))
365 (unless files (setq next-stage nil))))
366 (when (or result (not next-stage)) (funcall update-function result next-stage))
367 (when next-stage (vc-git-dir-status-goto-stage next-stage files update-function))))
369 (defun vc-git-dir-status-goto-stage (stage files update-function)
370 (erase-buffer)
371 (case stage
372 ('update-index
373 (if files
374 (vc-git-command (current-buffer) 'async files "add" "--refresh" "--")
375 (vc-git-command (current-buffer) 'async nil "update-index" "--refresh")))
376 ('ls-files-added
377 (vc-git-command (current-buffer) 'async files "ls-files" "-z" "-c" "-s" "--"))
378 ('ls-files-up-to-date
379 (vc-git-command (current-buffer) 'async files "ls-files" "-z" "-c" "-s" "--"))
380 ('ls-files-unknown
381 (vc-git-command (current-buffer) 'async files "ls-files" "-z" "-o"
382 "--directory" "--no-empty-directory" "--exclude-standard" "--"))
383 ('ls-files-ignored
384 (vc-git-command (current-buffer) 'async files "ls-files" "-z" "-o" "-i"
385 "--directory" "--no-empty-directory" "--exclude-standard" "--"))
386 ('diff-index
387 (vc-git-command (current-buffer) 'async files "diff-index" "-z" "-M" "HEAD" "--")))
388 (vc-exec-after
389 `(vc-git-after-dir-status-stage (quote ,stage) (quote ,files) (quote ,update-function))))
391 (defun vc-git-dir-status (dir update-function)
392 "Return a list of (FILE STATE EXTRA) entries for DIR."
393 ;; Further things that would have to be fixed later:
394 ;; - how to handle unregistered directories
395 ;; - how to support vc-dir on a subdir of the project tree
396 (vc-git-dir-status-goto-stage 'update-index nil update-function))
398 (defun vc-git-dir-status-files (dir files default-state update-function)
399 "Return a list of (FILE STATE EXTRA) entries for FILES in DIR."
400 (vc-git-dir-status-goto-stage 'update-index files update-function))
402 (defun vc-git-status-extra-headers (dir)
403 (let ((str (with-output-to-string
404 (with-current-buffer standard-output
405 (vc-git--out-ok "symbolic-ref" "HEAD")))))
406 (concat
407 (propertize "Branch : " 'face 'font-lock-type-face)
408 (propertize
409 (if (string-match "^\\(refs/heads/\\)?\\(.+\\)$" str)
410 (match-string 2 str)
411 "not (detached HEAD)")
412 'face 'font-lock-variable-name-face))))
414 ;;; STATE-CHANGING FUNCTIONS
416 (defun vc-git-create-repo ()
417 "Create a new Git repository."
418 (vc-git-command nil 0 nil "init"))
420 (defun vc-git-register (files &optional rev comment)
421 "Register FILE into the git version-control system."
422 (vc-git-command nil 0 files "update-index" "--add" "--"))
424 (defalias 'vc-git-responsible-p 'vc-git-root)
426 (defun vc-git-unregister (file)
427 (vc-git-command nil 0 file "rm" "-f" "--cached" "--"))
430 (defun vc-git-checkin (files rev comment)
431 (let ((coding-system-for-write git-commits-coding-system))
432 (vc-git-command nil 0 files "commit" "-m" comment "--only" "--")))
434 (defun vc-git-find-revision (file rev buffer)
435 (let ((coding-system-for-read 'binary)
436 (coding-system-for-write 'binary)
437 (fullname (substring
438 (vc-git--run-command-string
439 file "ls-files" "-z" "--full-name" "--")
440 0 -1)))
441 (vc-git-command
442 buffer 0
443 (concat (if rev rev "HEAD") ":" fullname) "cat-file" "blob")))
445 (defun vc-git-checkout (file &optional editable rev)
446 (vc-git-command nil 0 file "checkout" (or rev "HEAD")))
448 (defun vc-git-revert (file &optional contents-done)
449 "Revert FILE to the version stored in the git repository."
450 (if contents-done
451 (vc-git-command nil 0 file "update-index" "--")
452 (vc-git-command nil 0 file "checkout" "HEAD")))
454 ;;; HISTORY FUNCTIONS
456 (defun vc-git-print-log (files &optional buffer)
457 "Get change log associated with FILES."
458 (let ((coding-system-for-read git-commits-coding-system)
459 ;; Support both the old print-log interface that passes a
460 ;; single file, and the new one that passes a file list.
461 (flist (if (listp files) files (list files))))
462 ;; `vc-do-command' creates the buffer, but we need it before running
463 ;; the command.
464 (vc-setup-buffer buffer)
465 ;; If the buffer exists from a previous invocation it might be
466 ;; read-only.
467 (let ((inhibit-read-only t))
468 ;; XXX `log-view-mode' needs to have something to identify where
469 ;; the log for each individual file starts. It seems that by
470 ;; default git does not output this info. So loop here and call
471 ;; "git rev-list" on each file separately to make sure that each
472 ;; file gets a "File:" header before the corresponding
473 ;; log. Maybe there is a way to do this with one command...
474 (dolist (file flist)
475 (with-current-buffer
476 buffer
477 (insert "File: " (file-name-nondirectory file) "\n"))
478 (vc-git-command buffer 'async (file-relative-name file)
479 "rev-list" "--pretty" "HEAD" "--")))))
481 (defvar log-view-message-re)
482 (defvar log-view-file-re)
483 (defvar log-view-font-lock-keywords)
485 (define-derived-mode vc-git-log-view-mode log-view-mode "Git-Log-View"
486 (require 'add-log) ;; we need the faces add-log
487 ;; Don't have file markers, so use impossible regexp.
488 (set (make-local-variable 'log-view-file-re) "^File:[ \t]+\\(.+\\)")
489 (set (make-local-variable 'log-view-message-re)
490 "^commit *\\([0-9a-z]+\\)")
491 (set (make-local-variable 'log-view-font-lock-keywords)
492 (append
493 `((,log-view-message-re (1 'change-log-acknowledgement))
494 (,log-view-file-re (1 'change-log-file-face)))
495 ;; Handle the case:
496 ;; user: foo@bar
497 '(("^Author:[ \t]+\\([A-Za-z0-9_.+-]+@[A-Za-z0-9_.-]+\\)"
498 (1 'change-log-email))
499 ;; Handle the case:
500 ;; user: FirstName LastName <foo@bar>
501 ("^Author:[ \t]+\\([^<(]+?\\)[ \t]*[(<]\\([A-Za-z0-9_.+-]+@[A-Za-z0-9_.-]+\\)[>)]"
502 (1 'change-log-name)
503 (2 'change-log-email))
504 ("^ +\\(?:\\(?:[Aa]cked\\|[Ss]igned-[Oo]ff\\)-[Bb]y:\\)[ \t]+\\([A-Za-z0-9_.+-]+@[A-Za-z0-9_.-]+\\)"
505 (1 'change-log-name))
506 ("^ +\\(?:\\(?:[Aa]cked\\|[Ss]igned-[Oo]ff\\)-[Bb]y:\\)[ \t]+\\([^<(]+?\\)[ \t]*[(<]\\([A-Za-z0-9_.+-]+@[A-Za-z0-9_.-]+\\)[>)]"
507 (1 'change-log-name)
508 (2 'change-log-email))
509 ("^Merge: \\([0-9a-z]+\\) \\([0-9a-z]+\\)"
510 (1 'change-log-acknowledgement)
511 (2 'change-log-acknowledgement))
512 ("^Date: \\(.+\\)" (1 'change-log-date))
513 ("^summary:[ \t]+\\(.+\\)" (1 'log-view-message))))))
515 (defun vc-git-show-log-entry (revision)
516 "Move to the log entry for REVISION.
517 REVISION may have the form BRANCH, BRANCH~N,
518 or BRANCH^ (where \"^\" can be repeated)."
519 (goto-char (point-min))
520 (search-forward "\ncommit" nil t
521 (cond ((string-match "~\\([0-9]\\)$" revision)
522 (1+ (string-to-number (match-string 1 revision))))
523 ((string-match "\\^+$" revision)
524 (1+ (length (match-string 0 revision))))
525 (t nil)))
526 (beginning-of-line))
528 (defun vc-git-diff (files &optional rev1 rev2 buffer)
529 (let ((buf (or buffer "*vc-diff*")))
530 (if (and rev1 rev2)
531 (vc-git-command buf 1 files "diff-tree" "--exit-code" "-p"
532 rev1 rev2 "--")
533 (vc-git-command buf 1 files "diff-index" "--exit-code" "-p"
534 (or rev1 "HEAD") "--"))))
536 (defun vc-git-revision-table (files)
537 ;; What about `files'?!? --Stef
538 (let ((table (list "HEAD")))
539 (with-temp-buffer
540 (vc-git-command t nil nil "for-each-ref" "--format=%(refname)")
541 (goto-char (point-min))
542 (while (re-search-forward "^refs/\\(heads\\|tags\\)/\\(.*\\)$" nil t)
543 (push (match-string 2) table)))
544 table))
546 (defun vc-git-revision-completion-table (files)
547 (lexical-let ((files files)
548 table)
549 (setq table (lazy-completion-table
550 table (lambda () (vc-git-revision-table files))))
551 table))
553 (defun vc-git-annotate-command (file buf &optional rev)
554 ;; FIXME: rev is ignored
555 (let ((name (file-relative-name file)))
556 (vc-git-command buf 0 name "blame" (if rev (concat "-r" rev)))))
558 (defun vc-git-annotate-time ()
559 (and (re-search-forward "[0-9a-f]+[^()]+(.* \\([0-9]+\\)-\\([0-9]+\\)-\\([0-9]+\\) \\([0-9]+\\):\\([0-9]+\\):\\([0-9]+\\) \\([-+0-9]+\\) +[0-9]+) " nil t)
560 (vc-annotate-convert-time
561 (apply #'encode-time (mapcar (lambda (match)
562 (string-to-number (match-string match)))
563 '(6 5 4 3 2 1 7))))))
565 (defun vc-git-annotate-extract-revision-at-line ()
566 (save-excursion
567 (move-beginning-of-line 1)
568 (and (looking-at "[0-9a-f^][0-9a-f]+")
569 (buffer-substring-no-properties (match-beginning 0) (match-end 0)))))
571 ;;; SNAPSHOT SYSTEM
573 (defun vc-git-create-snapshot (dir name branchp)
574 (let ((default-directory dir))
575 (and (vc-git-command nil 0 nil "update-index" "--refresh")
576 (if branchp
577 (vc-git-command nil 0 nil "checkout" "-b" name)
578 (vc-git-command nil 0 nil "tag" name)))))
580 (defun vc-git-retrieve-snapshot (dir name update)
581 (let ((default-directory dir))
582 (vc-git-command nil 0 nil "checkout" name)
583 ;; FIXME: update buffers if `update' is true
587 ;;; MISCELLANEOUS
589 (defun vc-git-previous-revision (file rev)
590 "Git-specific version of `vc-previous-revision'."
591 (let ((default-directory (file-name-directory (expand-file-name file)))
592 (file (file-name-nondirectory file)))
593 (vc-git-symbolic-commit
594 (with-temp-buffer
595 (and
596 (vc-git--out-ok "rev-list" "-2" rev "--" file)
597 (goto-char (point-max))
598 (bolp)
599 (zerop (forward-line -1))
600 (not (bobp))
601 (buffer-substring-no-properties
602 (point)
603 (1- (point-max))))))))
605 (defun vc-git-next-revision (file rev)
606 "Git-specific version of `vc-next-revision'."
607 (let* ((default-directory (file-name-directory
608 (expand-file-name file)))
609 (file (file-name-nondirectory file))
610 (current-rev
611 (with-temp-buffer
612 (and
613 (vc-git--out-ok "rev-list" "-1" rev "--" file)
614 (goto-char (point-max))
615 (bolp)
616 (zerop (forward-line -1))
617 (bobp)
618 (buffer-substring-no-properties
619 (point)
620 (1- (point-max)))))))
621 (and current-rev
622 (vc-git-symbolic-commit
623 (with-temp-buffer
624 (and
625 (vc-git--out-ok "rev-list" "HEAD" "--" file)
626 (goto-char (point-min))
627 (search-forward current-rev nil t)
628 (zerop (forward-line -1))
629 (buffer-substring-no-properties
630 (point)
631 (progn (forward-line 1) (1- (point))))))))))
633 (defun vc-git-delete-file (file)
634 (vc-git-command nil 0 file "rm" "-f" "--"))
636 (defun vc-git-rename-file (old new)
637 (vc-git-command nil 0 (list old new) "mv" "-f" "--"))
639 (defvar vc-git-extra-menu-map
640 (let ((map (make-sparse-keymap)))
641 (define-key map [git-grep]
642 '(menu-item "Git grep..." vc-git-grep
643 :help "Run the `git grep' command"))
644 map))
646 (defun vc-git-extra-menu () vc-git-extra-menu-map)
648 (defun vc-git-extra-status-menu () vc-git-extra-menu-map)
650 ;; Derived from `lgrep'.
651 (defun vc-git-grep (regexp &optional files dir)
652 "Run git grep, searching for REGEXP in FILES in directory DIR.
653 The search is limited to file names matching shell pattern FILES.
654 FILES may use abbreviations defined in `grep-files-aliases', e.g.
655 entering `ch' is equivalent to `*.[ch]'.
657 With \\[universal-argument] prefix, you can edit the constructed shell command line
658 before it is executed.
659 With two \\[universal-argument] prefixes, directly edit and run `grep-command'.
661 Collect output in a buffer. While git grep runs asynchronously, you
662 can use \\[next-error] (M-x next-error), or \\<grep-mode-map>\\[compile-goto-error] \
663 in the grep output buffer,
664 to go to the lines where grep found matches.
666 This command shares argument histories with \\[rgrep] and \\[grep]."
667 (interactive
668 (progn
669 (grep-compute-defaults)
670 (cond
671 ((equal current-prefix-arg '(16))
672 (list (read-from-minibuffer "Run: " "git grep"
673 nil nil 'grep-history)
674 nil))
675 (t (let* ((regexp (grep-read-regexp))
676 (files (grep-read-files regexp))
677 (dir (read-directory-name "In directory: "
678 nil default-directory t)))
679 (list regexp files dir))))))
680 (require 'grep)
681 (when (and (stringp regexp) (> (length regexp) 0))
682 (let ((command regexp))
683 (if (null files)
684 (if (string= command "git grep")
685 (setq command nil))
686 (setq dir (file-name-as-directory (expand-file-name dir)))
687 (setq command
688 (grep-expand-template "git grep -n -e <R> -- <F>" regexp files))
689 (when command
690 (if (equal current-prefix-arg '(4))
691 (setq command
692 (read-from-minibuffer "Confirm: "
693 command nil nil 'grep-history))
694 (add-to-history 'grep-history command))))
695 (when command
696 (let ((default-directory dir)
697 (compilation-environment '("PAGER=")))
698 ;; Setting process-setup-function makes exit-message-function work
699 ;; even when async processes aren't supported.
700 (compilation-start command 'grep-mode))
701 (if (eq next-error-last-buffer (current-buffer))
702 (setq default-directory dir))))))
704 ;;; Internal commands
706 (defun vc-git-root (file)
707 (vc-find-root file ".git"))
709 (defun vc-git-command (buffer okstatus file-or-list &rest flags)
710 "A wrapper around `vc-do-command' for use in vc-git.el.
711 The difference to vc-do-command is that this function always invokes `git'."
712 (apply 'vc-do-command buffer okstatus "git" file-or-list flags))
714 (defun vc-git--empty-db-p ()
715 "Check if the git db is empty (no commit done yet)."
716 (not (eq 0 (vc-git--call nil "rev-parse" "--verify" "HEAD"))))
718 (defun vc-git--call (buffer command &rest args)
719 ;; We don't need to care the arguments. If there is a file name, it
720 ;; is always a relative one. This works also for remote
721 ;; directories.
722 (apply 'process-file "git" nil buffer nil command args))
724 (defun vc-git--out-ok (command &rest args)
725 (zerop (apply 'vc-git--call '(t nil) command args)))
727 (defun vc-git--run-command-string (file &rest args)
728 "Run a git command on FILE and return its output as string."
729 (let* ((ok t)
730 (str (with-output-to-string
731 (with-current-buffer standard-output
732 (unless (apply 'vc-git--out-ok
733 (append args (list (file-relative-name
734 file))))
735 (setq ok nil))))))
736 (and ok str)))
738 (defun vc-git-symbolic-commit (commit)
739 "Translate COMMIT string into symbolic form.
740 Returns nil if not possible."
741 (and commit
742 (with-temp-buffer
743 (and
744 (vc-git--out-ok "name-rev" "--name-only" "--tags" commit)
745 (goto-char (point-min))
746 (= (forward-line 2) 1)
747 (bolp)
748 (buffer-substring-no-properties (point-min) (1- (point-max)))))))
750 (provide 'vc-git)
752 ;; arch-tag: bd10664a-0e5b-48f5-a877-6c17b135be12
753 ;;; vc-git.el ends here