1 ;;; vc-git.el --- VC backend for the git version control system
3 ;; Copyright (C) 2006, 2007, 2008, 2009 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 when
73 ;; 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 &optional buffer) 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, needs to update buffers
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 (when (vc-git-root file
)
142 (let* ((dir (file-name-directory file
))
143 (name (file-relative-name file dir
))
146 (vc-git--out-ok "ls-files" "-c" "-z" "--" name
)
147 ;; if result is empty, use ls-tree to check for deleted file
148 (when (eq (point-min) (point-max))
149 (vc-git--out-ok "ls-tree" "--name-only" "-z" "HEAD" "--" name
))
152 (> (length str
) (length name
))
153 (string= (substring str
0 (1+ (length name
)))
154 (concat name
"\0")))))))
156 (defun vc-git--state-code (code)
157 "Convert from a string to a added/deleted/modified state."
158 (case (string-to-char code
)
162 (?U
'edited
) ;; FIXME
163 (?T
'edited
))) ;; FIXME
165 (defun vc-git-state (file)
166 "Git-specific version of `vc-state'."
167 ;; FIXME: This can't set 'ignored yet
168 (if (not (vc-git-registered file
))
170 (vc-git--call nil
"add" "--refresh" "--" (file-relative-name file
))
171 (let ((diff (vc-git--run-command-string file
"diff-index" "-z" "HEAD" "--")))
172 (if (and diff
(string-match ":[0-7]\\{6\\} [0-7]\\{6\\} [0-9a-f]\\{40\\} [0-9a-f]\\{40\\} \\([ADMUT]\\)\0[^\0]+\0"
174 (vc-git--state-code (match-string 1 diff
))
175 (if (vc-git--empty-db-p) 'added
'up-to-date
)))))
177 (defun vc-git-working-revision (file)
178 "Git-specific version of `vc-working-revision'."
179 (let ((str (with-output-to-string
180 (with-current-buffer standard-output
181 (vc-git--out-ok "symbolic-ref" "HEAD")))))
182 (if (string-match "^\\(refs/heads/\\)?\\(.+\\)$" str
)
186 (defun vc-git-workfile-unchanged-p (file)
187 (eq 'up-to-date
(vc-git-state file
)))
189 (defun vc-git-mode-line-string (file)
190 "Return string for placement into the modeline for FILE."
191 (let* ((branch (vc-git-working-revision file
))
192 (def-ml (vc-default-mode-line-string 'Git file
))
193 (help-echo (get-text-property 0 'help-echo def-ml
)))
194 (if (zerop (length branch
))
197 'help-echo
(concat help-echo
"\nNo current branch (detached HEAD)"))
199 'help-echo
(concat help-echo
"\nCurrent branch: " branch
)))))
201 (defstruct (vc-git-extra-fileinfo
203 (:constructor vc-git-create-extra-fileinfo
(old-perm new-perm
&optional rename-state orig-name
))
204 (:conc-name vc-git-extra-fileinfo-
>))
205 old-perm new-perm
;; permission flags
206 rename-state
;; rename or copy state
207 orig-name
) ;; original name for renames or copies
209 (defun vc-git-escape-file-name (name)
210 "Escape a file name if necessary."
211 (if (string-match "[\n\t\"\\]" name
)
213 (mapconcat (lambda (c)
219 (t (char-to-string c
))))
224 (defun vc-git-file-type-as-string (old-perm new-perm
)
225 "Return a string describing the file type based on its permissions."
226 (let* ((old-type (lsh (or old-perm
0) -
9))
227 (new-type (lsh (or new-perm
0) -
9))
232 (?
\120 " (type change symlink -> file)")
233 (?
\160 " (type change subproject -> file)")))
236 (?
\100 " (type change file -> symlink)")
237 (?
\160 " (type change subproject -> symlink)")
241 (?
\100 " (type change file -> subproject)")
242 (?
\120 " (type change symlink -> subproject)")
243 (t " (subproject)")))
244 (?
\110 nil
) ;; directory (internal, not a real git state)
245 (?
\000 ;; deleted or unknown
248 (?
\160 " (subproject)")))
249 (t (format " (unknown type %o)" new-type
)))))
250 (cond (str (propertize str
'face
'font-lock-comment-face
))
251 ((eq new-type ?
\110) "/")
254 (defun vc-git-rename-as-string (state extra
)
255 "Return a string describing the copy or rename associated with INFO, or an empty string if none."
256 (let ((rename-state (when extra
257 (vc-git-extra-fileinfo->rename-state extra
))))
261 (if (eq rename-state
'copy
) "copied from "
262 (if (eq state
'added
) "renamed from "
264 (vc-git-escape-file-name (vc-git-extra-fileinfo->orig-name extra
))
265 ")") 'face
'font-lock-comment-face
)
268 (defun vc-git-permissions-as-string (old-perm new-perm
)
269 "Format a permission change as string."
271 (if (or (not old-perm
)
273 (eq 0 (logand ?
\111 (logxor old-perm new-perm
))))
275 (if (eq 0 (logand ?
\111 old-perm
)) "+x" "-x"))
276 'face
'font-lock-type-face
))
278 (defun vc-git-dir-printer (info)
279 "Pretty-printer for the vc-dir-fileinfo structure."
280 (let* ((isdir (vc-dir-fileinfo->directory info
))
281 (state (if isdir
"" (vc-dir-fileinfo->state info
)))
282 (extra (vc-dir-fileinfo->extra info
))
283 (old-perm (when extra
(vc-git-extra-fileinfo->old-perm extra
)))
284 (new-perm (when extra
(vc-git-extra-fileinfo->new-perm extra
))))
287 (propertize (format "%c" (if (vc-dir-fileinfo->marked info
) ?
* ?
))
288 'face
'font-lock-type-face
)
291 (format "%-12s" state
)
292 'face
(cond ((eq state
'up-to-date
) 'font-lock-builtin-face
)
293 ((eq state
'missing
) 'font-lock-warning-face
)
294 (t 'font-lock-variable-name-face
))
295 'mouse-face
'highlight
)
296 " " (vc-git-permissions-as-string old-perm new-perm
)
298 (propertize (vc-git-escape-file-name (vc-dir-fileinfo->name info
))
299 'face
(if isdir
'font-lock-comment-delimiter-face
'font-lock-function-name-face
)
302 "Directory\nVC operations can be applied to it\nmouse-3: Pop-up menu"
303 "File\nmouse-3: Pop-up menu")
304 'keymap vc-dir-filename-mouse-map
305 'mouse-face
'highlight
)
306 (vc-git-file-type-as-string old-perm new-perm
)
307 (vc-git-rename-as-string state extra
))))
309 (defun vc-git-after-dir-status-stage (stage files update-function
)
310 "Process sentinel for the various dir-status stages."
311 (let (remaining next-stage result
)
312 (goto-char (point-min))
315 (setq next-stage
(if (vc-git--empty-db-p) 'ls-files-added
316 (if files
'ls-files-up-to-date
'diff-index
))))
318 (setq next-stage
'ls-files-unknown
)
319 (while (re-search-forward "\\([0-7]\\{6\\}\\) [0-9a-f]\\{40\\} 0\t\\([^\0]+\\)\0" nil t
)
320 (let ((new-perm (string-to-number (match-string 1) 8))
321 (name (match-string 2)))
322 (push (list name
'added
(vc-git-create-extra-fileinfo 0 new-perm
)) result
))))
323 ('ls-files-up-to-date
324 (setq next-stage
'diff-index
)
325 (while (re-search-forward "\\([0-7]\\{6\\}\\) [0-9a-f]\\{40\\} 0\t\\([^\0]+\\)\0" nil t
)
326 (let ((perm (string-to-number (match-string 1) 8))
327 (name (match-string 2)))
328 (push (list name
'up-to-date
(vc-git-create-extra-fileinfo perm perm
)) result
))))
330 (when files
(setq next-stage
'ls-files-ignored
))
331 (while (re-search-forward "\\([^\0]*?\\)\0" nil t
1)
332 (push (list (match-string 1) 'unregistered
(vc-git-create-extra-fileinfo 0 0)) result
)))
334 (while (re-search-forward "\\([^\0]*?\\)\0" nil t
1)
335 (push (list (match-string 1) 'ignored
(vc-git-create-extra-fileinfo 0 0)) result
)))
337 (setq next-stage
'ls-files-unknown
)
338 (while (re-search-forward
339 ":\\([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"
341 (let ((old-perm (string-to-number (match-string 1) 8))
342 (new-perm (string-to-number (match-string 2) 8))
343 (state (or (match-string 4) (match-string 6)))
344 (name (or (match-string 5) (match-string 7)))
345 (new-name (match-string 8)))
346 (if new-name
; copy or rename
347 (if (eq ?C
(string-to-char state
))
348 (push (list new-name
'added
(vc-git-create-extra-fileinfo old-perm new-perm
'copy name
)) result
)
349 (push (list name
'removed
(vc-git-create-extra-fileinfo 0 0 'rename new-name
)) result
)
350 (push (list new-name
'added
(vc-git-create-extra-fileinfo old-perm new-perm
'rename name
)) result
))
351 (push (list name
(vc-git--state-code state
) (vc-git-create-extra-fileinfo old-perm new-perm
)) result
))))))
353 (setq result
(nreverse result
))
355 (dolist (entry result
) (setq files
(delete (car entry
) files
)))
356 (unless files
(setq next-stage nil
))))
357 (when (or result
(not next-stage
)) (funcall update-function result next-stage
))
358 (when next-stage
(vc-git-dir-status-goto-stage next-stage files update-function
))))
360 (defun vc-git-dir-status-goto-stage (stage files update-function
)
365 (vc-git-command (current-buffer) 'async files
"add" "--refresh" "--")
366 (vc-git-command (current-buffer) 'async nil
"update-index" "--refresh")))
368 (vc-git-command (current-buffer) 'async files
"ls-files" "-z" "-c" "-s" "--"))
369 ('ls-files-up-to-date
370 (vc-git-command (current-buffer) 'async files
"ls-files" "-z" "-c" "-s" "--"))
372 (vc-git-command (current-buffer) 'async files
"ls-files" "-z" "-o"
373 "--directory" "--no-empty-directory" "--exclude-standard" "--"))
375 (vc-git-command (current-buffer) 'async files
"ls-files" "-z" "-o" "-i"
376 "--directory" "--no-empty-directory" "--exclude-standard" "--"))
378 (vc-git-command (current-buffer) 'async files
"diff-index" "-z" "-M" "HEAD" "--")))
380 `(vc-git-after-dir-status-stage (quote ,stage
) (quote ,files
) (quote ,update-function
))))
382 (defun vc-git-dir-status (dir update-function
)
383 "Return a list of (FILE STATE EXTRA) entries for DIR."
384 ;; Further things that would have to be fixed later:
385 ;; - how to handle unregistered directories
386 ;; - how to support vc-dir on a subdir of the project tree
387 (vc-git-dir-status-goto-stage 'update-index nil update-function
))
389 (defun vc-git-dir-status-files (dir files default-state update-function
)
390 "Return a list of (FILE STATE EXTRA) entries for FILES in DIR."
391 (vc-git-dir-status-goto-stage 'update-index files update-function
))
393 (defun vc-git-dir-extra-headers (dir)
394 (let ((str (with-output-to-string
395 (with-current-buffer standard-output
396 (vc-git--out-ok "symbolic-ref" "HEAD")))))
398 (propertize "Branch : " 'face
'font-lock-type-face
)
400 (if (string-match "^\\(refs/heads/\\)?\\(.+\\)$" str
)
402 "not (detached HEAD)")
403 'face
'font-lock-variable-name-face
))))
405 ;;; STATE-CHANGING FUNCTIONS
407 (defun vc-git-create-repo ()
408 "Create a new Git repository."
409 (vc-git-command nil
0 nil
"init"))
411 (defun vc-git-register (files &optional rev comment
)
412 "Register FILE into the git version-control system."
413 (vc-git-command nil
0 files
"update-index" "--add" "--"))
415 (defalias 'vc-git-responsible-p
'vc-git-root
)
417 (defun vc-git-unregister (file)
418 (vc-git-command nil
0 file
"rm" "-f" "--cached" "--"))
421 (defun vc-git-checkin (files rev comment
)
422 (let ((coding-system-for-write git-commits-coding-system
))
423 (vc-git-command nil
0 files
"commit" "-m" comment
"--only" "--")))
425 (defun vc-git-find-revision (file rev buffer
)
426 (let ((coding-system-for-read 'binary
)
427 (coding-system-for-write 'binary
)
429 (vc-git--run-command-string
430 file
"ls-files" "-z" "--full-name" "--")
434 (concat (if rev rev
"HEAD") ":" fullname
) "cat-file" "blob")))
436 (defun vc-git-checkout (file &optional editable rev
)
437 (vc-git-command nil
0 file
"checkout" (or rev
"HEAD")))
439 (defun vc-git-revert (file &optional contents-done
)
440 "Revert FILE to the version stored in the git repository."
442 (vc-git-command nil
0 file
"update-index" "--")
443 (vc-git-command nil
0 file
"checkout" "HEAD")))
445 ;;; HISTORY FUNCTIONS
447 (defun vc-git-print-log (files &optional buffer
)
448 "Get change log associated with FILES."
449 (let ((coding-system-for-read git-commits-coding-system
)
450 ;; Support both the old print-log interface that passes a
451 ;; single file, and the new one that passes a file list.
452 (flist (if (listp files
) files
(list files
))))
453 ;; `vc-do-command' creates the buffer, but we need it before running
455 (vc-setup-buffer buffer
)
456 ;; If the buffer exists from a previous invocation it might be
458 (let ((inhibit-read-only t
))
461 (vc-git-command buffer
'async files
462 "rev-list" "--pretty" "HEAD" "--")))))
464 (defvar log-view-message-re
)
465 (defvar log-view-file-re
)
466 (defvar log-view-font-lock-keywords
)
467 (defvar log-view-per-file-logs
)
469 (define-derived-mode vc-git-log-view-mode log-view-mode
"Git-Log-View"
470 (require 'add-log
) ;; we need the faces add-log
471 ;; Don't have file markers, so use impossible regexp.
472 (set (make-local-variable 'log-view-file-re
) "\\`a\\`")
473 (set (make-local-variable 'log-view-per-file-logs
) nil
)
474 (set (make-local-variable 'log-view-message-re
)
475 "^commit *\\([0-9a-z]+\\)")
476 (set (make-local-variable 'log-view-font-lock-keywords
)
478 `((,log-view-message-re
(1 'change-log-acknowledgement
)))
481 '(("^Author:[ \t]+\\([A-Za-z0-9_.+-]+@[A-Za-z0-9_.-]+\\)"
482 (1 'change-log-email
))
484 ;; user: FirstName LastName <foo@bar>
485 ("^Author:[ \t]+\\([^<(]+?\\)[ \t]*[(<]\\([A-Za-z0-9_.+-]+@[A-Za-z0-9_.-]+\\)[>)]"
487 (2 'change-log-email
))
488 ("^ +\\(?:\\(?:[Aa]cked\\|[Ss]igned-[Oo]ff\\)-[Bb]y:\\)[ \t]+\\([A-Za-z0-9_.+-]+@[A-Za-z0-9_.-]+\\)"
489 (1 'change-log-name
))
490 ("^ +\\(?:\\(?:[Aa]cked\\|[Ss]igned-[Oo]ff\\)-[Bb]y:\\)[ \t]+\\([^<(]+?\\)[ \t]*[(<]\\([A-Za-z0-9_.+-]+@[A-Za-z0-9_.-]+\\)[>)]"
492 (2 'change-log-email
))
493 ("^Merge: \\([0-9a-z]+\\) \\([0-9a-z]+\\)"
494 (1 'change-log-acknowledgement
)
495 (2 'change-log-acknowledgement
))
496 ("^Date: \\(.+\\)" (1 'change-log-date
))
497 ("^summary:[ \t]+\\(.+\\)" (1 'log-view-message
))))))
499 (defun vc-git-show-log-entry (revision)
500 "Move to the log entry for REVISION.
501 REVISION may have the form BRANCH, BRANCH~N,
502 or BRANCH^ (where \"^\" can be repeated)."
503 (goto-char (point-min))
505 (search-forward (format "\ncommit %s" revision
) nil t
506 (cond ((string-match "~\\([0-9]\\)$" revision
)
507 (1+ (string-to-number (match-string 1 revision
))))
508 ((string-match "\\^+$" revision
)
509 (1+ (length (match-string 0 revision
))))
513 (defun vc-git-diff (files &optional rev1 rev2 buffer
)
514 "Get a difference report using Git between two revisions of FILES."
515 (apply #'vc-git-command
(or buffer
"*vc-diff*") 1 files
516 (if (and rev1 rev2
) "diff-tree" "diff-index")
518 (append (vc-switches 'git
'diff
)
519 (list "-p" (or rev1
"HEAD") rev2
"--"))))
521 (defun vc-git-revision-table (files)
522 ;; What about `files'?!? --Stef
523 (let ((table (list "HEAD")))
525 (vc-git-command t nil nil
"for-each-ref" "--format=%(refname)")
526 (goto-char (point-min))
527 (while (re-search-forward "^refs/\\(heads\\|tags\\)/\\(.*\\)$" nil t
)
528 (push (match-string 2) table
)))
531 (defun vc-git-revision-completion-table (files)
532 (lexical-let ((files files
)
534 (setq table
(lazy-completion-table
535 table
(lambda () (vc-git-revision-table files
))))
538 (defun vc-git-annotate-command (file buf
&optional rev
)
539 (let ((name (file-relative-name file
)))
540 (vc-git-command buf
0 name
"blame" rev
)))
542 (declare-function vc-annotate-convert-time
"vc-annotate" (time))
544 (defun vc-git-annotate-time ()
545 (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
)
546 (vc-annotate-convert-time
547 (apply #'encode-time
(mapcar (lambda (match)
548 (string-to-number (match-string match
)))
549 '(6 5 4 3 2 1 7))))))
551 (defun vc-git-annotate-extract-revision-at-line ()
553 (move-beginning-of-line 1)
554 (and (looking-at "[0-9a-f^][0-9a-f]+")
555 (buffer-substring-no-properties (match-beginning 0) (match-end 0)))))
559 (defun vc-git-create-tag (dir name branchp
)
560 (let ((default-directory dir
))
561 (and (vc-git-command nil
0 nil
"update-index" "--refresh")
563 (vc-git-command nil
0 nil
"checkout" "-b" name
)
564 (vc-git-command nil
0 nil
"tag" name
)))))
566 (defun vc-git-retrieve-tag (dir name update
)
567 (let ((default-directory dir
))
568 (vc-git-command nil
0 nil
"checkout" name
)
569 ;; FIXME: update buffers if `update' is true
575 (defun vc-git-previous-revision (file rev
)
576 "Git-specific version of `vc-previous-revision'."
578 (let* ((default-directory (file-name-directory (expand-file-name file
)))
579 (file (file-name-nondirectory file
))
580 (prev-rev (with-temp-buffer
582 (vc-git--out-ok "rev-list" "-2" rev
"--" file
)
583 (goto-char (point-max))
585 (zerop (forward-line -
1))
587 (buffer-substring-no-properties
589 (1- (point-max)))))))
590 (or (vc-git-symbolic-commit prev-rev
) prev-rev
))
593 (vc-git--out-ok "rev-parse" (concat rev
"^"))
594 (buffer-substring-no-properties (point-min) (+ (point-min) 40))))))
596 (defun vc-git-next-revision (file rev
)
597 "Git-specific version of `vc-next-revision'."
598 (let* ((default-directory (file-name-directory
599 (expand-file-name file
)))
600 (file (file-name-nondirectory file
))
604 (vc-git--out-ok "rev-list" "-1" rev
"--" file
)
605 (goto-char (point-max))
607 (zerop (forward-line -
1))
609 (buffer-substring-no-properties
616 (vc-git--out-ok "rev-list" "HEAD" "--" file
)
617 (goto-char (point-min))
618 (search-forward current-rev nil t
)
619 (zerop (forward-line -
1))
620 (buffer-substring-no-properties
622 (progn (forward-line 1) (1- (point)))))))))
623 (or (vc-git-symbolic-commit next-rev
) next-rev
)))
625 (defun vc-git-delete-file (file)
626 (vc-git-command nil
0 file
"rm" "-f" "--"))
628 (defun vc-git-rename-file (old new
)
629 (vc-git-command nil
0 (list old new
) "mv" "-f" "--"))
631 (defvar vc-git-extra-menu-map
632 (let ((map (make-sparse-keymap)))
633 (define-key map
[git-grep
]
634 '(menu-item "Git grep..." vc-git-grep
635 :help
"Run the `git grep' command"))
638 (defun vc-git-extra-menu () vc-git-extra-menu-map
)
640 (defun vc-git-extra-status-menu () vc-git-extra-menu-map
)
642 ;; Derived from `lgrep'.
643 (defun vc-git-grep (regexp &optional files dir
)
644 "Run git grep, searching for REGEXP in FILES in directory DIR.
645 The search is limited to file names matching shell pattern FILES.
646 FILES may use abbreviations defined in `grep-files-aliases', e.g.
647 entering `ch' is equivalent to `*.[ch]'.
649 With \\[universal-argument] prefix, you can edit the constructed shell command line
650 before it is executed.
651 With two \\[universal-argument] prefixes, directly edit and run `grep-command'.
653 Collect output in a buffer. While git grep runs asynchronously, you
654 can use \\[next-error] (M-x next-error), or \\<grep-mode-map>\\[compile-goto-error] \
655 in the grep output buffer,
656 to go to the lines where grep found matches.
658 This command shares argument histories with \\[rgrep] and \\[grep]."
661 (grep-compute-defaults)
663 ((equal current-prefix-arg
'(16))
664 (list (read-from-minibuffer "Run: " "git grep"
665 nil nil
'grep-history
)
667 (t (let* ((regexp (grep-read-regexp))
668 (files (grep-read-files regexp
))
669 (dir (read-directory-name "In directory: "
670 nil default-directory t
)))
671 (list regexp files dir
))))))
673 (when (and (stringp regexp
) (> (length regexp
) 0))
674 (let ((command regexp
))
676 (if (string= command
"git grep")
678 (setq dir
(file-name-as-directory (expand-file-name dir
)))
680 (grep-expand-template "git grep -n -e <R> -- <F>" regexp files
))
682 (if (equal current-prefix-arg
'(4))
684 (read-from-minibuffer "Confirm: "
685 command nil nil
'grep-history
))
686 (add-to-history 'grep-history command
))))
688 (let ((default-directory dir
)
689 (compilation-environment '("PAGER=")))
690 ;; Setting process-setup-function makes exit-message-function work
691 ;; even when async processes aren't supported.
692 (compilation-start command
'grep-mode
))
693 (if (eq next-error-last-buffer
(current-buffer))
694 (setq default-directory dir
))))))
696 ;;; Internal commands
698 (defun vc-git-root (file)
699 (vc-find-root file
".git"))
701 (defun vc-git-command (buffer okstatus file-or-list
&rest flags
)
702 "A wrapper around `vc-do-command' for use in vc-git.el.
703 The difference to vc-do-command is that this function always invokes `git'."
704 (apply 'vc-do-command
(or buffer
"*vc*") okstatus
"git" file-or-list flags
))
706 (defun vc-git--empty-db-p ()
707 "Check if the git db is empty (no commit done yet)."
708 (not (eq 0 (vc-git--call nil
"rev-parse" "--verify" "HEAD"))))
710 (defun vc-git--call (buffer command
&rest args
)
711 ;; We don't need to care the arguments. If there is a file name, it
712 ;; is always a relative one. This works also for remote
714 (apply 'process-file
"git" nil buffer nil command args
))
716 (defun vc-git--out-ok (command &rest args
)
717 (zerop (apply 'vc-git--call
'(t nil
) command args
)))
719 (defun vc-git--run-command-string (file &rest args
)
720 "Run a git command on FILE and return its output as string."
722 (str (with-output-to-string
723 (with-current-buffer standard-output
724 (unless (apply 'vc-git--out-ok
725 (append args
(list (file-relative-name
730 (defun vc-git-symbolic-commit (commit)
731 "Translate COMMIT string into symbolic form.
732 Returns nil if not possible."
734 (let ((name (with-temp-buffer
736 (vc-git--out-ok "name-rev" "--name-only" commit
)
737 (goto-char (point-min))
738 (= (forward-line 2) 1)
740 (buffer-substring-no-properties (point-min) (1- (point-max)))))))
741 (and name
(not (string= name
"undefined")) name
))))
745 ;; arch-tag: bd10664a-0e5b-48f5-a877-6c17b135be12
746 ;;; vc-git.el ends here