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