lisp/vc-git.el

   1 ;;; vc-git.el --- VC backend for the git version control system
   2
   3 ;; Copyright (C) 2006, 2007, 2008 Free Software Foundation, Inc.
   4
   5 ;; Author: Alexandre Julliard <julliard@winehq.org>
   6 ;; Keywords: tools
   7
   8 ;; This file is part of GNU Emacs.
   9
  10 ;; GNU Emacs is free software; you can redistribute it and/or modify
  11 ;; it under the terms of the GNU General Public License as published by
  12 ;; the Free Software Foundation; either version 3, or (at your option)
  13 ;; any later version.
  14
  15 ;; GNU Emacs is distributed in the hope that it will be useful,
  16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;; GNU General Public License for more details.
  19
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  22 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  23 ;; Boston, MA 02110-1301, USA.
  24
  25 ;;; Commentary:
  26
  27 ;; This file contains a VC backend for the git version control
  28 ;; system.
  29 ;;
  30
  31 ;;; Installation:
  32
  33 ;; To install: put this file on the load-path and add Git to the list
  34 ;; of supported backends in `vc-handled-backends'; the following line,
  35 ;; placed in your ~/.emacs, will accomplish this:
  36 ;;
  37 ;;     (add-to-list 'vc-handled-backends 'Git)
  38
  39 ;;; Todo:
  40 ;;  - check if more functions could use vc-git-command instead
  41 ;;     of start-process.
  42 ;;  - changelog generation
  43
  44 ;; Implement the rest of the vc interface. See the comment at the
  45 ;; beginning of vc.el. The current status is:
  46 ;; ("??" means: "figure out what to do about it")
  47 ;;
  48 ;; FUNCTION NAME                                   STATUS
  49 ;; BACKEND PROPERTIES
  50 ;; * revision-granularity                          OK
  51 ;; STATE-QUERYING FUNCTIONS
  52 ;; * registered (file)                             OK
  53 ;; * state (file)                                  OK
  54 ;; - state-heuristic (file)                        NOT NEEDED
  55 ;; - dir-state (dir)                               OK
  56 ;; * working-revision (file)                       OK
  57 ;; - latest-on-branch-p (file)                     NOT NEEDED
  58 ;; * checkout-model (files)                        OK
  59 ;; - workfile-unchanged-p (file)                   OK
  60 ;; - mode-line-string (file)                       OK
  61 ;; - prettify-state-info (file)                    OK
  62 ;; STATE-CHANGING FUNCTIONS
  63 ;; * create-repo ()                                OK
  64 ;; * register (files &optional rev comment)        OK
  65 ;; - init-revision (file)                          NOT NEEDED
  66 ;; - responsible-p (file)                          OK
  67 ;; - could-register (file)                         NOT NEEDED, DEFAULT IS GOOD
  68 ;; - receive-file (file rev)                       NOT NEEDED
  69 ;; - unregister (file)                             OK
  70 ;; * checkin (files rev comment)                   OK
  71 ;; * find-revision (file rev buffer)               OK
  72 ;; * checkout (file &optional editable rev)        OK
  73 ;; * revert (file &optional contents-done)         OK
  74 ;; - rollback (files)                              COULD BE SUPPORTED
  75 ;; - merge (file rev1 rev2)                        It would be possible to merge changes into
  76 ;;                                                 a single file, but when committing they
  77 ;;                                                 wouldn't be identified as a merge by git,
  78 ;;                                                 so it's probably not a good idea.
  79 ;; - merge-news (file)                             see `merge'
  80 ;; - steal-lock (file &optional revision)          NOT NEEDED
  81 ;; HISTORY FUNCTIONS
  82 ;; * print-log (files &optional buffer)            OK
  83 ;; - log-view-mode ()                              OK
  84 ;; - show-log-entry (revision)                     OK
  85 ;; - wash-log (file)                               COULD BE SUPPORTED
  86 ;; - logentry-check ()                             NOT NEEDED
  87 ;; - comment-history (file)                        ??
  88 ;; - update-changelog (files)                      COULD BE SUPPORTED
  89 ;; * diff (file &optional rev1 rev2 buffer)        OK
  90 ;; - revision-completion-table (files)             OK
  91 ;; - annotate-command (file buf &optional rev)     OK
  92 ;; - annotate-time ()                              OK
  93 ;; - annotate-current-time ()                      NOT NEEDED
  94 ;; - annotate-extract-revision-at-line ()          OK
  95 ;; SNAPSHOT SYSTEM
  96 ;; - create-snapshot (dir name branchp)            OK
  97 ;; - assign-name (file name)                       NOT NEEDED
  98 ;; - retrieve-snapshot (dir name update)           OK, needs to update buffers
  99 ;; MISCELLANEOUS
 100 ;; - make-version-backups-p (file)                 NOT NEEDED
 101 ;; - repository-hostname (dirname)                 NOT NEEDED
 102 ;; - previous-revision (file rev)                  OK
 103 ;; - next-revision (file rev)                      OK
 104 ;; - check-headers ()                              COULD BE SUPPORTED
 105 ;; - clear-headers ()                              NOT NEEDED
 106 ;; - delete-file (file)                            OK
 107 ;; - rename-file (old new)                         OK
 108 ;; - find-file-hook ()                             NOT NEEDED
 109 ;; - find-file-not-found-hook ()                   NOT NEEDED
 110
 111 (eval-when-compile
 112   (require 'cl)
 113   (require 'vc)
 114   (require 'grep))
 115
 116 (defvar git-commits-coding-system 'utf-8
 117   "Default coding system for git commits.")
 118
 119 ;;; BACKEND PROPERTIES
 120
 121 (defun vc-git-revision-granularity () 'repository)
 122 (defun vc-git-checkout-model (files) 'implicit)
 123
 124 ;;; STATE-QUERYING FUNCTIONS
 125
 126 ;;;###autoload (defun vc-git-registered (file)
 127 ;;;###autoload   "Return non-nil if FILE is registered with git."
 128 ;;;###autoload   (if (vc-find-root file ".git")       ; short cut
 129 ;;;###autoload       (progn
 130 ;;;###autoload         (load "vc-git")
 131 ;;;###autoload         (vc-git-registered file))))
 132
 133 (defun vc-git-registered (file)
 134   "Check whether FILE is registered with git."
 135   (when (vc-git-root file)
 136     (with-temp-buffer
 137       (let* ((dir (file-name-directory file))
 138              (name (file-relative-name file dir)))
 139         (and (ignore-errors
 140                (when dir (cd dir))
 141                (vc-git--out-ok "ls-files" "-c" "-z" "--" name))
 142              (let ((str (buffer-string)))
 143                (and (> (length str) (length name))
 144                     (string= (substring str 0 (1+ (length name)))
 145                              (concat name "\0")))))))))
 146
 147 (defun vc-git--state-code (code)
 148   "Convert from a string to a added/deleted/modified state."
 149   (case (string-to-char code)
 150     (?M 'edited)
 151     (?A 'added)
 152     (?D 'removed)
 153     (?U 'edited)     ;; FIXME
 154     (?T 'edited)))   ;; FIXME
 155
 156 (defun vc-git-state (file)
 157   "Git-specific version of `vc-state'."
 158   ;; FIXME: This can't set 'ignored yet
 159   (if (not (vc-git-registered file))
 160       'unregistered
 161     (vc-git--call nil "add" "--refresh" "--" (file-relative-name file))
 162     (let ((diff (vc-git--run-command-string file "diff-index" "-z" "HEAD" "--")))
 163       (if (and diff (string-match ":[0-7]\\{6\\} [0-7]\\{6\\} [0-9a-f]\\{40\\} [0-9a-f]\\{40\\} \\([ADMUT]\\)\0[^\0]+\0"
 164                                   diff))
 165           (vc-git--state-code (match-string 1 diff))
 166         (if (vc-git--empty-db-p) 'added 'up-to-date)))))
 167
 168 (defun vc-git--ls-files-state (state &rest args)
 169   "Set state to STATE on all files found with git-ls-files ARGS."
 170   (with-temp-buffer
 171     (apply 'vc-git-command (current-buffer) nil nil "ls-files" "-z" args)
 172     (goto-char (point-min))
 173     (let ((start (point)))
 174       (while (search-forward "\0" nil t)
 175         (let ((file (expand-file-name
 176                      (buffer-substring-no-properties start (1- (point))))))
 177           (vc-file-setprop file 'vc-backend (if state 'Git 'none))
 178           (vc-file-setprop file 'vc-state state))
 179         (setq start (point))))))
 180
 181 (defun vc-git-dir-state (dir)
 182   "Git-specific version of `dir-state'."
 183   (vc-git--ls-files-state 'up-to-date "-c")
 184   (vc-git--ls-files-state 'edited "-m")
 185   (vc-git--ls-files-state 'removed "-d")
 186   (vc-git--ls-files-state 'ignored "-o" "-i" "--exclude-standard")
 187   (vc-git--ls-files-state nil "-o" "--exclude-standard"))
 188
 189 (defun vc-git-working-revision (file)
 190   "Git-specific version of `vc-working-revision'."
 191   (let ((str (with-output-to-string
 192                (with-current-buffer standard-output
 193                  (vc-git--out-ok "symbolic-ref" "HEAD")))))
 194     (if (string-match "^\\(refs/heads/\\)?\\(.+\\)$" str)
 195         (match-string 2 str)
 196       str)))
 197
 198 (defun vc-git-workfile-unchanged-p (file)
 199   (eq 'up-to-date (vc-git-state file)))
 200
 201 (defun vc-git-mode-line-string (file)
 202   "Return string for placement into the modeline for FILE."
 203   (let* ((branch (vc-git-working-revision file))
 204          (def-ml (vc-default-mode-line-string 'Git file))
 205          (help-echo (get-text-property 0 'help-echo def-ml)))
 206     (if (zerop (length branch))
 207         (propertize
 208          (concat def-ml "!")
 209          'help-echo (concat help-echo "\nNo current branch (detached HEAD)"))
 210       (propertize def-ml
 211                   'help-echo (concat help-echo "\nCurrent branch: " branch)))))
 212
 213 (defstruct (vc-git-extra-fileinfo
 214             (:copier nil)
 215             (:constructor vc-git-create-extra-fileinfo (old-perm new-perm &optional rename-state orig-name))
 216             (:conc-name vc-git-extra-fileinfo->))
 217   old-perm new-perm   ;; permission flags
 218   rename-state        ;; rename or copy state
 219   orig-name)          ;; original name for renames or copies
 220
 221 (defun vc-git-escape-file-name (name)
 222   "Escape a file name if necessary."
 223   (if (string-match "[\n\t\"\\]" name)
 224       (concat "\""
 225               (mapconcat (lambda (c)
 226                    (case c
 227                      (?\n "\\n")
 228                      (?\t "\\t")
 229                      (?\\ "\\\\")
 230                      (?\" "\\\"")
 231                      (t (char-to-string c))))
 232                  name "")
 233               "\"")
 234     name))
 235
 236 (defun vc-git-file-type-as-string (old-perm new-perm)
 237   "Return a string describing the file type based on its permissions."
 238   (let* ((old-type (lsh (or old-perm 0) -9))
 239          (new-type (lsh (or new-perm 0) -9))
 240          (str (case new-type
 241                 (?\100  ;; file
 242                  (case old-type
 243                    (?\100 nil)
 244                    (?\120 "   (type change symlink -> file)")
 245                    (?\160 "   (type change subproject -> file)")))
 246                  (?\120  ;; symlink
 247                   (case old-type
 248                     (?\100 "   (type change file -> symlink)")
 249                     (?\160 "   (type change subproject -> symlink)")
 250                     (t "   (symlink)")))
 251                   (?\160  ;; subproject
 252                    (case old-type
 253                      (?\100 "   (type change file -> subproject)")
 254                      (?\120 "   (type change symlink -> subproject)")
 255                      (t "   (subproject)")))
 256                   (?\110 nil)  ;; directory (internal, not a real git state)
 257                   (?\000  ;; deleted or unknown
 258                    (case old-type
 259                      (?\120 "   (symlink)")
 260                      (?\160 "   (subproject)")))
 261                   (t (format "   (unknown type %o)" new-type)))))
 262     (cond (str (propertize str 'face 'font-lock-comment-face))
 263           ((eq new-type ?\110) "/")
 264           (t ""))))
 265
 266 (defun vc-git-rename-as-string (state extra)
 267   "Return a string describing the copy or rename associated with INFO, or an empty string if none."
 268   (let ((rename-state (when extra
 269                         (vc-git-extra-fileinfo->rename-state extra))))
 270     (if rename-state
 271         (propertize
 272          (concat "   ("
 273                  (if (eq rename-state 'copy) "copied from "
 274                    (if (eq state 'added) "renamed from "
 275                      "renamed to "))
 276                  (vc-git-escape-file-name (vc-git-extra-fileinfo->orig-name extra))
 277                  ")") 'face 'font-lock-comment-face)
 278       "")))
 279
 280 (defun vc-git-permissions-as-string (old-perm new-perm)
 281   "Format a permission change as string."
 282   (propertize
 283    (if (or (not old-perm)
 284            (not new-perm)
 285            (eq 0 (logand ?\111 (logxor old-perm new-perm))))
 286        "  "
 287      (if (eq 0 (logand ?\111 old-perm)) "+x" "-x"))
 288   'face 'font-lock-type-face))
 289
 290 (defun vc-git-status-printer (info)
 291   "Pretty-printer for the vc-dir-fileinfo structure."
 292   (let* ((state (if (vc-dir-fileinfo->directory info)
 293                     'DIRECTORY
 294                   (vc-dir-fileinfo->state info)))
 295          (extra (vc-dir-fileinfo->extra info))
 296          (old-perm (when extra (vc-git-extra-fileinfo->old-perm extra)))
 297          (new-perm (when extra (vc-git-extra-fileinfo->new-perm extra))))
 298     (insert
 299      "  "
 300      (propertize (format "%c" (if (vc-dir-fileinfo->marked info) ?* ? ))
 301                  'face 'font-lock-type-face)
 302      "  "
 303      (propertize
 304       (format "%-12s" state)
 305       'face (cond ((eq state 'up-to-date) 'font-lock-builtin-face)
 306                   ((eq state 'missing) 'font-lock-warning-face)
 307                   (t 'font-lock-variable-name-face))
 308       'mouse-face 'highlight)
 309      "  " (vc-git-permissions-as-string old-perm new-perm)
 310      "     "
 311      (propertize (vc-git-escape-file-name (vc-dir-fileinfo->name info))
 312                  'face 'font-lock-function-name-face
 313                  'mouse-face 'highlight)
 314      (vc-git-file-type-as-string old-perm new-perm)
 315      (vc-git-rename-as-string state extra))))
 316
 317 (defun vc-git-after-dir-status-stage (stage files update-function)
 318   "Process sentinel for the various dir-status stages."
 319   (let (remaining next-stage result)
 320     (goto-char (point-min))
 321     (case stage
 322       ('update-index
 323        (setq next-stage (if (vc-git--empty-db-p) 'ls-files-added
 324                           (if files 'ls-files-up-to-date 'diff-index))))
 325       ('ls-files-added
 326        (setq next-stage 'ls-files-unknown)
 327        (while (re-search-forward "\\([0-7]\\{6\\}\\) [0-9a-f]\\{40\\} 0\t\\([^\0]+\\)\0" nil t)
 328          (let ((new-perm (string-to-number (match-string 1) 8))
 329                (name (match-string 2)))
 330            (push (list name 'added (vc-git-create-extra-fileinfo 0 new-perm)) result))))
 331       ('ls-files-up-to-date
 332        (setq next-stage 'diff-index)
 333        (while (re-search-forward "\\([0-7]\\{6\\}\\) [0-9a-f]\\{40\\} 0\t\\([^\0]+\\)\0" nil t)
 334          (let ((perm (string-to-number (match-string 1) 8))
 335                (name (match-string 2)))
 336            (push (list name 'up-to-date (vc-git-create-extra-fileinfo perm perm)) result))))
 337       ('ls-files-unknown
 338        (when files (setq next-stage 'ls-files-ignored))
 339        (while (re-search-forward "\\([^\0]*?\\)\0" nil t 1)
 340          (push (list (match-string 1) 'unregistered (vc-git-create-extra-fileinfo 0 0)) result)))
 341       ('ls-files-ignored
 342        (while (re-search-forward "\\([^\0]*?\\)\0" nil t 1)
 343          (push (list (match-string 1) 'ignored (vc-git-create-extra-fileinfo 0 0)) result)))
 344       ('diff-index
 345        (setq next-stage 'ls-files-unknown)
 346        (while (re-search-forward
 347                ":\\([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"
 348                nil t 1)
 349          (let ((old-perm (string-to-number (match-string 1) 8))
 350                (new-perm (string-to-number (match-string 2) 8))
 351                (state (or (match-string 4) (match-string 6)))
 352                (name (or (match-string 5) (match-string 7)))
 353                (new-name (match-string 8)))
 354            (if new-name  ; copy or rename
 355                (if (eq ?C (string-to-char state))
 356                    (push (list new-name 'added (vc-git-create-extra-fileinfo old-perm new-perm 'copy name)) result)
 357                  (push (list name 'removed (vc-git-create-extra-fileinfo 0 0 'rename new-name)) result)
 358                  (push (list new-name 'added (vc-git-create-extra-fileinfo old-perm new-perm 'rename name)) result))
 359              (push (list name (vc-git--state-code state) (vc-git-create-extra-fileinfo old-perm new-perm)) result))))))
 360     (when result
 361       (setq result (nreverse result))
 362       (when files
 363         (dolist (entry result) (setq files (delete (car entry) files)))
 364         (unless files (setq next-stage nil))))
 365     (when (or result (not next-stage)) (funcall update-function result next-stage))
 366     (when next-stage (vc-git-dir-status-goto-stage next-stage files update-function))))
 367
 368 (defun vc-git-dir-status-goto-stage (stage files update-function)
 369   (erase-buffer)
 370   (case stage
 371     ('update-index
 372      (if files
 373          (vc-git-command (current-buffer) 'async files "add" "--refresh" "--")
 374        (vc-git-command (current-buffer) 'async nil "update-index" "--refresh")))
 375     ('ls-files-added
 376      (vc-git-command (current-buffer) 'async files "ls-files" "-z" "-c" "-s" "--"))
 377     ('ls-files-up-to-date
 378      (vc-git-command (current-buffer) 'async files "ls-files" "-z" "-c" "-s" "--"))
 379     ('ls-files-unknown
 380      (vc-git-command (current-buffer) 'async files "ls-files" "-z" "-o"
 381                      "--directory" "--no-empty-directory" "--exclude-standard" "--"))
 382     ('ls-files-ignored
 383      (vc-git-command (current-buffer) 'async files "ls-files" "-z" "-o" "-i"
 384                      "--directory" "--no-empty-directory" "--exclude-standard" "--"))
 385     ('diff-index
 386      (vc-git-command (current-buffer) 'async files "diff-index" "-z" "-M" "HEAD" "--")))
 387   (vc-exec-after
 388    `(vc-git-after-dir-status-stage (quote ,stage) (quote ,files) (quote ,update-function))))
 389
 390 (defun vc-git-dir-status (dir update-function)
 391   "Return a list of (FILE STATE EXTRA) entries for DIR."
 392   ;; Further things that would have to be fixed later:
 393   ;; - how to handle unregistered directories
 394   ;; - how to support vc-dir on a subdir of the project tree
 395   (vc-git-dir-status-goto-stage 'update-index nil update-function))
 396
 397 (defun vc-git-dir-status-files (dir files default-state update-function)
 398   "Return a list of (FILE STATE EXTRA) entries for FILES in DIR."
 399   (vc-git-dir-status-goto-stage 'update-index files update-function))
 400
 401 (defun vc-git-status-extra-headers (dir)
 402   (let ((str (with-output-to-string
 403                (with-current-buffer standard-output
 404                  (vc-git--out-ok "symbolic-ref" "HEAD")))))
 405     (concat
 406      (propertize "Branch     : " 'face 'font-lock-type-face)
 407      (propertize
 408       (if (string-match "^\\(refs/heads/\\)?\\(.+\\)$" str)
 409           (match-string 2 str)
 410         "not (detached HEAD)")
 411        'face 'font-lock-variable-name-face))))
 412
 413 ;;; STATE-CHANGING FUNCTIONS
 414
 415 (defun vc-git-create-repo ()
 416   "Create a new Git repository."
 417   (vc-git-command nil 0 nil "init"))
 418
 419 (defun vc-git-register (files &optional rev comment)
 420   "Register FILE into the git version-control system."
 421   (vc-git-command nil 0 files "update-index" "--add" "--"))
 422
 423 (defalias 'vc-git-responsible-p 'vc-git-root)
 424
 425 (defun vc-git-unregister (file)
 426   (vc-git-command nil 0 file "rm" "-f" "--cached" "--"))
 427
 428
 429 (defun vc-git-checkin (files rev comment)
 430   (let ((coding-system-for-write git-commits-coding-system))
 431     (vc-git-command nil 0 files "commit" "-m" comment "--only" "--")))
 432
 433 (defun vc-git-find-revision (file rev buffer)
 434   (let ((coding-system-for-read 'binary)
 435         (coding-system-for-write 'binary)
 436         (fullname (substring
 437                    (vc-git--run-command-string
 438                     file "ls-files" "-z" "--full-name" "--")
 439                    0 -1)))
 440     (vc-git-command
 441      buffer 0
 442      (concat (if rev rev "HEAD") ":" fullname) "cat-file" "blob")))
 443
 444 (defun vc-git-checkout (file &optional editable rev)
 445   (vc-git-command nil 0 file "checkout" (or rev "HEAD")))
 446
 447 (defun vc-git-revert (file &optional contents-done)
 448   "Revert FILE to the version stored in the git repository."
 449   (if contents-done
 450       (vc-git-command nil 0 file "update-index" "--")
 451     (vc-git-command nil 0 file "checkout" "HEAD")))
 452
 453 ;;; HISTORY FUNCTIONS
 454
 455 (defun vc-git-print-log (files &optional buffer)
 456   "Get change log associated with FILES."
 457   (let ((coding-system-for-read git-commits-coding-system)
 458         ;; Support both the old print-log interface that passes a
 459         ;; single file, and the new one that passes a file list.
 460         (flist (if (listp files) files (list files))))
 461     ;; `vc-do-command' creates the buffer, but we need it before running
 462     ;; the command.
 463     (vc-setup-buffer buffer)
 464     ;; If the buffer exists from a previous invocation it might be
 465     ;; read-only.
 466     (let ((inhibit-read-only t))
 467       ;; XXX `log-view-mode' needs to have something to identify where
 468       ;; the log for each individual file starts. It seems that by
 469       ;; default git does not output this info. So loop here and call
 470       ;; "git rev-list" on each file separately to make sure that each
 471       ;; file gets a "File:" header before the corresponding
 472       ;; log. Maybe there is a way to do this with one command...
 473       (dolist (file flist)
 474         (with-current-buffer
 475             buffer
 476           (insert "File: " (file-name-nondirectory file) "\n"))
 477         (vc-git-command buffer 'async (file-relative-name file)
 478                         "rev-list" "--pretty" "HEAD" "--")))))
 479
 480 (defvar log-view-message-re)
 481 (defvar log-view-file-re)
 482 (defvar log-view-font-lock-keywords)
 483
 484 (define-derived-mode vc-git-log-view-mode log-view-mode "Git-Log-View"
 485   (require 'add-log) ;; we need the faces add-log
 486   ;; Don't have file markers, so use impossible regexp.
 487   (set (make-local-variable 'log-view-file-re) "^File:[ \t]+\\(.+\\)")
 488   (set (make-local-variable 'log-view-message-re)
 489        "^commit *\\([0-9a-z]+\\)")
 490   (set (make-local-variable 'log-view-font-lock-keywords)
 491        (append
 492         `((,log-view-message-re  (1 'change-log-acknowledgement))
 493           (,log-view-file-re (1 'change-log-file-face)))
 494         ;; Handle the case:
 495         ;; user: foo@bar
 496         '(("^Author:[ \t]+\\([A-Za-z0-9_.+-]+@[A-Za-z0-9_.-]+\\)"
 497            (1 'change-log-email))
 498           ;; Handle the case:
 499           ;; user: FirstName LastName <foo@bar>
 500           ("^Author:[ \t]+\\([^<(]+?\\)[ \t]*[(<]\\([A-Za-z0-9_.+-]+@[A-Za-z0-9_.-]+\\)[>)]"
 501            (1 'change-log-name)
 502            (2 'change-log-email))
 503           ("^ +\\(?:\\(?:[Aa]cked\\|[Ss]igned-[Oo]ff\\)-[Bb]y:\\)[ \t]+\\([A-Za-z0-9_.+-]+@[A-Za-z0-9_.-]+\\)"
 504            (1 'change-log-name))
 505           ("^ +\\(?:\\(?:[Aa]cked\\|[Ss]igned-[Oo]ff\\)-[Bb]y:\\)[ \t]+\\([^<(]+?\\)[ \t]*[(<]\\([A-Za-z0-9_.+-]+@[A-Za-z0-9_.-]+\\)[>)]"
 506            (1 'change-log-name)
 507            (2 'change-log-email))
 508           ("^Merge: \\([0-9a-z]+\\) \\([0-9a-z]+\\)"
 509            (1 'change-log-acknowledgement)
 510            (2 'change-log-acknowledgement))
 511           ("^Date:   \\(.+\\)" (1 'change-log-date))
 512           ("^summary:[ \t]+\\(.+\\)" (1 'log-view-message))))))
 513
 514 (defun vc-git-show-log-entry (revision)
 515   "Move to the log entry for REVISION.
 516 REVISION may have the form BRANCH, BRANCH~N,
 517 or BRANCH^ (where \"^\" can be repeated)."
 518   (goto-char (point-min))
 519   (search-forward "\ncommit" nil t
 520                   (cond ((string-match "~\\([0-9]\\)$" revision)
 521                          (1+ (string-to-number (match-string 1 revision))))
 522                         ((string-match "\\^+$" revision)
 523                          (1+ (length (match-string 0 revision))))
 524                         (t nil)))
 525   (beginning-of-line))
 526
 527 (defun vc-git-diff (files &optional rev1 rev2 buffer)
 528   (let ((buf (or buffer "*vc-diff*")))
 529     (if (and rev1 rev2)
 530         (vc-git-command buf 1 files "diff-tree" "--exit-code" "-p"
 531                         rev1 rev2 "--")
 532       (vc-git-command buf 1 files "diff-index" "--exit-code" "-p"
 533                       (or rev1 "HEAD") "--"))))
 534
 535 (defun vc-git-revision-table (files)
 536   ;; What about `files'?!?  --Stef
 537   (let ((table (list "HEAD")))
 538     (with-temp-buffer
 539       (vc-git-command t nil nil "for-each-ref" "--format=%(refname)")
 540       (goto-char (point-min))
 541       (while (re-search-forward "^refs/\\(heads\\|tags\\)/\\(.*\\)$" nil t)
 542         (push (match-string 2) table)))
 543     table))
 544
 545 (defun vc-git-revision-completion-table (files)
 546   (lexical-let ((files files)
 547                 table)
 548     (setq table (lazy-completion-table
 549                  table (lambda () (vc-git-revision-table files))))
 550     table))
 551
 552 (defun vc-git-annotate-command (file buf &optional rev)
 553   ;; FIXME: rev is ignored
 554   (let ((name (file-relative-name file)))
 555     (vc-git-command buf 0 name "blame" (if rev (concat "-r" rev)))))
 556
 557 (defun vc-git-annotate-time ()
 558   (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)
 559        (vc-annotate-convert-time
 560         (apply #'encode-time (mapcar (lambda (match)
 561                                        (string-to-number (match-string match)))
 562                                      '(6 5 4 3 2 1 7))))))
 563
 564 (defun vc-git-annotate-extract-revision-at-line ()
 565   (save-excursion
 566     (move-beginning-of-line 1)
 567     (and (looking-at "[0-9a-f^][0-9a-f]+")
 568          (buffer-substring-no-properties (match-beginning 0) (match-end 0)))))
 569
 570 ;;; SNAPSHOT SYSTEM
 571
 572 (defun vc-git-create-snapshot (dir name branchp)
 573   (let ((default-directory dir))
 574     (and (vc-git-command nil 0 nil "update-index" "--refresh")
 575          (if branchp
 576              (vc-git-command nil 0 nil "checkout" "-b" name)
 577            (vc-git-command nil 0 nil "tag" name)))))
 578
 579 (defun vc-git-retrieve-snapshot (dir name update)
 580   (let ((default-directory dir))
 581     (vc-git-command nil 0 nil "checkout" name)
 582     ;; FIXME: update buffers if `update' is true
 583     ))
 584
 585
 586 ;;; MISCELLANEOUS
 587
 588 (defun vc-git-previous-revision (file rev)
 589   "Git-specific version of `vc-previous-revision'."
 590   (let ((default-directory (file-name-directory (expand-file-name file)))
 591         (file (file-name-nondirectory file)))
 592     (vc-git-symbolic-commit
 593      (with-temp-buffer
 594        (and
 595         (vc-git--out-ok "rev-list" "-2" rev "--" file)
 596         (goto-char (point-max))
 597         (bolp)
 598         (zerop (forward-line -1))
 599         (not (bobp))
 600         (buffer-substring-no-properties
 601          (point)
 602          (1- (point-max))))))))
 603
 604 (defun vc-git-next-revision (file rev)
 605   "Git-specific version of `vc-next-revision'."
 606   (let* ((default-directory (file-name-directory
 607                              (expand-file-name file)))
 608          (file (file-name-nondirectory file))
 609          (current-rev
 610           (with-temp-buffer
 611             (and
 612              (vc-git--out-ok "rev-list" "-1" rev "--" file)
 613              (goto-char (point-max))
 614              (bolp)
 615              (zerop (forward-line -1))
 616              (bobp)
 617              (buffer-substring-no-properties
 618               (point)
 619               (1- (point-max)))))))
 620     (and current-rev
 621          (vc-git-symbolic-commit
 622           (with-temp-buffer
 623             (and
 624              (vc-git--out-ok "rev-list" "HEAD" "--" file)
 625              (goto-char (point-min))
 626              (search-forward current-rev nil t)
 627              (zerop (forward-line -1))
 628              (buffer-substring-no-properties
 629               (point)
 630               (progn (forward-line 1) (1- (point))))))))))
 631
 632 (defun vc-git-delete-file (file)
 633   (vc-git-command nil 0 file "rm" "-f" "--"))
 634
 635 (defun vc-git-rename-file (old new)
 636   (vc-git-command nil 0 (list old new) "mv" "-f" "--"))
 637
 638 (defvar vc-git-extra-menu-map
 639   (let ((map (make-sparse-keymap)))
 640     (define-key map [git-grep]
 641       '(menu-item "Git grep..." vc-git-grep
 642                   :help "Run the `git grep' command"))
 643     map))
 644
 645 (defun vc-git-extra-menu () vc-git-extra-menu-map)
 646
 647 (defun vc-git-extra-status-menu () vc-git-extra-menu-map)
 648
 649 ;; Derived from `lgrep'.
 650 (defun vc-git-grep (regexp &optional files dir)
 651   "Run git grep, searching for REGEXP in FILES in directory DIR.
 652 The search is limited to file names matching shell pattern FILES.
 653 FILES may use abbreviations defined in `grep-files-aliases', e.g.
 654 entering `ch' is equivalent to `*.[ch]'.
 655
 656 With \\[universal-argument] prefix, you can edit the constructed shell command line
 657 before it is executed.
 658 With two \\[universal-argument] prefixes, directly edit and run `grep-command'.
 659
 660 Collect output in a buffer.  While git grep runs asynchronously, you
 661 can use \\[next-error] (M-x next-error), or \\<grep-mode-map>\\[compile-goto-error] \
 662 in the grep output buffer,
 663 to go to the lines where grep found matches.
 664
 665 This command shares argument histories with \\[rgrep] and \\[grep]."
 666   (interactive
 667    (progn
 668      (grep-compute-defaults)
 669      (cond
 670       ((equal current-prefix-arg '(16))
 671        (list (read-from-minibuffer "Run: " "git grep"
 672                                    nil nil 'grep-history)
 673              nil))
 674       (t (let* ((regexp (grep-read-regexp))
 675                 (files (grep-read-files regexp))
 676                 (dir (read-directory-name "In directory: "
 677                                           nil default-directory t)))
 678            (list regexp files dir))))))
 679   (require 'grep)
 680   (when (and (stringp regexp) (> (length regexp) 0))
 681     (let ((command regexp))
 682       (if (null files)
 683           (if (string= command "git grep")
 684               (setq command nil))
 685         (setq dir (file-name-as-directory (expand-file-name dir)))
 686         (setq command
 687               (grep-expand-template "git grep -n -e <R> -- <F>" regexp files))
 688         (when command
 689           (if (equal current-prefix-arg '(4))
 690               (setq command
 691                     (read-from-minibuffer "Confirm: "
 692                                           command nil nil 'grep-history))
 693             (add-to-history 'grep-history command))))
 694       (when command
 695         (let ((default-directory dir)
 696               (compilation-environment '("PAGER=")))
 697           ;; Setting process-setup-function makes exit-message-function work
 698           ;; even when async processes aren't supported.
 699           (compilation-start command 'grep-mode))
 700         (if (eq next-error-last-buffer (current-buffer))
 701             (setq default-directory dir))))))
 702 \f
 703 ;;; Internal commands
 704
 705 (defun vc-git-root (file)
 706   (vc-find-root file ".git"))
 707
 708 (defun vc-git-command (buffer okstatus file-or-list &rest flags)
 709   "A wrapper around `vc-do-command' for use in vc-git.el.
 710 The difference to vc-do-command is that this function always invokes `git'."
 711   (apply 'vc-do-command buffer okstatus "git" file-or-list flags))
 712
 713 (defun vc-git--empty-db-p ()
 714   "Check if the git db is empty (no commit done yet)."
 715   (not (eq 0 (vc-git--call nil "rev-parse" "--verify" "HEAD"))))
 716
 717 (defun vc-git--call (buffer command &rest args)
 718   ;; We don't need to care the arguments.  If there is a file name, it
 719   ;; is always a relative one.  This works also for remote
 720   ;; directories.
 721   (apply 'process-file "git" nil buffer nil command args))
 722
 723 (defun vc-git--out-ok (command &rest args)
 724   (zerop (apply 'vc-git--call '(t nil) command args)))
 725
 726 (defun vc-git--run-command-string (file &rest args)
 727   "Run a git command on FILE and return its output as string."
 728   (let* ((ok t)
 729          (str (with-output-to-string
 730                 (with-current-buffer standard-output
 731                   (unless (apply 'vc-git--out-ok
 732                                  (append args (list (file-relative-name
 733                                                      file))))
 734                     (setq ok nil))))))
 735     (and ok str)))
 736
 737 (defun vc-git-symbolic-commit (commit)
 738   "Translate COMMIT string into symbolic form.
 739 Returns nil if not possible."
 740   (and commit
 741        (with-temp-buffer
 742          (and
 743           (vc-git--out-ok "name-rev" "--name-only" "--tags" commit)
 744           (goto-char (point-min))
 745           (= (forward-line 2) 1)
 746           (bolp)
 747           (buffer-substring-no-properties (point-min) (1- (point-max)))))))
 748
 749 (provide 'vc-git)
 750
 751 ;; arch-tag: bd10664a-0e5b-48f5-a877-6c17b135be12
 752 ;;; vc-git.el ends here