Line data Source code
1 : ;;; vc-git.el --- VC backend for the git version control system -*- lexical-binding: t -*-
2 :
3 : ;; Copyright (C) 2006-2017 Free Software Foundation, Inc.
4 :
5 : ;; Author: Alexandre Julliard <julliard@winehq.org>
6 : ;; Keywords: vc tools
7 : ;; Package: vc
8 :
9 : ;; This file is part of GNU Emacs.
10 :
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.
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
22 : ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
23 :
24 : ;;; Commentary:
25 :
26 : ;; This file contains a VC backend for the git version control
27 : ;; system.
28 : ;;
29 :
30 : ;;; Installation:
31 :
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 init file, will accomplish this:
35 : ;;
36 : ;; (add-to-list 'vc-handled-backends 'Git)
37 :
38 : ;;; Todo:
39 : ;; - check if more functions could use vc-git-command instead
40 : ;; of start-process.
41 : ;; - changelog generation
42 :
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")
46 : ;;
47 : ;; FUNCTION NAME STATUS
48 : ;; BACKEND PROPERTIES
49 : ;; * revision-granularity OK
50 : ;; STATE-QUERYING FUNCTIONS
51 : ;; * registered (file) OK
52 : ;; * state (file) OK
53 : ;; - dir-status-files (dir files uf) OK
54 : ;; * working-revision (file) OK
55 : ;; * checkout-model (files) OK
56 : ;; - mode-line-string (file) OK
57 : ;; STATE-CHANGING FUNCTIONS
58 : ;; * create-repo () OK
59 : ;; * register (files &optional rev comment) OK
60 : ;; - responsible-p (file) OK
61 : ;; - receive-file (file rev) NOT NEEDED
62 : ;; - unregister (file) OK
63 : ;; * checkin (files rev comment) OK
64 : ;; * find-revision (file rev buffer) OK
65 : ;; * checkout (file &optional rev) OK
66 : ;; * revert (file &optional contents-done) OK
67 : ;; - merge-file (file rev1 rev2) It would be possible to merge
68 : ;; changes into a single file, but
69 : ;; when committing they wouldn't
70 : ;; be identified as a merge
71 : ;; by git, so it's probably
72 : ;; not a good idea.
73 : ;; - merge-news (file) see `merge-file'
74 : ;; - steal-lock (file &optional revision) NOT NEEDED
75 : ;; HISTORY FUNCTIONS
76 : ;; * print-log (files buffer &optional shortlog start-revision limit) OK
77 : ;; - log-view-mode () OK
78 : ;; - show-log-entry (revision) OK
79 : ;; - comment-history (file) ??
80 : ;; - update-changelog (files) COULD BE SUPPORTED
81 : ;; * diff (file &optional rev1 rev2 buffer async) OK
82 : ;; - revision-completion-table (files) OK
83 : ;; - annotate-command (file buf &optional rev) OK
84 : ;; - annotate-time () OK
85 : ;; - annotate-current-time () NOT NEEDED
86 : ;; - annotate-extract-revision-at-line () OK
87 : ;; TAG SYSTEM
88 : ;; - create-tag (dir name branchp) OK
89 : ;; - retrieve-tag (dir name update) OK
90 : ;; MISCELLANEOUS
91 : ;; - make-version-backups-p (file) NOT NEEDED
92 : ;; - previous-revision (file rev) OK
93 : ;; - next-revision (file rev) OK
94 : ;; - check-headers () COULD BE SUPPORTED
95 : ;; - delete-file (file) OK
96 : ;; - rename-file (old new) OK
97 : ;; - find-file-hook () OK
98 : ;; - conflicted-files OK
99 :
100 : ;;; Code:
101 :
102 : (eval-when-compile
103 : (require 'cl-lib)
104 : (require 'vc)
105 : (require 'vc-dir)
106 : (require 'grep))
107 :
108 : (defgroup vc-git nil
109 : "VC Git backend."
110 : :version "24.1"
111 : :group 'vc)
112 :
113 : (defcustom vc-git-diff-switches t
114 : "String or list of strings specifying switches for Git diff under VC.
115 : If nil, use the value of `vc-diff-switches'. If t, use no switches."
116 : :type '(choice (const :tag "Unspecified" nil)
117 : (const :tag "None" t)
118 : (string :tag "Argument String")
119 : (repeat :tag "Argument List" :value ("") string))
120 : :version "23.1")
121 :
122 : (defcustom vc-git-annotate-switches nil
123 : "String or list of strings specifying switches for Git blame under VC.
124 : If nil, use the value of `vc-annotate-switches'. If t, use no switches."
125 : :type '(choice (const :tag "Unspecified" nil)
126 : (const :tag "None" t)
127 : (string :tag "Argument String")
128 : (repeat :tag "Argument List" :value ("") string))
129 : :version "25.1")
130 :
131 : (defcustom vc-git-resolve-conflicts t
132 : "When non-nil, mark conflicted file as resolved upon saving.
133 : That is performed after all conflict markers in it have been
134 : removed. If the value is `unstage-maybe', and no merge is in
135 : progress, then after the last conflict is resolved, also clear
136 : the staging area."
137 : :type '(choice (const :tag "Don't resolve" nil)
138 : (const :tag "Resolve" t)
139 : (const :tag "Resolve and maybe unstage all files"
140 : unstage-maybe))
141 : :version "25.1")
142 :
143 : (defcustom vc-git-program "git"
144 : "Name of the Git executable (excluding any arguments)."
145 : :version "24.1"
146 : :type 'string)
147 :
148 : (defcustom vc-git-root-log-format
149 : '("%d%h..: %an %ad %s"
150 : ;; The first shy group matches the characters drawn by --graph.
151 : ;; We use numbered groups because `log-view-message-re' wants the
152 : ;; revision number to be group 1.
153 : "^\\(?:[*/\\| ]+ \\)?\\(?2: ([^)]+)\\)?\\(?1:[0-9a-z]+\\)..: \
154 : \\(?3:.*?\\)[ \t]+\\(?4:[0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}\\)"
155 : ((1 'log-view-message)
156 : (2 'change-log-list nil lax)
157 : (3 'change-log-name)
158 : (4 'change-log-date)))
159 : "Git log format for `vc-print-root-log'.
160 : This should be a list (FORMAT REGEXP KEYWORDS), where FORMAT is a
161 : format string (which is passed to \"git log\" via the argument
162 : \"--pretty=tformat:FORMAT\"), REGEXP is a regular expression
163 : matching the resulting Git log output, and KEYWORDS is a list of
164 : `font-lock-keywords' for highlighting the Log View buffer."
165 : :type '(list string string (repeat sexp))
166 : :version "24.1")
167 :
168 : (defcustom vc-git-commits-coding-system 'utf-8
169 : "Default coding system for sending commit log messages to Git.
170 :
171 : Should be consistent with the Git config value i18n.commitEncoding,
172 : and should also be consistent with `locale-coding-system'."
173 : :type '(coding-system :tag "Coding system to encode Git commit logs")
174 : :version "25.1")
175 :
176 : (defcustom vc-git-log-output-coding-system 'utf-8
177 : "Default coding system for receiving log output from Git.
178 :
179 : Should be consistent with the Git config value i18n.logOutputEncoding."
180 : :type '(coding-system :tag "Coding system to decode Git log output")
181 : :version "25.1")
182 :
183 : ;; History of Git commands.
184 : (defvar vc-git-history nil)
185 :
186 : ;;; BACKEND PROPERTIES
187 :
188 : (defun vc-git-revision-granularity () 'repository)
189 : (defun vc-git-checkout-model (_files) 'implicit)
190 :
191 : ;;; STATE-QUERYING FUNCTIONS
192 :
193 : ;;;###autoload (defun vc-git-registered (file)
194 : ;;;###autoload "Return non-nil if FILE is registered with git."
195 : ;;;###autoload (if (vc-find-root file ".git") ; Short cut.
196 : ;;;###autoload (progn
197 : ;;;###autoload (load "vc-git" nil t)
198 : ;;;###autoload (vc-git-registered file))))
199 :
200 : (defun vc-git-registered (file)
201 : "Check whether FILE is registered with git."
202 : (let ((dir (vc-git-root file)))
203 : (when dir
204 : (with-temp-buffer
205 : (let* (process-file-side-effects
206 : ;; Do not use the `file-name-directory' here: git-ls-files
207 : ;; sometimes fails to return the correct status for relative
208 : ;; path specs.
209 : ;; See also: http://marc.info/?l=git&m=125787684318129&w=2
210 : (name (file-relative-name file dir))
211 : (str (ignore-errors
212 : (cd dir)
213 : (vc-git--out-ok "ls-files" "-c" "-z" "--" name)
214 : ;; If result is empty, use ls-tree to check for deleted
215 : ;; file.
216 : (when (eq (point-min) (point-max))
217 : (vc-git--out-ok "ls-tree" "--name-only" "-z" "HEAD"
218 : "--" name))
219 : (buffer-string))))
220 : (and str
221 : (> (length str) (length name))
222 : (string= (substring str 0 (1+ (length name)))
223 : (concat name "\0"))))))))
224 :
225 : (defun vc-git--state-code (code)
226 : "Convert from a string to a added/deleted/modified state."
227 0 : (pcase (string-to-char code)
228 : (?M 'edited)
229 : (?A 'added)
230 : (?D 'removed)
231 : (?U 'edited) ;; FIXME
232 0 : (?T 'edited))) ;; FIXME
233 :
234 : (defvar vc-git--program-version nil)
235 :
236 : (defun vc-git--program-version ()
237 40 : (or vc-git--program-version
238 0 : (let ((version-string
239 0 : (vc-git--run-command-string nil "version")))
240 0 : (setq vc-git--program-version
241 0 : (if (and version-string
242 0 : (string-match "git version \\([0-9.]+\\)$"
243 0 : version-string))
244 0 : (match-string 1 version-string)
245 40 : "0")))))
246 :
247 : (defun vc-git--git-status-to-vc-state (code-list)
248 : "Convert CODE-LIST to a VC status.
249 :
250 : Each element of CODE-LIST comes from the first two characters of
251 : a line returned by 'git status --porcelain' and should be passed
252 : in the order given by 'git status'."
253 : ;; It is necessary to allow CODE-LIST to be a list because sometimes git
254 : ;; status returns multiple lines, e.g. for a file that is removed from
255 : ;; the index but is present in the HEAD and working tree.
256 40 : (pcase code-list
257 : ('nil 'up-to-date)
258 : (`(,code)
259 0 : (pcase code
260 : ("!!" 'ignored)
261 : ("??" 'unregistered)
262 : ;; I have only seen this with a file that is only present in the
263 : ;; index. Let us call this `removed'.
264 : ("AD" 'removed)
265 0 : (_ (cond
266 0 : ((string-match-p "^[ RD]+$" code) 'removed)
267 0 : ((string-match-p "^[ M]+$" code) 'edited)
268 0 : ((string-match-p "^[ A]+$" code) 'added)
269 0 : ((string-match-p "^[ U]+$" code) 'conflict)
270 0 : (t 'edited)))))
271 : ;; I know of two cases when git state returns more than one element,
272 : ;; in both cases returning '("D " "??")':
273 : ;; 1. When a file is removed from the index but present in the
274 : ;; HEAD and working tree.
275 : ;; 2. When a file A is renamed to B in the index and then back to A
276 : ;; in the working tree.
277 : ;; In both of these instances, `unregistered' is a reasonable response.
278 : (`("D " "??") 'unregistered)
279 : ;; In other cases, let us return `edited'.
280 40 : (_ 'edited)))
281 :
282 : (defun vc-git-state (file)
283 : "Git-specific version of `vc-state'."
284 : ;; It can't set `needs-update' or `needs-merge'. The rough
285 : ;; equivalent would be that upstream branch for current branch is in
286 : ;; fast-forward state i.e. current branch is direct ancestor of
287 : ;; corresponding upstream branch, and the file was modified
288 : ;; upstream. We'd need to check against the upstream tracking
289 : ;; branch for that (an extra process call or two).
290 40 : (let* ((args
291 40 : `("status" "--porcelain" "-z"
292 : ;; Just to be explicit, it's the default anyway.
293 : "--untracked-files"
294 40 : ,@(when (version<= "1.7.6.3" (vc-git--program-version))
295 40 : '("--ignored"))
296 40 : "--"))
297 40 : (status (apply #'vc-git--run-command-string file args)))
298 : ;; Alternatively, the `ignored' state could be detected with 'git
299 : ;; ls-files -i -o --exclude-standard', but that's an extra process
300 : ;; call, and the `ignored' state is rarely needed.
301 40 : (if (null status)
302 : ;; If status is nil, there was an error calling git, likely because
303 : ;; the file is not in a git repo.
304 : 'unregistered
305 : ;; If this code is adapted to parse 'git status' for a directory,
306 : ;; note that a renamed file takes up two null values and needs to be
307 : ;; treated slightly more carefully.
308 40 : (vc-git--git-status-to-vc-state
309 40 : (mapcar (lambda (s)
310 0 : (substring s 0 2))
311 40 : (split-string status "\0" t))))))
312 :
313 : (defun vc-git-working-revision (_file)
314 : "Git-specific version of `vc-working-revision'."
315 40 : (let (process-file-side-effects)
316 40 : (vc-git--rev-parse "HEAD")))
317 :
318 : (defun vc-git--symbolic-ref (file)
319 40 : (or
320 40 : (vc-file-getprop file 'vc-git-symbolic-ref)
321 40 : (let* (process-file-side-effects
322 40 : (str (vc-git--run-command-string nil "symbolic-ref" "HEAD")))
323 40 : (vc-file-setprop file 'vc-git-symbolic-ref
324 40 : (if str
325 40 : (if (string-match "^\\(refs/heads/\\)?\\(.+\\)$" str)
326 40 : (match-string 2 str)
327 40 : str))))))
328 :
329 : (defun vc-git-mode-line-string (file)
330 : "Return a string for `vc-mode-line' to put in the mode line for FILE."
331 40 : (let* ((rev (vc-working-revision file 'Git))
332 40 : (disp-rev (or (vc-git--symbolic-ref file)
333 40 : (substring rev 0 7)))
334 40 : (def-ml (vc-default-mode-line-string 'Git file))
335 40 : (help-echo (get-text-property 0 'help-echo def-ml))
336 40 : (face (get-text-property 0 'face def-ml)))
337 40 : (propertize (concat (substring def-ml 0 4) disp-rev)
338 40 : 'face face
339 40 : 'help-echo (concat help-echo "\nCurrent revision: " rev))))
340 :
341 : (cl-defstruct (vc-git-extra-fileinfo
342 : (:copier nil)
343 : (:constructor vc-git-create-extra-fileinfo
344 : (old-perm new-perm &optional rename-state orig-name))
345 : (:conc-name vc-git-extra-fileinfo->))
346 : old-perm new-perm ;; Permission flags.
347 : rename-state ;; Rename or copy state.
348 : orig-name) ;; Original name for renames or copies.
349 :
350 : (defun vc-git-escape-file-name (name)
351 : "Escape a file name if necessary."
352 0 : (if (string-match "[\n\t\"\\]" name)
353 0 : (concat "\""
354 0 : (mapconcat (lambda (c)
355 0 : (pcase c
356 : (?\n "\\n")
357 : (?\t "\\t")
358 : (?\\ "\\\\")
359 : (?\" "\\\"")
360 0 : (_ (char-to-string c))))
361 0 : name "")
362 0 : "\"")
363 0 : name))
364 :
365 : (defun vc-git-file-type-as-string (old-perm new-perm)
366 : "Return a string describing the file type based on its permissions."
367 0 : (let* ((old-type (lsh (or old-perm 0) -9))
368 0 : (new-type (lsh (or new-perm 0) -9))
369 0 : (str (pcase new-type
370 : (?\100 ;; File.
371 0 : (pcase old-type
372 : (?\100 nil)
373 : (?\120 " (type change symlink -> file)")
374 0 : (?\160 " (type change subproject -> file)")))
375 : (?\120 ;; Symlink.
376 0 : (pcase old-type
377 : (?\100 " (type change file -> symlink)")
378 : (?\160 " (type change subproject -> symlink)")
379 0 : (_ " (symlink)")))
380 : (?\160 ;; Subproject.
381 0 : (pcase old-type
382 : (?\100 " (type change file -> subproject)")
383 : (?\120 " (type change symlink -> subproject)")
384 0 : (_ " (subproject)")))
385 : (?\110 nil) ;; Directory (internal, not a real git state).
386 : (?\000 ;; Deleted or unknown.
387 0 : (pcase old-type
388 : (?\120 " (symlink)")
389 0 : (?\160 " (subproject)")))
390 0 : (_ (format " (unknown type %o)" new-type)))))
391 0 : (cond (str (propertize str 'face 'font-lock-comment-face))
392 0 : ((eq new-type ?\110) "/")
393 0 : (t ""))))
394 :
395 : (defun vc-git-rename-as-string (state extra)
396 : "Return a string describing the copy or rename associated with INFO,
397 : or an empty string if none."
398 0 : (let ((rename-state (when extra
399 0 : (vc-git-extra-fileinfo->rename-state extra))))
400 0 : (if rename-state
401 0 : (propertize
402 0 : (concat " ("
403 0 : (if (eq rename-state 'copy) "copied from "
404 0 : (if (eq state 'added) "renamed from "
405 0 : "renamed to "))
406 0 : (vc-git-escape-file-name
407 0 : (vc-git-extra-fileinfo->orig-name extra))
408 0 : ")")
409 0 : 'face 'font-lock-comment-face)
410 0 : "")))
411 :
412 : (defun vc-git-permissions-as-string (old-perm new-perm)
413 : "Format a permission change as string."
414 0 : (propertize
415 0 : (if (or (not old-perm)
416 0 : (not new-perm)
417 0 : (eq 0 (logand ?\111 (logxor old-perm new-perm))))
418 : " "
419 0 : (if (eq 0 (logand ?\111 old-perm)) "+x" "-x"))
420 0 : 'face 'font-lock-type-face))
421 :
422 : (defun vc-git-dir-printer (info)
423 : "Pretty-printer for the vc-dir-fileinfo structure."
424 0 : (let* ((isdir (vc-dir-fileinfo->directory info))
425 0 : (state (if isdir "" (vc-dir-fileinfo->state info)))
426 0 : (extra (vc-dir-fileinfo->extra info))
427 0 : (old-perm (when extra (vc-git-extra-fileinfo->old-perm extra)))
428 0 : (new-perm (when extra (vc-git-extra-fileinfo->new-perm extra))))
429 0 : (insert
430 : " "
431 0 : (propertize (format "%c" (if (vc-dir-fileinfo->marked info) ?* ? ))
432 0 : 'face 'font-lock-type-face)
433 : " "
434 0 : (propertize
435 0 : (format "%-12s" state)
436 0 : 'face (cond ((eq state 'up-to-date) 'font-lock-builtin-face)
437 0 : ((eq state 'missing) 'font-lock-warning-face)
438 0 : (t 'font-lock-variable-name-face))
439 0 : 'mouse-face 'highlight)
440 0 : " " (vc-git-permissions-as-string old-perm new-perm)
441 : " "
442 0 : (propertize (vc-git-escape-file-name (vc-dir-fileinfo->name info))
443 0 : 'face (if isdir 'font-lock-comment-delimiter-face
444 0 : 'font-lock-function-name-face)
445 : 'help-echo
446 0 : (if isdir
447 : "Directory\nVC operations can be applied to it\nmouse-3: Pop-up menu"
448 0 : "File\nmouse-3: Pop-up menu")
449 0 : 'keymap vc-dir-filename-mouse-map
450 0 : 'mouse-face 'highlight)
451 0 : (vc-git-file-type-as-string old-perm new-perm)
452 0 : (vc-git-rename-as-string state extra))))
453 :
454 : (cl-defstruct (vc-git-dir-status-state
455 : (:copier nil)
456 : (:conc-name vc-git-dir-status-state->))
457 : ;; Current stage.
458 : stage
459 : ;; List of files still to be processed.
460 : files
461 : ;; Update function to be called at the end.
462 : update-function
463 : ;; Hash table of entries for files we've computed so far.
464 0 : (hash (make-hash-table :test 'equal)))
465 :
466 : (defsubst vc-git-dir-status-update-file (state filename file-state file-info)
467 0 : (puthash filename (list file-state file-info)
468 0 : (vc-git-dir-status-state->hash state))
469 0 : (setf (vc-git-dir-status-state->files state)
470 0 : (delete filename (vc-git-dir-status-state->files state))))
471 :
472 : (defun vc-git-after-dir-status-stage (git-state)
473 : "Process sentinel for the various dir-status stages."
474 0 : (let (next-stage
475 0 : (files (vc-git-dir-status-state->files git-state)))
476 0 : (goto-char (point-min))
477 0 : (pcase (vc-git-dir-status-state->stage git-state)
478 : (`update-index
479 0 : (setq next-stage (if (vc-git--empty-db-p) 'ls-files-added 'diff-index)))
480 : (`ls-files-added
481 0 : (setq next-stage 'ls-files-unknown)
482 0 : (while (re-search-forward "\\([0-7]\\{6\\}\\) [0-9a-f]\\{40\\} 0\t\\([^\0]+\\)\0" nil t)
483 0 : (let ((new-perm (string-to-number (match-string 1) 8))
484 0 : (name (match-string 2)))
485 0 : (vc-git-dir-status-update-file
486 0 : git-state name 'added
487 0 : (vc-git-create-extra-fileinfo 0 new-perm)))))
488 : (`ls-files-up-to-date
489 0 : (setq next-stage 'ls-files-unknown)
490 0 : (while (re-search-forward "\\([0-7]\\{6\\}\\) [0-9a-f]\\{40\\} \\([0-3]\\)\t\\([^\0]+\\)\0" nil t)
491 0 : (let ((perm (string-to-number (match-string 1) 8))
492 0 : (state (match-string 2))
493 0 : (name (match-string 3)))
494 0 : (vc-git-dir-status-update-file
495 0 : git-state name (if (equal state "0")
496 : 'up-to-date
497 0 : 'conflict)
498 0 : (vc-git-create-extra-fileinfo perm perm)))))
499 : (`ls-files-conflict
500 0 : (setq next-stage 'ls-files-unknown)
501 : ;; It's enough to look for "3" to notice a conflict.
502 0 : (while (re-search-forward "\\([0-7]\\{6\\}\\) [0-9a-f]\\{40\\} 3\t\\([^\0]+\\)\0" nil t)
503 0 : (let ((perm (string-to-number (match-string 1) 8))
504 0 : (name (match-string 2)))
505 0 : (vc-git-dir-status-update-file
506 0 : git-state name 'conflict
507 0 : (vc-git-create-extra-fileinfo perm perm)))))
508 : (`ls-files-unknown
509 0 : (when files (setq next-stage 'ls-files-ignored))
510 0 : (while (re-search-forward "\\([^\0]*?\\)\0" nil t 1)
511 0 : (vc-git-dir-status-update-file git-state (match-string 1) 'unregistered
512 0 : (vc-git-create-extra-fileinfo 0 0))))
513 : (`ls-files-ignored
514 0 : (while (re-search-forward "\\([^\0]*?\\)\0" nil t 1)
515 0 : (vc-git-dir-status-update-file git-state (match-string 1) 'ignored
516 0 : (vc-git-create-extra-fileinfo 0 0))))
517 : (`diff-index
518 0 : (setq next-stage (if files 'ls-files-up-to-date 'ls-files-conflict))
519 0 : (while (re-search-forward
520 : ":\\([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"
521 0 : nil t 1)
522 0 : (let ((old-perm (string-to-number (match-string 1) 8))
523 0 : (new-perm (string-to-number (match-string 2) 8))
524 0 : (state (or (match-string 4) (match-string 6)))
525 0 : (name (or (match-string 5) (match-string 7)))
526 0 : (new-name (match-string 8)))
527 0 : (if new-name ; Copy or rename.
528 0 : (if (eq ?C (string-to-char state))
529 0 : (vc-git-dir-status-update-file
530 0 : git-state new-name 'added
531 0 : (vc-git-create-extra-fileinfo old-perm new-perm
532 0 : 'copy name))
533 0 : (vc-git-dir-status-update-file
534 0 : git-state name 'removed
535 0 : (vc-git-create-extra-fileinfo 0 0 'rename new-name))
536 0 : (vc-git-dir-status-update-file
537 0 : git-state new-name 'added
538 0 : (vc-git-create-extra-fileinfo old-perm new-perm
539 0 : 'rename name)))
540 0 : (vc-git-dir-status-update-file
541 0 : git-state name (vc-git--state-code state)
542 0 : (vc-git-create-extra-fileinfo old-perm new-perm)))))))
543 : ;; If we had files but now we don't, it's time to stop.
544 0 : (when (and files (not (vc-git-dir-status-state->files git-state)))
545 0 : (setq next-stage nil))
546 0 : (setf (vc-git-dir-status-state->stage git-state) next-stage)
547 0 : (setf (vc-git-dir-status-state->files git-state) files)
548 0 : (if next-stage
549 0 : (vc-git-dir-status-goto-stage git-state)
550 0 : (funcall (vc-git-dir-status-state->update-function git-state)
551 0 : (let ((result nil))
552 0 : (maphash (lambda (key value)
553 0 : (push (cons key value) result))
554 0 : (vc-git-dir-status-state->hash git-state))
555 0 : result)
556 0 : nil))))
557 :
558 : ;; Follows vc-git-command (or vc-do-async-command), which uses vc-do-command
559 : ;; from vc-dispatcher.
560 : (declare-function vc-exec-after "vc-dispatcher" (code))
561 : ;; Follows vc-exec-after.
562 : (declare-function vc-set-async-update "vc-dispatcher" (process-buffer))
563 :
564 : (defun vc-git-dir-status-goto-stage (git-state)
565 0 : (let ((files (vc-git-dir-status-state->files git-state)))
566 0 : (erase-buffer)
567 0 : (pcase (vc-git-dir-status-state->stage git-state)
568 : (`update-index
569 0 : (if files
570 0 : (vc-git-command (current-buffer) 'async files "add" "--refresh" "--")
571 0 : (vc-git-command (current-buffer) 'async nil
572 0 : "update-index" "--refresh")))
573 : (`ls-files-added
574 0 : (vc-git-command (current-buffer) 'async files
575 0 : "ls-files" "-z" "-c" "-s" "--"))
576 : (`ls-files-up-to-date
577 0 : (vc-git-command (current-buffer) 'async files
578 0 : "ls-files" "-z" "-c" "-s" "--"))
579 : (`ls-files-conflict
580 0 : (vc-git-command (current-buffer) 'async files
581 0 : "ls-files" "-z" "-c" "-s" "--"))
582 : (`ls-files-unknown
583 0 : (vc-git-command (current-buffer) 'async files
584 : "ls-files" "-z" "-o" "--directory"
585 0 : "--no-empty-directory" "--exclude-standard" "--"))
586 : (`ls-files-ignored
587 0 : (vc-git-command (current-buffer) 'async files
588 : "ls-files" "-z" "-o" "-i" "--directory"
589 0 : "--no-empty-directory" "--exclude-standard" "--"))
590 : ;; --relative added in Git 1.5.5.
591 : (`diff-index
592 0 : (vc-git-command (current-buffer) 'async files
593 0 : "diff-index" "--relative" "-z" "-M" "HEAD" "--")))
594 0 : (vc-run-delayed
595 0 : (vc-git-after-dir-status-stage git-state))))
596 :
597 : (defun vc-git-dir-status-files (_dir files update-function)
598 : "Return a list of (FILE STATE EXTRA) entries for DIR."
599 : ;; Further things that would have to be fixed later:
600 : ;; - how to handle unregistered directories
601 : ;; - how to support vc-dir on a subdir of the project tree
602 0 : (vc-git-dir-status-goto-stage
603 0 : (make-vc-git-dir-status-state :stage 'update-index
604 0 : :files files
605 0 : :update-function update-function)))
606 :
607 : (defvar vc-git-stash-map
608 : (let ((map (make-sparse-keymap)))
609 : ;; Turn off vc-dir marking
610 : (define-key map [mouse-2] 'ignore)
611 :
612 : (define-key map [down-mouse-3] 'vc-git-stash-menu)
613 : (define-key map "\C-k" 'vc-git-stash-delete-at-point)
614 : (define-key map "=" 'vc-git-stash-show-at-point)
615 : (define-key map "\C-m" 'vc-git-stash-show-at-point)
616 : (define-key map "A" 'vc-git-stash-apply-at-point)
617 : (define-key map "P" 'vc-git-stash-pop-at-point)
618 : (define-key map "S" 'vc-git-stash-snapshot)
619 : map))
620 :
621 : (defvar vc-git-stash-menu-map
622 : (let ((map (make-sparse-keymap "Git Stash")))
623 : (define-key map [de]
624 : '(menu-item "Delete Stash" vc-git-stash-delete-at-point
625 : :help "Delete the current stash"))
626 : (define-key map [ap]
627 : '(menu-item "Apply Stash" vc-git-stash-apply-at-point
628 : :help "Apply the current stash and keep it in the stash list"))
629 : (define-key map [po]
630 : '(menu-item "Apply and Remove Stash (Pop)" vc-git-stash-pop-at-point
631 : :help "Apply the current stash and remove it"))
632 : (define-key map [sh]
633 : '(menu-item "Show Stash" vc-git-stash-show-at-point
634 : :help "Show the contents of the current stash"))
635 : map))
636 :
637 : (defun vc-git-dir-extra-headers (dir)
638 0 : (let ((str (with-output-to-string
639 0 : (with-current-buffer standard-output
640 0 : (vc-git--out-ok "symbolic-ref" "HEAD"))))
641 0 : (stash (vc-git-stash-list))
642 : (stash-help-echo "Use M-x vc-git-stash to create stashes.")
643 : branch remote remote-url)
644 0 : (if (string-match "^\\(refs/heads/\\)?\\(.+\\)$" str)
645 0 : (progn
646 0 : (setq branch (match-string 2 str))
647 0 : (setq remote
648 0 : (with-output-to-string
649 0 : (with-current-buffer standard-output
650 0 : (vc-git--out-ok "config"
651 0 : (concat "branch." branch ".remote")))))
652 0 : (when (string-match "\\([^\n]+\\)" remote)
653 0 : (setq remote (match-string 1 remote)))
654 0 : (when remote
655 0 : (setq remote-url
656 0 : (with-output-to-string
657 0 : (with-current-buffer standard-output
658 0 : (vc-git--out-ok "config"
659 0 : (concat "remote." remote ".url"))))))
660 0 : (when (string-match "\\([^\n]+\\)" remote-url)
661 0 : (setq remote-url (match-string 1 remote-url))))
662 0 : (setq branch "not (detached HEAD)"))
663 : ;; FIXME: maybe use a different face when nothing is stashed.
664 0 : (concat
665 0 : (propertize "Branch : " 'face 'font-lock-type-face)
666 0 : (propertize branch
667 0 : 'face 'font-lock-variable-name-face)
668 0 : (when remote
669 0 : (concat
670 : "\n"
671 0 : (propertize "Remote : " 'face 'font-lock-type-face)
672 0 : (propertize remote-url
673 0 : 'face 'font-lock-variable-name-face)))
674 : "\n"
675 : ;; For now just a heading, key bindings can be added later for various bisect actions
676 0 : (when (file-exists-p (expand-file-name ".git/BISECT_START" (vc-git-root dir)))
677 0 : (propertize "Bisect : in progress\n" 'face 'font-lock-warning-face))
678 0 : (when (file-exists-p (expand-file-name ".git/rebase-apply" (vc-git-root dir)))
679 0 : (propertize "Rebase : in progress\n" 'face 'font-lock-warning-face))
680 0 : (if stash
681 0 : (concat
682 0 : (propertize "Stash :\n" 'face 'font-lock-type-face
683 0 : 'help-echo stash-help-echo)
684 0 : (mapconcat
685 : (lambda (x)
686 0 : (propertize x
687 : 'face 'font-lock-variable-name-face
688 : 'mouse-face 'highlight
689 : 'help-echo "mouse-3: Show stash menu\nRET: Show stash\nA: Apply stash\nP: Apply and remove stash (pop)\nC-k: Delete stash"
690 0 : 'keymap vc-git-stash-map))
691 0 : stash "\n"))
692 0 : (concat
693 0 : (propertize "Stash : " 'face 'font-lock-type-face
694 0 : 'help-echo stash-help-echo)
695 0 : (propertize "Nothing stashed"
696 0 : 'help-echo stash-help-echo
697 0 : 'face 'font-lock-variable-name-face))))))
698 :
699 : (defun vc-git-branches ()
700 : "Return the existing branches, as a list of strings.
701 : The car of the list is the current branch."
702 0 : (with-temp-buffer
703 0 : (vc-git--call t "branch")
704 0 : (goto-char (point-min))
705 0 : (let (current-branch branches)
706 0 : (while (not (eobp))
707 0 : (when (looking-at "^\\([ *]\\) \\(.+\\)$")
708 0 : (if (string-equal (match-string 1) "*")
709 0 : (setq current-branch (match-string 2))
710 0 : (push (match-string 2) branches)))
711 0 : (forward-line 1))
712 0 : (cons current-branch (nreverse branches)))))
713 :
714 : ;;; STATE-CHANGING FUNCTIONS
715 :
716 : (defun vc-git-create-repo ()
717 : "Create a new Git repository."
718 0 : (vc-git-command nil 0 nil "init"))
719 :
720 : (defun vc-git-register (files &optional _comment)
721 : "Register FILES into the git version-control system."
722 0 : (let (flist dlist)
723 0 : (dolist (crt files)
724 0 : (if (file-directory-p crt)
725 0 : (push crt dlist)
726 0 : (push crt flist)))
727 0 : (when flist
728 0 : (vc-git-command nil 0 flist "update-index" "--add" "--"))
729 0 : (when dlist
730 0 : (vc-git-command nil 0 dlist "add"))))
731 :
732 : (defalias 'vc-git-responsible-p 'vc-git-root)
733 :
734 : (defun vc-git-unregister (file)
735 0 : (vc-git-command nil 0 file "rm" "-f" "--cached" "--"))
736 :
737 : (declare-function log-edit-mode "log-edit" ())
738 : (declare-function log-edit-toggle-header "log-edit" (header value))
739 : (declare-function log-edit-extract-headers "log-edit" (headers string))
740 : (declare-function log-edit-set-header "log-edit" (header value &optional toggle))
741 :
742 : (defun vc-git-log-edit-toggle-signoff ()
743 : "Toggle whether to add the \"Signed-off-by\" line at the end of
744 : the commit message."
745 : (interactive)
746 0 : (log-edit-toggle-header "Sign-Off" "yes"))
747 :
748 : (defun vc-git-log-edit-toggle-amend ()
749 : "Toggle whether this will amend the previous commit.
750 : If toggling on, also insert its message into the buffer."
751 : (interactive)
752 0 : (when (log-edit-toggle-header "Amend" "yes")
753 0 : (goto-char (point-max))
754 0 : (unless (bolp) (insert "\n"))
755 0 : (insert (with-output-to-string
756 0 : (vc-git-command
757 0 : standard-output 1 nil
758 0 : "log" "--max-count=1" "--pretty=format:%B" "HEAD")))
759 0 : (save-excursion
760 0 : (rfc822-goto-eoh)
761 0 : (forward-line 1)
762 0 : (let ((pt (point)))
763 0 : (and (zerop (forward-line 1))
764 0 : (looking-at "\n\\|\\'")
765 0 : (let ((summary (buffer-substring-no-properties pt (1- (point)))))
766 0 : (skip-chars-forward " \n")
767 0 : (delete-region pt (point))
768 0 : (log-edit-set-header "Summary" summary)))))))
769 :
770 : (defvar vc-git-log-edit-mode-map
771 : (let ((map (make-sparse-keymap "Git-Log-Edit")))
772 : (define-key map "\C-c\C-s" 'vc-git-log-edit-toggle-signoff)
773 : (define-key map "\C-c\C-e" 'vc-git-log-edit-toggle-amend)
774 : map))
775 :
776 : (define-derived-mode vc-git-log-edit-mode log-edit-mode "Log-Edit/git"
777 : "Major mode for editing Git log messages.
778 : It is based on `log-edit-mode', and has Git-specific extensions.")
779 :
780 : (defun vc-git-checkin (files comment &optional _rev)
781 0 : (let* ((file1 (or (car files) default-directory))
782 0 : (root (vc-git-root file1))
783 0 : (default-directory (expand-file-name root))
784 0 : (only (or (cdr files)
785 0 : (not (equal root (abbreviate-file-name file1)))))
786 0 : (pcsw coding-system-for-write)
787 : (coding-system-for-write
788 : ;; On MS-Windows, we must encode command-line arguments in
789 : ;; the system codepage.
790 0 : (if (eq system-type 'windows-nt)
791 0 : locale-coding-system
792 0 : (or coding-system-for-write vc-git-commits-coding-system)))
793 : (msg-file
794 : ;; On MS-Windows, pass the commit log message through a
795 : ;; file, to work around the limitation that command-line
796 : ;; arguments must be in the system codepage, and therefore
797 : ;; might not support the non-ASCII characters in the log
798 : ;; message. Handle also remote files.
799 0 : (if (eq system-type 'windows-nt)
800 0 : (let ((default-directory (file-name-directory file1)))
801 0 : (make-nearby-temp-file "git-msg")))))
802 0 : (cl-flet ((boolean-arg-fn
803 : (argument)
804 0 : (lambda (value) (when (equal value "yes") (list argument)))))
805 : ;; When operating on the whole tree, better pass "-a" than ".", since "."
806 : ;; fails when we're committing a merge.
807 0 : (apply 'vc-git-command nil 0 (if only files)
808 0 : (nconc (if msg-file (list "commit" "-F"
809 0 : (file-local-name msg-file))
810 0 : (list "commit" "-m"))
811 0 : (let ((args
812 0 : (log-edit-extract-headers
813 0 : `(("Author" . "--author")
814 : ("Date" . "--date")
815 0 : ("Amend" . ,(boolean-arg-fn "--amend"))
816 0 : ("Sign-Off" . ,(boolean-arg-fn "--signoff")))
817 0 : comment)))
818 0 : (when msg-file
819 0 : (let ((coding-system-for-write
820 0 : (or pcsw vc-git-commits-coding-system)))
821 0 : (write-region (car args) nil msg-file))
822 0 : (setq args (cdr args)))
823 0 : args)
824 0 : (if only (list "--only" "--") '("-a")))))
825 0 : (if (and msg-file (file-exists-p msg-file)) (delete-file msg-file))))
826 :
827 : (defun vc-git-find-revision (file rev buffer)
828 0 : (let* (process-file-side-effects
829 : (coding-system-for-read 'binary)
830 : (coding-system-for-write 'binary)
831 : (fullname
832 0 : (let ((fn (vc-git--run-command-string
833 0 : file "ls-files" "-z" "--full-name" "--")))
834 : ;; ls-files does not return anything when looking for a
835 : ;; revision of a file that has been renamed or removed.
836 0 : (if (string= fn "")
837 0 : (file-relative-name file (vc-git-root default-directory))
838 0 : (substring fn 0 -1)))))
839 0 : (vc-git-command
840 0 : buffer 0
841 : nil
842 0 : "cat-file" "blob" (concat (if rev rev "HEAD") ":" fullname))))
843 :
844 : (defun vc-git-find-ignore-file (file)
845 : "Return the git ignore file that controls FILE."
846 0 : (expand-file-name ".gitignore"
847 0 : (vc-git-root file)))
848 :
849 : (defun vc-git-checkout (file &optional rev)
850 0 : (vc-git-command nil 0 file "checkout" (or rev "HEAD")))
851 :
852 : (defun vc-git-revert (file &optional contents-done)
853 : "Revert FILE to the version stored in the git repository."
854 0 : (if contents-done
855 0 : (vc-git-command nil 0 file "update-index" "--")
856 0 : (vc-git-command nil 0 file "reset" "-q" "--")
857 0 : (vc-git-command nil nil file "checkout" "-q" "--")))
858 :
859 : (defvar vc-git-error-regexp-alist
860 : '(("^ \\(.+\\) |" 1 nil nil 0))
861 : "Value of `compilation-error-regexp-alist' in *vc-git* buffers.")
862 :
863 : ;; To be called via vc-pull from vc.el, which requires vc-dispatcher.
864 : (declare-function vc-compilation-mode "vc-dispatcher" (backend))
865 :
866 : (defun vc-git--pushpull (command prompt)
867 : "Run COMMAND (a string; either push or pull) on the current Git branch.
868 : If PROMPT is non-nil, prompt for the Git command to run."
869 0 : (let* ((root (vc-git-root default-directory))
870 0 : (buffer (format "*vc-git : %s*" (expand-file-name root)))
871 0 : (git-program vc-git-program)
872 : args)
873 : ;; If necessary, prompt for the exact command.
874 : ;; TODO if pushing, prompt if no default push location - cf bzr.
875 0 : (when prompt
876 0 : (setq args (split-string
877 0 : (read-shell-command
878 0 : (format "Git %s command: " command)
879 0 : (format "%s %s" git-program command)
880 0 : 'vc-git-history)
881 0 : " " t))
882 0 : (setq git-program (car args)
883 0 : command (cadr args)
884 0 : args (cddr args)))
885 0 : (require 'vc-dispatcher)
886 0 : (apply 'vc-do-async-command buffer root git-program command args)
887 0 : (with-current-buffer buffer
888 0 : (vc-run-delayed
889 0 : (vc-compilation-mode 'git)
890 0 : (setq-local compile-command
891 0 : (concat git-program " " command " "
892 0 : (if args (mapconcat 'identity args " ") "")))
893 0 : (setq-local compilation-directory root)
894 : ;; Either set `compilation-buffer-name-function' locally to nil
895 : ;; or use `compilation-arguments' to set `name-function'.
896 : ;; See `compilation-buffer-name'.
897 0 : (setq-local compilation-arguments
898 0 : (list compile-command nil
899 0 : (lambda (_name-of-mode) buffer)
900 0 : nil))))
901 0 : (vc-set-async-update buffer)))
902 :
903 : (defun vc-git-pull (prompt)
904 : "Pull changes into the current Git branch.
905 : Normally, this runs \"git pull\". If PROMPT is non-nil, prompt
906 : for the Git command to run."
907 0 : (vc-git--pushpull "pull" prompt))
908 :
909 : (defun vc-git-push (prompt)
910 : "Push changes from the current Git branch.
911 : Normally, this runs \"git push\". If PROMPT is non-nil, prompt
912 : for the Git command to run."
913 0 : (vc-git--pushpull "push" prompt))
914 :
915 : (defun vc-git-merge-branch ()
916 : "Merge changes into the current Git branch.
917 : This prompts for a branch to merge from."
918 0 : (let* ((root (vc-git-root default-directory))
919 0 : (buffer (format "*vc-git : %s*" (expand-file-name root)))
920 0 : (branches (cdr (vc-git-branches)))
921 : (merge-source
922 0 : (completing-read "Merge from branch: "
923 0 : (if (or (member "FETCH_HEAD" branches)
924 0 : (not (file-readable-p
925 0 : (expand-file-name ".git/FETCH_HEAD"
926 0 : root))))
927 0 : branches
928 0 : (cons "FETCH_HEAD" branches))
929 0 : nil t)))
930 0 : (apply 'vc-do-async-command buffer root vc-git-program "merge"
931 0 : (list merge-source))
932 0 : (with-current-buffer buffer (vc-run-delayed (vc-compilation-mode 'git)))
933 0 : (vc-set-async-update buffer)))
934 :
935 : (defun vc-git-conflicted-files (directory)
936 : "Return the list of files with conflicts in DIRECTORY."
937 40 : (let* ((status
938 40 : (vc-git--run-command-string directory "status" "--porcelain" "--"))
939 40 : (lines (when status (split-string status "\n" 'omit-nulls)))
940 : files)
941 : ;; TODO: Look into reimplementing `vc-git-state', as well as
942 : ;; `vc-git-dir-status-files', based on this output, thus making the
943 : ;; extra process call in `vc-git-find-file-hook' unnecessary.
944 40 : (dolist (line lines files)
945 0 : (when (string-match "\\([ MADRCU?!][ MADRCU?!]\\) \\(.+\\)\\(?: -> \\(.+\\)\\)?"
946 0 : line)
947 0 : (let ((state (match-string 1 line))
948 0 : (file (match-string 2 line)))
949 : ;; See git-status(1).
950 0 : (when (member state '("AU" "UD" "UA" ;; "DD"
951 0 : "DU" "AA" "UU"))
952 40 : (push (expand-file-name file directory) files)))))))
953 :
954 : (defun vc-git-resolve-when-done ()
955 : "Call \"git add\" if the conflict markers have been removed."
956 0 : (save-excursion
957 0 : (goto-char (point-min))
958 0 : (unless (re-search-forward "^<<<<<<< " nil t)
959 0 : (vc-git-command nil 0 buffer-file-name "add")
960 0 : (unless (or
961 0 : (not (eq vc-git-resolve-conflicts 'unstage-maybe))
962 : ;; Doing a merge, so bug#20292 doesn't apply.
963 0 : (file-exists-p (expand-file-name ".git/MERGE_HEAD"
964 0 : (vc-git-root buffer-file-name)))
965 0 : (vc-git-conflicted-files (vc-git-root buffer-file-name)))
966 0 : (vc-git-command nil 0 nil "reset"))
967 : ;; Remove the hook so that it is not called multiple times.
968 0 : (remove-hook 'after-save-hook 'vc-git-resolve-when-done t))))
969 :
970 : (defun vc-git-find-file-hook ()
971 : "Activate `smerge-mode' if there is a conflict."
972 40 : (when (and buffer-file-name
973 : ;; FIXME
974 : ;; 1) the net result is to call git twice per file.
975 : ;; 2) v-g-c-f is documented to take a directory.
976 : ;; http://lists.gnu.org/archive/html/emacs-devel/2014-01/msg01126.html
977 40 : (vc-git-conflicted-files buffer-file-name)
978 0 : (save-excursion
979 0 : (goto-char (point-min))
980 40 : (re-search-forward "^<<<<<<< " nil 'noerror)))
981 0 : (vc-file-setprop buffer-file-name 'vc-state 'conflict)
982 0 : (smerge-start-session)
983 0 : (when vc-git-resolve-conflicts
984 0 : (add-hook 'after-save-hook 'vc-git-resolve-when-done nil 'local))
985 40 : (vc-message-unresolved-conflicts buffer-file-name)))
986 :
987 : ;;; HISTORY FUNCTIONS
988 :
989 : (autoload 'vc-setup-buffer "vc-dispatcher")
990 :
991 : (defcustom vc-git-print-log-follow nil
992 : "If true, follow renames in Git logs for files."
993 : :type 'boolean
994 : :version "26.1")
995 :
996 : (defun vc-git-print-log (files buffer &optional shortlog start-revision limit)
997 : "Print commit log associated with FILES into specified BUFFER.
998 : If SHORTLOG is non-nil, use a short format based on `vc-git-root-log-format'.
999 : \(This requires at least Git version 1.5.6, for the --graph option.)
1000 : If START-REVISION is non-nil, it is the newest revision to show.
1001 : If LIMIT is non-nil, show no more than this many entries."
1002 0 : (let ((coding-system-for-read
1003 0 : (or coding-system-for-read vc-git-log-output-coding-system)))
1004 : ;; `vc-do-command' creates the buffer, but we need it before running
1005 : ;; the command.
1006 0 : (vc-setup-buffer buffer)
1007 : ;; If the buffer exists from a previous invocation it might be
1008 : ;; read-only.
1009 0 : (let ((inhibit-read-only t))
1010 0 : (with-current-buffer
1011 0 : buffer
1012 0 : (apply 'vc-git-command buffer
1013 0 : 'async files
1014 0 : (append
1015 : '("log" "--no-color")
1016 0 : (when (and vc-git-print-log-follow
1017 0 : (not (cl-some #'file-directory-p files)))
1018 : ;; "--follow" on directories is broken
1019 : ;; https://debbugs.gnu.org/cgi/bugreport.cgi?bug=8756
1020 : ;; https://debbugs.gnu.org/cgi/bugreport.cgi?bug=16422
1021 0 : (list "--follow"))
1022 0 : (when shortlog
1023 0 : `("--graph" "--decorate" "--date=short"
1024 0 : ,(format "--pretty=tformat:%s"
1025 0 : (car vc-git-root-log-format))
1026 0 : "--abbrev-commit"))
1027 0 : (when limit (list "-n" (format "%s" limit)))
1028 0 : (when start-revision (list start-revision))
1029 0 : '("--")))))))
1030 :
1031 : (defun vc-git-log-outgoing (buffer remote-location)
1032 : (interactive)
1033 0 : (vc-git-command
1034 0 : buffer 'async nil
1035 : "log"
1036 : "--no-color" "--graph" "--decorate" "--date=short"
1037 0 : (format "--pretty=tformat:%s" (car vc-git-root-log-format))
1038 : "--abbrev-commit"
1039 0 : (concat (if (string= remote-location "")
1040 : "@{upstream}"
1041 0 : remote-location)
1042 0 : "..HEAD")))
1043 :
1044 : (defun vc-git-log-incoming (buffer remote-location)
1045 : (interactive)
1046 0 : (vc-git-command nil 0 nil "fetch")
1047 0 : (vc-git-command
1048 0 : buffer 'async nil
1049 : "log"
1050 : "--no-color" "--graph" "--decorate" "--date=short"
1051 0 : (format "--pretty=tformat:%s" (car vc-git-root-log-format))
1052 : "--abbrev-commit"
1053 0 : (concat "HEAD.." (if (string= remote-location "")
1054 : "@{upstream}"
1055 0 : remote-location))))
1056 :
1057 : (defvar log-view-message-re)
1058 : (defvar log-view-file-re)
1059 : (defvar log-view-font-lock-keywords)
1060 : (defvar log-view-per-file-logs)
1061 : (defvar log-view-expanded-log-entry-function)
1062 :
1063 : (define-derived-mode vc-git-log-view-mode log-view-mode "Git-Log-View"
1064 0 : (require 'add-log) ;; We need the faces add-log.
1065 : ;; Don't have file markers, so use impossible regexp.
1066 0 : (set (make-local-variable 'log-view-file-re) "\\`a\\`")
1067 0 : (set (make-local-variable 'log-view-per-file-logs) nil)
1068 0 : (set (make-local-variable 'log-view-message-re)
1069 0 : (if (not (eq vc-log-view-type 'long))
1070 0 : (cadr vc-git-root-log-format)
1071 0 : "^commit *\\([0-9a-z]+\\)"))
1072 : ;; Allow expanding short log entries.
1073 0 : (when (memq vc-log-view-type '(short log-outgoing log-incoming))
1074 0 : (setq truncate-lines t)
1075 0 : (set (make-local-variable 'log-view-expanded-log-entry-function)
1076 0 : 'vc-git-expanded-log-entry))
1077 0 : (set (make-local-variable 'log-view-font-lock-keywords)
1078 0 : (if (not (eq vc-log-view-type 'long))
1079 0 : (list (cons (nth 1 vc-git-root-log-format)
1080 0 : (nth 2 vc-git-root-log-format)))
1081 0 : (append
1082 0 : `((,log-view-message-re (1 'change-log-acknowledgment)))
1083 : ;; Handle the case:
1084 : ;; user: foo@bar
1085 : '(("^Author:[ \t]+\\([A-Za-z0-9_.+-]+@[A-Za-z0-9_.-]+\\)"
1086 : (1 'change-log-email))
1087 : ;; Handle the case:
1088 : ;; user: FirstName LastName <foo@bar>
1089 : ("^Author:[ \t]+\\([^<(]+?\\)[ \t]*[(<]\\([A-Za-z0-9_.+-]+@[A-Za-z0-9_.-]+\\)[>)]"
1090 : (1 'change-log-name)
1091 : (2 'change-log-email))
1092 : ("^ +\\(?:\\(?:[Aa]cked\\|[Ss]igned-[Oo]ff\\)-[Bb]y:\\)[ \t]+\\([A-Za-z0-9_.+-]+@[A-Za-z0-9_.-]+\\)"
1093 : (1 'change-log-name))
1094 : ("^ +\\(?:\\(?:[Aa]cked\\|[Ss]igned-[Oo]ff\\)-[Bb]y:\\)[ \t]+\\([^<(]+?\\)[ \t]*[(<]\\([A-Za-z0-9_.+-]+@[A-Za-z0-9_.-]+\\)[>)]"
1095 : (1 'change-log-name)
1096 : (2 'change-log-email))
1097 : ("^Merge: \\([0-9a-z]+\\) \\([0-9a-z]+\\)"
1098 : (1 'change-log-acknowledgment)
1099 : (2 'change-log-acknowledgment))
1100 : ("^Date: \\(.+\\)" (1 'change-log-date))
1101 0 : ("^summary:[ \t]+\\(.+\\)" (1 'log-view-message)))))))
1102 :
1103 :
1104 : (defun vc-git-show-log-entry (revision)
1105 : "Move to the log entry for REVISION.
1106 : REVISION may have the form BRANCH, BRANCH~N,
1107 : or BRANCH^ (where \"^\" can be repeated)."
1108 0 : (goto-char (point-min))
1109 0 : (prog1
1110 0 : (when revision
1111 0 : (search-forward
1112 0 : (format "\ncommit %s" revision) nil t
1113 0 : (cond ((string-match "~\\([0-9]\\)\\'" revision)
1114 0 : (1+ (string-to-number (match-string 1 revision))))
1115 0 : ((string-match "\\^+\\'" revision)
1116 0 : (1+ (length (match-string 0 revision))))
1117 0 : (t nil))))
1118 0 : (beginning-of-line)))
1119 :
1120 : (defun vc-git-expanded-log-entry (revision)
1121 0 : (with-temp-buffer
1122 0 : (apply 'vc-git-command t nil nil (list "log" revision "-1" "--"))
1123 0 : (goto-char (point-min))
1124 0 : (unless (eobp)
1125 : ;; Indent the expanded log entry.
1126 0 : (while (re-search-forward "^ " nil t)
1127 0 : (replace-match "")
1128 0 : (forward-line))
1129 0 : (buffer-string))))
1130 :
1131 : (defun vc-git-region-history (file buffer lfrom lto)
1132 : "Insert into BUFFER the history of FILE for lines LFROM to LTO.
1133 : This requires git 1.8.4 or later, for the \"-L\" option of \"git log\"."
1134 : ;; The "git log" command below interprets the line numbers as applying
1135 : ;; to the HEAD version of the file, not to the current state of the file.
1136 : ;; So we need to look at all the local changes and adjust lfrom/lto
1137 : ;; accordingly.
1138 : ;; FIXME: Maybe this should be done in vc.el (i.e. for all backends), but
1139 : ;; since Git is the only backend to support this operation so far, it's hard
1140 : ;; to tell.
1141 0 : (with-temp-buffer
1142 0 : (vc-call-backend 'git 'diff file "HEAD" nil (current-buffer))
1143 0 : (goto-char (point-min))
1144 0 : (let ((last-offset 0)
1145 : (from-offset nil)
1146 : (to-offset nil))
1147 0 : (while (re-search-forward
1148 0 : "^@@ -\\([0-9]+\\),\\([0-9]+\\) \\+\\([0-9]+\\),\\([0-9]+\\) @@" nil t)
1149 0 : (let ((headno (string-to-number (match-string 1)))
1150 0 : (headcnt (string-to-number (match-string 2)))
1151 0 : (curno (string-to-number (match-string 3)))
1152 0 : (curcnt (string-to-number (match-string 4))))
1153 0 : (cl-assert (equal (- curno headno) last-offset))
1154 0 : (and (null from-offset) (> curno lfrom)
1155 0 : (setq from-offset last-offset))
1156 0 : (and (null to-offset) (> curno lto)
1157 0 : (setq to-offset last-offset))
1158 0 : (setq last-offset
1159 0 : (- (+ curno curcnt) (+ headno headcnt)))))
1160 0 : (setq lto (- lto (or to-offset last-offset)))
1161 0 : (setq lfrom (- lfrom (or to-offset last-offset)))))
1162 0 : (vc-git-command buffer 'async nil "log" "-p" ;"--follow" ;FIXME: not supported?
1163 0 : (format "-L%d,%d:%s" lfrom lto (file-relative-name file))))
1164 :
1165 : (require 'diff-mode)
1166 :
1167 : (defvar vc-git-region-history-mode-map
1168 : (let ((map (make-composed-keymap
1169 : nil (make-composed-keymap
1170 : (list diff-mode-map vc-git-log-view-mode-map)))))
1171 : map))
1172 :
1173 : (defvar vc-git--log-view-long-font-lock-keywords nil)
1174 : (defvar font-lock-keywords)
1175 : (defvar vc-git-region-history-font-lock-keywords
1176 : `((vc-git-region-history-font-lock)))
1177 :
1178 : (defun vc-git-region-history-font-lock (limit)
1179 0 : (let ((in-diff (save-excursion
1180 0 : (beginning-of-line)
1181 0 : (or (looking-at "^\\(?:diff\\|commit\\)\\>")
1182 0 : (re-search-backward "^\\(?:diff\\|commit\\)\\>" nil t))
1183 0 : (eq ?d (char-after (match-beginning 0))))))
1184 0 : (while
1185 0 : (let ((end (save-excursion
1186 0 : (if (re-search-forward "\n\\(diff\\|commit\\)\\>"
1187 0 : limit t)
1188 0 : (match-beginning 1)
1189 0 : limit))))
1190 0 : (let ((font-lock-keywords (if in-diff diff-font-lock-keywords
1191 0 : vc-git--log-view-long-font-lock-keywords)))
1192 0 : (font-lock-fontify-keywords-region (point) end))
1193 0 : (goto-char end)
1194 0 : (prog1 (< (point) limit)
1195 0 : (setq in-diff (eq ?d (char-after))))))
1196 0 : nil))
1197 :
1198 : (define-derived-mode vc-git-region-history-mode
1199 : vc-git-log-view-mode "Git-Region-History"
1200 : "Major mode to browse Git's \"log -p\" output."
1201 0 : (setq-local vc-git--log-view-long-font-lock-keywords
1202 0 : log-view-font-lock-keywords)
1203 0 : (setq-local font-lock-defaults
1204 0 : (cons 'vc-git-region-history-font-lock-keywords
1205 0 : (cdr font-lock-defaults))))
1206 :
1207 : (defun vc-git--asciify-coding-system ()
1208 : ;; Try to reconcile the content encoding with the encoding of Git's
1209 : ;; auxiliary output (which is ASCII or ASCII-compatible), bug#23595.
1210 0 : (unless (let ((samp "Binary files differ"))
1211 0 : (string-equal samp (decode-coding-string
1212 0 : samp coding-system-for-read t)))
1213 0 : (setq coding-system-for-read 'undecided)))
1214 :
1215 : (autoload 'vc-switches "vc")
1216 :
1217 : (defun vc-git-diff (files &optional rev1 rev2 buffer _async)
1218 : "Get a difference report using Git between two revisions of FILES."
1219 0 : (let (process-file-side-effects
1220 : (command "diff-tree"))
1221 0 : (vc-git--asciify-coding-system)
1222 0 : (if rev2
1223 : ;; Diffing against the empty tree.
1224 0 : (unless rev1 (setq rev1 "4b825dc642cb6eb9a060e54bf8d69288fbee4904"))
1225 0 : (setq command "diff-index")
1226 0 : (unless rev1 (setq rev1 "HEAD")))
1227 0 : (if vc-git-diff-switches
1228 0 : (apply #'vc-git-command (or buffer "*vc-diff*")
1229 : 1 ; bug#21969
1230 0 : files
1231 0 : command
1232 : "--exit-code"
1233 0 : (append (vc-switches 'git 'diff)
1234 0 : (list "-p" (or rev1 "HEAD") rev2 "--")))
1235 0 : (vc-git-command (or buffer "*vc-diff*") 1 files
1236 : "difftool" "--exit-code" "--no-prompt" "-x"
1237 0 : (concat "diff "
1238 0 : (mapconcat 'identity
1239 0 : (vc-switches nil 'diff) " "))
1240 0 : rev1 rev2 "--"))))
1241 :
1242 : (defun vc-git-revision-table (_files)
1243 : ;; What about `files'?!? --Stef
1244 0 : (let (process-file-side-effects
1245 0 : (table (list "HEAD")))
1246 0 : (with-temp-buffer
1247 0 : (vc-git-command t nil nil "for-each-ref" "--format=%(refname)")
1248 0 : (goto-char (point-min))
1249 0 : (while (re-search-forward "^refs/\\(heads\\|tags\\|remotes\\)/\\(.*\\)$"
1250 0 : nil t)
1251 0 : (push (match-string 2) table)))
1252 0 : table))
1253 :
1254 : (defun vc-git-revision-completion-table (files)
1255 0 : (letrec ((table (lazy-completion-table
1256 0 : table (lambda () (vc-git-revision-table files)))))
1257 0 : table))
1258 :
1259 : (defun vc-git-annotate-command (file buf &optional rev)
1260 0 : (vc-git--asciify-coding-system)
1261 0 : (let ((name (file-relative-name file)))
1262 0 : (apply #'vc-git-command buf 'async nil "blame" "--date=short"
1263 0 : (append (vc-switches 'git 'annotate)
1264 0 : (list rev "--" name)))))
1265 :
1266 : (declare-function vc-annotate-convert-time "vc-annotate" (&optional time))
1267 :
1268 : (defun vc-git-annotate-time ()
1269 0 : (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)
1270 0 : (vc-annotate-convert-time
1271 0 : (apply #'encode-time (mapcar (lambda (match)
1272 0 : (if (match-beginning match)
1273 0 : (string-to-number (match-string match))
1274 0 : 0))
1275 0 : '(6 5 4 3 2 1 7))))))
1276 :
1277 : (defun vc-git-annotate-extract-revision-at-line ()
1278 0 : (save-excursion
1279 0 : (beginning-of-line)
1280 0 : (when (looking-at "\\^?\\([0-9a-f]+\\) \\(\\([^(]+\\) \\)?")
1281 0 : (let ((revision (match-string-no-properties 1)))
1282 0 : (if (match-beginning 2)
1283 0 : (let ((fname (match-string-no-properties 3)))
1284 : ;; Remove trailing whitespace from the file name.
1285 0 : (when (string-match " +\\'" fname)
1286 0 : (setq fname (substring fname 0 (match-beginning 0))))
1287 0 : (cons revision
1288 0 : (expand-file-name fname (vc-git-root default-directory))))
1289 0 : revision)))))
1290 :
1291 : ;;; TAG SYSTEM
1292 :
1293 : (defun vc-git-create-tag (dir name branchp)
1294 0 : (let ((default-directory dir))
1295 0 : (and (vc-git-command nil 0 nil "update-index" "--refresh")
1296 0 : (if branchp
1297 0 : (vc-git-command nil 0 nil "checkout" "-b" name)
1298 0 : (vc-git-command nil 0 nil "tag" name)))))
1299 :
1300 : (defun vc-git-retrieve-tag (dir name _update)
1301 0 : (let ((default-directory dir))
1302 0 : (vc-git-command nil 0 nil "checkout" name)))
1303 :
1304 :
1305 : ;;; MISCELLANEOUS
1306 :
1307 : (defun vc-git-previous-revision (file rev)
1308 : "Git-specific version of `vc-previous-revision'."
1309 0 : (if file
1310 0 : (let* ((fname (file-relative-name file))
1311 0 : (prev-rev (with-temp-buffer
1312 0 : (and
1313 0 : (vc-git--out-ok "rev-list" "-2" rev "--" fname)
1314 0 : (goto-char (point-max))
1315 0 : (bolp)
1316 0 : (zerop (forward-line -1))
1317 0 : (not (bobp))
1318 0 : (buffer-substring-no-properties
1319 0 : (point)
1320 0 : (1- (point-max)))))))
1321 0 : (or (vc-git-symbolic-commit prev-rev) prev-rev))
1322 : ;; We used to use "^" here, but that fails on MS-Windows if git is
1323 : ;; invoked via a batch file, in which case cmd.exe strips the "^"
1324 : ;; because it is a special character for cmd which process-file
1325 : ;; does not (and cannot) quote.
1326 0 : (vc-git--rev-parse (concat rev "~1"))))
1327 :
1328 : (defun vc-git--rev-parse (rev)
1329 40 : (with-temp-buffer
1330 40 : (and
1331 40 : (vc-git--out-ok "rev-parse" rev)
1332 40 : (buffer-substring-no-properties (point-min) (+ (point-min) 40)))))
1333 :
1334 : (defun vc-git-next-revision (file rev)
1335 : "Git-specific version of `vc-next-revision'."
1336 0 : (let* ((default-directory (vc-git-root file))
1337 0 : (file (file-relative-name file))
1338 : (current-rev
1339 0 : (with-temp-buffer
1340 0 : (and
1341 0 : (vc-git--out-ok "rev-list" "-1" rev "--" file)
1342 0 : (goto-char (point-max))
1343 0 : (bolp)
1344 0 : (zerop (forward-line -1))
1345 0 : (bobp)
1346 0 : (buffer-substring-no-properties
1347 0 : (point)
1348 0 : (1- (point-max))))))
1349 : (next-rev
1350 0 : (and current-rev
1351 0 : (with-temp-buffer
1352 0 : (and
1353 0 : (vc-git--out-ok "rev-list" "HEAD" "--" file)
1354 0 : (goto-char (point-min))
1355 0 : (search-forward current-rev nil t)
1356 0 : (zerop (forward-line -1))
1357 0 : (buffer-substring-no-properties
1358 0 : (point)
1359 0 : (progn (forward-line 1) (1- (point)))))))))
1360 0 : (or (vc-git-symbolic-commit next-rev) next-rev)))
1361 :
1362 : (defun vc-git-delete-file (file)
1363 0 : (vc-git-command nil 0 file "rm" "-f" "--"))
1364 :
1365 : (defun vc-git-rename-file (old new)
1366 0 : (vc-git-command nil 0 (list old new) "mv" "-f" "--"))
1367 :
1368 : (defvar vc-git-extra-menu-map
1369 : (let ((map (make-sparse-keymap)))
1370 : (define-key map [git-grep]
1371 : '(menu-item "Git grep..." vc-git-grep
1372 : :help "Run the `git grep' command"))
1373 : (define-key map [git-sn]
1374 : '(menu-item "Stash a Snapshot" vc-git-stash-snapshot
1375 : :help "Stash the current state of the tree and keep the current state"))
1376 : (define-key map [git-st]
1377 : '(menu-item "Create Stash..." vc-git-stash
1378 : :help "Stash away changes"))
1379 : (define-key map [git-ss]
1380 : '(menu-item "Show Stash..." vc-git-stash-show
1381 : :help "Show stash contents"))
1382 : map))
1383 :
1384 1 : (defun vc-git-extra-menu () vc-git-extra-menu-map)
1385 :
1386 0 : (defun vc-git-extra-status-menu () vc-git-extra-menu-map)
1387 :
1388 : (defun vc-git-root (file)
1389 42 : (or (vc-file-getprop file 'git-root)
1390 42 : (vc-file-setprop file 'git-root (vc-find-root file ".git"))))
1391 :
1392 : ;; grep-compute-defaults autoloads grep.
1393 : (declare-function grep-read-regexp "grep" ())
1394 : (declare-function grep-read-files "grep" (regexp))
1395 : (declare-function grep-expand-template "grep"
1396 : (template &optional regexp files dir excl))
1397 :
1398 : ;; Derived from `lgrep'.
1399 : (defun vc-git-grep (regexp &optional files dir)
1400 : "Run git grep, searching for REGEXP in FILES in directory DIR.
1401 : The search is limited to file names matching shell pattern FILES.
1402 : FILES may use abbreviations defined in `grep-files-aliases', e.g.
1403 : entering `ch' is equivalent to `*.[ch]'.
1404 :
1405 : With \\[universal-argument] prefix, you can edit the constructed shell command line
1406 : before it is executed.
1407 : With two \\[universal-argument] prefixes, directly edit and run `grep-command'.
1408 :
1409 : Collect output in a buffer. While git grep runs asynchronously, you
1410 : can use \\[next-error] (M-x next-error), or \\<grep-mode-map>\\[compile-goto-error] \
1411 : in the grep output buffer,
1412 : to go to the lines where grep found matches.
1413 :
1414 : This command shares argument histories with \\[rgrep] and \\[grep]."
1415 : (interactive
1416 0 : (progn
1417 0 : (grep-compute-defaults)
1418 0 : (cond
1419 0 : ((equal current-prefix-arg '(16))
1420 0 : (list (read-from-minibuffer "Run: " "git grep"
1421 0 : nil nil 'grep-history)
1422 0 : nil))
1423 0 : (t (let* ((regexp (grep-read-regexp))
1424 0 : (files (grep-read-files regexp))
1425 0 : (dir (read-directory-name "In directory: "
1426 0 : nil default-directory t)))
1427 0 : (list regexp files dir))))))
1428 0 : (require 'grep)
1429 0 : (when (and (stringp regexp) (> (length regexp) 0))
1430 0 : (let ((command regexp))
1431 0 : (if (null files)
1432 0 : (if (string= command "git grep")
1433 0 : (setq command nil))
1434 0 : (setq dir (file-name-as-directory (expand-file-name dir)))
1435 0 : (setq command
1436 0 : (grep-expand-template "git --no-pager grep -n -e <R> -- <F>"
1437 0 : regexp files))
1438 0 : (when command
1439 0 : (if (equal current-prefix-arg '(4))
1440 0 : (setq command
1441 0 : (read-from-minibuffer "Confirm: "
1442 0 : command nil nil 'grep-history))
1443 0 : (add-to-history 'grep-history command))))
1444 0 : (when command
1445 0 : (let ((default-directory dir)
1446 0 : (compilation-environment (cons "PAGER=" compilation-environment)))
1447 : ;; Setting process-setup-function makes exit-message-function work
1448 : ;; even when async processes aren't supported.
1449 0 : (compilation-start command 'grep-mode))
1450 0 : (if (eq next-error-last-buffer (current-buffer))
1451 0 : (setq default-directory dir))))))
1452 :
1453 : ;; Everywhere but here, follows vc-git-command, which uses vc-do-command
1454 : ;; from vc-dispatcher.
1455 : (autoload 'vc-resynch-buffer "vc-dispatcher")
1456 :
1457 : (defun vc-git-stash (name)
1458 : "Create a stash."
1459 : (interactive "sStash name: ")
1460 0 : (let ((root (vc-git-root default-directory)))
1461 0 : (when root
1462 0 : (vc-git--call nil "stash" "save" name)
1463 0 : (vc-resynch-buffer root t t))))
1464 :
1465 : (defun vc-git-stash-show (name)
1466 : "Show the contents of stash NAME."
1467 : (interactive "sStash name: ")
1468 0 : (vc-setup-buffer "*vc-git-stash*")
1469 0 : (vc-git-command "*vc-git-stash*" 'async nil "stash" "show" "-p" name)
1470 0 : (set-buffer "*vc-git-stash*")
1471 0 : (diff-mode)
1472 0 : (setq buffer-read-only t)
1473 0 : (pop-to-buffer (current-buffer)))
1474 :
1475 : (defun vc-git-stash-apply (name)
1476 : "Apply stash NAME."
1477 : (interactive "sApply stash: ")
1478 0 : (vc-git-command "*vc-git-stash*" 0 nil "stash" "apply" "-q" name)
1479 0 : (vc-resynch-buffer (vc-git-root default-directory) t t))
1480 :
1481 : (defun vc-git-stash-pop (name)
1482 : "Pop stash NAME."
1483 : (interactive "sPop stash: ")
1484 0 : (vc-git-command "*vc-git-stash*" 0 nil "stash" "pop" "-q" name)
1485 0 : (vc-resynch-buffer (vc-git-root default-directory) t t))
1486 :
1487 : (defun vc-git-stash-snapshot ()
1488 : "Create a stash with the current tree state."
1489 : (interactive)
1490 0 : (vc-git--call nil "stash" "save"
1491 0 : (let ((ct (current-time)))
1492 0 : (concat
1493 0 : (format-time-string "Snapshot on %Y-%m-%d" ct)
1494 0 : (format-time-string " at %H:%M" ct))))
1495 0 : (vc-git-command "*vc-git-stash*" 0 nil "stash" "apply" "-q" "stash@{0}")
1496 0 : (vc-resynch-buffer (vc-git-root default-directory) t t))
1497 :
1498 : (defun vc-git-stash-list ()
1499 0 : (delete
1500 : ""
1501 0 : (split-string
1502 0 : (replace-regexp-in-string
1503 0 : "^stash@" " " (vc-git--run-command-string nil "stash" "list"))
1504 0 : "\n")))
1505 :
1506 : (defun vc-git-stash-get-at-point (point)
1507 0 : (save-excursion
1508 0 : (goto-char point)
1509 0 : (beginning-of-line)
1510 0 : (if (looking-at "^ +\\({[0-9]+}\\):")
1511 0 : (match-string 1)
1512 0 : (error "Cannot find stash at point"))))
1513 :
1514 : ;; vc-git-stash-delete-at-point must be called from a vc-dir buffer.
1515 : (declare-function vc-dir-refresh "vc-dir" ())
1516 :
1517 : (defun vc-git-stash-delete-at-point ()
1518 : (interactive)
1519 0 : (let ((stash (vc-git-stash-get-at-point (point))))
1520 0 : (when (y-or-n-p (format "Remove stash %s ? " stash))
1521 0 : (vc-git--run-command-string nil "stash" "drop" (format "stash@%s" stash))
1522 0 : (vc-dir-refresh))))
1523 :
1524 : (defun vc-git-stash-show-at-point ()
1525 : (interactive)
1526 0 : (vc-git-stash-show (format "stash@%s" (vc-git-stash-get-at-point (point)))))
1527 :
1528 : (defun vc-git-stash-apply-at-point ()
1529 : (interactive)
1530 0 : (let (vc-dir-buffers) ; Small optimization.
1531 0 : (vc-git-stash-apply (format "stash@%s" (vc-git-stash-get-at-point (point)))))
1532 0 : (vc-dir-refresh))
1533 :
1534 : (defun vc-git-stash-pop-at-point ()
1535 : (interactive)
1536 0 : (let (vc-dir-buffers) ; Likewise.
1537 0 : (vc-git-stash-pop (format "stash@%s" (vc-git-stash-get-at-point (point)))))
1538 0 : (vc-dir-refresh))
1539 :
1540 : (defun vc-git-stash-menu (e)
1541 : (interactive "e")
1542 0 : (vc-dir-at-event e (popup-menu vc-git-stash-menu-map e)))
1543 :
1544 :
1545 : ;;; Internal commands
1546 :
1547 : (defun vc-git-command (buffer okstatus file-or-list &rest flags)
1548 : "A wrapper around `vc-do-command' for use in vc-git.el.
1549 : The difference to vc-do-command is that this function always invokes
1550 : `vc-git-program'."
1551 0 : (let ((coding-system-for-read
1552 0 : (or coding-system-for-read vc-git-log-output-coding-system))
1553 : (coding-system-for-write
1554 0 : (or coding-system-for-write vc-git-commits-coding-system))
1555 0 : (process-environment (cons "GIT_DIR" process-environment)))
1556 0 : (apply 'vc-do-command (or buffer "*vc*") okstatus vc-git-program
1557 : ;; http://debbugs.gnu.org/16897
1558 0 : (unless (and (not (cdr-safe file-or-list))
1559 0 : (let ((file (or (car-safe file-or-list)
1560 0 : file-or-list)))
1561 0 : (and file
1562 0 : (eq ?/ (aref file (1- (length file))))
1563 0 : (equal file (vc-git-root file)))))
1564 0 : file-or-list)
1565 0 : (cons "--no-pager" flags))))
1566 :
1567 : (defun vc-git--empty-db-p ()
1568 : "Check if the git db is empty (no commit done yet)."
1569 0 : (let (process-file-side-effects)
1570 0 : (not (eq 0 (vc-git--call nil "rev-parse" "--verify" "HEAD")))))
1571 :
1572 : (defun vc-git--call (buffer command &rest args)
1573 : ;; We don't need to care the arguments. If there is a file name, it
1574 : ;; is always a relative one. This works also for remote
1575 : ;; directories. We enable `inhibit-null-byte-detection', otherwise
1576 : ;; Tramp's eol conversion might be confused.
1577 204 : (let ((inhibit-null-byte-detection t)
1578 : (coding-system-for-read
1579 204 : (or coding-system-for-read vc-git-log-output-coding-system))
1580 : (coding-system-for-write
1581 204 : (or coding-system-for-write vc-git-commits-coding-system))
1582 204 : (process-environment (cons "PAGER=" process-environment)))
1583 408 : (push "GIT_DIR" process-environment)
1584 204 : (apply 'process-file vc-git-program nil buffer nil command args)))
1585 :
1586 : (defun vc-git--out-ok (command &rest args)
1587 204 : (zerop (apply 'vc-git--call '(t nil) command args)))
1588 :
1589 : (defun vc-git--run-command-string (file &rest args)
1590 : "Run a git command on FILE and return its output as string.
1591 : FILE can be nil."
1592 120 : (let* ((ok t)
1593 120 : (str (with-output-to-string
1594 120 : (with-current-buffer standard-output
1595 120 : (unless (apply 'vc-git--out-ok
1596 120 : (if file
1597 80 : (append args (list (file-relative-name
1598 80 : file)))
1599 120 : args))
1600 120 : (setq ok nil))))))
1601 120 : (and ok str)))
1602 :
1603 : (defun vc-git-symbolic-commit (commit)
1604 : "Translate COMMIT string into symbolic form.
1605 : Returns nil if not possible."
1606 0 : (and commit
1607 0 : (let ((name (with-temp-buffer
1608 0 : (and
1609 0 : (vc-git--out-ok "name-rev" "--name-only" commit)
1610 0 : (goto-char (point-min))
1611 0 : (= (forward-line 2) 1)
1612 0 : (bolp)
1613 0 : (buffer-substring-no-properties (point-min)
1614 0 : (1- (point-max)))))))
1615 0 : (and name (not (string= name "undefined")) name))))
1616 :
1617 : (provide 'vc-git)
1618 :
1619 : ;;; vc-git.el ends here
|