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>
9 ;; This file is part of GNU Emacs.
11 ;; GNU Emacs is free software: you can redistribute it and/or modify
12 ;; it under the terms of the GNU General Public License as published by
13 ;; the Free Software Foundation, either version 3 of the License, or
14 ;; (at your option) any later version.
16 ;; GNU Emacs is distributed in the hope that it will be useful,
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19 ;; GNU General Public License for more details.
21 ;; You should have received a copy of the GNU General Public License
22 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
26 ;; This file contains a VC backend for the git version control
32 ;; To install: put this file on the load-path and add Git to the list
33 ;; of supported backends in `vc-handled-backends'; the following line,
34 ;; placed in your ~/.emacs, will accomplish this:
36 ;; (add-to-list 'vc-handled-backends 'Git)
39 ;; - check if more functions could use vc-git-command instead
41 ;; - changelog generation
43 ;; Implement the rest of the vc interface. See the comment at the
44 ;; beginning of vc.el. The current status is:
45 ;; ("??" means: "figure out what to do about it")
47 ;; FUNCTION NAME STATUS
49 ;; * revision-granularity OK
50 ;; STATE-QUERYING FUNCTIONS
51 ;; * registered (file) OK
53 ;; - state-heuristic (file) NOT NEEDED
54 ;; * working-revision (file) OK
55 ;; - latest-on-branch-p (file) NOT NEEDED
56 ;; * checkout-model (files) OK
57 ;; - workfile-unchanged-p (file) OK
58 ;; - mode-line-string (file) OK
59 ;; STATE-CHANGING FUNCTIONS
60 ;; * create-repo () OK
61 ;; * register (files &optional rev comment) OK
62 ;; - init-revision (file) NOT NEEDED
63 ;; - responsible-p (file) OK
64 ;; - could-register (file) NOT NEEDED, DEFAULT IS GOOD
65 ;; - receive-file (file rev) NOT NEEDED
66 ;; - unregister (file) OK
67 ;; * checkin (files rev comment) OK
68 ;; * find-revision (file rev buffer) OK
69 ;; * checkout (file &optional editable rev) OK
70 ;; * revert (file &optional contents-done) OK
71 ;; - rollback (files) COULD BE SUPPORTED
72 ;; - merge (file rev1 rev2) It would be possible to merge
73 ;; changes into a single file, but
74 ;; when committing they wouldn't
75 ;; be identified as a merge
76 ;; by git, so it's probably
78 ;; - merge-news (file) see `merge'
79 ;; - steal-lock (file &optional revision) NOT NEEDED
81 ;; * print-log (files buffer &optional shortlog start-revision limit) OK
82 ;; - log-view-mode () OK
83 ;; - show-log-entry (revision) OK
84 ;; - comment-history (file) ??
85 ;; - update-changelog (files) COULD BE SUPPORTED
86 ;; * diff (file &optional rev1 rev2 buffer) OK
87 ;; - revision-completion-table (files) OK
88 ;; - annotate-command (file buf &optional rev) OK
89 ;; - annotate-time () OK
90 ;; - annotate-current-time () NOT NEEDED
91 ;; - annotate-extract-revision-at-line () OK
93 ;; - create-tag (dir name branchp) OK
94 ;; - retrieve-tag (dir name update) OK
96 ;; - make-version-backups-p (file) NOT NEEDED
97 ;; - repository-hostname (dirname) NOT NEEDED
98 ;; - previous-revision (file rev) OK
99 ;; - next-revision (file rev) OK
100 ;; - check-headers () COULD BE SUPPORTED
101 ;; - clear-headers () NOT NEEDED
102 ;; - delete-file (file) OK
103 ;; - rename-file (old new) OK
104 ;; - find-file-hook () NOT NEEDED
112 (defcustom vc-git-diff-switches t
113 "String or list of strings specifying switches for Git diff under VC.
114 If nil, use the value of `vc-diff-switches'. If t, use no switches."
115 :type
'(choice (const :tag
"Unspecified" nil
)
116 (const :tag
"None" t
)
117 (string :tag
"Argument String")
118 (repeat :tag
"Argument List" :value
("") string
))
122 (defvar vc-git-commits-coding-system
'utf-8
123 "Default coding system for git commits.")
125 ;;; BACKEND PROPERTIES
127 (defun vc-git-revision-granularity () 'repository
)
128 (defun vc-git-checkout-model (files) 'implicit
)
130 ;;; STATE-QUERYING FUNCTIONS
132 ;;;###autoload (defun vc-git-registered (file)
133 ;;;###autoload "Return non-nil if FILE is registered with git."
134 ;;;###autoload (if (vc-find-root file ".git") ; Short cut.
135 ;;;###autoload (progn
136 ;;;###autoload (load "vc-git")
137 ;;;###autoload (vc-git-registered file))))
139 (defun vc-git-registered (file)
140 "Check whether FILE is registered with git."
141 (let ((dir (vc-git-root file
)))
144 (let* (process-file-side-effects
145 ;; Do not use the `file-name-directory' here: git-ls-files
146 ;; sometimes fails to return the correct status for relative
148 ;; See also: http://marc.info/?l=git&m=125787684318129&w=2
149 (name (file-relative-name file dir
))
152 (vc-git--out-ok "ls-files" "-c" "-z" "--" name
)
153 ;; If result is empty, use ls-tree to check for deleted
155 (when (eq (point-min) (point-max))
156 (vc-git--out-ok "ls-tree" "--name-only" "-z" "HEAD"
160 (> (length str
) (length name
))
161 (string= (substring str
0 (1+ (length name
)))
162 (concat name
"\0"))))))))
164 (defun vc-git--state-code (code)
165 "Convert from a string to a added/deleted/modified state."
166 (case (string-to-char code
)
170 (?U
'edited
) ;; FIXME
171 (?T
'edited
))) ;; FIXME
173 (defun vc-git-state (file)
174 "Git-specific version of `vc-state'."
175 ;; FIXME: This can't set 'ignored or 'conflict yet
176 ;; The 'ignored state could be detected with `git ls-files -i -o
177 ;; --exclude-standard` It also can't set 'needs-update or
178 ;; 'needs-merge. The rough equivalent would be that upstream branch
179 ;; for current branch is in fast-forward state i.e. current branch
180 ;; is direct ancestor of corresponding upstream branch, and the file
181 ;; was modified upstream. But we can't check that without a network
183 (if (not (vc-git-registered file
))
185 (vc-git--call nil
"add" "--refresh" "--" (file-relative-name file
))
186 (let ((diff (vc-git--run-command-string
187 file
"diff-index" "-z" "HEAD" "--")))
188 (if (and diff
(string-match ":[0-7]\\{6\\} [0-7]\\{6\\} [0-9a-f]\\{40\\} [0-9a-f]\\{40\\} \\([ADMUT]\\)\0[^\0]+\0"
190 (vc-git--state-code (match-string 1 diff
))
191 (if (vc-git--empty-db-p) 'added
'up-to-date
)))))
193 (defun vc-git-working-revision (file)
194 "Git-specific version of `vc-working-revision'."
195 (let* (process-file-side-effects
196 (str (with-output-to-string
197 (with-current-buffer standard-output
198 (vc-git--out-ok "symbolic-ref" "HEAD")))))
199 (if (string-match "^\\(refs/heads/\\)?\\(.+\\)$" str
)
203 (defun vc-git-workfile-unchanged-p (file)
204 (eq 'up-to-date
(vc-git-state file
)))
206 (defun vc-git-mode-line-string (file)
207 "Return string for placement into the modeline for FILE."
208 (let* ((branch (vc-git-working-revision file
))
209 (def-ml (vc-default-mode-line-string 'Git file
))
210 (help-echo (get-text-property 0 'help-echo def-ml
)))
211 (if (zerop (length branch
))
214 'help-echo
(concat help-echo
"\nNo current branch (detached HEAD)"))
216 'help-echo
(concat help-echo
"\nCurrent branch: " branch
)))))
218 (defstruct (vc-git-extra-fileinfo
220 (:constructor vc-git-create-extra-fileinfo
221 (old-perm new-perm
&optional rename-state orig-name
))
222 (:conc-name vc-git-extra-fileinfo-
>))
223 old-perm new-perm
;; Permission flags.
224 rename-state
;; Rename or copy state.
225 orig-name
) ;; Original name for renames or copies.
227 (defun vc-git-escape-file-name (name)
228 "Escape a file name if necessary."
229 (if (string-match "[\n\t\"\\]" name
)
231 (mapconcat (lambda (c)
237 (t (char-to-string c
))))
242 (defun vc-git-file-type-as-string (old-perm new-perm
)
243 "Return a string describing the file type based on its permissions."
244 (let* ((old-type (lsh (or old-perm
0) -
9))
245 (new-type (lsh (or new-perm
0) -
9))
250 (?
\120 " (type change symlink -> file)")
251 (?
\160 " (type change subproject -> file)")))
254 (?
\100 " (type change file -> symlink)")
255 (?
\160 " (type change subproject -> symlink)")
257 (?
\160 ;; Subproject.
259 (?
\100 " (type change file -> subproject)")
260 (?
\120 " (type change symlink -> subproject)")
261 (t " (subproject)")))
262 (?
\110 nil
) ;; Directory (internal, not a real git state).
263 (?
\000 ;; Deleted or unknown.
266 (?
\160 " (subproject)")))
267 (t (format " (unknown type %o)" new-type
)))))
268 (cond (str (propertize str
'face
'font-lock-comment-face
))
269 ((eq new-type ?
\110) "/")
272 (defun vc-git-rename-as-string (state extra
)
273 "Return a string describing the copy or rename associated with INFO,
274 or an empty string if none."
275 (let ((rename-state (when extra
276 (vc-git-extra-fileinfo->rename-state extra
))))
280 (if (eq rename-state
'copy
) "copied from "
281 (if (eq state
'added
) "renamed from "
283 (vc-git-escape-file-name
284 (vc-git-extra-fileinfo->orig-name extra
))
286 'face
'font-lock-comment-face
)
289 (defun vc-git-permissions-as-string (old-perm new-perm
)
290 "Format a permission change as string."
292 (if (or (not old-perm
)
294 (eq 0 (logand ?
\111 (logxor old-perm new-perm
))))
296 (if (eq 0 (logand ?
\111 old-perm
)) "+x" "-x"))
297 'face
'font-lock-type-face
))
299 (defun vc-git-dir-printer (info)
300 "Pretty-printer for the vc-dir-fileinfo structure."
301 (let* ((isdir (vc-dir-fileinfo->directory info
))
302 (state (if isdir
"" (vc-dir-fileinfo->state info
)))
303 (extra (vc-dir-fileinfo->extra info
))
304 (old-perm (when extra
(vc-git-extra-fileinfo->old-perm extra
)))
305 (new-perm (when extra
(vc-git-extra-fileinfo->new-perm extra
))))
308 (propertize (format "%c" (if (vc-dir-fileinfo->marked info
) ?
* ?
))
309 'face
'font-lock-type-face
)
312 (format "%-12s" state
)
313 'face
(cond ((eq state
'up-to-date
) 'font-lock-builtin-face
)
314 ((eq state
'missing
) 'font-lock-warning-face
)
315 (t 'font-lock-variable-name-face
))
316 'mouse-face
'highlight
)
317 " " (vc-git-permissions-as-string old-perm new-perm
)
319 (propertize (vc-git-escape-file-name (vc-dir-fileinfo->name info
))
320 'face
(if isdir
'font-lock-comment-delimiter-face
321 'font-lock-function-name-face
)
324 "Directory\nVC operations can be applied to it\nmouse-3: Pop-up menu"
325 "File\nmouse-3: Pop-up menu")
326 'keymap vc-dir-filename-mouse-map
327 'mouse-face
'highlight
)
328 (vc-git-file-type-as-string old-perm new-perm
)
329 (vc-git-rename-as-string state extra
))))
331 (defun vc-git-after-dir-status-stage (stage files update-function
)
332 "Process sentinel for the various dir-status stages."
333 (let (next-stage result
)
334 (goto-char (point-min))
337 (setq next-stage
(if (vc-git--empty-db-p) 'ls-files-added
338 (if files
'ls-files-up-to-date
'diff-index
))))
340 (setq next-stage
'ls-files-unknown
)
341 (while (re-search-forward "\\([0-7]\\{6\\}\\) [0-9a-f]\\{40\\} 0\t\\([^\0]+\\)\0" nil t
)
342 (let ((new-perm (string-to-number (match-string 1) 8))
343 (name (match-string 2)))
344 (push (list name
'added
(vc-git-create-extra-fileinfo 0 new-perm
))
347 (setq next-stage
'diff-index
)
348 (while (re-search-forward "\\([0-7]\\{6\\}\\) [0-9a-f]\\{40\\} 0\t\\([^\0]+\\)\0" nil t
)
349 (let ((perm (string-to-number (match-string 1) 8))
350 (name (match-string 2)))
351 (push (list name
'up-to-date
352 (vc-git-create-extra-fileinfo perm perm
))
355 (when files
(setq next-stage
'ls-files-ignored
))
356 (while (re-search-forward "\\([^\0]*?\\)\0" nil t
1)
357 (push (list (match-string 1) 'unregistered
358 (vc-git-create-extra-fileinfo 0 0))
361 (while (re-search-forward "\\([^\0]*?\\)\0" nil t
1)
362 (push (list (match-string 1) 'ignored
363 (vc-git-create-extra-fileinfo 0 0))
366 (setq next-stage
'ls-files-unknown
)
367 (while (re-search-forward
368 ":\\([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"
370 (let ((old-perm (string-to-number (match-string 1) 8))
371 (new-perm (string-to-number (match-string 2) 8))
372 (state (or (match-string 4) (match-string 6)))
373 (name (or (match-string 5) (match-string 7)))
374 (new-name (match-string 8)))
375 (if new-name
; Copy or rename.
376 (if (eq ?C
(string-to-char state
))
377 (push (list new-name
'added
378 (vc-git-create-extra-fileinfo old-perm new-perm
381 (push (list name
'removed
382 (vc-git-create-extra-fileinfo 0 0
385 (push (list new-name
'added
386 (vc-git-create-extra-fileinfo old-perm new-perm
389 (push (list name
(vc-git--state-code state
)
390 (vc-git-create-extra-fileinfo old-perm new-perm
))
393 (setq result
(nreverse result
))
395 (dolist (entry result
) (setq files
(delete (car entry
) files
)))
396 (unless files
(setq next-stage nil
))))
397 (when (or result
(not next-stage
))
398 (funcall update-function result next-stage
))
400 (vc-git-dir-status-goto-stage next-stage files update-function
))))
402 (defun vc-git-dir-status-goto-stage (stage files update-function
)
407 (vc-git-command (current-buffer) 'async files
"add" "--refresh" "--")
408 (vc-git-command (current-buffer) 'async nil
409 "update-index" "--refresh")))
411 (vc-git-command (current-buffer) 'async files
412 "ls-files" "-z" "-c" "-s" "--"))
414 (vc-git-command (current-buffer) 'async files
415 "ls-files" "-z" "-c" "-s" "--"))
417 (vc-git-command (current-buffer) 'async files
418 "ls-files" "-z" "-o" "--directory"
419 "--no-empty-directory" "--exclude-standard" "--"))
421 (vc-git-command (current-buffer) 'async files
422 "ls-files" "-z" "-o" "-i" "--directory"
423 "--no-empty-directory" "--exclude-standard" "--"))
424 ;; --relative added in Git 1.5.5.
426 (vc-git-command (current-buffer) 'async files
427 "diff-index" "--relative" "-z" "-M" "HEAD" "--")))
429 `(vc-git-after-dir-status-stage ',stage
',files
',update-function
)))
431 (defun vc-git-dir-status (dir update-function
)
432 "Return a list of (FILE STATE EXTRA) entries for DIR."
433 ;; Further things that would have to be fixed later:
434 ;; - how to handle unregistered directories
435 ;; - how to support vc-dir on a subdir of the project tree
436 (vc-git-dir-status-goto-stage 'update-index nil update-function
))
438 (defun vc-git-dir-status-files (dir files default-state update-function
)
439 "Return a list of (FILE STATE EXTRA) entries for FILES in DIR."
440 (vc-git-dir-status-goto-stage 'update-index files update-function
))
442 (defvar vc-git-stash-map
443 (let ((map (make-sparse-keymap)))
444 ;; Turn off vc-dir marking
445 (define-key map
[mouse-2
] 'ignore
)
447 (define-key map
[down-mouse-3
] 'vc-git-stash-menu
)
448 (define-key map
"\C-k" 'vc-git-stash-delete-at-point
)
449 (define-key map
"=" 'vc-git-stash-show-at-point
)
450 (define-key map
"\C-m" 'vc-git-stash-show-at-point
)
451 (define-key map
"A" 'vc-git-stash-apply-at-point
)
452 (define-key map
"P" 'vc-git-stash-pop-at-point
)
453 (define-key map
"S" 'vc-git-stash-snapshot
)
456 (defvar vc-git-stash-menu-map
457 (let ((map (make-sparse-keymap "Git Stash")))
459 '(menu-item "Delete stash" vc-git-stash-delete-at-point
460 :help "Delete the current stash"))
462 '(menu-item "Apply stash" vc-git-stash-apply-at-point
463 :help "Apply the current stash and keep it in the stash list"))
465 '(menu-item "Apply and remove stash (pop)" vc-git-stash-pop-at-point
466 :help "Apply the current stash and remove it"))
468 '(menu-item "Show stash" vc-git-stash-show-at-point
469 :help "Show the contents of the current stash"))
472 (defun vc-git-dir-extra-headers (dir)
473 (let ((str (with-output-to-string
474 (with-current-buffer standard-output
475 (vc-git--out-ok "symbolic-ref" "HEAD"))))
476 (stash (vc-git-stash-list))
477 (stash-help-echo "Use M-x vc-git-stash to create stashes.")
478 branch remote remote-url)
479 (if (string-match "^\\(refs/heads/\\)?\\(.+\\)$" str)
481 (setq branch (match-string 2 str))
483 (with-output-to-string
484 (with-current-buffer standard-output
485 (vc-git--out-ok "config"
486 (concat "branch." branch ".remote")))))
487 (when (string-match "\\([^\n]+\\)" remote)
488 (setq remote (match-string 1 remote)))
491 (with-output-to-string
492 (with-current-buffer standard-output
493 (vc-git--out-ok "config"
494 (concat "remote." remote ".url"))))))
495 (when (string-match "\\([^\n]+\\)" remote-url)
496 (setq remote-url (match-string 1 remote-url))))
497 (setq branch "not (detached HEAD)"))
498 ;; FIXME: maybe use a different face when nothing is stashed.
500 (propertize "Branch : " 'face 'font-lock-type-face)
502 'face 'font-lock-variable-name-face)
506 (propertize "Remote : " 'face 'font-lock-type-face)
507 (propertize remote-url
508 'face 'font-lock-variable-name-face)))
512 (propertize "Stash :\n" 'face 'font-lock-type-face
513 'help-echo stash-help-echo)
517 'face 'font-lock-variable-name-face
518 'mouse-face 'highlight
519 'help-echo "mouse-3: Show stash menu\nRET: Show stash\nA: Apply stash\nP: Apply and remove stash (pop)\nC-k: Delete stash"
520 'keymap vc-git-stash-map))
523 (propertize "Stash : " 'face 'font-lock-type-face
524 'help-echo stash-help-echo)
525 (propertize "Nothing stashed"
526 'help-echo stash-help-echo
527 'face 'font-lock-variable-name-face))))))
529 ;;; STATE-CHANGING FUNCTIONS
531 (defun vc-git-create-repo ()
532 "Create a new Git repository."
533 (vc-git-command nil 0 nil "init"))
535 (defun vc-git-register (files &optional rev comment)
536 "Register FILES into the git version-control system."
539 (if (file-directory-p crt)
543 (vc-git-command nil 0 flist "update-index" "--add" "--"))
545 (vc-git-command nil 0 dlist "add"))))
547 (defalias 'vc-git-responsible-p 'vc-git-root)
549 (defun vc-git-unregister (file)
550 (vc-git-command nil 0 file "rm" "-f" "--cached" "--"))
552 (declare-function log-edit-extract-headers "log-edit" (headers string))
554 (defun vc-git-checkin (files rev comment)
555 (let ((coding-system-for-write vc-git-commits-coding-system))
556 (apply 'vc-git-command nil 0 files
557 (nconc (list "commit" "-m")
558 (log-edit-extract-headers '(("Author" . "--author")
561 (list "--only" "--")))))
563 (defun vc-git-find-revision (file rev buffer)
564 (let* (process-file-side-effects
565 (coding-system-for-read 'binary)
566 (coding-system-for-write 'binary)
568 (let ((fn (vc-git--run-command-string
569 file "ls-files" "-z" "--full-name" "--")))
570 ;; ls-files does not return anything when looking for a
571 ;; revision of a file that has been renamed or removed.
573 (file-relative-name file (vc-git-root default-directory))
574 (substring fn 0 -1)))))
578 "cat-file" "blob" (concat (if rev rev "HEAD") ":" fullname))))
580 (defun vc-git-checkout (file &optional editable rev)
581 (vc-git-command nil 0 file "checkout" (or rev "HEAD")))
583 (defun vc-git-revert (file &optional contents-done)
584 "Revert FILE to the version stored in the git repository."
586 (vc-git-command nil 0 file "update-index" "--")
587 (vc-git-command nil 0 file "reset" "-q" "--")
588 (vc-git-command nil nil file "checkout" "-q" "--")))
590 ;;; HISTORY FUNCTIONS
592 (defun vc-git-print-log (files buffer &optional shortlog start-revision limit)
593 "Get change log associated with FILES.
594 Note that using SHORTLOG requires at least Git version 1.5.6,
595 for the --graph option."
596 (let ((coding-system-for-read vc-git-commits-coding-system))
597 ;; `vc-do-command' creates the buffer, but we need it before running
599 (vc-setup-buffer buffer)
600 ;; If the buffer exists from a previous invocation it might be
602 (let ((inhibit-read-only t))
605 (apply 'vc-git-command buffer
608 '("log" "--no-color")
610 '("--graph" "--decorate" "--date=short"
611 "--pretty=tformat:%d%h %ad %s" "--abbrev-commit"))
612 (when limit (list "-n" (format "%s" limit)))
613 (when start-revision (list start-revision))
616 (defun vc-git-log-outgoing (buffer remote-location)
621 "--no-color" "--graph" "--decorate" "--date=short"
622 "--pretty=tformat:%d%h %ad %s" "--abbrev-commit"
623 (concat (if (string= remote-location "")
628 (defun vc-git-log-incoming (buffer remote-location)
630 (vc-git-command nil 0 nil "fetch")
634 "--no-color" "--graph" "--decorate" "--date=short"
635 "--pretty=tformat:%d%h %ad %s" "--abbrev-commit"
636 (concat "HEAD.." (if (string= remote-location "")
640 (defvar log-view-message-re)
641 (defvar log-view-file-re)
642 (defvar log-view-font-lock-keywords)
643 (defvar log-view-per-file-logs)
645 (define-derived-mode vc-git-log-view-mode log-view-mode "Git-Log-View"
646 (require 'add-log) ;; We need the faces add-log.
647 ;; Don't have file markers, so use impossible regexp.
648 (set (make-local-variable 'log-view-file-re) "\\`a\\`")
649 (set (make-local-variable 'log-view-per-file-logs) nil)
650 (set (make-local-variable 'log-view-message-re)
651 (if (not (eq vc-log-view-type 'long))
652 "^\\(?:[*/\\| ]+ \\)?\\(?: ([^)]+)\\)?\\([0-9a-z]+\\) \\([-a-z0-9]+\\) \\(.*\\)"
653 "^commit *\\([0-9a-z]+\\)"))
654 (set (make-local-variable 'log-view-font-lock-keywords)
655 (if (not (eq vc-log-view-type 'long))
657 ;; Same as log-view-message-re, except that we don't
658 ;; want the shy group for the tag name.
659 ("^\\(?:[*/\\| ]+ \\)?\\( ([^)]+)\\)?\\([0-9a-z]+\\) \\([-a-z0-9]+\\) \\(.*\\)"
660 (1 'highlight nil lax)
661 (2 'change-log-acknowledgement)
662 (3 'change-log-date)))
664 `((,log-view-message-re (1 'change-log-acknowledgement)))
667 '(("^Author:[ \t]+\\([A-Za-z0-9_.+-]+@[A-Za-z0-9_.-]+\\)"
668 (1 'change-log-email))
670 ;; user: FirstName LastName <foo@bar>
671 ("^Author:[ \t]+\\([^<(]+?\\)[ \t]*[(<]\\([A-Za-z0-9_.+-]+@[A-Za-z0-9_.-]+\\)[>)]"
673 (2 'change-log-email))
674 ("^ +\\(?:\\(?:[Aa]cked\\|[Ss]igned-[Oo]ff\\)-[Bb]y:\\)[ \t]+\\([A-Za-z0-9_.+-]+@[A-Za-z0-9_.-]+\\)"
675 (1 'change-log-name))
676 ("^ +\\(?:\\(?:[Aa]cked\\|[Ss]igned-[Oo]ff\\)-[Bb]y:\\)[ \t]+\\([^<(]+?\\)[ \t]*[(<]\\([A-Za-z0-9_.+-]+@[A-Za-z0-9_.-]+\\)[>)]"
678 (2 'change-log-email))
679 ("^Merge: \\([0-9a-z]+\\) \\([0-9a-z]+\\)"
680 (1 'change-log-acknowledgement)
681 (2 'change-log-acknowledgement))
682 ("^Date: \\(.+\\)" (1 'change-log-date))
683 ("^summary:[ \t]+\\(.+\\)" (1 'log-view-message)))))))
686 (defun vc-git-show-log-entry (revision)
687 "Move to the log entry for REVISION.
688 REVISION may have the form BRANCH, BRANCH~N,
689 or BRANCH^ (where \"^\" can be repeated)."
690 (goto-char (point-min))
694 (format "\ncommit %s" revision) nil t
695 (cond ((string-match "~\\([0-9]\\)\\'" revision)
696 (1+ (string-to-number (match-string 1 revision))))
697 ((string-match "\\^+\\'" revision)
698 (1+ (length (match-string 0 revision))))
700 (beginning-of-line)))
702 (defun vc-git-diff (files &optional rev1 rev2 buffer)
703 "Get a difference report using Git between two revisions of FILES."
704 (let (process-file-side-effects)
705 (apply #'vc-git-command (or buffer "*vc-diff*") 1 files
706 (if (and rev1 rev2) "diff-tree" "diff-index")
708 (append (vc-switches 'git 'diff)
709 (list "-p" (or rev1 "HEAD") rev2 "--")))))
711 (defun vc-git-revision-table (files)
712 ;; What about `files'?!? --Stef
713 (let (process-file-side-effects
714 (table (list "HEAD")))
716 (vc-git-command t nil nil "for-each-ref" "--format=%(refname)")
717 (goto-char (point-min))
718 (while (re-search-forward "^refs/\\(heads\\|tags\\|remotes\\)/\\(.*\\)$"
720 (push (match-string 2) table)))
723 (defun vc-git-revision-completion-table (files)
724 (lexical-let ((files files)
726 (setq table (lazy-completion-table
727 table (lambda () (vc-git-revision-table files))))
730 (defun vc-git-annotate-command (file buf &optional rev)
731 (let ((name (file-relative-name file)))
732 (vc-git-command buf 'async nil "blame" "--date=iso" "-C" "-C" rev "--" name)))
734 (declare-function vc-annotate-convert-time "vc-annotate" (time))
736 (defun vc-git-annotate-time ()
737 (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)
738 (vc-annotate-convert-time
739 (apply #'encode-time (mapcar (lambda (match)
740 (string-to-number (match-string match)))
741 '(6 5 4 3 2 1 7))))))
743 (defun vc-git-annotate-extract-revision-at-line ()
745 (move-beginning-of-line 1)
746 (when (looking-at "\\([0-9a-f^][0-9a-f]+\\) \\(\\([^(]+\\) \\)?")
747 (let ((revision (match-string-no-properties 1)))
748 (if (match-beginning 2)
749 (let ((fname (match-string-no-properties 3)))
750 ;; Remove trailing whitespace from the file name.
751 (when (string-match " +\\'" fname)
752 (setq fname (substring fname 0 (match-beginning 0))))
754 (expand-file-name fname (vc-git-root default-directory))))
759 (defun vc-git-create-tag (dir name branchp)
760 (let ((default-directory dir))
761 (and (vc-git-command nil 0 nil "update-index" "--refresh")
763 (vc-git-command nil 0 nil "checkout" "-b" name)
764 (vc-git-command nil 0 nil "tag" name)))))
766 (defun vc-git-retrieve-tag (dir name update)
767 (let ((default-directory dir))
768 (vc-git-command nil 0 nil "checkout" name)
769 ;; FIXME: update buffers if `update' is true
775 (defun vc-git-previous-revision (file rev)
776 "Git-specific version of `vc-previous-revision'."
778 (let* ((fname (file-relative-name file))
779 (prev-rev (with-temp-buffer
781 (vc-git--out-ok "rev-list" "-2" rev "--" fname)
782 (goto-char (point-max))
784 (zerop (forward-line -1))
786 (buffer-substring-no-properties
788 (1- (point-max)))))))
789 (or (vc-git-symbolic-commit prev-rev) prev-rev))
792 (vc-git--out-ok "rev-parse" (concat rev "^"))
793 (buffer-substring-no-properties (point-min) (+ (point-min) 40))))))
795 (defun vc-git-next-revision (file rev)
796 "Git-specific version of `vc-next-revision'."
797 (let* ((default-directory (file-name-directory
798 (expand-file-name file)))
799 (file (file-name-nondirectory file))
803 (vc-git--out-ok "rev-list" "-1" rev "--" file)
804 (goto-char (point-max))
806 (zerop (forward-line -1))
808 (buffer-substring-no-properties
815 (vc-git--out-ok "rev-list" "HEAD" "--" file)
816 (goto-char (point-min))
817 (search-forward current-rev nil t)
818 (zerop (forward-line -1))
819 (buffer-substring-no-properties
821 (progn (forward-line 1) (1- (point)))))))))
822 (or (vc-git-symbolic-commit next-rev) next-rev)))
824 (defun vc-git-delete-file (file)
825 (vc-git-command nil 0 file "rm" "-f" "--"))
827 (defun vc-git-rename-file (old new)
828 (vc-git-command nil 0 (list old new) "mv" "-f" "--"))
830 (defvar vc-git-extra-menu-map
831 (let ((map (make-sparse-keymap)))
832 (define-key map [git-grep]
833 '(menu-item "Git grep..." vc-git-grep
834 :help "Run the `git grep' command"))
835 (define-key map [git-sn]
836 '(menu-item "Stash a snapshot" vc-git-stash-snapshot
837 :help "Stash the current state of the tree and keep the current state"))
838 (define-key map [git-st]
839 '(menu-item "Create Stash..." vc-git-stash
840 :help "Stash away changes"))
841 (define-key map [git-ss]
842 '(menu-item "Show Stash..." vc-git-stash-show
843 :help "Show stash contents"))
846 (defun vc-git-extra-menu () vc-git-extra-menu-map)
848 (defun vc-git-extra-status-menu () vc-git-extra-menu-map)
850 (defun vc-git-root (file)
851 (vc-find-root file ".git"))
853 ;; Derived from `lgrep'.
854 (defun vc-git-grep (regexp &optional files dir)
855 "Run git grep, searching for REGEXP in FILES in directory DIR.
856 The search is limited to file names matching shell pattern FILES.
857 FILES may use abbreviations defined in `grep-files-aliases', e.g.
858 entering `ch' is equivalent to `*.[ch]'.
860 With \\[universal-argument] prefix, you can edit the constructed shell command line
861 before it is executed.
862 With two \\[universal-argument] prefixes, directly edit and run `grep-command'.
864 Collect output in a buffer. While git grep runs asynchronously, you
865 can use \\[next-error] (M-x next-error), or \\<grep-mode-map>\\[compile-goto-error] \
866 in the grep output buffer,
867 to go to the lines where grep found matches.
869 This command shares argument histories with \\[rgrep] and \\[grep]."
872 (grep-compute-defaults)
874 ((equal current-prefix-arg '(16))
875 (list (read-from-minibuffer "Run: " "git grep"
876 nil nil 'grep-history)
878 (t (let* ((regexp (grep-read-regexp))
879 (files (grep-read-files regexp))
880 (dir (read-directory-name "In directory: "
881 nil default-directory t)))
882 (list regexp files dir))))))
884 (when (and (stringp regexp) (> (length regexp) 0))
885 (let ((command regexp))
887 (if (string= command "git grep")
889 (setq dir (file-name-as-directory (expand-file-name dir)))
891 (grep-expand-template "git grep -n -e <R> -- <F>" regexp files))
893 (if (equal current-prefix-arg '(4))
895 (read-from-minibuffer "Confirm: "
896 command nil nil 'grep-history))
897 (add-to-history 'grep-history command))))
899 (let ((default-directory dir)
900 (compilation-environment '("PAGER=")))
901 ;; Setting process-setup-function makes exit-message-function work
902 ;; even when async processes aren't supported.
903 (compilation-start command 'grep-mode))
904 (if (eq next-error-last-buffer (current-buffer))
905 (setq default-directory dir))))))
907 (defun vc-git-stash (name)
909 (interactive "sStash name: ")
910 (let ((root (vc-git-root default-directory)))
912 (vc-git--call nil "stash" "save" name)
913 (vc-resynch-buffer root t t))))
915 (defun vc-git-stash-show (name)
916 "Show the contents of stash NAME."
917 (interactive "sStash name: ")
918 (vc-setup-buffer "*vc-git-stash*")
919 (vc-git-command "*vc-git-stash*" 'async nil "stash" "show" "-p" name)
920 (set-buffer "*vc-git-stash*")
922 (setq buffer-read-only t)
923 (pop-to-buffer (current-buffer)))
925 (defun vc-git-stash-apply (name)
927 (interactive "sApply stash: ")
928 (vc-git-command "*vc-git-stash*" 0 nil "stash" "apply" "-q" name)
929 (vc-resynch-buffer (vc-git-root default-directory) t t))
931 (defun vc-git-stash-pop (name)
933 (interactive "sPop stash: ")
934 (vc-git-command "*vc-git-stash*" 0 nil "stash" "pop" "-q" name)
935 (vc-resynch-buffer (vc-git-root default-directory) t t))
937 (defun vc-git-stash-snapshot ()
938 "Create a stash with the current tree state."
940 (vc-git--call nil "stash" "save"
941 (let ((ct (current-time)))
943 (format-time-string "Snapshot on %Y-%m-%d" ct)
944 (format-time-string " at %H:%M" ct))))
945 (vc-git-command "*vc-git-stash*" 0 nil "stash" "apply" "-q" "stash@{0}")
946 (vc-resynch-buffer (vc-git-root default-directory) t t))
948 (defun vc-git-stash-list ()
952 (replace-regexp-in-string
953 "^stash@" " " (vc-git--run-command-string nil "stash" "list"))
956 (defun vc-git-stash-get-at-point (point)
960 (if (looking-at "^ +\\({[0-9]+}\\):")
962 (error "Cannot find stash at point"))))
964 (defun vc-git-stash-delete-at-point ()
966 (let ((stash (vc-git-stash-get-at-point (point))))
967 (when (y-or-n-p (format "Remove stash %s ? " stash))
968 (vc-git--run-command-string nil "stash" "drop" (format "stash@%s" stash))
971 (defun vc-git-stash-show-at-point ()
973 (vc-git-stash-show (format "stash@%s" (vc-git-stash-get-at-point (point)))))
975 (defun vc-git-stash-apply-at-point ()
977 (vc-git-stash-apply (format "stash@%s" (vc-git-stash-get-at-point (point)))))
979 (defun vc-git-stash-pop-at-point ()
981 (vc-git-stash-pop (format "stash@%s" (vc-git-stash-get-at-point (point)))))
983 (defun vc-git-stash-menu (e)
985 (vc-dir-at-event e (popup-menu vc-git-stash-menu-map e)))
988 ;;; Internal commands
990 (defun vc-git-command (buffer okstatus file-or-list &rest flags)
991 "A wrapper around `vc-do-command' for use in vc-git.el.
992 The difference to vc-do-command is that this function always invokes `git'."
993 (apply 'vc-do-command (or buffer "*vc*") okstatus "git" file-or-list flags))
995 (defun vc-git--empty-db-p ()
996 "Check if the git db is empty (no commit done yet)."
997 (let (process-file-side-effects)
998 (not (eq 0 (vc-git--call nil "rev-parse" "--verify" "HEAD")))))
1000 (defun vc-git--call (buffer command &rest args)
1001 ;; We don't need to care the arguments. If there is a file name, it
1002 ;; is always a relative one. This works also for remote
1004 (apply 'process-file "git" nil buffer nil command args))
1006 (defun vc-git--out-ok (command &rest args)
1007 (zerop (apply 'vc-git--call '(t nil) command args)))
1009 (defun vc-git--run-command-string (file &rest args)
1010 "Run a git command on FILE and return its output as string.
1013 (str (with-output-to-string
1014 (with-current-buffer standard-output
1015 (unless (apply 'vc-git--out-ok
1017 (append args (list (file-relative-name
1023 (defun vc-git-symbolic-commit (commit)
1024 "Translate COMMIT string into symbolic form.
1025 Returns nil if not possible."
1027 (let ((name (with-temp-buffer
1029 (vc-git--out-ok "name-rev" "--name-only" commit)
1030 (goto-char (point-min))
1031 (= (forward-line 2) 1)
1033 (buffer-substring-no-properties (point-min)
1034 (1- (point-max)))))))
1035 (and name (not (string= name "undefined")) name))))
1039 ;; arch-tag: bd10664a-0e5b-48f5-a877-6c17b135be12
1040 ;;; vc-git.el ends here