lisp/vc-git.el

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