lisp/vc/vc-git.el

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