code.delx.au - gnu-emacs/blob - lisp/vc-git.el

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