Some fixes for vc-ignore.
[bpt/emacs.git] / lisp / vc / vc-git.el
CommitLineData
0d42eb3e 1;;; vc-git.el --- VC backend for the git version control system -*- lexical-binding: t -*-
fff4a046 2
ab422c4d 3;; Copyright (C) 2006-2013 Free Software Foundation, Inc.
fff4a046 4
8b38ce20 5;; Author: Alexandre Julliard <julliard@winehq.org>
9766adfb 6;; Keywords: vc tools
bd78fa1d 7;; Package: vc
fff4a046
DN
8
9;; This file is part of GNU Emacs.
10
eb3fa2cf 11;; GNU Emacs is free software: you can redistribute it and/or modify
fff4a046 12;; it under the terms of the GNU General Public License as published by
eb3fa2cf
GM
13;; the Free Software Foundation, either version 3 of the License, or
14;; (at your option) any later version.
fff4a046
DN
15
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.
20
21;; You should have received a copy of the GNU General Public License
eb3fa2cf 22;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
fff4a046
DN
23
24;;; Commentary:
25
26;; This file contains a VC backend for the git version control
27;; system.
28;;
29
30;;; Installation:
31
4211679b 32;; To install: put this file on the load-path and add Git to the list
fff4a046 33;; of supported backends in `vc-handled-backends'; the following line,
865fe16f 34;; placed in your init file, will accomplish this:
fff4a046 35;;
4211679b 36;; (add-to-list 'vc-handled-backends 'Git)
fff4a046
DN
37
38;;; Todo:
53cc90ab
DN
39;; - check if more functions could use vc-git-command instead
40;; of start-process.
fff4a046 41;; - changelog generation
53cc90ab
DN
42
43;; Implement the rest of the vc interface. See the comment at the
44;; beginning of vc.el. The current status is:
7546c767 45;; ("??" means: "figure out what to do about it")
fff4a046 46;;
b91f0762 47;; FUNCTION NAME STATUS
53cc90ab 48;; BACKEND PROPERTIES
b91f0762 49;; * revision-granularity OK
53cc90ab 50;; STATE-QUERYING FUNCTIONS
b91f0762
DN
51;; * registered (file) OK
52;; * state (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
53cc90ab 59;; STATE-CHANGING FUNCTIONS
b91f0762
DN
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
370fded4 72;; - merge (file rev1 rev2) It would be possible to merge
4c83ed3d
SM
73;; changes into a single file, but
74;; when committing they wouldn't
370fded4
ER
75;; be identified as a merge
76;; by git, so it's probably
77;; not a good idea.
b91f0762
DN
78;; - merge-news (file) see `merge'
79;; - steal-lock (file &optional revision) NOT NEEDED
53cc90ab 80;; HISTORY FUNCTIONS
662c5698 81;; * print-log (files buffer &optional shortlog start-revision limit) OK
b91f0762
DN
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
370fded4 92;; TAG SYSTEM
b91f0762
DN
93;; - create-tag (dir name branchp) OK
94;; - retrieve-tag (dir name update) OK
53cc90ab 95;; MISCELLANEOUS
b91f0762
DN
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
fff4a046 105
7aa7fff0
XF
106;;; Code:
107
c8149699 108(eval-when-compile
a464a6c7 109 (require 'cl-lib)
c8149699 110 (require 'vc)
10c7e431 111 (require 'vc-dir)
c8149699 112 (require 'grep))
fff4a046 113
67b0de11
CY
114(defgroup vc-git nil
115 "VC Git backend."
116 :version "24.1"
117 :group 'vc)
118
a0bea999 119(defcustom vc-git-diff-switches t
b6889b65
GM
120 "String or list of strings specifying switches for Git diff under VC.
121If nil, use the value of `vc-diff-switches'. If t, use no switches."
a0bea999
GM
122 :type '(choice (const :tag "Unspecified" nil)
123 (const :tag "None" t)
124 (string :tag "Argument String")
b6889b65 125 (repeat :tag "Argument List" :value ("") string))
a0bea999 126 :version "23.1"
67b0de11 127 :group 'vc-git)
a0bea999 128
02da65ff
GM
129(defcustom vc-git-program "git"
130 "Name of the Git executable (excluding any arguments)."
131 :version "24.1"
132 :type 'string
67b0de11 133 :group 'vc-git)
02da65ff 134
33f6cf7b
CY
135(defcustom vc-git-root-log-format
136 '("%d%h..: %an %ad %s"
137 ;; The first shy group matches the characters drawn by --graph.
138 ;; We use numbered groups because `log-view-message-re' wants the
139 ;; revision number to be group 1.
140 "^\\(?:[*/\\| ]+ \\)?\\(?2: ([^)]+)\\)?\\(?1:[0-9a-z]+\\)..: \
141\\(?3:.*?\\)[ \t]+\\(?4:[0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}\\)"
142 ((1 'log-view-message-face)
143 (2 'change-log-list nil lax)
144 (3 'change-log-name)
145 (4 'change-log-date)))
146 "Git log format for `vc-print-root-log'.
147This should be a list (FORMAT REGEXP KEYWORDS), where FORMAT is a
148format string (which is passed to \"git log\" via the argument
149\"--pretty=tformat:FORMAT\"), REGEXP is a regular expression
150matching the resulting Git log output, and KEYWORDS is a list of
151`font-lock-keywords' for highlighting the Log View buffer."
152 :type '(list string string (repeat sexp))
67b0de11 153 :group 'vc-git
33f6cf7b
CY
154 :version "24.1")
155
e97a42c1 156(defvar vc-git-commits-coding-system 'utf-8
fff4a046
DN
157 "Default coding system for git commits.")
158
659114fd
CY
159;; History of Git commands.
160(defvar vc-git-history nil)
161
53cc90ab
DN
162;;; BACKEND PROPERTIES
163
70e2f6c7 164(defun vc-git-revision-granularity () 'repository)
0d42eb3e 165(defun vc-git-checkout-model (_files) 'implicit)
53cc90ab
DN
166
167;;; STATE-QUERYING FUNCTIONS
168
169;;;###autoload (defun vc-git-registered (file)
170;;;###autoload "Return non-nil if FILE is registered with git."
4c83ed3d 171;;;###autoload (if (vc-find-root file ".git") ; Short cut.
53cc90ab 172;;;###autoload (progn
af314ba0 173;;;###autoload (load "vc-git" nil t)
53cc90ab
DN
174;;;###autoload (vc-git-registered file))))
175
fff4a046
DN
176(defun vc-git-registered (file)
177 "Check whether FILE is registered with git."
eceb6feb
DG
178 (let ((dir (vc-git-root file)))
179 (when dir
180 (with-temp-buffer
181 (let* (process-file-side-effects
182 ;; Do not use the `file-name-directory' here: git-ls-files
183 ;; sometimes fails to return the correct status for relative
184 ;; path specs.
185 ;; See also: http://marc.info/?l=git&m=125787684318129&w=2
186 (name (file-relative-name file dir))
187 (str (ignore-errors
188 (cd dir)
189 (vc-git--out-ok "ls-files" "-c" "-z" "--" name)
190 ;; If result is empty, use ls-tree to check for deleted
191 ;; file.
192 (when (eq (point-min) (point-max))
193 (vc-git--out-ok "ls-tree" "--name-only" "-z" "HEAD"
194 "--" name))
195 (buffer-string))))
196 (and str
197 (> (length str) (length name))
198 (string= (substring str 0 (1+ (length name)))
199 (concat name "\0"))))))))
108607bc 200
75cb52be
DN
201(defun vc-git--state-code (code)
202 "Convert from a string to a added/deleted/modified state."
a464a6c7 203 (pcase (string-to-char code)
75cb52be
DN
204 (?M 'edited)
205 (?A 'added)
206 (?D 'removed)
207 (?U 'edited) ;; FIXME
208 (?T 'edited))) ;; FIXME
209
fff4a046 210(defun vc-git-state (file)
53cc90ab 211 "Git-specific version of `vc-state'."
f6d90772
ER
212 ;; FIXME: This can't set 'ignored or 'conflict yet
213 ;; The 'ignored state could be detected with `git ls-files -i -o
214 ;; --exclude-standard` It also can't set 'needs-update or
215 ;; 'needs-merge. The rough equivalent would be that upstream branch
216 ;; for current branch is in fast-forward state i.e. current branch
217 ;; is direct ancestor of corresponding upstream branch, and the file
218 ;; was modified upstream. But we can't check that without a network
219 ;; operation.
eceb6feb
DG
220 ;; This assumes that status is known to be not `unregistered' because
221 ;; we've been successfully dispatched here from `vc-state', that
222 ;; means `vc-git-registered' returned t earlier once. Bug#11757
223 (let ((diff (vc-git--run-command-string
224 file "diff-index" "-p" "--raw" "-z" "HEAD" "--")))
225 (if (and diff
226 (string-match ":[0-7]\\{6\\} [0-7]\\{6\\} [0-9a-f]\\{40\\} [0-9a-f]\\{40\\} \\([ADMUT]\\)\0[^\0]+\0\\(.*\n.\\)?"
227 diff))
228 (let ((diff-letter (match-string 1 diff)))
229 (if (not (match-beginning 2))
230 ;; Empty diff: file contents is the same as the HEAD
231 ;; revision, but timestamps are different (eg, file
232 ;; was "touch"ed). Update timestamp in index:
233 (prog1 'up-to-date
234 (vc-git--call nil "add" "--refresh" "--"
235 (file-relative-name file)))
236 (vc-git--state-code diff-letter)))
237 (if (vc-git--empty-db-p) 'added 'up-to-date))))
fff4a046 238
f1a60a0f 239(defun vc-git-working-revision (file)
ac3f4c6f 240 "Git-specific version of `vc-working-revision'."
20c76c55 241 (let* (process-file-side-effects
f1a60a0f
DG
242 (str (vc-git--run-command-string nil "symbolic-ref" "HEAD")))
243 (vc-file-setprop file 'vc-git-detached (null str))
244 (if str
245 (if (string-match "^\\(refs/heads/\\)?\\(.+\\)$" str)
246 (match-string 2 str)
247 str)
248 (vc-git--rev-parse "HEAD"))))
fff4a046 249
fff4a046 250(defun vc-git-workfile-unchanged-p (file)
00d67080 251 (eq 'up-to-date (vc-git-state file)))
fff4a046 252
6f222162 253(defun vc-git-mode-line-string (file)
37269466 254 "Return a string for `vc-mode-line' to put in the mode line for FILE."
f1a60a0f
DG
255 (let* ((rev (vc-working-revision file))
256 (detached (vc-file-getprop file 'vc-git-detached))
6f222162
DN
257 (def-ml (vc-default-mode-line-string 'Git file))
258 (help-echo (get-text-property 0 'help-echo def-ml)))
f1a60a0f
DG
259 (propertize (if detached
260 (substring def-ml 0 (- 7 (length rev)))
261 def-ml)
262 'help-echo (concat help-echo "\nCurrent revision: " rev))))
6f222162 263
a464a6c7 264(cl-defstruct (vc-git-extra-fileinfo
236b5827 265 (:copier nil)
4c83ed3d
SM
266 (:constructor vc-git-create-extra-fileinfo
267 (old-perm new-perm &optional rename-state orig-name))
236b5827 268 (:conc-name vc-git-extra-fileinfo->))
4c83ed3d
SM
269 old-perm new-perm ;; Permission flags.
270 rename-state ;; Rename or copy state.
271 orig-name) ;; Original name for renames or copies.
236b5827
DN
272
273(defun vc-git-escape-file-name (name)
274 "Escape a file name if necessary."
275 (if (string-match "[\n\t\"\\]" name)
276 (concat "\""
277 (mapconcat (lambda (c)
a464a6c7 278 (pcase c
236b5827
DN
279 (?\n "\\n")
280 (?\t "\\t")
281 (?\\ "\\\\")
282 (?\" "\\\"")
a464a6c7 283 (_ (char-to-string c))))
236b5827
DN
284 name "")
285 "\"")
286 name))
287
288(defun vc-git-file-type-as-string (old-perm new-perm)
289 "Return a string describing the file type based on its permissions."
290 (let* ((old-type (lsh (or old-perm 0) -9))
291 (new-type (lsh (or new-perm 0) -9))
a464a6c7 292 (str (pcase new-type
4c83ed3d 293 (?\100 ;; File.
a464a6c7 294 (pcase old-type
236b5827
DN
295 (?\100 nil)
296 (?\120 " (type change symlink -> file)")
297 (?\160 " (type change subproject -> file)")))
4c83ed3d 298 (?\120 ;; Symlink.
a464a6c7 299 (pcase old-type
236b5827
DN
300 (?\100 " (type change file -> symlink)")
301 (?\160 " (type change subproject -> symlink)")
302 (t " (symlink)")))
4c83ed3d 303 (?\160 ;; Subproject.
a464a6c7 304 (pcase old-type
236b5827
DN
305 (?\100 " (type change file -> subproject)")
306 (?\120 " (type change symlink -> subproject)")
307 (t " (subproject)")))
4c83ed3d
SM
308 (?\110 nil) ;; Directory (internal, not a real git state).
309 (?\000 ;; Deleted or unknown.
a464a6c7 310 (pcase old-type
236b5827
DN
311 (?\120 " (symlink)")
312 (?\160 " (subproject)")))
a464a6c7 313 (_ (format " (unknown type %o)" new-type)))))
236b5827
DN
314 (cond (str (propertize str 'face 'font-lock-comment-face))
315 ((eq new-type ?\110) "/")
316 (t ""))))
317
318(defun vc-git-rename-as-string (state extra)
4c83ed3d
SM
319 "Return a string describing the copy or rename associated with INFO,
320or an empty string if none."
20c76c55 321 (let ((rename-state (when extra
236b5827
DN
322 (vc-git-extra-fileinfo->rename-state extra))))
323 (if rename-state
324 (propertize
325 (concat " ("
326 (if (eq rename-state 'copy) "copied from "
327 (if (eq state 'added) "renamed from "
328 "renamed to "))
4c83ed3d
SM
329 (vc-git-escape-file-name
330 (vc-git-extra-fileinfo->orig-name extra))
331 ")")
332 'face 'font-lock-comment-face)
236b5827
DN
333 "")))
334
335(defun vc-git-permissions-as-string (old-perm new-perm)
336 "Format a permission change as string."
337 (propertize
338 (if (or (not old-perm)
339 (not new-perm)
340 (eq 0 (logand ?\111 (logxor old-perm new-perm))))
341 " "
342 (if (eq 0 (logand ?\111 old-perm)) "+x" "-x"))
343 'face 'font-lock-type-face))
344
13ad7457 345(defun vc-git-dir-printer (info)
99e1b0c0 346 "Pretty-printer for the vc-dir-fileinfo structure."
d1bfcce1
DN
347 (let* ((isdir (vc-dir-fileinfo->directory info))
348 (state (if isdir "" (vc-dir-fileinfo->state info)))
99e1b0c0 349 (extra (vc-dir-fileinfo->extra info))
236b5827
DN
350 (old-perm (when extra (vc-git-extra-fileinfo->old-perm extra)))
351 (new-perm (when extra (vc-git-extra-fileinfo->new-perm extra))))
352 (insert
353 " "
99e1b0c0 354 (propertize (format "%c" (if (vc-dir-fileinfo->marked info) ?* ? ))
236b5827
DN
355 'face 'font-lock-type-face)
356 " "
357 (propertize
358 (format "%-12s" state)
359 'face (cond ((eq state 'up-to-date) 'font-lock-builtin-face)
360 ((eq state 'missing) 'font-lock-warning-face)
361 (t 'font-lock-variable-name-face))
362 'mouse-face 'highlight)
363 " " (vc-git-permissions-as-string old-perm new-perm)
7f4a3168 364 " "
99e1b0c0 365 (propertize (vc-git-escape-file-name (vc-dir-fileinfo->name info))
4c83ed3d
SM
366 'face (if isdir 'font-lock-comment-delimiter-face
367 'font-lock-function-name-face)
631601b5
DN
368 'help-echo
369 (if isdir
370 "Directory\nVC operations can be applied to it\nmouse-3: Pop-up menu"
371 "File\nmouse-3: Pop-up menu")
c7f9e440 372 'keymap vc-dir-filename-mouse-map
631601b5 373 'mouse-face 'highlight)
236b5827
DN
374 (vc-git-file-type-as-string old-perm new-perm)
375 (vc-git-rename-as-string state extra))))
376
d41080ca
AJ
377(defun vc-git-after-dir-status-stage (stage files update-function)
378 "Process sentinel for the various dir-status stages."
4c83ed3d 379 (let (next-stage result)
d41080ca 380 (goto-char (point-min))
a464a6c7
SM
381 (pcase stage
382 (`update-index
d41080ca
AJ
383 (setq next-stage (if (vc-git--empty-db-p) 'ls-files-added
384 (if files 'ls-files-up-to-date 'diff-index))))
a464a6c7 385 (`ls-files-added
d41080ca
AJ
386 (setq next-stage 'ls-files-unknown)
387 (while (re-search-forward "\\([0-7]\\{6\\}\\) [0-9a-f]\\{40\\} 0\t\\([^\0]+\\)\0" nil t)
388 (let ((new-perm (string-to-number (match-string 1) 8))
389 (name (match-string 2)))
4c83ed3d
SM
390 (push (list name 'added (vc-git-create-extra-fileinfo 0 new-perm))
391 result))))
a464a6c7 392 (`ls-files-up-to-date
d41080ca
AJ
393 (setq next-stage 'diff-index)
394 (while (re-search-forward "\\([0-7]\\{6\\}\\) [0-9a-f]\\{40\\} 0\t\\([^\0]+\\)\0" nil t)
395 (let ((perm (string-to-number (match-string 1) 8))
396 (name (match-string 2)))
4c83ed3d
SM
397 (push (list name 'up-to-date
398 (vc-git-create-extra-fileinfo perm perm))
399 result))))
a464a6c7 400 (`ls-files-unknown
d41080ca
AJ
401 (when files (setq next-stage 'ls-files-ignored))
402 (while (re-search-forward "\\([^\0]*?\\)\0" nil t 1)
4c83ed3d
SM
403 (push (list (match-string 1) 'unregistered
404 (vc-git-create-extra-fileinfo 0 0))
405 result)))
a464a6c7 406 (`ls-files-ignored
d41080ca 407 (while (re-search-forward "\\([^\0]*?\\)\0" nil t 1)
4c83ed3d
SM
408 (push (list (match-string 1) 'ignored
409 (vc-git-create-extra-fileinfo 0 0))
410 result)))
a464a6c7 411 (`diff-index
d41080ca
AJ
412 (setq next-stage 'ls-files-unknown)
413 (while (re-search-forward
414 ":\\([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"
415 nil t 1)
416 (let ((old-perm (string-to-number (match-string 1) 8))
417 (new-perm (string-to-number (match-string 2) 8))
418 (state (or (match-string 4) (match-string 6)))
419 (name (or (match-string 5) (match-string 7)))
420 (new-name (match-string 8)))
4c83ed3d 421 (if new-name ; Copy or rename.
d41080ca 422 (if (eq ?C (string-to-char state))
4c83ed3d
SM
423 (push (list new-name 'added
424 (vc-git-create-extra-fileinfo old-perm new-perm
425 'copy name))
426 result)
427 (push (list name 'removed
428 (vc-git-create-extra-fileinfo 0 0
429 'rename new-name))
430 result)
431 (push (list new-name 'added
432 (vc-git-create-extra-fileinfo old-perm new-perm
433 'rename name))
434 result))
435 (push (list name (vc-git--state-code state)
436 (vc-git-create-extra-fileinfo old-perm new-perm))
437 result))))))
d41080ca
AJ
438 (when result
439 (setq result (nreverse result))
440 (when files
441 (dolist (entry result) (setq files (delete (car entry) files)))
442 (unless files (setq next-stage nil))))
4c83ed3d
SM
443 (when (or result (not next-stage))
444 (funcall update-function result next-stage))
445 (when next-stage
446 (vc-git-dir-status-goto-stage next-stage files update-function))))
d41080ca 447
712b9732
GM
448;; Follows vc-git-command (or vc-do-async-command), which uses vc-do-command
449;; from vc-dispatcher.
450(declare-function vc-exec-after "vc-dispatcher" (code))
451;; Follows vc-exec-after.
452(declare-function vc-set-async-update "vc-dispatcher" (process-buffer))
453
d41080ca 454(defun vc-git-dir-status-goto-stage (stage files update-function)
8e4e4aef 455 (erase-buffer)
a464a6c7
SM
456 (pcase stage
457 (`update-index
d41080ca
AJ
458 (if files
459 (vc-git-command (current-buffer) 'async files "add" "--refresh" "--")
4c83ed3d
SM
460 (vc-git-command (current-buffer) 'async nil
461 "update-index" "--refresh")))
a464a6c7 462 (`ls-files-added
4c83ed3d
SM
463 (vc-git-command (current-buffer) 'async files
464 "ls-files" "-z" "-c" "-s" "--"))
a464a6c7 465 (`ls-files-up-to-date
4c83ed3d
SM
466 (vc-git-command (current-buffer) 'async files
467 "ls-files" "-z" "-c" "-s" "--"))
a464a6c7 468 (`ls-files-unknown
4c83ed3d
SM
469 (vc-git-command (current-buffer) 'async files
470 "ls-files" "-z" "-o" "--directory"
471 "--no-empty-directory" "--exclude-standard" "--"))
a464a6c7 472 (`ls-files-ignored
4c83ed3d
SM
473 (vc-git-command (current-buffer) 'async files
474 "ls-files" "-z" "-o" "-i" "--directory"
475 "--no-empty-directory" "--exclude-standard" "--"))
10a31174 476 ;; --relative added in Git 1.5.5.
a464a6c7 477 (`diff-index
4c83ed3d
SM
478 (vc-git-command (current-buffer) 'async files
479 "diff-index" "--relative" "-z" "-M" "HEAD" "--")))
8e4e4aef 480 (vc-exec-after
4c83ed3d 481 `(vc-git-after-dir-status-stage ',stage ',files ',update-function)))
8e4e4aef 482
0d42eb3e 483(defun vc-git-dir-status (_dir update-function)
d41080ca 484 "Return a list of (FILE STATE EXTRA) entries for DIR."
12cb746e 485 ;; Further things that would have to be fixed later:
12cb746e 486 ;; - how to handle unregistered directories
99e1b0c0 487 ;; - how to support vc-dir on a subdir of the project tree
d41080ca
AJ
488 (vc-git-dir-status-goto-stage 'update-index nil update-function))
489
0d42eb3e 490(defun vc-git-dir-status-files (_dir files _default-state update-function)
d41080ca
AJ
491 "Return a list of (FILE STATE EXTRA) entries for FILES in DIR."
492 (vc-git-dir-status-goto-stage 'update-index files update-function))
758dc0cc 493
881e4184
GM
494(defvar vc-git-stash-map
495 (let ((map (make-sparse-keymap)))
7fa4876f
DN
496 ;; Turn off vc-dir marking
497 (define-key map [mouse-2] 'ignore)
498
499 (define-key map [down-mouse-3] 'vc-git-stash-menu)
881e4184
GM
500 (define-key map "\C-k" 'vc-git-stash-delete-at-point)
501 (define-key map "=" 'vc-git-stash-show-at-point)
502 (define-key map "\C-m" 'vc-git-stash-show-at-point)
7fa4876f
DN
503 (define-key map "A" 'vc-git-stash-apply-at-point)
504 (define-key map "P" 'vc-git-stash-pop-at-point)
e2f3c692 505 (define-key map "S" 'vc-git-stash-snapshot)
7fa4876f
DN
506 map))
507
508(defvar vc-git-stash-menu-map
509 (let ((map (make-sparse-keymap "Git Stash")))
510 (define-key map [de]
7cc6e154 511 '(menu-item "Delete Stash" vc-git-stash-delete-at-point
7fa4876f
DN
512 :help "Delete the current stash"))
513 (define-key map [ap]
7cc6e154 514 '(menu-item "Apply Stash" vc-git-stash-apply-at-point
7fa4876f
DN
515 :help "Apply the current stash and keep it in the stash list"))
516 (define-key map [po]
7cc6e154 517 '(menu-item "Apply and Remove Stash (Pop)" vc-git-stash-pop-at-point
7fa4876f
DN
518 :help "Apply the current stash and remove it"))
519 (define-key map [sh]
7cc6e154 520 '(menu-item "Show Stash" vc-git-stash-show-at-point
7fa4876f 521 :help "Show the contents of the current stash"))
881e4184
GM
522 map))
523
0d42eb3e 524(defun vc-git-dir-extra-headers (_dir)
15c5c970
DN
525 (let ((str (with-output-to-string
526 (with-current-buffer standard-output
2a0e3379 527 (vc-git--out-ok "symbolic-ref" "HEAD"))))
60308853 528 (stash (vc-git-stash-list))
7fa4876f 529 (stash-help-echo "Use M-x vc-git-stash to create stashes.")
60308853
DN
530 branch remote remote-url)
531 (if (string-match "^\\(refs/heads/\\)?\\(.+\\)$" str)
532 (progn
533 (setq branch (match-string 2 str))
60308853
DN
534 (setq remote
535 (with-output-to-string
536 (with-current-buffer standard-output
4c83ed3d
SM
537 (vc-git--out-ok "config"
538 (concat "branch." branch ".remote")))))
60308853
DN
539 (when (string-match "\\([^\n]+\\)" remote)
540 (setq remote (match-string 1 remote)))
541 (when remote
542 (setq remote-url
543 (with-output-to-string
544 (with-current-buffer standard-output
4c83ed3d
SM
545 (vc-git--out-ok "config"
546 (concat "remote." remote ".url"))))))
60308853
DN
547 (when (string-match "\\([^\n]+\\)" remote-url)
548 (setq remote-url (match-string 1 remote-url))))
52964e54 549 (setq branch "not (detached HEAD)"))
2a0e3379 550 ;; FIXME: maybe use a different face when nothing is stashed.
15c5c970
DN
551 (concat
552 (propertize "Branch : " 'face 'font-lock-type-face)
60308853
DN
553 (propertize branch
554 'face 'font-lock-variable-name-face)
555 (when remote
556 (concat
557 "\n"
558 (propertize "Remote : " 'face 'font-lock-type-face)
559 (propertize remote-url
560 'face 'font-lock-variable-name-face)))
2a0e3379 561 "\n"
0e172cc2
DN
562 (if stash
563 (concat
7fa4876f
DN
564 (propertize "Stash :\n" 'face 'font-lock-type-face
565 'help-echo stash-help-echo)
0e172cc2
DN
566 (mapconcat
567 (lambda (x)
568 (propertize x
569 'face 'font-lock-variable-name-face
570 'mouse-face 'highlight
7fa4876f 571 'help-echo "mouse-3: Show stash menu\nRET: Show stash\nA: Apply stash\nP: Apply and remove stash (pop)\nC-k: Delete stash"
0e172cc2
DN
572 'keymap vc-git-stash-map))
573 stash "\n"))
574 (concat
7fa4876f
DN
575 (propertize "Stash : " 'face 'font-lock-type-face
576 'help-echo stash-help-echo)
0e172cc2 577 (propertize "Nothing stashed"
7fa4876f 578 'help-echo stash-help-echo
0e172cc2 579 'face 'font-lock-variable-name-face))))))
15c5c970 580
659114fd
CY
581(defun vc-git-branches ()
582 "Return the existing branches, as a list of strings.
583The car of the list is the current branch."
584 (with-temp-buffer
eceb6feb 585 (vc-git--call t "branch")
659114fd
CY
586 (goto-char (point-min))
587 (let (current-branch branches)
588 (while (not (eobp))
589 (when (looking-at "^\\([ *]\\) \\(.+\\)$")
590 (if (string-equal (match-string 1) "*")
591 (setq current-branch (match-string 2))
592 (push (match-string 2) branches)))
593 (forward-line 1))
594 (cons current-branch (nreverse branches)))))
595
53cc90ab
DN
596;;; STATE-CHANGING FUNCTIONS
597
598(defun vc-git-create-repo ()
4211679b 599 "Create a new Git repository."
00d67080 600 (vc-git-command nil 0 nil "init"))
53cc90ab 601
0d42eb3e 602(defun vc-git-register (files &optional _rev _comment)
b91f0762
DN
603 "Register FILES into the git version-control system."
604 (let (flist dlist)
605 (dolist (crt files)
606 (if (file-directory-p crt)
607 (push crt dlist)
608 (push crt flist)))
609 (when flist
610 (vc-git-command nil 0 flist "update-index" "--add" "--"))
611 (when dlist
612 (vc-git-command nil 0 dlist "add"))))
fff4a046 613
53cc90ab
DN
614(defalias 'vc-git-responsible-p 'vc-git-root)
615
d7009f45
DN
616(defun vc-git-unregister (file)
617 (vc-git-command nil 0 file "rm" "-f" "--cached" "--"))
108607bc 618
9f7b98f8
DG
619(declare-function log-edit-mode "log-edit" ())
620(declare-function log-edit-toggle-header "log-edit" (header value))
e97a42c1 621(declare-function log-edit-extract-headers "log-edit" (headers string))
d7009f45 622
9f7b98f8
DG
623(defun vc-git-log-edit-toggle-signoff ()
624 "Toggle whether to add the \"Signed-off-by\" line at the end of
625the commit message."
626 (interactive)
627 (log-edit-toggle-header "Sign-Off" "yes"))
628
629(defun vc-git-log-edit-toggle-amend ()
630 "Toggle whether this will amend the previous commit.
631If toggling on, also insert its message into the buffer."
632 (interactive)
633 (when (log-edit-toggle-header "Amend" "yes")
634 (goto-char (point-max))
635 (unless (bolp) (insert "\n"))
636 (insert (with-output-to-string
637 (vc-git-command
638 standard-output 1 nil
639 "log" "--max-count=1" "--pretty=format:%B" "HEAD")))))
640
641(defvar vc-git-log-edit-mode-map
642 (let ((map (make-sparse-keymap "Git-Log-Edit")))
643 (define-key map "\C-c\C-s" 'vc-git-log-edit-toggle-signoff)
644 (define-key map "\C-c\C-e" 'vc-git-log-edit-toggle-amend)
645 map))
646
647(define-derived-mode vc-git-log-edit-mode log-edit-mode "Log-Edit/git"
648 "Major mode for editing Git log messages.
649It is based on `log-edit-mode', and has Git-specific extensions.")
650
0d42eb3e 651(defun vc-git-checkin (files _rev comment)
e97a42c1 652 (let ((coding-system-for-write vc-git-commits-coding-system))
9f7b98f8
DG
653 (cl-flet ((boolean-arg-fn
654 (argument)
655 (lambda (value) (when (equal value "yes") (list argument)))))
656 (apply 'vc-git-command nil 0 files
657 (nconc (list "commit" "-m")
658 (log-edit-extract-headers
659 `(("Author" . "--author")
660 ("Date" . "--date")
661 ("Amend" . ,(boolean-arg-fn "--amend"))
662 ("Sign-Off" . ,(boolean-arg-fn "--signoff")))
663 comment)
664 (list "--only" "--"))))))
fff4a046 665
ac3f4c6f 666(defun vc-git-find-revision (file rev buffer)
20c76c55
MA
667 (let* (process-file-side-effects
668 (coding-system-for-read 'binary)
669 (coding-system-for-write 'binary)
50d76a9f
DN
670 (fullname
671 (let ((fn (vc-git--run-command-string
672 file "ls-files" "-z" "--full-name" "--")))
673 ;; ls-files does not return anything when looking for a
674 ;; revision of a file that has been renamed or removed.
675 (if (string= fn "")
676 (file-relative-name file (vc-git-root default-directory))
677 (substring fn 0 -1)))))
108607bc
DN
678 (vc-git-command
679 buffer 0
50d76a9f
DN
680 nil
681 "cat-file" "blob" (concat (if rev rev "HEAD") ":" fullname))))
b0f90937 682
ab419665
XF
683(defun vc-git-find-ignore-file (file)
684 "Return the root directory of the repository of FILE."
685 (expand-file-name ".gitignore"
686 (vc-git-root file)))
7aa7fff0 687
0d42eb3e 688(defun vc-git-checkout (file &optional _editable rev)
7546c767 689 (vc-git-command nil 0 file "checkout" (or rev "HEAD")))
fff4a046
DN
690
691(defun vc-git-revert (file &optional contents-done)
692 "Revert FILE to the version stored in the git repository."
693 (if contents-done
b0f90937 694 (vc-git-command nil 0 file "update-index" "--")
cebf8ec6
DN
695 (vc-git-command nil 0 file "reset" "-q" "--")
696 (vc-git-command nil nil file "checkout" "-q" "--")))
fff4a046 697
8a4e6db8
SS
698(defvar vc-git-error-regexp-alist
699 '(("^ \\(.+\\) |" 1 nil nil 0))
700 "Value of `compilation-error-regexp-alist' in *vc-git* buffers.")
701
659114fd
CY
702(defun vc-git-pull (prompt)
703 "Pull changes into the current Git branch.
a2b6e5d6
CY
704Normally, this runs \"git pull\". If PROMPT is non-nil, prompt
705for the Git command to run."
659114fd
CY
706 (let* ((root (vc-git-root default-directory))
707 (buffer (format "*vc-git : %s*" (expand-file-name root)))
708 (command "pull")
02da65ff 709 (git-program vc-git-program)
659114fd
CY
710 args)
711 ;; If necessary, prompt for the exact command.
712 (when prompt
713 (setq args (split-string
a2b6e5d6 714 (read-shell-command "Git pull command: "
02da65ff 715 (format "%s pull" git-program)
659114fd
CY
716 'vc-git-history)
717 " " t))
718 (setq git-program (car args)
719 command (cadr args)
720 args (cddr args)))
a2b6e5d6 721 (apply 'vc-do-async-command buffer root git-program command args)
8a4e6db8 722 (with-current-buffer buffer (vc-exec-after '(vc-compilation-mode 'git)))
a2b6e5d6 723 (vc-set-async-update buffer)))
659114fd
CY
724
725(defun vc-git-merge-branch ()
726 "Merge changes into the current Git branch.
727This prompts for a branch to merge from."
728 (let* ((root (vc-git-root default-directory))
729 (buffer (format "*vc-git : %s*" (expand-file-name root)))
730 (branches (cdr (vc-git-branches)))
731 (merge-source
a2b6e5d6
CY
732 (completing-read "Merge from branch: "
733 (if (or (member "FETCH_HEAD" branches)
734 (not (file-readable-p
735 (expand-file-name ".git/FETCH_HEAD"
736 root))))
737 branches
738 (cons "FETCH_HEAD" branches))
739 nil t)))
02da65ff 740 (apply 'vc-do-async-command buffer root vc-git-program "merge"
a2b6e5d6 741 (list merge-source))
8a4e6db8 742 (with-current-buffer buffer (vc-exec-after '(vc-compilation-mode 'git)))
a2b6e5d6 743 (vc-set-async-update buffer)))
659114fd 744
53cc90ab
DN
745;;; HISTORY FUNCTIONS
746
712b9732
GM
747(autoload 'vc-setup-buffer "vc-dispatcher")
748
662c5698 749(defun vc-git-print-log (files buffer &optional shortlog start-revision limit)
bb7cdf58
GM
750 "Print commit log associated with FILES into specified BUFFER.
751If SHORTLOG is non-nil, use a short format based on `vc-git-root-log-format'.
752\(This requires at least Git version 1.5.6, for the --graph option.)
753If START-REVISION is non-nil, it is the newest revision to show.
754If LIMIT is non-nil, show no more than this many entries."
e97a42c1 755 (let ((coding-system-for-read vc-git-commits-coding-system))
53cc90ab
DN
756 ;; `vc-do-command' creates the buffer, but we need it before running
757 ;; the command.
758 (vc-setup-buffer buffer)
759 ;; If the buffer exists from a previous invocation it might be
760 ;; read-only.
761 (let ((inhibit-read-only t))
934a944e
AJ
762 (with-current-buffer
763 buffer
0d3f8a78
DN
764 (apply 'vc-git-command buffer
765 'async files
766 (append
58941d03 767 '("log" "--no-color")
0d3f8a78 768 (when shortlog
33f6cf7b
CY
769 `("--graph" "--decorate" "--date=short"
770 ,(format "--pretty=tformat:%s"
771 (car vc-git-root-log-format))
772 "--abbrev-commit"))
0d3f8a78 773 (when limit (list "-n" (format "%s" limit)))
662c5698 774 (when start-revision (list start-revision))
0d3f8a78 775 '("--")))))))
53cc90ab 776
31527c56
DN
777(defun vc-git-log-outgoing (buffer remote-location)
778 (interactive)
779 (vc-git-command
780 buffer 0 nil
6941ffec
DN
781 "log"
782 "--no-color" "--graph" "--decorate" "--date=short"
33f6cf7b
CY
783 (format "--pretty=tformat:%s" (car vc-git-root-log-format))
784 "--abbrev-commit"
6941ffec 785 (concat (if (string= remote-location "")
eccdfe5f 786 "@{upstream}"
6941ffec
DN
787 remote-location)
788 "..HEAD")))
61158bfa
DN
789
790(defun vc-git-log-incoming (buffer remote-location)
791 (interactive)
6941ffec 792 (vc-git-command nil 0 nil "fetch")
61158bfa
DN
793 (vc-git-command
794 buffer 0 nil
33f6cf7b 795 "log"
6941ffec 796 "--no-color" "--graph" "--decorate" "--date=short"
33f6cf7b
CY
797 (format "--pretty=tformat:%s" (car vc-git-root-log-format))
798 "--abbrev-commit"
6941ffec 799 (concat "HEAD.." (if (string= remote-location "")
eccdfe5f 800 "@{upstream}"
6941ffec 801 remote-location))))
31527c56 802
53cc90ab
DN
803(defvar log-view-message-re)
804(defvar log-view-file-re)
805(defvar log-view-font-lock-keywords)
934a944e 806(defvar log-view-per-file-logs)
33f6cf7b 807(defvar log-view-expanded-log-entry-function)
53cc90ab 808
4211679b 809(define-derived-mode vc-git-log-view-mode log-view-mode "Git-Log-View"
4c83ed3d 810 (require 'add-log) ;; We need the faces add-log.
53cc90ab 811 ;; Don't have file markers, so use impossible regexp.
934a944e
AJ
812 (set (make-local-variable 'log-view-file-re) "\\`a\\`")
813 (set (make-local-variable 'log-view-per-file-logs) nil)
53cc90ab 814 (set (make-local-variable 'log-view-message-re)
eccdfe5f 815 (if (not (eq vc-log-view-type 'long))
33f6cf7b 816 (cadr vc-git-root-log-format)
79d316d3 817 "^commit *\\([0-9a-z]+\\)"))
33f6cf7b
CY
818 ;; Allow expanding short log entries
819 (when (eq vc-log-view-type 'short)
820 (setq truncate-lines t)
821 (set (make-local-variable 'log-view-expanded-log-entry-function)
822 'vc-git-expanded-log-entry))
53cc90ab 823 (set (make-local-variable 'log-view-font-lock-keywords)
eccdfe5f 824 (if (not (eq vc-log-view-type 'long))
33f6cf7b
CY
825 (list (cons (nth 1 vc-git-root-log-format)
826 (nth 2 vc-git-root-log-format)))
827 (append
09ae5da1 828 `((,log-view-message-re (1 'change-log-acknowledgment)))
33f6cf7b
CY
829 ;; Handle the case:
830 ;; user: foo@bar
831 '(("^Author:[ \t]+\\([A-Za-z0-9_.+-]+@[A-Za-z0-9_.-]+\\)"
832 (1 'change-log-email))
833 ;; Handle the case:
834 ;; user: FirstName LastName <foo@bar>
835 ("^Author:[ \t]+\\([^<(]+?\\)[ \t]*[(<]\\([A-Za-z0-9_.+-]+@[A-Za-z0-9_.-]+\\)[>)]"
836 (1 'change-log-name)
837 (2 'change-log-email))
838 ("^ +\\(?:\\(?:[Aa]cked\\|[Ss]igned-[Oo]ff\\)-[Bb]y:\\)[ \t]+\\([A-Za-z0-9_.+-]+@[A-Za-z0-9_.-]+\\)"
839 (1 'change-log-name))
840 ("^ +\\(?:\\(?:[Aa]cked\\|[Ss]igned-[Oo]ff\\)-[Bb]y:\\)[ \t]+\\([^<(]+?\\)[ \t]*[(<]\\([A-Za-z0-9_.+-]+@[A-Za-z0-9_.-]+\\)[>)]"
841 (1 'change-log-name)
842 (2 'change-log-email))
843 ("^Merge: \\([0-9a-z]+\\) \\([0-9a-z]+\\)"
09ae5da1
PE
844 (1 'change-log-acknowledgment)
845 (2 'change-log-acknowledgment))
33f6cf7b 846 ("^Date: \\(.+\\)" (1 'change-log-date))
32ba3abc
DN
847 ("^summary:[ \t]+\\(.+\\)" (1 'log-view-message)))))))
848
fff4a046 849
b16bd82d
TTN
850(defun vc-git-show-log-entry (revision)
851 "Move to the log entry for REVISION.
852REVISION may have the form BRANCH, BRANCH~N,
853or BRANCH^ (where \"^\" can be repeated)."
854 (goto-char (point-min))
4c83ed3d
SM
855 (prog1
856 (when revision
857 (search-forward
858 (format "\ncommit %s" revision) nil t
859 (cond ((string-match "~\\([0-9]\\)\\'" revision)
860 (1+ (string-to-number (match-string 1 revision))))
861 ((string-match "\\^+\\'" revision)
862 (1+ (length (match-string 0 revision))))
863 (t nil))))
864 (beginning-of-line)))
b16bd82d 865
33f6cf7b
CY
866(defun vc-git-expanded-log-entry (revision)
867 (with-temp-buffer
868 (apply 'vc-git-command t nil nil (list "log" revision "-1"))
869 (goto-char (point-min))
870 (unless (eobp)
871 ;; Indent the expanded log entry.
872 (indent-region (point-min) (point-max) 2)
873 (buffer-string))))
874
712b9732
GM
875(autoload 'vc-switches "vc")
876
b747d346 877(defun vc-git-diff (files &optional rev1 rev2 buffer)
a0bea999 878 "Get a difference report using Git between two revisions of FILES."
20c76c55
MA
879 (let (process-file-side-effects)
880 (apply #'vc-git-command (or buffer "*vc-diff*") 1 files
881 (if (and rev1 rev2) "diff-tree" "diff-index")
882 "--exit-code"
883 (append (vc-switches 'git 'diff)
884 (list "-p" (or rev1 "HEAD") rev2 "--")))))
fff4a046 885
0d42eb3e 886(defun vc-git-revision-table (_files)
9f11ce4e 887 ;; What about `files'?!? --Stef
20c76c55
MA
888 (let (process-file-side-effects
889 (table (list "HEAD")))
108607bc
DN
890 (with-temp-buffer
891 (vc-git-command t nil nil "for-each-ref" "--format=%(refname)")
892 (goto-char (point-min))
53ef91b1
SM
893 (while (re-search-forward "^refs/\\(heads\\|tags\\|remotes\\)/\\(.*\\)$"
894 nil t)
108607bc
DN
895 (push (match-string 2) table)))
896 table))
897
9f11ce4e 898(defun vc-git-revision-completion-table (files)
0d42eb3e
SM
899 (letrec ((table (lazy-completion-table
900 table (lambda () (vc-git-revision-table files)))))
108607bc
DN
901 table))
902
fff4a046 903(defun vc-git-annotate-command (file buf &optional rev)
fff4a046 904 (let ((name (file-relative-name file)))
50d76a9f 905 (vc-git-command buf 'async nil "blame" "--date=iso" "-C" "-C" rev "--" name)))
fff4a046 906
f8bd9ac6
DN
907(declare-function vc-annotate-convert-time "vc-annotate" (time))
908
fff4a046 909(defun vc-git-annotate-time ()
0bcc6163 910 (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)
fff4a046 911 (vc-annotate-convert-time
2aa0736a
TTN
912 (apply #'encode-time (mapcar (lambda (match)
913 (string-to-number (match-string match)))
914 '(6 5 4 3 2 1 7))))))
fff4a046 915
53cc90ab 916(defun vc-git-annotate-extract-revision-at-line ()
2aa0736a
TTN
917 (save-excursion
918 (move-beginning-of-line 1)
d1e4c403
DN
919 (when (looking-at "\\([0-9a-f^][0-9a-f]+\\) \\(\\([^(]+\\) \\)?")
920 (let ((revision (match-string-no-properties 1)))
921 (if (match-beginning 2)
c036381c
DN
922 (let ((fname (match-string-no-properties 3)))
923 ;; Remove trailing whitespace from the file name.
924 (when (string-match " +\\'" fname)
925 (setq fname (substring fname 0 (match-beginning 0))))
926 (cons revision
927 (expand-file-name fname (vc-git-root default-directory))))
d1e4c403 928 revision)))))
53cc90ab 929
370fded4 930;;; TAG SYSTEM
b747d346 931
370fded4 932(defun vc-git-create-tag (dir name branchp)
b747d346
DN
933 (let ((default-directory dir))
934 (and (vc-git-command nil 0 nil "update-index" "--refresh")
935 (if branchp
936 (vc-git-command nil 0 nil "checkout" "-b" name)
937 (vc-git-command nil 0 nil "tag" name)))))
938
0d42eb3e 939(defun vc-git-retrieve-tag (dir name _update)
b747d346
DN
940 (let ((default-directory dir))
941 (vc-git-command nil 0 nil "checkout" name)
942 ;; FIXME: update buffers if `update' is true
943 ))
944
945
53cc90ab 946;;; MISCELLANEOUS
fff4a046 947
5b5afd50
ER
948(defun vc-git-previous-revision (file rev)
949 "Git-specific version of `vc-previous-revision'."
934a944e 950 (if file
50d76a9f 951 (let* ((fname (file-relative-name file))
4537363c
AJ
952 (prev-rev (with-temp-buffer
953 (and
50d76a9f 954 (vc-git--out-ok "rev-list" "-2" rev "--" fname)
4537363c
AJ
955 (goto-char (point-max))
956 (bolp)
957 (zerop (forward-line -1))
958 (not (bobp))
959 (buffer-substring-no-properties
960 (point)
961 (1- (point-max)))))))
962 (or (vc-git-symbolic-commit prev-rev) prev-rev))
f1a60a0f
DG
963 (vc-git--rev-parse (concat rev "^"))))
964
965(defun vc-git--rev-parse (rev)
966 (with-temp-buffer
967 (and
968 (vc-git--out-ok "rev-parse" rev)
969 (buffer-substring-no-properties (point-min) (+ (point-min) 40)))))
fff4a046 970
5b5afd50
ER
971(defun vc-git-next-revision (file rev)
972 "Git-specific version of `vc-next-revision'."
fff4a046
DN
973 (let* ((default-directory (file-name-directory
974 (expand-file-name file)))
2aa0736a
TTN
975 (file (file-name-nondirectory file))
976 (current-rev
977 (with-temp-buffer
978 (and
5fdbecd8 979 (vc-git--out-ok "rev-list" "-1" rev "--" file)
2aa0736a
TTN
980 (goto-char (point-max))
981 (bolp)
982 (zerop (forward-line -1))
983 (bobp)
984 (buffer-substring-no-properties
985 (point)
4537363c
AJ
986 (1- (point-max))))))
987 (next-rev
988 (and current-rev
989 (with-temp-buffer
990 (and
991 (vc-git--out-ok "rev-list" "HEAD" "--" file)
992 (goto-char (point-min))
993 (search-forward current-rev nil t)
994 (zerop (forward-line -1))
995 (buffer-substring-no-properties
996 (point)
997 (progn (forward-line 1) (1- (point)))))))))
998 (or (vc-git-symbolic-commit next-rev) next-rev)))
fff4a046 999
8b38ce20
DN
1000(defun vc-git-delete-file (file)
1001 (vc-git-command nil 0 file "rm" "-f" "--"))
b0f90937 1002
8b38ce20
DN
1003(defun vc-git-rename-file (old new)
1004 (vc-git-command nil 0 (list old new) "mv" "-f" "--"))
b0f90937 1005
f0e1713e
DN
1006(defvar vc-git-extra-menu-map
1007 (let ((map (make-sparse-keymap)))
1008 (define-key map [git-grep]
1009 '(menu-item "Git grep..." vc-git-grep
1010 :help "Run the `git grep' command"))
e2f3c692 1011 (define-key map [git-sn]
7cc6e154 1012 '(menu-item "Stash a Snapshot" vc-git-stash-snapshot
e2f3c692 1013 :help "Stash the current state of the tree and keep the current state"))
2ddf440d 1014 (define-key map [git-st]
e2f3c692 1015 '(menu-item "Create Stash..." vc-git-stash
2ddf440d
DN
1016 :help "Stash away changes"))
1017 (define-key map [git-ss]
1018 '(menu-item "Show Stash..." vc-git-stash-show
1019 :help "Show stash contents"))
f0e1713e
DN
1020 map))
1021
1022(defun vc-git-extra-menu () vc-git-extra-menu-map)
1023
1024(defun vc-git-extra-status-menu () vc-git-extra-menu-map)
1025
32ba3abc 1026(defun vc-git-root (file)
a40c87a0
MA
1027 (or (vc-file-getprop file 'git-root)
1028 (vc-file-setprop file 'git-root (vc-find-root file ".git"))))
32ba3abc 1029
712b9732
GM
1030;; grep-compute-defaults autoloads grep.
1031(declare-function grep-read-regexp "grep" ())
1032(declare-function grep-read-files "grep" (regexp))
1033(declare-function grep-expand-template "grep"
1034 (template &optional regexp files dir excl))
1035
f0e1713e
DN
1036;; Derived from `lgrep'.
1037(defun vc-git-grep (regexp &optional files dir)
1038 "Run git grep, searching for REGEXP in FILES in directory DIR.
1039The search is limited to file names matching shell pattern FILES.
1040FILES may use abbreviations defined in `grep-files-aliases', e.g.
1041entering `ch' is equivalent to `*.[ch]'.
1042
1043With \\[universal-argument] prefix, you can edit the constructed shell command line
1044before it is executed.
1045With two \\[universal-argument] prefixes, directly edit and run `grep-command'.
1046
1047Collect output in a buffer. While git grep runs asynchronously, you
1048can use \\[next-error] (M-x next-error), or \\<grep-mode-map>\\[compile-goto-error] \
1049in the grep output buffer,
1050to go to the lines where grep found matches.
1051
1052This command shares argument histories with \\[rgrep] and \\[grep]."
1053 (interactive
1054 (progn
1055 (grep-compute-defaults)
1056 (cond
1057 ((equal current-prefix-arg '(16))
1058 (list (read-from-minibuffer "Run: " "git grep"
1059 nil nil 'grep-history)
1060 nil))
1061 (t (let* ((regexp (grep-read-regexp))
1062 (files (grep-read-files regexp))
1063 (dir (read-directory-name "In directory: "
1064 nil default-directory t)))
1065 (list regexp files dir))))))
1066 (require 'grep)
1067 (when (and (stringp regexp) (> (length regexp) 0))
1068 (let ((command regexp))
1069 (if (null files)
1070 (if (string= command "git grep")
1071 (setq command nil))
1072 (setq dir (file-name-as-directory (expand-file-name dir)))
1073 (setq command
91ab9c13 1074 (grep-expand-template "git grep -n -e <R> -- <F>"
793d32bb 1075 regexp files))
f0e1713e
DN
1076 (when command
1077 (if (equal current-prefix-arg '(4))
1078 (setq command
1079 (read-from-minibuffer "Confirm: "
1080 command nil nil 'grep-history))
1081 (add-to-history 'grep-history command))))
1082 (when command
1083 (let ((default-directory dir)
91ab9c13 1084 (compilation-environment (cons "PAGER=" compilation-environment)))
f0e1713e
DN
1085 ;; Setting process-setup-function makes exit-message-function work
1086 ;; even when async processes aren't supported.
1087 (compilation-start command 'grep-mode))
1088 (if (eq next-error-last-buffer (current-buffer))
1089 (setq default-directory dir))))))
2a0e3379 1090
712b9732
GM
1091;; Everywhere but here, follows vc-git-command, which uses vc-do-command
1092;; from vc-dispatcher.
1093(autoload 'vc-resynch-buffer "vc-dispatcher")
1094
2ddf440d
DN
1095(defun vc-git-stash (name)
1096 "Create a stash."
1097 (interactive "sStash name: ")
1098 (let ((root (vc-git-root default-directory)))
1099 (when root
1100 (vc-git--call nil "stash" "save" name)
1101 (vc-resynch-buffer root t t))))
1102
1103(defun vc-git-stash-show (name)
1104 "Show the contents of stash NAME."
1105 (interactive "sStash name: ")
1106 (vc-setup-buffer "*vc-git-stash*")
1107 (vc-git-command "*vc-git-stash*" 'async nil "stash" "show" "-p" name)
1108 (set-buffer "*vc-git-stash*")
1109 (diff-mode)
1110 (setq buffer-read-only t)
1111 (pop-to-buffer (current-buffer)))
1112
7fa4876f
DN
1113(defun vc-git-stash-apply (name)
1114 "Apply stash NAME."
1115 (interactive "sApply stash: ")
1116 (vc-git-command "*vc-git-stash*" 0 nil "stash" "apply" "-q" name)
1117 (vc-resynch-buffer (vc-git-root default-directory) t t))
1118
1119(defun vc-git-stash-pop (name)
1120 "Pop stash NAME."
1121 (interactive "sPop stash: ")
1122 (vc-git-command "*vc-git-stash*" 0 nil "stash" "pop" "-q" name)
1123 (vc-resynch-buffer (vc-git-root default-directory) t t))
1124
e2f3c692
DN
1125(defun vc-git-stash-snapshot ()
1126 "Create a stash with the current tree state."
1127 (interactive)
1128 (vc-git--call nil "stash" "save"
1129 (let ((ct (current-time)))
1130 (concat
1131 (format-time-string "Snapshot on %Y-%m-%d" ct)
1132 (format-time-string " at %H:%M" ct))))
1133 (vc-git-command "*vc-git-stash*" 0 nil "stash" "apply" "-q" "stash@{0}")
1134 (vc-resynch-buffer (vc-git-root default-directory) t t))
1135
2a0e3379 1136(defun vc-git-stash-list ()
0e172cc2
DN
1137 (delete
1138 ""
1139 (split-string
1140 (replace-regexp-in-string
1141 "^stash@" " " (vc-git--run-command-string nil "stash" "list"))
1142 "\n")))
1143
1144(defun vc-git-stash-get-at-point (point)
1145 (save-excursion
1146 (goto-char point)
1147 (beginning-of-line)
1148 (if (looking-at "^ +\\({[0-9]+}\\):")
1149 (match-string 1)
1150 (error "Cannot find stash at point"))))
1151
712b9732
GM
1152;; vc-git-stash-delete-at-point must be called from a vc-dir buffer.
1153(declare-function vc-dir-refresh "vc-dir" ())
1154
0e172cc2
DN
1155(defun vc-git-stash-delete-at-point ()
1156 (interactive)
1157 (let ((stash (vc-git-stash-get-at-point (point))))
e2f3c692 1158 (when (y-or-n-p (format "Remove stash %s ? " stash))
0e172cc2
DN
1159 (vc-git--run-command-string nil "stash" "drop" (format "stash@%s" stash))
1160 (vc-dir-refresh))))
1161
1162(defun vc-git-stash-show-at-point ()
1163 (interactive)
1164 (vc-git-stash-show (format "stash@%s" (vc-git-stash-get-at-point (point)))))
1165
7fa4876f
DN
1166(defun vc-git-stash-apply-at-point ()
1167 (interactive)
1168 (vc-git-stash-apply (format "stash@%s" (vc-git-stash-get-at-point (point)))))
1169
1170(defun vc-git-stash-pop-at-point ()
1171 (interactive)
1172 (vc-git-stash-pop (format "stash@%s" (vc-git-stash-get-at-point (point)))))
1173
1174(defun vc-git-stash-menu (e)
1175 (interactive "e")
1176 (vc-dir-at-event e (popup-menu vc-git-stash-menu-map e)))
1177
fff4a046 1178\f
b747d346 1179;;; Internal commands
fff4a046 1180
8b9783e0 1181(defun vc-git-command (buffer okstatus file-or-list &rest flags)
53cc90ab 1182 "A wrapper around `vc-do-command' for use in vc-git.el.
02da65ff
GM
1183The difference to vc-do-command is that this function always invokes
1184`vc-git-program'."
1185 (apply 'vc-do-command (or buffer "*vc*") okstatus vc-git-program
a8b733a5 1186 file-or-list (cons "--no-pager" flags)))
53cc90ab 1187
8e4e4aef
DN
1188(defun vc-git--empty-db-p ()
1189 "Check if the git db is empty (no commit done yet)."
20c76c55
MA
1190 (let (process-file-side-effects)
1191 (not (eq 0 (vc-git--call nil "rev-parse" "--verify" "HEAD")))))
8e4e4aef 1192
5fdbecd8 1193(defun vc-git--call (buffer command &rest args)
0664ff72
MA
1194 ;; We don't need to care the arguments. If there is a file name, it
1195 ;; is always a relative one. This works also for remote
99a54f21
MA
1196 ;; directories. We enable `inhibit-null-byte-detection', otherwise
1197 ;; Tramp's eol conversion might be confused.
1198 (let ((inhibit-null-byte-detection t)
1199 (process-environment (cons "PAGER=" process-environment)))
1200 (apply 'process-file vc-git-program nil buffer nil command args)))
5fdbecd8
TTN
1201
1202(defun vc-git--out-ok (command &rest args)
1203 (zerop (apply 'vc-git--call '(t nil) command args)))
1204
fff4a046 1205(defun vc-git--run-command-string (file &rest args)
2a0e3379
DN
1206 "Run a git command on FILE and return its output as string.
1207FILE can be nil."
fff4a046
DN
1208 (let* ((ok t)
1209 (str (with-output-to-string
1210 (with-current-buffer standard-output
5fdbecd8 1211 (unless (apply 'vc-git--out-ok
2a0e3379
DN
1212 (if file
1213 (append args (list (file-relative-name
1214 file)))
1215 args))
fff4a046
DN
1216 (setq ok nil))))))
1217 (and ok str)))
1218
fff4a046
DN
1219(defun vc-git-symbolic-commit (commit)
1220 "Translate COMMIT string into symbolic form.
1221Returns nil if not possible."
1222 (and commit
4537363c
AJ
1223 (let ((name (with-temp-buffer
1224 (and
1225 (vc-git--out-ok "name-rev" "--name-only" commit)
1226 (goto-char (point-min))
1227 (= (forward-line 2) 1)
1228 (bolp)
4c83ed3d
SM
1229 (buffer-substring-no-properties (point-min)
1230 (1- (point-max)))))))
4537363c 1231 (and name (not (string= name "undefined")) name))))
fff4a046
DN
1232
1233(provide 'vc-git)
53cc90ab
DN
1234
1235;;; vc-git.el ends here