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-status-fileinfo structure."
 290   (let* ((state (vc-status-fileinfo->state info))
 291          (extra (vc-status-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-status-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-status-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 ;; Variable used to keep the intermediate results for vc-git-status.
 314 (defvar vc-git-status-result nil)
 315
 316 (defun vc-git-after-dir-status-stage2 (update-function)
 317   (goto-char (point-min))
 318   (while (re-search-forward "\\([^\0]*?\\)\0" nil t 1)
 319     (push (list (match-string 1) 'unregistered (vc-git-create-extra-fileinfo 0 0)) vc-git-status-result))
 320   (funcall update-function (nreverse vc-git-status-result)))
 321
 322 (defun vc-git-after-dir-status-stage1 (update-function)
 323   (goto-char (point-min))
 324   (while (re-search-forward
 325           ":\\([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"
 326           nil t 1)
 327     (let ((old-perm (string-to-number (match-string 1) 8))
 328           (new-perm (string-to-number (match-string 2) 8))
 329           (state (or (match-string 4) (match-string 6)))
 330           (name (or (match-string 5) (match-string 7)))
 331           (new-name (match-string 8)))
 332       (if new-name  ; copy or rename
 333           (if (eq ?C (string-to-char state))
 334               (push (list new-name 'added (vc-git-create-extra-fileinfo old-perm new-perm 'copy name)) vc-git-status-result)
 335             (push (list name 'removed (vc-git-create-extra-fileinfo 0 0 'rename new-name)) vc-git-status-result)
 336             (push (list new-name 'added (vc-git-create-extra-fileinfo old-perm new-perm 'rename name)) vc-git-status-result))
 337         (push (list name (vc-git--state-code state) (vc-git-create-extra-fileinfo old-perm new-perm)) vc-git-status-result))))
 338   (erase-buffer)
 339   (vc-git-command (current-buffer) 'async nil "ls-files" "-z" "-o"
 340                   "--directory" "--no-empty-directory" "--exclude-standard")
 341   (vc-exec-after
 342    `(vc-git-after-dir-status-stage2 (quote ,update-function))))
 343
 344 (defun vc-git-after-dir-status-stage1-empty-db (update-function)
 345   (goto-char (point-min))
 346   (while (re-search-forward "\\([0-7]\\{6\\}\\) [0-9a-f]\\{40\\} 0\t\\([^\0]+\\)\0" nil t)
 347     (let ((new-perm (string-to-number (match-string 1) 8))
 348           (name (match-string 2)))
 349       (push (list name 'added (vc-git-create-extra-fileinfo 0 new-perm)) vc-git-status-result)))
 350   (erase-buffer)
 351   (vc-git-command (current-buffer) 'async nil "ls-files" "-z" "-o"
 352                   "--directory" "--no-empty-directory" "--exclude-standard")
 353   (vc-exec-after
 354    `(vc-git-after-dir-status-stage2 (quote ,update-function))))
 355
 356 (defun vc-git-dir-status (dir update-function)
 357   "Return a list of conses (file . state) for DIR."
 358   ;; Further things that would have to be fixed later:
 359   ;; - how to handle unregistered directories
 360   ;; - how to support vc-status on a subdir of the project tree
 361   (set (make-local-variable 'vc-git-status-result) nil)
 362   (if (vc-git--empty-db-p)
 363       (progn
 364         (vc-git-command (current-buffer) 'async nil "ls-files" "-z" "-c" "-s")
 365         (vc-exec-after
 366          `(vc-git-after-dir-status-stage1-empty-db
 367            (quote ,update-function))))
 368     (vc-git-command (current-buffer) 'async nil "diff-index" "-z" "-M" "HEAD")
 369     (vc-exec-after
 370      `(vc-git-after-dir-status-stage1 (quote ,update-function)))))
 371
 372 (defun vc-git-status-extra-headers (dir)
 373   (let ((str (with-output-to-string
 374                (with-current-buffer standard-output
 375                  (vc-git--out-ok "symbolic-ref" "HEAD")))))
 376     (concat
 377      (propertize "Branch     : " 'face 'font-lock-type-face)
 378      (propertize
 379       (if (string-match "^\\(refs/heads/\\)?\\(.+\\)$" str)
 380           (match-string 2 str)
 381         "not (detached HEAD)")
 382        'face 'font-lock-variable-name-face))))
 383
 384 ;;; STATE-CHANGING FUNCTIONS
 385
 386 (defun vc-git-create-repo ()
 387   "Create a new Git repository."
 388   (vc-git-command nil 0 nil "init"))
 389
 390 (defun vc-git-register (files &optional rev comment)
 391   "Register FILE into the git version-control system."
 392   (vc-git-command nil 0 files "update-index" "--add" "--"))
 393
 394 (defalias 'vc-git-responsible-p 'vc-git-root)
 395
 396 (defun vc-git-unregister (file)
 397   (vc-git-command nil 0 file "rm" "-f" "--cached" "--"))
 398
 399
 400 (defun vc-git-checkin (files rev comment)
 401   (let ((coding-system-for-write git-commits-coding-system))
 402     (vc-git-command nil 0 files "commit" "-m" comment "--only" "--")))
 403
 404 (defun vc-git-find-revision (file rev buffer)
 405   (let ((coding-system-for-read 'binary)
 406         (coding-system-for-write 'binary)
 407         (fullname (substring
 408                    (vc-git--run-command-string
 409                     file "ls-files" "-z" "--full-name" "--")
 410                    0 -1)))
 411     (vc-git-command
 412      buffer 0
 413      (concat (if rev rev "HEAD") ":" fullname) "cat-file" "blob")))
 414
 415 (defun vc-git-checkout (file &optional editable rev)
 416   (vc-git-command nil 0 file "checkout" (or rev "HEAD")))
 417
 418 (defun vc-git-revert (file &optional contents-done)
 419   "Revert FILE to the version stored in the git repository."
 420   (if contents-done
 421       (vc-git-command nil 0 file "update-index" "--")
 422     (vc-git-command nil 0 file "checkout" "HEAD")))
 423
 424 ;;; HISTORY FUNCTIONS
 425
 426 (defun vc-git-print-log (files &optional buffer)
 427   "Get change log associated with FILES."
 428   (let ((coding-system-for-read git-commits-coding-system)
 429         ;; Support both the old print-log interface that passes a
 430         ;; single file, and the new one that passes a file list.
 431         (flist (if (listp files) files (list files))))
 432     ;; `vc-do-command' creates the buffer, but we need it before running
 433     ;; the command.
 434     (vc-setup-buffer buffer)
 435     ;; If the buffer exists from a previous invocation it might be
 436     ;; read-only.
 437     (let ((inhibit-read-only t))
 438       ;; XXX `log-view-mode' needs to have something to identify where
 439       ;; the log for each individual file starts. It seems that by
 440       ;; default git does not output this info. So loop here and call
 441       ;; "git rev-list" on each file separately to make sure that each
 442       ;; file gets a "File:" header before the corresponding
 443       ;; log. Maybe there is a way to do this with one command...
 444       (dolist (file flist)
 445         (with-current-buffer
 446             buffer
 447           (insert "File: " (file-name-nondirectory file) "\n"))
 448         (vc-git-command buffer 'async (file-relative-name file)
 449                         "rev-list" "--pretty" "HEAD" "--")))))
 450
 451 (defvar log-view-message-re)
 452 (defvar log-view-file-re)
 453 (defvar log-view-font-lock-keywords)
 454
 455 (define-derived-mode vc-git-log-view-mode log-view-mode "Git-Log-View"
 456   (require 'add-log) ;; we need the faces add-log
 457   ;; Don't have file markers, so use impossible regexp.
 458   (set (make-local-variable 'log-view-file-re) "^File:[ \t]+\\(.+\\)")
 459   (set (make-local-variable 'log-view-message-re)
 460        "^commit *\\([0-9a-z]+\\)")
 461   (set (make-local-variable 'log-view-font-lock-keywords)
 462        (append
 463         `((,log-view-message-re  (1 'change-log-acknowledgement))
 464           (,log-view-file-re (1 'change-log-file-face)))
 465         ;; Handle the case:
 466         ;; user: foo@bar
 467         '(("^Author:[ \t]+\\([A-Za-z0-9_.+-]+@[A-Za-z0-9_.-]+\\)"
 468            (1 'change-log-email))
 469           ;; Handle the case:
 470           ;; user: FirstName LastName <foo@bar>
 471           ("^Author:[ \t]+\\([^<(]+?\\)[ \t]*[(<]\\([A-Za-z0-9_.+-]+@[A-Za-z0-9_.-]+\\)[>)]"
 472            (1 'change-log-name)
 473            (2 'change-log-email))
 474           ("^ +\\(?:\\(?:[Aa]cked\\|[Ss]igned-[Oo]ff\\)-[Bb]y:\\)[ \t]+\\([A-Za-z0-9_.+-]+@[A-Za-z0-9_.-]+\\)"
 475            (1 'change-log-name))
 476           ("^ +\\(?:\\(?:[Aa]cked\\|[Ss]igned-[Oo]ff\\)-[Bb]y:\\)[ \t]+\\([^<(]+?\\)[ \t]*[(<]\\([A-Za-z0-9_.+-]+@[A-Za-z0-9_.-]+\\)[>)]"
 477            (1 'change-log-name)
 478            (2 'change-log-email))
 479           ("^Merge: \\([0-9a-z]+\\) \\([0-9a-z]+\\)"
 480            (1 'change-log-acknowledgement)
 481            (2 'change-log-acknowledgement))
 482           ("^Date:   \\(.+\\)" (1 'change-log-date))
 483           ("^summary:[ \t]+\\(.+\\)" (1 'log-view-message))))))
 484
 485 (defun vc-git-show-log-entry (revision)
 486   "Move to the log entry for REVISION.
 487 REVISION may have the form BRANCH, BRANCH~N,
 488 or BRANCH^ (where \"^\" can be repeated)."
 489   (goto-char (point-min))
 490   (search-forward "\ncommit" nil t
 491                   (cond ((string-match "~\\([0-9]\\)$" revision)
 492                          (1+ (string-to-number (match-string 1 revision))))
 493                         ((string-match "\\^+$" revision)
 494                          (1+ (length (match-string 0 revision))))
 495                         (t nil)))
 496   (beginning-of-line))
 497
 498 (defun vc-git-diff (files &optional rev1 rev2 buffer)
 499   (let ((buf (or buffer "*vc-diff*")))
 500     (if (and rev1 rev2)
 501         (vc-git-command buf 1 files "diff-tree" "--exit-code" "-p"
 502                         rev1 rev2 "--")
 503       (vc-git-command buf 1 files "diff-index" "--exit-code" "-p"
 504                       (or rev1 "HEAD") "--"))))
 505
 506 (defun vc-git-revision-table (files)
 507   ;; What about `files'?!?  --Stef
 508   (let ((table (list "HEAD")))
 509     (with-temp-buffer
 510       (vc-git-command t nil nil "for-each-ref" "--format=%(refname)")
 511       (goto-char (point-min))
 512       (while (re-search-forward "^refs/\\(heads\\|tags\\)/\\(.*\\)$" nil t)
 513         (push (match-string 2) table)))
 514     table))
 515
 516 (defun vc-git-revision-completion-table (files)
 517   (lexical-let ((files files)
 518                 table)
 519     (setq table (lazy-completion-table
 520                  table (lambda () (vc-git-revision-table files))))
 521     table))
 522
 523 (defun vc-git-annotate-command (file buf &optional rev)
 524   ;; FIXME: rev is ignored
 525   (let ((name (file-relative-name file)))
 526     (vc-git-command buf 0 name "blame" (if rev (concat "-r" rev)))))
 527
 528 (defun vc-git-annotate-time ()
 529   (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)
 530        (vc-annotate-convert-time
 531         (apply #'encode-time (mapcar (lambda (match)
 532                                        (string-to-number (match-string match)))
 533                                      '(6 5 4 3 2 1 7))))))
 534
 535 (defun vc-git-annotate-extract-revision-at-line ()
 536   (save-excursion
 537     (move-beginning-of-line 1)
 538     (and (looking-at "[0-9a-f^][0-9a-f]+")
 539          (buffer-substring-no-properties (match-beginning 0) (match-end 0)))))
 540
 541 ;;; SNAPSHOT SYSTEM
 542
 543 (defun vc-git-create-snapshot (dir name branchp)
 544   (let ((default-directory dir))
 545     (and (vc-git-command nil 0 nil "update-index" "--refresh")
 546          (if branchp
 547              (vc-git-command nil 0 nil "checkout" "-b" name)
 548            (vc-git-command nil 0 nil "tag" name)))))
 549
 550 (defun vc-git-retrieve-snapshot (dir name update)
 551   (let ((default-directory dir))
 552     (vc-git-command nil 0 nil "checkout" name)
 553     ;; FIXME: update buffers if `update' is true
 554     ))
 555
 556
 557 ;;; MISCELLANEOUS
 558
 559 (defun vc-git-previous-revision (file rev)
 560   "Git-specific version of `vc-previous-revision'."
 561   (let ((default-directory (file-name-directory (expand-file-name file)))
 562         (file (file-name-nondirectory file)))
 563     (vc-git-symbolic-commit
 564      (with-temp-buffer
 565        (and
 566         (vc-git--out-ok "rev-list" "-2" rev "--" file)
 567         (goto-char (point-max))
 568         (bolp)
 569         (zerop (forward-line -1))
 570         (not (bobp))
 571         (buffer-substring-no-properties
 572          (point)
 573          (1- (point-max))))))))
 574
 575 (defun vc-git-next-revision (file rev)
 576   "Git-specific version of `vc-next-revision'."
 577   (let* ((default-directory (file-name-directory
 578                              (expand-file-name file)))
 579          (file (file-name-nondirectory file))
 580          (current-rev
 581           (with-temp-buffer
 582             (and
 583              (vc-git--out-ok "rev-list" "-1" rev "--" file)
 584              (goto-char (point-max))
 585              (bolp)
 586              (zerop (forward-line -1))
 587              (bobp)
 588              (buffer-substring-no-properties
 589               (point)
 590               (1- (point-max)))))))
 591     (and current-rev
 592          (vc-git-symbolic-commit
 593           (with-temp-buffer
 594             (and
 595              (vc-git--out-ok "rev-list" "HEAD" "--" file)
 596              (goto-char (point-min))
 597              (search-forward current-rev nil t)
 598              (zerop (forward-line -1))
 599              (buffer-substring-no-properties
 600               (point)
 601               (progn (forward-line 1) (1- (point))))))))))
 602
 603 (defun vc-git-delete-file (file)
 604   (vc-git-command nil 0 file "rm" "-f" "--"))
 605
 606 (defun vc-git-rename-file (old new)
 607   (vc-git-command nil 0 (list old new) "mv" "-f" "--"))
 608
 609 (defvar vc-git-extra-menu-map
 610   (let ((map (make-sparse-keymap)))
 611     (define-key map [git-grep]
 612       '(menu-item "Git grep..." vc-git-grep
 613                   :help "Run the `git grep' command"))
 614     map))
 615
 616 (defun vc-git-extra-menu () vc-git-extra-menu-map)
 617
 618 (defun vc-git-extra-status-menu () vc-git-extra-menu-map)
 619
 620 ;; Derived from `lgrep'.
 621 (defun vc-git-grep (regexp &optional files dir)
 622   "Run git grep, searching for REGEXP in FILES in directory DIR.
 623 The search is limited to file names matching shell pattern FILES.
 624 FILES may use abbreviations defined in `grep-files-aliases', e.g.
 625 entering `ch' is equivalent to `*.[ch]'.
 626
 627 With \\[universal-argument] prefix, you can edit the constructed shell command line
 628 before it is executed.
 629 With two \\[universal-argument] prefixes, directly edit and run `grep-command'.
 630
 631 Collect output in a buffer.  While git grep runs asynchronously, you
 632 can use \\[next-error] (M-x next-error), or \\<grep-mode-map>\\[compile-goto-error] \
 633 in the grep output buffer,
 634 to go to the lines where grep found matches.
 635
 636 This command shares argument histories with \\[rgrep] and \\[grep]."
 637   (interactive
 638    (progn
 639      (grep-compute-defaults)
 640      (cond
 641       ((equal current-prefix-arg '(16))
 642        (list (read-from-minibuffer "Run: " "git grep"
 643                                    nil nil 'grep-history)
 644              nil))
 645       (t (let* ((regexp (grep-read-regexp))
 646                 (files (grep-read-files regexp))
 647                 (dir (read-directory-name "In directory: "
 648                                           nil default-directory t)))
 649            (list regexp files dir))))))
 650   (require 'grep)
 651   (when (and (stringp regexp) (> (length regexp) 0))
 652     (let ((command regexp))
 653       (if (null files)
 654           (if (string= command "git grep")
 655               (setq command nil))
 656         (setq dir (file-name-as-directory (expand-file-name dir)))
 657         (setq command
 658               (grep-expand-template "git grep -n -e <R> -- <F>" regexp files))
 659         (when command
 660           (if (equal current-prefix-arg '(4))
 661               (setq command
 662                     (read-from-minibuffer "Confirm: "
 663                                           command nil nil 'grep-history))
 664             (add-to-history 'grep-history command))))
 665       (when command
 666         (let ((default-directory dir)
 667               (compilation-environment '("PAGER=")))
 668           ;; Setting process-setup-function makes exit-message-function work
 669           ;; even when async processes aren't supported.
 670           (compilation-start command 'grep-mode))
 671         (if (eq next-error-last-buffer (current-buffer))
 672             (setq default-directory dir))))))
 673 \f
 674 ;;; Internal commands
 675
 676 (defun vc-git-root (file)
 677   (vc-find-root file ".git"))
 678
 679 (defun vc-git-command (buffer okstatus file-or-list &rest flags)
 680   "A wrapper around `vc-do-command' for use in vc-git.el.
 681 The difference to vc-do-command is that this function always invokes `git'."
 682   (apply 'vc-do-command buffer okstatus "git" file-or-list flags))
 683
 684 (defun vc-git--empty-db-p ()
 685   "Check if the git db is empty (no commit done yet)."
 686   (not (eq 0 (vc-git--call nil "rev-parse" "--verify" "HEAD"))))
 687
 688 (defun vc-git--call (buffer command &rest args)
 689   ;; We don't need to care the arguments.  If there is a file name, it
 690   ;; is always a relative one.  This works also for remote
 691   ;; directories.
 692   (apply 'process-file "git" nil buffer nil command args))
 693
 694 (defun vc-git--out-ok (command &rest args)
 695   (zerop (apply 'vc-git--call '(t nil) command args)))
 696
 697 (defun vc-git--run-command-string (file &rest args)
 698   "Run a git command on FILE and return its output as string."
 699   (let* ((ok t)
 700          (str (with-output-to-string
 701                 (with-current-buffer standard-output
 702                   (unless (apply 'vc-git--out-ok
 703                                  (append args (list (file-relative-name
 704                                                      file))))
 705                     (setq ok nil))))))
 706     (and ok str)))
 707
 708 (defun vc-git-symbolic-commit (commit)
 709   "Translate COMMIT string into symbolic form.
 710 Returns nil if not possible."
 711   (and commit
 712        (with-temp-buffer
 713          (and
 714           (vc-git--out-ok "name-rev" "--name-only" "--tags" commit)
 715           (goto-char (point-min))
 716           (= (forward-line 2) 1)
 717           (bolp)
 718           (buffer-substring-no-properties (point-min) (1- (point-max)))))))
 719
 720 (provide 'vc-git)
 721
 722 ;; arch-tag: bd10664a-0e5b-48f5-a877-6c17b135be12
 723 ;;; vc-git.el ends here