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