lisp/vc-git.el

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