lisp/vc/vc-git.el

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