lisp/vc-git.el

   1 ;;; vc-git.el --- VC backend for the git version control system
   2
   3 ;; Copyright (C) 2006, 2007, 2008, 2009, 2010 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
  73 ;;                                          when 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 buffer &optional shortlog start-revision limit)   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
  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
 105 (eval-when-compile
 106   (require 'cl)
 107   (require 'vc)
 108   (require 'vc-dir)
 109   (require 'grep))
 110
 111 (defcustom vc-git-diff-switches t
 112   "String or list of strings specifying switches for Git diff under VC.
 113 If nil, use the value of `vc-diff-switches'.  If t, use no switches."
 114   :type '(choice (const :tag "Unspecified" nil)
 115                  (const :tag "None" t)
 116                  (string :tag "Argument String")
 117                  (repeat :tag "Argument List" :value ("") string))
 118   :version "23.1"
 119   :group 'vc)
 120
 121 (defvar git-commits-coding-system 'utf-8
 122   "Default coding system for git commits.")
 123
 124 ;;; BACKEND PROPERTIES
 125
 126 (defun vc-git-revision-granularity () 'repository)
 127 (defun vc-git-checkout-model (files) 'implicit)
 128
 129 ;;; STATE-QUERYING FUNCTIONS
 130
 131 ;;;###autoload (defun vc-git-registered (file)
 132 ;;;###autoload   "Return non-nil if FILE is registered with git."
 133 ;;;###autoload   (if (vc-find-root file ".git")       ; Short cut.
 134 ;;;###autoload       (progn
 135 ;;;###autoload         (load "vc-git")
 136 ;;;###autoload         (vc-git-registered file))))
 137
 138 (defun vc-git-registered (file)
 139   "Check whether FILE is registered with git."
 140   (let ((dir (vc-git-root file)))
 141     (when dir
 142       (with-temp-buffer
 143         (let* (process-file-side-effects
 144                ;; Do not use the `file-name-directory' here: git-ls-files
 145                ;; sometimes fails to return the correct status for relative
 146                ;; path specs.
 147                ;; See also: http://marc.info/?l=git&m=125787684318129&w=2
 148                (name (file-relative-name file dir))
 149                (str (ignore-errors
 150                      (cd dir)
 151                      (vc-git--out-ok "ls-files" "-c" "-z" "--" name)
 152                      ;; If result is empty, use ls-tree to check for deleted
 153                      ;; file.
 154                      (when (eq (point-min) (point-max))
 155                        (vc-git--out-ok "ls-tree" "--name-only" "-z" "HEAD"
 156                                        "--" name))
 157                      (buffer-string))))
 158           (and str
 159                (> (length str) (length name))
 160                (string= (substring str 0 (1+ (length name)))
 161                         (concat name "\0"))))))))
 162
 163 (defun vc-git--state-code (code)
 164   "Convert from a string to a added/deleted/modified state."
 165   (case (string-to-char code)
 166     (?M 'edited)
 167     (?A 'added)
 168     (?D 'removed)
 169     (?U 'edited)     ;; FIXME
 170     (?T 'edited)))   ;; FIXME
 171
 172 (defun vc-git-state (file)
 173   "Git-specific version of `vc-state'."
 174   ;; FIXME: This can't set 'ignored yet
 175   (if (not (vc-git-registered file))
 176       'unregistered
 177     (vc-git--call nil "add" "--refresh" "--" (file-relative-name file))
 178     (let ((diff (vc-git--run-command-string
 179                  file "diff-index" "-z" "HEAD" "--")))
 180       (if (and diff (string-match ":[0-7]\\{6\\} [0-7]\\{6\\} [0-9a-f]\\{40\\} [0-9a-f]\\{40\\} \\([ADMUT]\\)\0[^\0]+\0"
 181                                   diff))
 182           (vc-git--state-code (match-string 1 diff))
 183         (if (vc-git--empty-db-p) 'added 'up-to-date)))))
 184
 185 (defun vc-git-working-revision (file)
 186   "Git-specific version of `vc-working-revision'."
 187   (let* (process-file-side-effects
 188          (str (with-output-to-string
 189                 (with-current-buffer standard-output
 190                   (vc-git--out-ok "symbolic-ref" "HEAD")))))
 191     (if (string-match "^\\(refs/heads/\\)?\\(.+\\)$" str)
 192         (match-string 2 str)
 193       str)))
 194
 195 (defun vc-git-workfile-unchanged-p (file)
 196   (eq 'up-to-date (vc-git-state file)))
 197
 198 (defun vc-git-mode-line-string (file)
 199   "Return string for placement into the modeline for FILE."
 200   (let* ((branch (vc-git-working-revision file))
 201          (def-ml (vc-default-mode-line-string 'Git file))
 202          (help-echo (get-text-property 0 'help-echo def-ml)))
 203     (if (zerop (length branch))
 204         (propertize
 205          (concat def-ml "!")
 206          'help-echo (concat help-echo "\nNo current branch (detached HEAD)"))
 207       (propertize def-ml
 208                   'help-echo (concat help-echo "\nCurrent branch: " branch)))))
 209
 210 (defstruct (vc-git-extra-fileinfo
 211             (:copier nil)
 212             (:constructor vc-git-create-extra-fileinfo
 213                           (old-perm new-perm &optional rename-state orig-name))
 214             (:conc-name vc-git-extra-fileinfo->))
 215   old-perm new-perm   ;; Permission flags.
 216   rename-state        ;; Rename or copy state.
 217   orig-name)          ;; Original name for renames or copies.
 218
 219 (defun vc-git-escape-file-name (name)
 220   "Escape a file name if necessary."
 221   (if (string-match "[\n\t\"\\]" name)
 222       (concat "\""
 223               (mapconcat (lambda (c)
 224                    (case c
 225                      (?\n "\\n")
 226                      (?\t "\\t")
 227                      (?\\ "\\\\")
 228                      (?\" "\\\"")
 229                      (t (char-to-string c))))
 230                  name "")
 231               "\"")
 232     name))
 233
 234 (defun vc-git-file-type-as-string (old-perm new-perm)
 235   "Return a string describing the file type based on its permissions."
 236   (let* ((old-type (lsh (or old-perm 0) -9))
 237          (new-type (lsh (or new-perm 0) -9))
 238          (str (case new-type
 239                 (?\100  ;; File.
 240                  (case old-type
 241                    (?\100 nil)
 242                    (?\120 "   (type change symlink -> file)")
 243                    (?\160 "   (type change subproject -> file)")))
 244                  (?\120  ;; Symlink.
 245                   (case old-type
 246                     (?\100 "   (type change file -> symlink)")
 247                     (?\160 "   (type change subproject -> symlink)")
 248                     (t "   (symlink)")))
 249                   (?\160  ;; Subproject.
 250                    (case old-type
 251                      (?\100 "   (type change file -> subproject)")
 252                      (?\120 "   (type change symlink -> subproject)")
 253                      (t "   (subproject)")))
 254                   (?\110 nil)  ;; Directory (internal, not a real git state).
 255                   (?\000  ;; Deleted or unknown.
 256                    (case old-type
 257                      (?\120 "   (symlink)")
 258                      (?\160 "   (subproject)")))
 259                   (t (format "   (unknown type %o)" new-type)))))
 260     (cond (str (propertize str 'face 'font-lock-comment-face))
 261           ((eq new-type ?\110) "/")
 262           (t ""))))
 263
 264 (defun vc-git-rename-as-string (state extra)
 265   "Return a string describing the copy or rename associated with INFO,
 266 or an empty string if none."
 267   (let ((rename-state (when extra
 268                         (vc-git-extra-fileinfo->rename-state extra))))
 269     (if rename-state
 270         (propertize
 271          (concat "   ("
 272                  (if (eq rename-state 'copy) "copied from "
 273                    (if (eq state 'added) "renamed from "
 274                      "renamed to "))
 275                  (vc-git-escape-file-name
 276                   (vc-git-extra-fileinfo->orig-name extra))
 277                  ")")
 278          'face 'font-lock-comment-face)
 279       "")))
 280
 281 (defun vc-git-permissions-as-string (old-perm new-perm)
 282   "Format a permission change as string."
 283   (propertize
 284    (if (or (not old-perm)
 285            (not new-perm)
 286            (eq 0 (logand ?\111 (logxor old-perm new-perm))))
 287        "  "
 288      (if (eq 0 (logand ?\111 old-perm)) "+x" "-x"))
 289   'face 'font-lock-type-face))
 290
 291 (defun vc-git-dir-printer (info)
 292   "Pretty-printer for the vc-dir-fileinfo structure."
 293   (let* ((isdir (vc-dir-fileinfo->directory info))
 294          (state (if isdir "" (vc-dir-fileinfo->state info)))
 295          (extra (vc-dir-fileinfo->extra info))
 296          (old-perm (when extra (vc-git-extra-fileinfo->old-perm extra)))
 297          (new-perm (when extra (vc-git-extra-fileinfo->new-perm extra))))
 298     (insert
 299      "  "
 300      (propertize (format "%c" (if (vc-dir-fileinfo->marked info) ?* ? ))
 301                  'face 'font-lock-type-face)
 302      "  "
 303      (propertize
 304       (format "%-12s" state)
 305       'face (cond ((eq state 'up-to-date) 'font-lock-builtin-face)
 306                   ((eq state 'missing) 'font-lock-warning-face)
 307                   (t 'font-lock-variable-name-face))
 308       'mouse-face 'highlight)
 309      "  " (vc-git-permissions-as-string old-perm new-perm)
 310      "    "
 311      (propertize (vc-git-escape-file-name (vc-dir-fileinfo->name info))
 312                  'face (if isdir 'font-lock-comment-delimiter-face
 313                          'font-lock-function-name-face)
 314                  'help-echo
 315                  (if isdir
 316                      "Directory\nVC operations can be applied to it\nmouse-3: Pop-up menu"
 317                    "File\nmouse-3: Pop-up menu")
 318                  'keymap vc-dir-filename-mouse-map
 319                  'mouse-face 'highlight)
 320      (vc-git-file-type-as-string old-perm new-perm)
 321      (vc-git-rename-as-string state extra))))
 322
 323 (defun vc-git-after-dir-status-stage (stage files update-function)
 324   "Process sentinel for the various dir-status stages."
 325   (let (next-stage result)
 326     (goto-char (point-min))
 327     (case stage
 328       (update-index
 329        (setq next-stage (if (vc-git--empty-db-p) 'ls-files-added
 330                           (if files 'ls-files-up-to-date 'diff-index))))
 331       (ls-files-added
 332        (setq next-stage 'ls-files-unknown)
 333        (while (re-search-forward "\\([0-7]\\{6\\}\\) [0-9a-f]\\{40\\} 0\t\\([^\0]+\\)\0" nil t)
 334          (let ((new-perm (string-to-number (match-string 1) 8))
 335                (name (match-string 2)))
 336            (push (list name 'added (vc-git-create-extra-fileinfo 0 new-perm))
 337                  result))))
 338       (ls-files-up-to-date
 339        (setq next-stage 'diff-index)
 340        (while (re-search-forward "\\([0-7]\\{6\\}\\) [0-9a-f]\\{40\\} 0\t\\([^\0]+\\)\0" nil t)
 341          (let ((perm (string-to-number (match-string 1) 8))
 342                (name (match-string 2)))
 343            (push (list name 'up-to-date
 344                        (vc-git-create-extra-fileinfo perm perm))
 345                  result))))
 346       (ls-files-unknown
 347        (when files (setq next-stage 'ls-files-ignored))
 348        (while (re-search-forward "\\([^\0]*?\\)\0" nil t 1)
 349          (push (list (match-string 1) 'unregistered
 350                      (vc-git-create-extra-fileinfo 0 0))
 351                result)))
 352       (ls-files-ignored
 353        (while (re-search-forward "\\([^\0]*?\\)\0" nil t 1)
 354          (push (list (match-string 1) 'ignored
 355                      (vc-git-create-extra-fileinfo 0 0))
 356                result)))
 357       (diff-index
 358        (setq next-stage 'ls-files-unknown)
 359        (while (re-search-forward
 360                ":\\([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"
 361                nil t 1)
 362          (let ((old-perm (string-to-number (match-string 1) 8))
 363                (new-perm (string-to-number (match-string 2) 8))
 364                (state (or (match-string 4) (match-string 6)))
 365                (name (or (match-string 5) (match-string 7)))
 366                (new-name (match-string 8)))
 367            (if new-name  ; Copy or rename.
 368                (if (eq ?C (string-to-char state))
 369                    (push (list new-name 'added
 370                                (vc-git-create-extra-fileinfo old-perm new-perm
 371                                                              'copy name))
 372                          result)
 373                  (push (list name 'removed
 374                              (vc-git-create-extra-fileinfo 0 0
 375                                                            'rename new-name))
 376                        result)
 377                  (push (list new-name 'added
 378                              (vc-git-create-extra-fileinfo old-perm new-perm
 379                                                            'rename name))
 380                        result))
 381              (push (list name (vc-git--state-code state)
 382                          (vc-git-create-extra-fileinfo old-perm new-perm))
 383                    result))))))
 384     (when result
 385       (setq result (nreverse result))
 386       (when files
 387         (dolist (entry result) (setq files (delete (car entry) files)))
 388         (unless files (setq next-stage nil))))
 389     (when (or result (not next-stage))
 390       (funcall update-function result next-stage))
 391     (when next-stage
 392       (vc-git-dir-status-goto-stage next-stage files update-function))))
 393
 394 (defun vc-git-dir-status-goto-stage (stage files update-function)
 395   (erase-buffer)
 396   (case stage
 397     (update-index
 398      (if files
 399          (vc-git-command (current-buffer) 'async files "add" "--refresh" "--")
 400        (vc-git-command (current-buffer) 'async nil
 401                        "update-index" "--refresh")))
 402     (ls-files-added
 403      (vc-git-command (current-buffer) 'async files
 404                      "ls-files" "-z" "-c" "-s" "--"))
 405     (ls-files-up-to-date
 406      (vc-git-command (current-buffer) 'async files
 407                      "ls-files" "-z" "-c" "-s" "--"))
 408     (ls-files-unknown
 409      (vc-git-command (current-buffer) 'async files
 410                      "ls-files" "-z" "-o" "--directory"
 411                      "--no-empty-directory" "--exclude-standard" "--"))
 412     (ls-files-ignored
 413      (vc-git-command (current-buffer) 'async files
 414                      "ls-files" "-z" "-o" "-i" "--directory"
 415                      "--no-empty-directory" "--exclude-standard" "--"))
 416     (diff-index
 417      (vc-git-command (current-buffer) 'async files
 418                      "diff-index" "--relative" "-z" "-M" "HEAD" "--")))
 419   (vc-exec-after
 420    `(vc-git-after-dir-status-stage ',stage  ',files ',update-function)))
 421
 422 (defun vc-git-dir-status (dir update-function)
 423   "Return a list of (FILE STATE EXTRA) entries for DIR."
 424   ;; Further things that would have to be fixed later:
 425   ;; - how to handle unregistered directories
 426   ;; - how to support vc-dir on a subdir of the project tree
 427   (vc-git-dir-status-goto-stage 'update-index nil update-function))
 428
 429 (defun vc-git-dir-status-files (dir files default-state update-function)
 430   "Return a list of (FILE STATE EXTRA) entries for FILES in DIR."
 431   (vc-git-dir-status-goto-stage 'update-index files update-function))
 432
 433 (defvar vc-git-stash-map
 434   (let ((map (make-sparse-keymap)))
 435     ;; Turn off vc-dir marking
 436     (define-key map [mouse-2] 'ignore)
 437
 438     (define-key map [down-mouse-3] 'vc-git-stash-menu)
 439     (define-key map "\C-k" 'vc-git-stash-delete-at-point)
 440     (define-key map "=" 'vc-git-stash-show-at-point)
 441     (define-key map "\C-m" 'vc-git-stash-show-at-point)
 442     (define-key map "A" 'vc-git-stash-apply-at-point)
 443     (define-key map "P" 'vc-git-stash-pop-at-point)
 444     (define-key map "S" 'vc-git-stash-snapshot)
 445     map))
 446
 447 (defvar vc-git-stash-menu-map
 448   (let ((map (make-sparse-keymap "Git Stash")))
 449     (define-key map [de]
 450       '(menu-item "Delete stash" vc-git-stash-delete-at-point
 451                   :help "Delete the current stash"))
 452     (define-key map [ap]
 453       '(menu-item "Apply stash" vc-git-stash-apply-at-point
 454                   :help "Apply the current stash and keep it in the stash list"))
 455     (define-key map [po]
 456       '(menu-item "Apply and remove stash (pop)" vc-git-stash-pop-at-point
 457                   :help "Apply the current stash and remove it"))
 458     (define-key map [sh]
 459       '(menu-item "Show stash" vc-git-stash-show-at-point
 460                   :help "Show the contents of the current stash"))
 461     map))
 462
 463 (defun vc-git-dir-extra-headers (dir)
 464   (let ((str (with-output-to-string
 465                (with-current-buffer standard-output
 466                  (vc-git--out-ok "symbolic-ref" "HEAD"))))
 467         (stash (vc-git-stash-list))
 468         (stash-help-echo "Use M-x vc-git-stash to create stashes.")
 469         branch remote remote-url)
 470     (if (string-match "^\\(refs/heads/\\)?\\(.+\\)$" str)
 471         (progn
 472           (setq branch (match-string 2 str))
 473           (setq remote
 474                 (with-output-to-string
 475                   (with-current-buffer standard-output
 476                     (vc-git--out-ok "config"
 477                                     (concat "branch." branch ".remote")))))
 478           (when (string-match "\\([^\n]+\\)" remote)
 479             (setq remote (match-string 1 remote)))
 480           (when remote
 481             (setq remote-url
 482                   (with-output-to-string
 483                     (with-current-buffer standard-output
 484                       (vc-git--out-ok "config"
 485                                       (concat "remote." remote ".url"))))))
 486           (when (string-match "\\([^\n]+\\)" remote-url)
 487             (setq remote-url (match-string 1 remote-url))))
 488       (setq branch "not (detached HEAD)"))
 489     ;; FIXME: maybe use a different face when nothing is stashed.
 490     (concat
 491      (propertize "Branch     : " 'face 'font-lock-type-face)
 492      (propertize branch
 493                  'face 'font-lock-variable-name-face)
 494      (when remote
 495        (concat
 496         "\n"
 497         (propertize "Remote     : " 'face 'font-lock-type-face)
 498         (propertize remote-url
 499                     'face 'font-lock-variable-name-face)))
 500      "\n"
 501      (if stash
 502        (concat
 503         (propertize "Stash      :\n" 'face 'font-lock-type-face
 504                     'help-echo stash-help-echo)
 505         (mapconcat
 506          (lambda (x)
 507            (propertize x
 508                        'face 'font-lock-variable-name-face
 509                        'mouse-face 'highlight
 510                        'help-echo "mouse-3: Show stash menu\nRET: Show stash\nA: Apply stash\nP: Apply and remove stash (pop)\nC-k: Delete stash"
 511                        'keymap vc-git-stash-map))
 512          stash "\n"))
 513        (concat
 514         (propertize "Stash      : " 'face 'font-lock-type-face
 515                     'help-echo stash-help-echo)
 516         (propertize "Nothing stashed"
 517                     'help-echo stash-help-echo
 518                     'face 'font-lock-variable-name-face))))))
 519
 520 ;;; STATE-CHANGING FUNCTIONS
 521
 522 (defun vc-git-create-repo ()
 523   "Create a new Git repository."
 524   (vc-git-command nil 0 nil "init"))
 525
 526 (defun vc-git-register (files &optional rev comment)
 527   "Register FILES into the git version-control system."
 528   (let (flist dlist)
 529     (dolist (crt files)
 530       (if (file-directory-p crt)
 531           (push crt dlist)
 532         (push crt flist)))
 533     (when flist
 534       (vc-git-command nil 0 flist "update-index" "--add" "--"))
 535     (when dlist
 536       (vc-git-command nil 0 dlist "add"))))
 537
 538 (defalias 'vc-git-responsible-p 'vc-git-root)
 539
 540 (defun vc-git-unregister (file)
 541   (vc-git-command nil 0 file "rm" "-f" "--cached" "--"))
 542
 543
 544 (defun vc-git-checkin (files rev comment  &optional extra-args-ignored)
 545   (let ((coding-system-for-write git-commits-coding-system))
 546     (vc-git-command nil 0 files "commit"
 547                     "-m" comment "--only" "--")))
 548
 549 (defun vc-git-find-revision (file rev buffer)
 550   (let* (process-file-side-effects
 551          (coding-system-for-read 'binary)
 552          (coding-system-for-write 'binary)
 553          (fullname (substring
 554                     (vc-git--run-command-string
 555                      file "ls-files" "-z" "--full-name" "--")
 556                     0 -1)))
 557     (vc-git-command
 558      buffer 0
 559      (concat (if rev rev "HEAD") ":" fullname) "cat-file" "blob")))
 560
 561 (defun vc-git-checkout (file &optional editable rev)
 562   (vc-git-command nil 0 file "checkout" (or rev "HEAD")))
 563
 564 (defun vc-git-revert (file &optional contents-done)
 565   "Revert FILE to the version stored in the git repository."
 566   (if contents-done
 567       (vc-git-command nil 0 file "update-index" "--")
 568     (vc-git-command nil 0 file "reset" "-q" "--")
 569     (vc-git-command nil nil file "checkout" "-q" "--")))
 570
 571 ;;; HISTORY FUNCTIONS
 572
 573 (defun vc-git-print-log (files buffer &optional shortlog start-revision limit)
 574   "Get change log associated with FILES."
 575   (let ((coding-system-for-read git-commits-coding-system))
 576     ;; `vc-do-command' creates the buffer, but we need it before running
 577     ;; the command.
 578     (vc-setup-buffer buffer)
 579     ;; If the buffer exists from a previous invocation it might be
 580     ;; read-only.
 581     (let ((inhibit-read-only t))
 582       (with-current-buffer
 583           buffer
 584         (apply 'vc-git-command buffer
 585                'async files
 586                (append
 587                 '("log" "--no-color")
 588                 (when shortlog
 589                   '("--graph" "--decorate" "--date=short"
 590                     "--pretty=tformat:%d%h  %ad  %s" "--abbrev-commit"))
 591                 (when limit (list "-n" (format "%s" limit)))
 592                 (when start-revision (list start-revision))
 593                 '("--")))))))
 594
 595 (defvar log-view-message-re)
 596 (defvar log-view-file-re)
 597 (defvar log-view-font-lock-keywords)
 598 (defvar log-view-per-file-logs)
 599
 600 ;; Dynamically bound.
 601 (defvar vc-short-log)
 602
 603 (define-derived-mode vc-git-log-view-mode log-view-mode "Git-Log-View"
 604   (require 'add-log) ;; We need the faces add-log.
 605   ;; Don't have file markers, so use impossible regexp.
 606   (set (make-local-variable 'log-view-file-re) "\\`a\\`")
 607   (set (make-local-variable 'log-view-per-file-logs) nil)
 608   (set (make-local-variable 'log-view-message-re)
 609        (if vc-short-log
 610            "^\\(?:[*/\\| ]+ \\)?\\(?: ([^)]+)\\)?\\([0-9a-z]+\\)  \\([-a-z0-9]+\\)  \\(.*\\)"
 611          "^commit *\\([0-9a-z]+\\)"))
 612   (set (make-local-variable 'log-view-font-lock-keywords)
 613        (if vc-short-log
 614            '(
 615              ;; Same as log-view-message-re, except that we don't
 616              ;; want the shy group for the tag name.
 617              ("^\\(?:[*/\\| ]+ \\)?\\( ([^)]+)\\)?\\([0-9a-z]+\\)  \\([-a-z0-9]+\\)  \\(.*\\)"
 618               (1 'highlight nil lax)
 619               (2 'change-log-acknowledgement)
 620               (3 'change-log-date)))
 621        (append
 622         `((,log-view-message-re (1 'change-log-acknowledgement)))
 623         ;; Handle the case:
 624         ;; user: foo@bar
 625         '(("^Author:[ \t]+\\([A-Za-z0-9_.+-]+@[A-Za-z0-9_.-]+\\)"
 626            (1 'change-log-email))
 627           ;; Handle the case:
 628           ;; user: FirstName LastName <foo@bar>
 629           ("^Author:[ \t]+\\([^<(]+?\\)[ \t]*[(<]\\([A-Za-z0-9_.+-]+@[A-Za-z0-9_.-]+\\)[>)]"
 630            (1 'change-log-name)
 631            (2 'change-log-email))
 632           ("^ +\\(?:\\(?:[Aa]cked\\|[Ss]igned-[Oo]ff\\)-[Bb]y:\\)[ \t]+\\([A-Za-z0-9_.+-]+@[A-Za-z0-9_.-]+\\)"
 633            (1 'change-log-name))
 634           ("^ +\\(?:\\(?:[Aa]cked\\|[Ss]igned-[Oo]ff\\)-[Bb]y:\\)[ \t]+\\([^<(]+?\\)[ \t]*[(<]\\([A-Za-z0-9_.+-]+@[A-Za-z0-9_.-]+\\)[>)]"
 635            (1 'change-log-name)
 636            (2 'change-log-email))
 637           ("^Merge: \\([0-9a-z]+\\) \\([0-9a-z]+\\)"
 638            (1 'change-log-acknowledgement)
 639            (2 'change-log-acknowledgement))
 640           ("^Date:   \\(.+\\)" (1 'change-log-date))
 641             ("^summary:[ \t]+\\(.+\\)" (1 'log-view-message)))))))
 642
 643
 644 (defun vc-git-show-log-entry (revision)
 645   "Move to the log entry for REVISION.
 646 REVISION may have the form BRANCH, BRANCH~N,
 647 or BRANCH^ (where \"^\" can be repeated)."
 648   (goto-char (point-min))
 649   (prog1
 650       (when revision
 651         (search-forward
 652          (format "\ncommit %s" revision) nil t
 653          (cond ((string-match "~\\([0-9]\\)\\'" revision)
 654                 (1+ (string-to-number (match-string 1 revision))))
 655                ((string-match "\\^+\\'" revision)
 656                 (1+ (length (match-string 0 revision))))
 657                (t nil))))
 658     (beginning-of-line)))
 659
 660 (defun vc-git-diff (files &optional rev1 rev2 buffer)
 661   "Get a difference report using Git between two revisions of FILES."
 662   (let (process-file-side-effects)
 663     (apply #'vc-git-command (or buffer "*vc-diff*") 1 files
 664            (if (and rev1 rev2) "diff-tree" "diff-index")
 665            "--exit-code"
 666            (append (vc-switches 'git 'diff)
 667                    (list "-p" (or rev1 "HEAD") rev2 "--")))))
 668
 669 (defun vc-git-revision-table (files)
 670   ;; What about `files'?!?  --Stef
 671   (let (process-file-side-effects
 672         (table (list "HEAD")))
 673     (with-temp-buffer
 674       (vc-git-command t nil nil "for-each-ref" "--format=%(refname)")
 675       (goto-char (point-min))
 676       (while (re-search-forward "^refs/\\(heads\\|tags\\|remotes\\)/\\(.*\\)$"
 677                                 nil t)
 678         (push (match-string 2) table)))
 679     table))
 680
 681 (defun vc-git-revision-completion-table (files)
 682   (lexical-let ((files files)
 683                 table)
 684     (setq table (lazy-completion-table
 685                  table (lambda () (vc-git-revision-table files))))
 686     table))
 687
 688 (defun vc-git-annotate-command (file buf &optional rev)
 689   (let ((name (file-relative-name file)))
 690     (vc-git-command buf 'async name "blame" "--date=iso" "-C" "-C" rev)))
 691
 692 (declare-function vc-annotate-convert-time "vc-annotate" (time))
 693
 694 (defun vc-git-annotate-time ()
 695   (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)
 696        (vc-annotate-convert-time
 697         (apply #'encode-time (mapcar (lambda (match)
 698                                        (string-to-number (match-string match)))
 699                                      '(6 5 4 3 2 1 7))))))
 700
 701 (defun vc-git-annotate-extract-revision-at-line ()
 702   (save-excursion
 703     (move-beginning-of-line 1)
 704     (when (looking-at "\\([0-9a-f^][0-9a-f]+\\) \\(\\([^(]+\\) \\)?")
 705       (let ((revision (match-string-no-properties 1)))
 706         (if (match-beginning 2)
 707             (cons revision (expand-file-name (match-string-no-properties 3)
 708                                              (vc-git-root default-directory)))
 709           revision)))))
 710
 711 ;;; TAG SYSTEM
 712
 713 (defun vc-git-create-tag (dir name branchp)
 714   (let ((default-directory dir))
 715     (and (vc-git-command nil 0 nil "update-index" "--refresh")
 716          (if branchp
 717              (vc-git-command nil 0 nil "checkout" "-b" name)
 718            (vc-git-command nil 0 nil "tag" name)))))
 719
 720 (defun vc-git-retrieve-tag (dir name update)
 721   (let ((default-directory dir))
 722     (vc-git-command nil 0 nil "checkout" name)
 723     ;; FIXME: update buffers if `update' is true
 724     ))
 725
 726
 727 ;;; MISCELLANEOUS
 728
 729 (defun vc-git-previous-revision (file rev)
 730   "Git-specific version of `vc-previous-revision'."
 731   (if file
 732       (let* ((default-directory (file-name-directory (expand-file-name file)))
 733              (file (file-name-nondirectory file))
 734              (prev-rev (with-temp-buffer
 735                          (and
 736                           (vc-git--out-ok "rev-list" "-2" rev "--" file)
 737                           (goto-char (point-max))
 738                           (bolp)
 739                           (zerop (forward-line -1))
 740                           (not (bobp))
 741                           (buffer-substring-no-properties
 742                            (point)
 743                            (1- (point-max)))))))
 744         (or (vc-git-symbolic-commit prev-rev) prev-rev))
 745     (with-temp-buffer
 746       (and
 747        (vc-git--out-ok "rev-parse" (concat rev "^"))
 748        (buffer-substring-no-properties (point-min) (+ (point-min) 40))))))
 749
 750 (defun vc-git-next-revision (file rev)
 751   "Git-specific version of `vc-next-revision'."
 752   (let* ((default-directory (file-name-directory
 753                              (expand-file-name file)))
 754          (file (file-name-nondirectory file))
 755          (current-rev
 756           (with-temp-buffer
 757             (and
 758              (vc-git--out-ok "rev-list" "-1" rev "--" file)
 759              (goto-char (point-max))
 760              (bolp)
 761              (zerop (forward-line -1))
 762              (bobp)
 763              (buffer-substring-no-properties
 764               (point)
 765               (1- (point-max))))))
 766          (next-rev
 767           (and current-rev
 768                (with-temp-buffer
 769                  (and
 770                   (vc-git--out-ok "rev-list" "HEAD" "--" file)
 771                   (goto-char (point-min))
 772                   (search-forward current-rev nil t)
 773                   (zerop (forward-line -1))
 774                   (buffer-substring-no-properties
 775                    (point)
 776                    (progn (forward-line 1) (1- (point)))))))))
 777     (or (vc-git-symbolic-commit next-rev) next-rev)))
 778
 779 (defun vc-git-delete-file (file)
 780   (vc-git-command nil 0 file "rm" "-f" "--"))
 781
 782 (defun vc-git-rename-file (old new)
 783   (vc-git-command nil 0 (list old new) "mv" "-f" "--"))
 784
 785 (defvar vc-git-extra-menu-map
 786   (let ((map (make-sparse-keymap)))
 787     (define-key map [git-grep]
 788       '(menu-item "Git grep..." vc-git-grep
 789                   :help "Run the `git grep' command"))
 790     (define-key map [git-sn]
 791       '(menu-item "Stash a snapshot" vc-git-stash-snapshot
 792                   :help "Stash the current state of the tree and keep the current state"))
 793     (define-key map [git-st]
 794       '(menu-item "Create Stash..." vc-git-stash
 795                   :help "Stash away changes"))
 796     (define-key map [git-ss]
 797       '(menu-item "Show Stash..." vc-git-stash-show
 798                   :help "Show stash contents"))
 799     map))
 800
 801 (defun vc-git-extra-menu () vc-git-extra-menu-map)
 802
 803 (defun vc-git-extra-status-menu () vc-git-extra-menu-map)
 804
 805 (defun vc-git-root (file)
 806   (vc-find-root file ".git"))
 807
 808 ;; Derived from `lgrep'.
 809 (defun vc-git-grep (regexp &optional files dir)
 810   "Run git grep, searching for REGEXP in FILES in directory DIR.
 811 The search is limited to file names matching shell pattern FILES.
 812 FILES may use abbreviations defined in `grep-files-aliases', e.g.
 813 entering `ch' is equivalent to `*.[ch]'.
 814
 815 With \\[universal-argument] prefix, you can edit the constructed shell command line
 816 before it is executed.
 817 With two \\[universal-argument] prefixes, directly edit and run `grep-command'.
 818
 819 Collect output in a buffer.  While git grep runs asynchronously, you
 820 can use \\[next-error] (M-x next-error), or \\<grep-mode-map>\\[compile-goto-error] \
 821 in the grep output buffer,
 822 to go to the lines where grep found matches.
 823
 824 This command shares argument histories with \\[rgrep] and \\[grep]."
 825   (interactive
 826    (progn
 827      (grep-compute-defaults)
 828      (cond
 829       ((equal current-prefix-arg '(16))
 830        (list (read-from-minibuffer "Run: " "git grep"
 831                                    nil nil 'grep-history)
 832              nil))
 833       (t (let* ((regexp (grep-read-regexp))
 834                 (files (grep-read-files regexp))
 835                 (dir (read-directory-name "In directory: "
 836                                           nil default-directory t)))
 837            (list regexp files dir))))))
 838   (require 'grep)
 839   (when (and (stringp regexp) (> (length regexp) 0))
 840     (let ((command regexp))
 841       (if (null files)
 842           (if (string= command "git grep")
 843               (setq command nil))
 844         (setq dir (file-name-as-directory (expand-file-name dir)))
 845         (setq command
 846               (grep-expand-template "git grep -n -e <R> -- <F>" regexp files))
 847         (when command
 848           (if (equal current-prefix-arg '(4))
 849               (setq command
 850                     (read-from-minibuffer "Confirm: "
 851                                           command nil nil 'grep-history))
 852             (add-to-history 'grep-history command))))
 853       (when command
 854         (let ((default-directory dir)
 855               (compilation-environment '("PAGER=")))
 856           ;; Setting process-setup-function makes exit-message-function work
 857           ;; even when async processes aren't supported.
 858           (compilation-start command 'grep-mode))
 859         (if (eq next-error-last-buffer (current-buffer))
 860             (setq default-directory dir))))))
 861
 862 (defun vc-git-stash (name)
 863   "Create a stash."
 864   (interactive "sStash name: ")
 865   (let ((root (vc-git-root default-directory)))
 866     (when root
 867       (vc-git--call nil "stash" "save" name)
 868       (vc-resynch-buffer root t t))))
 869
 870 (defun vc-git-stash-show (name)
 871   "Show the contents of stash NAME."
 872   (interactive "sStash name: ")
 873   (vc-setup-buffer "*vc-git-stash*")
 874   (vc-git-command "*vc-git-stash*" 'async nil "stash" "show" "-p" name)
 875   (set-buffer "*vc-git-stash*")
 876   (diff-mode)
 877   (setq buffer-read-only t)
 878   (pop-to-buffer (current-buffer)))
 879
 880 (defun vc-git-stash-apply (name)
 881   "Apply stash NAME."
 882   (interactive "sApply stash: ")
 883   (vc-git-command "*vc-git-stash*" 0 nil "stash" "apply" "-q" name)
 884   (vc-resynch-buffer (vc-git-root default-directory) t t))
 885
 886 (defun vc-git-stash-pop (name)
 887   "Pop stash NAME."
 888   (interactive "sPop stash: ")
 889   (vc-git-command "*vc-git-stash*" 0 nil "stash" "pop" "-q" name)
 890   (vc-resynch-buffer (vc-git-root default-directory) t t))
 891
 892 (defun vc-git-stash-snapshot ()
 893   "Create a stash with the current tree state."
 894   (interactive)
 895   (vc-git--call nil "stash" "save"
 896                 (let ((ct (current-time)))
 897                   (concat
 898                    (format-time-string "Snapshot on %Y-%m-%d" ct)
 899                    (format-time-string " at %H:%M" ct))))
 900   (vc-git-command "*vc-git-stash*" 0 nil "stash" "apply" "-q" "stash@{0}")
 901   (vc-resynch-buffer (vc-git-root default-directory) t t))
 902
 903 (defun vc-git-stash-list ()
 904   (delete
 905    ""
 906    (split-string
 907     (replace-regexp-in-string
 908      "^stash@" "             " (vc-git--run-command-string nil "stash" "list"))
 909     "\n")))
 910
 911 (defun vc-git-stash-get-at-point (point)
 912   (save-excursion
 913     (goto-char point)
 914     (beginning-of-line)
 915     (if (looking-at "^ +\\({[0-9]+}\\):")
 916         (match-string 1)
 917       (error "Cannot find stash at point"))))
 918
 919 (defun vc-git-stash-delete-at-point ()
 920   (interactive)
 921   (let ((stash (vc-git-stash-get-at-point (point))))
 922     (when (y-or-n-p (format "Remove stash %s ? " stash))
 923       (vc-git--run-command-string nil "stash" "drop" (format "stash@%s" stash))
 924       (vc-dir-refresh))))
 925
 926 (defun vc-git-stash-show-at-point ()
 927   (interactive)
 928   (vc-git-stash-show (format "stash@%s" (vc-git-stash-get-at-point (point)))))
 929
 930 (defun vc-git-stash-apply-at-point ()
 931   (interactive)
 932   (vc-git-stash-apply (format "stash@%s" (vc-git-stash-get-at-point (point)))))
 933
 934 (defun vc-git-stash-pop-at-point ()
 935   (interactive)
 936   (vc-git-stash-pop (format "stash@%s" (vc-git-stash-get-at-point (point)))))
 937
 938 (defun vc-git-stash-menu (e)
 939   (interactive "e")
 940   (vc-dir-at-event e (popup-menu vc-git-stash-menu-map e)))
 941
 942 \f
 943 ;;; Internal commands
 944
 945 (defun vc-git-command (buffer okstatus file-or-list &rest flags)
 946   "A wrapper around `vc-do-command' for use in vc-git.el.
 947 The difference to vc-do-command is that this function always invokes `git'."
 948   (apply 'vc-do-command (or buffer "*vc*") okstatus "git" file-or-list flags))
 949
 950 (defun vc-git--empty-db-p ()
 951   "Check if the git db is empty (no commit done yet)."
 952   (let (process-file-side-effects)
 953     (not (eq 0 (vc-git--call nil "rev-parse" "--verify" "HEAD")))))
 954
 955 (defun vc-git--call (buffer command &rest args)
 956   ;; We don't need to care the arguments.  If there is a file name, it
 957   ;; is always a relative one.  This works also for remote
 958   ;; directories.
 959   (apply 'process-file "git" nil buffer nil command args))
 960
 961 (defun vc-git--out-ok (command &rest args)
 962   (zerop (apply 'vc-git--call '(t nil) command args)))
 963
 964 (defun vc-git--run-command-string (file &rest args)
 965   "Run a git command on FILE and return its output as string.
 966 FILE can be nil."
 967   (let* ((ok t)
 968          (str (with-output-to-string
 969                 (with-current-buffer standard-output
 970                   (unless (apply 'vc-git--out-ok
 971                                  (if file
 972                                      (append args (list (file-relative-name
 973                                                          file)))
 974                                    args))
 975                     (setq ok nil))))))
 976     (and ok str)))
 977
 978 (defun vc-git-symbolic-commit (commit)
 979   "Translate COMMIT string into symbolic form.
 980 Returns nil if not possible."
 981   (and commit
 982        (let ((name (with-temp-buffer
 983                      (and
 984                       (vc-git--out-ok "name-rev" "--name-only" commit)
 985                       (goto-char (point-min))
 986                       (= (forward-line 2) 1)
 987                       (bolp)
 988                       (buffer-substring-no-properties (point-min)
 989                                                       (1- (point-max)))))))
 990          (and name (not (string= name "undefined")) name))))
 991
 992 (provide 'vc-git)
 993
 994 ;; arch-tag: bd10664a-0e5b-48f5-a877-6c17b135be12
 995 ;;; vc-git.el ends here