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