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