code.delx.au - gnu-emacs/blob - lisp/vc/vc-git.el

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