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