1 ;;; vc-git.el --- VC backend for the git version control system
3 ;; Copyright (C) 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
5 ;; Author: Alexandre Julliard <julliard@winehq.org>
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 of the License, or
13 ;; (at your option) 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. If not, see <http://www.gnu.org/licenses/>.
25 ;; This file contains a VC backend for the git version control
31 ;; To install: put this file on the load-path and add Git to the list
32 ;; of supported backends in `vc-handled-backends'; the following line,
33 ;; placed in your ~/.emacs, will accomplish this:
35 ;; (add-to-list 'vc-handled-backends 'Git)
38 ;; - check if more functions could use vc-git-command instead
40 ;; - changelog generation
42 ;; Implement the rest of the vc interface. See the comment at the
43 ;; beginning of vc.el. The current status is:
44 ;; ("??" means: "figure out what to do about it")
46 ;; FUNCTION NAME STATUS
48 ;; * revision-granularity OK
49 ;; STATE-QUERYING FUNCTIONS
50 ;; * registered (file) OK
52 ;; - state-heuristic (file) NOT NEEDED
53 ;; * working-revision (file) OK
54 ;; - latest-on-branch-p (file) NOT NEEDED
55 ;; * checkout-model (files) OK
56 ;; - workfile-unchanged-p (file) OK
57 ;; - mode-line-string (file) OK
58 ;; STATE-CHANGING FUNCTIONS
59 ;; * create-repo () OK
60 ;; * register (files &optional rev comment) OK
61 ;; - init-revision (file) NOT NEEDED
62 ;; - responsible-p (file) OK
63 ;; - could-register (file) NOT NEEDED, DEFAULT IS GOOD
64 ;; - receive-file (file rev) NOT NEEDED
65 ;; - unregister (file) OK
66 ;; * checkin (files rev comment) OK
67 ;; * find-revision (file rev buffer) OK
68 ;; * checkout (file &optional editable rev) OK
69 ;; * revert (file &optional contents-done) OK
70 ;; - rollback (files) COULD BE SUPPORTED
71 ;; - merge (file rev1 rev2) It would be possible to merge
72 ;; changes into a single file, but
73 ;; when committing they wouldn't
74 ;; be identified as a merge
75 ;; by git, so it's probably
77 ;; - merge-news (file) see `merge'
78 ;; - steal-lock (file &optional revision) NOT NEEDED
80 ;; * print-log (files buffer &optional shortlog start-revision limit) OK
81 ;; - log-view-mode () OK
82 ;; - show-log-entry (revision) OK
83 ;; - comment-history (file) ??
84 ;; - update-changelog (files) COULD BE SUPPORTED
85 ;; * diff (file &optional rev1 rev2 buffer) OK
86 ;; - revision-completion-table (files) OK
87 ;; - annotate-command (file buf &optional rev) OK
88 ;; - annotate-time () OK
89 ;; - annotate-current-time () NOT NEEDED
90 ;; - annotate-extract-revision-at-line () OK
92 ;; - create-tag (dir name branchp) OK
93 ;; - retrieve-tag (dir name update) OK
95 ;; - make-version-backups-p (file) NOT NEEDED
96 ;; - repository-hostname (dirname) NOT NEEDED
97 ;; - previous-revision (file rev) OK
98 ;; - next-revision (file rev) OK
99 ;; - check-headers () COULD BE SUPPORTED
100 ;; - clear-headers () NOT NEEDED
101 ;; - delete-file (file) OK
102 ;; - rename-file (old new) OK
103 ;; - find-file-hook () NOT NEEDED
111 (defcustom vc-git-diff-switches t
112 "String or list of strings specifying switches for Git diff under VC.
113 If nil, use the value of `vc-diff-switches'. If t, use no switches."
114 :type
'(choice (const :tag
"Unspecified" nil
)
115 (const :tag
"None" t
)
116 (string :tag
"Argument String")
117 (repeat :tag
"Argument List" :value
("") string
))
121 (defvar git-commits-coding-system
'utf-8
122 "Default coding system for git commits.")
124 ;;; BACKEND PROPERTIES
126 (defun vc-git-revision-granularity () 'repository
)
127 (defun vc-git-checkout-model (files) 'implicit
)
129 ;;; STATE-QUERYING FUNCTIONS
131 ;;;###autoload (defun vc-git-registered (file)
132 ;;;###autoload "Return non-nil if FILE is registered with git."
133 ;;;###autoload (if (vc-find-root file ".git") ; Short cut.
134 ;;;###autoload (progn
135 ;;;###autoload (load "vc-git")
136 ;;;###autoload (vc-git-registered file))))
138 (defun vc-git-registered (file)
139 "Check whether FILE is registered with git."
140 (let ((dir (vc-git-root file
)))
143 (let* (process-file-side-effects
144 ;; Do not use the `file-name-directory' here: git-ls-files
145 ;; sometimes fails to return the correct status for relative
147 ;; See also: http://marc.info/?l=git&m=125787684318129&w=2
148 (name (file-relative-name file dir
))
151 (vc-git--out-ok "ls-files" "-c" "-z" "--" name
)
152 ;; If result is empty, use ls-tree to check for deleted
154 (when (eq (point-min) (point-max))
155 (vc-git--out-ok "ls-tree" "--name-only" "-z" "HEAD"
159 (> (length str
) (length name
))
160 (string= (substring str
0 (1+ (length name
)))
161 (concat name
"\0"))))))))
163 (defun vc-git--state-code (code)
164 "Convert from a string to a added/deleted/modified state."
165 (case (string-to-char code
)
169 (?U
'edited
) ;; FIXME
170 (?T
'edited
))) ;; FIXME
172 (defun vc-git-state (file)
173 "Git-specific version of `vc-state'."
174 ;; FIXME: This can't set 'ignored yet
175 (if (not (vc-git-registered file
))
177 (vc-git--call nil
"add" "--refresh" "--" (file-relative-name file
))
178 (let ((diff (vc-git--run-command-string
179 file
"diff-index" "-z" "HEAD" "--")))
180 (if (and diff
(string-match ":[0-7]\\{6\\} [0-7]\\{6\\} [0-9a-f]\\{40\\} [0-9a-f]\\{40\\} \\([ADMUT]\\)\0[^\0]+\0"
182 (vc-git--state-code (match-string 1 diff
))
183 (if (vc-git--empty-db-p) 'added
'up-to-date
)))))
185 (defun vc-git-working-revision (file)
186 "Git-specific version of `vc-working-revision'."
187 (let* (process-file-side-effects
188 (str (with-output-to-string
189 (with-current-buffer standard-output
190 (vc-git--out-ok "symbolic-ref" "HEAD")))))
191 (if (string-match "^\\(refs/heads/\\)?\\(.+\\)$" str
)
195 (defun vc-git-workfile-unchanged-p (file)
196 (eq 'up-to-date
(vc-git-state file
)))
198 (defun vc-git-mode-line-string (file)
199 "Return string for placement into the modeline for FILE."
200 (let* ((branch (vc-git-working-revision file
))
201 (def-ml (vc-default-mode-line-string 'Git file
))
202 (help-echo (get-text-property 0 'help-echo def-ml
)))
203 (if (zerop (length branch
))
206 'help-echo
(concat help-echo
"\nNo current branch (detached HEAD)"))
208 'help-echo
(concat help-echo
"\nCurrent branch: " branch
)))))
210 (defstruct (vc-git-extra-fileinfo
212 (:constructor vc-git-create-extra-fileinfo
213 (old-perm new-perm
&optional rename-state orig-name
))
214 (:conc-name vc-git-extra-fileinfo-
>))
215 old-perm new-perm
;; Permission flags.
216 rename-state
;; Rename or copy state.
217 orig-name
) ;; Original name for renames or copies.
219 (defun vc-git-escape-file-name (name)
220 "Escape a file name if necessary."
221 (if (string-match "[\n\t\"\\]" name
)
223 (mapconcat (lambda (c)
229 (t (char-to-string c
))))
234 (defun vc-git-file-type-as-string (old-perm new-perm
)
235 "Return a string describing the file type based on its permissions."
236 (let* ((old-type (lsh (or old-perm
0) -
9))
237 (new-type (lsh (or new-perm
0) -
9))
242 (?
\120 " (type change symlink -> file)")
243 (?
\160 " (type change subproject -> file)")))
246 (?
\100 " (type change file -> symlink)")
247 (?
\160 " (type change subproject -> symlink)")
249 (?
\160 ;; Subproject.
251 (?
\100 " (type change file -> subproject)")
252 (?
\120 " (type change symlink -> subproject)")
253 (t " (subproject)")))
254 (?
\110 nil
) ;; Directory (internal, not a real git state).
255 (?
\000 ;; Deleted or unknown.
258 (?
\160 " (subproject)")))
259 (t (format " (unknown type %o)" new-type
)))))
260 (cond (str (propertize str
'face
'font-lock-comment-face
))
261 ((eq new-type ?
\110) "/")
264 (defun vc-git-rename-as-string (state extra
)
265 "Return a string describing the copy or rename associated with INFO,
266 or an empty string if none."
267 (let ((rename-state (when extra
268 (vc-git-extra-fileinfo->rename-state extra
))))
272 (if (eq rename-state
'copy
) "copied from "
273 (if (eq state
'added
) "renamed from "
275 (vc-git-escape-file-name
276 (vc-git-extra-fileinfo->orig-name extra
))
278 'face
'font-lock-comment-face
)
281 (defun vc-git-permissions-as-string (old-perm new-perm
)
282 "Format a permission change as string."
284 (if (or (not old-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-dir-printer (info)
292 "Pretty-printer for the vc-dir-fileinfo structure."
293 (let* ((isdir (vc-dir-fileinfo->directory info
))
294 (state (if isdir
"" (vc-dir-fileinfo->state info
)))
295 (extra (vc-dir-fileinfo->extra info
))
296 (old-perm (when extra
(vc-git-extra-fileinfo->old-perm extra
)))
297 (new-perm (when extra
(vc-git-extra-fileinfo->new-perm extra
))))
300 (propertize (format "%c" (if (vc-dir-fileinfo->marked info
) ?
* ?
))
301 'face
'font-lock-type-face
)
304 (format "%-12s" state
)
305 'face
(cond ((eq state
'up-to-date
) 'font-lock-builtin-face
)
306 ((eq state
'missing
) 'font-lock-warning-face
)
307 (t 'font-lock-variable-name-face
))
308 'mouse-face
'highlight
)
309 " " (vc-git-permissions-as-string old-perm new-perm
)
311 (propertize (vc-git-escape-file-name (vc-dir-fileinfo->name info
))
312 'face
(if isdir
'font-lock-comment-delimiter-face
313 'font-lock-function-name-face
)
316 "Directory\nVC operations can be applied to it\nmouse-3: Pop-up menu"
317 "File\nmouse-3: Pop-up menu")
318 'keymap vc-dir-filename-mouse-map
319 'mouse-face
'highlight
)
320 (vc-git-file-type-as-string old-perm new-perm
)
321 (vc-git-rename-as-string state extra
))))
323 (defun vc-git-after-dir-status-stage (stage files update-function
)
324 "Process sentinel for the various dir-status stages."
325 (let (next-stage result
)
326 (goto-char (point-min))
329 (setq next-stage
(if (vc-git--empty-db-p) 'ls-files-added
330 (if files
'ls-files-up-to-date
'diff-index
))))
332 (setq next-stage
'ls-files-unknown
)
333 (while (re-search-forward "\\([0-7]\\{6\\}\\) [0-9a-f]\\{40\\} 0\t\\([^\0]+\\)\0" nil t
)
334 (let ((new-perm (string-to-number (match-string 1) 8))
335 (name (match-string 2)))
336 (push (list name
'added
(vc-git-create-extra-fileinfo 0 new-perm
))
339 (setq next-stage
'diff-index
)
340 (while (re-search-forward "\\([0-7]\\{6\\}\\) [0-9a-f]\\{40\\} 0\t\\([^\0]+\\)\0" nil t
)
341 (let ((perm (string-to-number (match-string 1) 8))
342 (name (match-string 2)))
343 (push (list name
'up-to-date
344 (vc-git-create-extra-fileinfo perm perm
))
347 (when files
(setq next-stage
'ls-files-ignored
))
348 (while (re-search-forward "\\([^\0]*?\\)\0" nil t
1)
349 (push (list (match-string 1) 'unregistered
350 (vc-git-create-extra-fileinfo 0 0))
353 (while (re-search-forward "\\([^\0]*?\\)\0" nil t
1)
354 (push (list (match-string 1) 'ignored
355 (vc-git-create-extra-fileinfo 0 0))
358 (setq next-stage
'ls-files-unknown
)
359 (while (re-search-forward
360 ":\\([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"
362 (let ((old-perm (string-to-number (match-string 1) 8))
363 (new-perm (string-to-number (match-string 2) 8))
364 (state (or (match-string 4) (match-string 6)))
365 (name (or (match-string 5) (match-string 7)))
366 (new-name (match-string 8)))
367 (if new-name
; Copy or rename.
368 (if (eq ?C
(string-to-char state
))
369 (push (list new-name
'added
370 (vc-git-create-extra-fileinfo old-perm new-perm
373 (push (list name
'removed
374 (vc-git-create-extra-fileinfo 0 0
377 (push (list new-name
'added
378 (vc-git-create-extra-fileinfo old-perm new-perm
381 (push (list name
(vc-git--state-code state
)
382 (vc-git-create-extra-fileinfo old-perm new-perm
))
385 (setq result
(nreverse result
))
387 (dolist (entry result
) (setq files
(delete (car entry
) files
)))
388 (unless files
(setq next-stage nil
))))
389 (when (or result
(not next-stage
))
390 (funcall update-function result next-stage
))
392 (vc-git-dir-status-goto-stage next-stage files update-function
))))
394 (defun vc-git-dir-status-goto-stage (stage files update-function
)
399 (vc-git-command (current-buffer) 'async files
"add" "--refresh" "--")
400 (vc-git-command (current-buffer) 'async nil
401 "update-index" "--refresh")))
403 (vc-git-command (current-buffer) 'async files
404 "ls-files" "-z" "-c" "-s" "--"))
406 (vc-git-command (current-buffer) 'async files
407 "ls-files" "-z" "-c" "-s" "--"))
409 (vc-git-command (current-buffer) 'async files
410 "ls-files" "-z" "-o" "--directory"
411 "--no-empty-directory" "--exclude-standard" "--"))
413 (vc-git-command (current-buffer) 'async files
414 "ls-files" "-z" "-o" "-i" "--directory"
415 "--no-empty-directory" "--exclude-standard" "--"))
417 (vc-git-command (current-buffer) 'async files
418 "diff-index" "--relative" "-z" "-M" "HEAD" "--")))
420 `(vc-git-after-dir-status-stage ',stage
',files
',update-function
)))
422 (defun vc-git-dir-status (dir update-function
)
423 "Return a list of (FILE STATE EXTRA) entries for DIR."
424 ;; Further things that would have to be fixed later:
425 ;; - how to handle unregistered directories
426 ;; - how to support vc-dir on a subdir of the project tree
427 (vc-git-dir-status-goto-stage 'update-index nil update-function
))
429 (defun vc-git-dir-status-files (dir files default-state update-function
)
430 "Return a list of (FILE STATE EXTRA) entries for FILES in DIR."
431 (vc-git-dir-status-goto-stage 'update-index files update-function
))
433 (defvar vc-git-stash-map
434 (let ((map (make-sparse-keymap)))
435 ;; Turn off vc-dir marking
436 (define-key map
[mouse-2
] 'ignore
)
438 (define-key map
[down-mouse-3
] 'vc-git-stash-menu
)
439 (define-key map
"\C-k" 'vc-git-stash-delete-at-point
)
440 (define-key map
"=" 'vc-git-stash-show-at-point
)
441 (define-key map
"\C-m" 'vc-git-stash-show-at-point
)
442 (define-key map
"A" 'vc-git-stash-apply-at-point
)
443 (define-key map
"P" 'vc-git-stash-pop-at-point
)
444 (define-key map
"S" 'vc-git-stash-snapshot
)
447 (defvar vc-git-stash-menu-map
448 (let ((map (make-sparse-keymap "Git Stash")))
450 '(menu-item "Delete stash" vc-git-stash-delete-at-point
451 :help "Delete the current stash"))
453 '(menu-item "Apply stash" vc-git-stash-apply-at-point
454 :help "Apply the current stash and keep it in the stash list"))
456 '(menu-item "Apply and remove stash (pop)" vc-git-stash-pop-at-point
457 :help "Apply the current stash and remove it"))
459 '(menu-item "Show stash" vc-git-stash-show-at-point
460 :help "Show the contents of the current stash"))
463 (defun vc-git-dir-extra-headers (dir)
464 (let ((str (with-output-to-string
465 (with-current-buffer standard-output
466 (vc-git--out-ok "symbolic-ref" "HEAD"))))
467 (stash (vc-git-stash-list))
468 (stash-help-echo "Use M-x vc-git-stash to create stashes.")
469 branch remote remote-url)
470 (if (string-match "^\\(refs/heads/\\)?\\(.+\\)$" str)
472 (setq branch (match-string 2 str))
474 (with-output-to-string
475 (with-current-buffer standard-output
476 (vc-git--out-ok "config"
477 (concat "branch." branch ".remote")))))
478 (when (string-match "\\([^\n]+\\)" remote)
479 (setq remote (match-string 1 remote)))
482 (with-output-to-string
483 (with-current-buffer standard-output
484 (vc-git--out-ok "config"
485 (concat "remote." remote ".url"))))))
486 (when (string-match "\\([^\n]+\\)" remote-url)
487 (setq remote-url (match-string 1 remote-url))))
488 (setq branch "not (detached HEAD)"))
489 ;; FIXME: maybe use a different face when nothing is stashed.
491 (propertize "Branch : " 'face 'font-lock-type-face)
493 'face 'font-lock-variable-name-face)
497 (propertize "Remote : " 'face 'font-lock-type-face)
498 (propertize remote-url
499 'face 'font-lock-variable-name-face)))
503 (propertize "Stash :\n" 'face 'font-lock-type-face
504 'help-echo stash-help-echo)
508 'face 'font-lock-variable-name-face
509 'mouse-face 'highlight
510 'help-echo "mouse-3: Show stash menu\nRET: Show stash\nA: Apply stash\nP: Apply and remove stash (pop)\nC-k: Delete stash"
511 'keymap vc-git-stash-map))
514 (propertize "Stash : " 'face 'font-lock-type-face
515 'help-echo stash-help-echo)
516 (propertize "Nothing stashed"
517 'help-echo stash-help-echo
518 'face 'font-lock-variable-name-face))))))
520 ;;; STATE-CHANGING FUNCTIONS
522 (defun vc-git-create-repo ()
523 "Create a new Git repository."
524 (vc-git-command nil 0 nil "init"))
526 (defun vc-git-register (files &optional rev comment)
527 "Register FILES into the git version-control system."
530 (if (file-directory-p crt)
534 (vc-git-command nil 0 flist "update-index" "--add" "--"))
536 (vc-git-command nil 0 dlist "add"))))
538 (defalias 'vc-git-responsible-p 'vc-git-root)
540 (defun vc-git-unregister (file)
541 (vc-git-command nil 0 file "rm" "-f" "--cached" "--"))
544 (defun vc-git-checkin (files rev comment &optional extra-args-ignored)
545 (let ((coding-system-for-write git-commits-coding-system))
546 (vc-git-command nil 0 files "commit"
547 "-m" comment "--only" "--")))
549 (defun vc-git-find-revision (file rev buffer)
550 (let* (process-file-side-effects
551 (coding-system-for-read 'binary)
552 (coding-system-for-write 'binary)
554 (vc-git--run-command-string
555 file "ls-files" "-z" "--full-name" "--")
559 (concat (if rev rev "HEAD") ":" fullname) "cat-file" "blob")))
561 (defun vc-git-checkout (file &optional editable rev)
562 (vc-git-command nil 0 file "checkout" (or rev "HEAD")))
564 (defun vc-git-revert (file &optional contents-done)
565 "Revert FILE to the version stored in the git repository."
567 (vc-git-command nil 0 file "update-index" "--")
568 (vc-git-command nil 0 file "reset" "-q" "--")
569 (vc-git-command nil nil file "checkout" "-q" "--")))
571 ;;; HISTORY FUNCTIONS
573 (defun vc-git-print-log (files buffer &optional shortlog start-revision limit)
574 "Get change log associated with FILES."
575 (let ((coding-system-for-read git-commits-coding-system))
576 ;; `vc-do-command' creates the buffer, but we need it before running
578 (vc-setup-buffer buffer)
579 ;; If the buffer exists from a previous invocation it might be
581 (let ((inhibit-read-only t))
584 (apply 'vc-git-command buffer
587 '("log" "--no-color")
589 '("--graph" "--decorate" "--date=short"
590 "--pretty=tformat:%d%h %ad %s" "--abbrev-commit"))
591 (when limit (list "-n" (format "%s" limit)))
592 (when start-revision (list start-revision))
595 (defvar log-view-message-re)
596 (defvar log-view-file-re)
597 (defvar log-view-font-lock-keywords)
598 (defvar log-view-per-file-logs)
600 ;; Dynamically bound.
601 (defvar vc-short-log)
603 (define-derived-mode vc-git-log-view-mode log-view-mode "Git-Log-View"
604 (require 'add-log) ;; We need the faces add-log.
605 ;; Don't have file markers, so use impossible regexp.
606 (set (make-local-variable 'log-view-file-re) "\\`a\\`")
607 (set (make-local-variable 'log-view-per-file-logs) nil)
608 (set (make-local-variable 'log-view-message-re)
610 "^\\(?:[*/\\| ]+ \\)?\\(?: ([^)]+)\\)?\\([0-9a-z]+\\) \\([-a-z0-9]+\\) \\(.*\\)"
611 "^commit *\\([0-9a-z]+\\)"))
612 (set (make-local-variable 'log-view-font-lock-keywords)
615 ;; Same as log-view-message-re, except that we don't
616 ;; want the shy group for the tag name.
617 ("^\\(?:[*/\\| ]+ \\)?\\( ([^)]+)\\)?\\([0-9a-z]+\\) \\([-a-z0-9]+\\) \\(.*\\)"
618 (1 'highlight nil lax)
619 (2 'change-log-acknowledgement)
620 (3 'change-log-date)))
622 `((,log-view-message-re (1 'change-log-acknowledgement)))
625 '(("^Author:[ \t]+\\([A-Za-z0-9_.+-]+@[A-Za-z0-9_.-]+\\)"
626 (1 'change-log-email))
628 ;; user: FirstName LastName <foo@bar>
629 ("^Author:[ \t]+\\([^<(]+?\\)[ \t]*[(<]\\([A-Za-z0-9_.+-]+@[A-Za-z0-9_.-]+\\)[>)]"
631 (2 'change-log-email))
632 ("^ +\\(?:\\(?:[Aa]cked\\|[Ss]igned-[Oo]ff\\)-[Bb]y:\\)[ \t]+\\([A-Za-z0-9_.+-]+@[A-Za-z0-9_.-]+\\)"
633 (1 'change-log-name))
634 ("^ +\\(?:\\(?:[Aa]cked\\|[Ss]igned-[Oo]ff\\)-[Bb]y:\\)[ \t]+\\([^<(]+?\\)[ \t]*[(<]\\([A-Za-z0-9_.+-]+@[A-Za-z0-9_.-]+\\)[>)]"
636 (2 'change-log-email))
637 ("^Merge: \\([0-9a-z]+\\) \\([0-9a-z]+\\)"
638 (1 'change-log-acknowledgement)
639 (2 'change-log-acknowledgement))
640 ("^Date: \\(.+\\)" (1 'change-log-date))
641 ("^summary:[ \t]+\\(.+\\)" (1 'log-view-message)))))))
644 (defun vc-git-show-log-entry (revision)
645 "Move to the log entry for REVISION.
646 REVISION may have the form BRANCH, BRANCH~N,
647 or BRANCH^ (where \"^\" can be repeated)."
648 (goto-char (point-min))
652 (format "\ncommit %s" revision) nil t
653 (cond ((string-match "~\\([0-9]\\)\\'" revision)
654 (1+ (string-to-number (match-string 1 revision))))
655 ((string-match "\\^+\\'" revision)
656 (1+ (length (match-string 0 revision))))
658 (beginning-of-line)))
660 (defun vc-git-diff (files &optional rev1 rev2 buffer)
661 "Get a difference report using Git between two revisions of FILES."
662 (let (process-file-side-effects)
663 (apply #'vc-git-command (or buffer "*vc-diff*") 1 files
664 (if (and rev1 rev2) "diff-tree" "diff-index")
666 (append (vc-switches 'git 'diff)
667 (list "-p" (or rev1 "HEAD") rev2 "--")))))
669 (defun vc-git-revision-table (files)
670 ;; What about `files'?!? --Stef
671 (let (process-file-side-effects
672 (table (list "HEAD")))
674 (vc-git-command t nil nil "for-each-ref" "--format=%(refname)")
675 (goto-char (point-min))
676 (while (re-search-forward "^refs/\\(heads\\|tags\\|remotes\\)/\\(.*\\)$"
678 (push (match-string 2) table)))
681 (defun vc-git-revision-completion-table (files)
682 (lexical-let ((files files)
684 (setq table (lazy-completion-table
685 table (lambda () (vc-git-revision-table files))))
688 (defun vc-git-annotate-command (file buf &optional rev)
689 (let ((name (file-relative-name file)))
690 (vc-git-command buf 'async name "blame" "--date=iso" "-C" "-C" rev)))
692 (declare-function vc-annotate-convert-time "vc-annotate" (time))
694 (defun vc-git-annotate-time ()
695 (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)
696 (vc-annotate-convert-time
697 (apply #'encode-time (mapcar (lambda (match)
698 (string-to-number (match-string match)))
699 '(6 5 4 3 2 1 7))))))
701 (defun vc-git-annotate-extract-revision-at-line ()
703 (move-beginning-of-line 1)
704 (when (looking-at "\\([0-9a-f^][0-9a-f]+\\) \\(\\([^(]+\\) \\)?")
705 (let ((revision (match-string-no-properties 1)))
706 (if (match-beginning 2)
707 (cons revision (expand-file-name (match-string-no-properties 3)
708 (vc-git-root default-directory)))
713 (defun vc-git-create-tag (dir name branchp)
714 (let ((default-directory dir))
715 (and (vc-git-command nil 0 nil "update-index" "--refresh")
717 (vc-git-command nil 0 nil "checkout" "-b" name)
718 (vc-git-command nil 0 nil "tag" name)))))
720 (defun vc-git-retrieve-tag (dir name update)
721 (let ((default-directory dir))
722 (vc-git-command nil 0 nil "checkout" name)
723 ;; FIXME: update buffers if `update' is true
729 (defun vc-git-previous-revision (file rev)
730 "Git-specific version of `vc-previous-revision'."
732 (let* ((default-directory (file-name-directory (expand-file-name file)))
733 (file (file-name-nondirectory file))
734 (prev-rev (with-temp-buffer
736 (vc-git--out-ok "rev-list" "-2" rev "--" file)
737 (goto-char (point-max))
739 (zerop (forward-line -1))
741 (buffer-substring-no-properties
743 (1- (point-max)))))))
744 (or (vc-git-symbolic-commit prev-rev) prev-rev))
747 (vc-git--out-ok "rev-parse" (concat rev "^"))
748 (buffer-substring-no-properties (point-min) (+ (point-min) 40))))))
750 (defun vc-git-next-revision (file rev)
751 "Git-specific version of `vc-next-revision'."
752 (let* ((default-directory (file-name-directory
753 (expand-file-name file)))
754 (file (file-name-nondirectory file))
758 (vc-git--out-ok "rev-list" "-1" rev "--" file)
759 (goto-char (point-max))
761 (zerop (forward-line -1))
763 (buffer-substring-no-properties
770 (vc-git--out-ok "rev-list" "HEAD" "--" file)
771 (goto-char (point-min))
772 (search-forward current-rev nil t)
773 (zerop (forward-line -1))
774 (buffer-substring-no-properties
776 (progn (forward-line 1) (1- (point)))))))))
777 (or (vc-git-symbolic-commit next-rev) next-rev)))
779 (defun vc-git-delete-file (file)
780 (vc-git-command nil 0 file "rm" "-f" "--"))
782 (defun vc-git-rename-file (old new)
783 (vc-git-command nil 0 (list old new) "mv" "-f" "--"))
785 (defvar vc-git-extra-menu-map
786 (let ((map (make-sparse-keymap)))
787 (define-key map [git-grep]
788 '(menu-item "Git grep..." vc-git-grep
789 :help "Run the `git grep' command"))
790 (define-key map [git-sn]
791 '(menu-item "Stash a snapshot" vc-git-stash-snapshot
792 :help "Stash the current state of the tree and keep the current state"))
793 (define-key map [git-st]
794 '(menu-item "Create Stash..." vc-git-stash
795 :help "Stash away changes"))
796 (define-key map [git-ss]
797 '(menu-item "Show Stash..." vc-git-stash-show
798 :help "Show stash contents"))
801 (defun vc-git-extra-menu () vc-git-extra-menu-map)
803 (defun vc-git-extra-status-menu () vc-git-extra-menu-map)
805 (defun vc-git-root (file)
806 (vc-find-root file ".git"))
808 ;; Derived from `lgrep'.
809 (defun vc-git-grep (regexp &optional files dir)
810 "Run git grep, searching for REGEXP in FILES in directory DIR.
811 The search is limited to file names matching shell pattern FILES.
812 FILES may use abbreviations defined in `grep-files-aliases', e.g.
813 entering `ch' is equivalent to `*.[ch]'.
815 With \\[universal-argument] prefix, you can edit the constructed shell command line
816 before it is executed.
817 With two \\[universal-argument] prefixes, directly edit and run `grep-command'.
819 Collect output in a buffer. While git grep runs asynchronously, you
820 can use \\[next-error] (M-x next-error), or \\<grep-mode-map>\\[compile-goto-error] \
821 in the grep output buffer,
822 to go to the lines where grep found matches.
824 This command shares argument histories with \\[rgrep] and \\[grep]."
827 (grep-compute-defaults)
829 ((equal current-prefix-arg '(16))
830 (list (read-from-minibuffer "Run: " "git grep"
831 nil nil 'grep-history)
833 (t (let* ((regexp (grep-read-regexp))
834 (files (grep-read-files regexp))
835 (dir (read-directory-name "In directory: "
836 nil default-directory t)))
837 (list regexp files dir))))))
839 (when (and (stringp regexp) (> (length regexp) 0))
840 (let ((command regexp))
842 (if (string= command "git grep")
844 (setq dir (file-name-as-directory (expand-file-name dir)))
846 (grep-expand-template "git grep -n -e <R> -- <F>" regexp files))
848 (if (equal current-prefix-arg '(4))
850 (read-from-minibuffer "Confirm: "
851 command nil nil 'grep-history))
852 (add-to-history 'grep-history command))))
854 (let ((default-directory dir)
855 (compilation-environment '("PAGER=")))
856 ;; Setting process-setup-function makes exit-message-function work
857 ;; even when async processes aren't supported.
858 (compilation-start command 'grep-mode))
859 (if (eq next-error-last-buffer (current-buffer))
860 (setq default-directory dir))))))
862 (defun vc-git-stash (name)
864 (interactive "sStash name: ")
865 (let ((root (vc-git-root default-directory)))
867 (vc-git--call nil "stash" "save" name)
868 (vc-resynch-buffer root t t))))
870 (defun vc-git-stash-show (name)
871 "Show the contents of stash NAME."
872 (interactive "sStash name: ")
873 (vc-setup-buffer "*vc-git-stash*")
874 (vc-git-command "*vc-git-stash*" 'async nil "stash" "show" "-p" name)
875 (set-buffer "*vc-git-stash*")
877 (setq buffer-read-only t)
878 (pop-to-buffer (current-buffer)))
880 (defun vc-git-stash-apply (name)
882 (interactive "sApply stash: ")
883 (vc-git-command "*vc-git-stash*" 0 nil "stash" "apply" "-q" name)
884 (vc-resynch-buffer (vc-git-root default-directory) t t))
886 (defun vc-git-stash-pop (name)
888 (interactive "sPop stash: ")
889 (vc-git-command "*vc-git-stash*" 0 nil "stash" "pop" "-q" name)
890 (vc-resynch-buffer (vc-git-root default-directory) t t))
892 (defun vc-git-stash-snapshot ()
893 "Create a stash with the current tree state."
895 (vc-git--call nil "stash" "save"
896 (let ((ct (current-time)))
898 (format-time-string "Snapshot on %Y-%m-%d" ct)
899 (format-time-string " at %H:%M" ct))))
900 (vc-git-command "*vc-git-stash*" 0 nil "stash" "apply" "-q" "stash@{0}")
901 (vc-resynch-buffer (vc-git-root default-directory) t t))
903 (defun vc-git-stash-list ()
907 (replace-regexp-in-string
908 "^stash@" " " (vc-git--run-command-string nil "stash" "list"))
911 (defun vc-git-stash-get-at-point (point)
915 (if (looking-at "^ +\\({[0-9]+}\\):")
917 (error "Cannot find stash at point"))))
919 (defun vc-git-stash-delete-at-point ()
921 (let ((stash (vc-git-stash-get-at-point (point))))
922 (when (y-or-n-p (format "Remove stash %s ? " stash))
923 (vc-git--run-command-string nil "stash" "drop" (format "stash@%s" stash))
926 (defun vc-git-stash-show-at-point ()
928 (vc-git-stash-show (format "stash@%s" (vc-git-stash-get-at-point (point)))))
930 (defun vc-git-stash-apply-at-point ()
932 (vc-git-stash-apply (format "stash@%s" (vc-git-stash-get-at-point (point)))))
934 (defun vc-git-stash-pop-at-point ()
936 (vc-git-stash-pop (format "stash@%s" (vc-git-stash-get-at-point (point)))))
938 (defun vc-git-stash-menu (e)
940 (vc-dir-at-event e (popup-menu vc-git-stash-menu-map e)))
943 ;;; Internal commands
945 (defun vc-git-command (buffer okstatus file-or-list &rest flags)
946 "A wrapper around `vc-do-command' for use in vc-git.el.
947 The difference to vc-do-command is that this function always invokes `git'."
948 (apply 'vc-do-command (or buffer "*vc*") okstatus "git" file-or-list flags))
950 (defun vc-git--empty-db-p ()
951 "Check if the git db is empty (no commit done yet)."
952 (let (process-file-side-effects)
953 (not (eq 0 (vc-git--call nil "rev-parse" "--verify" "HEAD")))))
955 (defun vc-git--call (buffer command &rest args)
956 ;; We don't need to care the arguments. If there is a file name, it
957 ;; is always a relative one. This works also for remote
959 (apply 'process-file "git" nil buffer nil command args))
961 (defun vc-git--out-ok (command &rest args)
962 (zerop (apply 'vc-git--call '(t nil) command args)))
964 (defun vc-git--run-command-string (file &rest args)
965 "Run a git command on FILE and return its output as string.
968 (str (with-output-to-string
969 (with-current-buffer standard-output
970 (unless (apply 'vc-git--out-ok
972 (append args (list (file-relative-name
978 (defun vc-git-symbolic-commit (commit)
979 "Translate COMMIT string into symbolic form.
980 Returns nil if not possible."
982 (let ((name (with-temp-buffer
984 (vc-git--out-ok "name-rev" "--name-only" commit)
985 (goto-char (point-min))
986 (= (forward-line 2) 1)
988 (buffer-substring-no-properties (point-min)
989 (1- (point-max)))))))
990 (and name (not (string= name "undefined")) name))))
994 ;; arch-tag: bd10664a-0e5b-48f5-a877-6c17b135be12
995 ;;; vc-git.el ends here