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     ;; --relative added in Git 1.5.5.
 417     (diff-index
 418      (vc-git-command (current-buffer) 'async files
 419                      "diff-index" "--relative" "-z" "-M" "HEAD" "--")))
 420   (vc-exec-after
 421    `(vc-git-after-dir-status-stage ',stage  ',files ',update-function)))
 422
 423 (defun vc-git-dir-status (dir update-function)
 424   "Return a list of (FILE STATE EXTRA) entries for DIR."
 425   ;; Further things that would have to be fixed later:
 426   ;; - how to handle unregistered directories
 427   ;; - how to support vc-dir on a subdir of the project tree
 428   (vc-git-dir-status-goto-stage 'update-index nil update-function))
 429
 430 (defun vc-git-dir-status-files (dir files default-state update-function)
 431   "Return a list of (FILE STATE EXTRA) entries for FILES in DIR."
 432   (vc-git-dir-status-goto-stage 'update-index files update-function))
 433
 434 (defvar vc-git-stash-map
 435   (let ((map (make-sparse-keymap)))
 436     ;; Turn off vc-dir marking
 437     (define-key map [mouse-2] 'ignore)
 438
 439     (define-key map [down-mouse-3] 'vc-git-stash-menu)
 440     (define-key map "\C-k" 'vc-git-stash-delete-at-point)
 441     (define-key map "=" 'vc-git-stash-show-at-point)
 442     (define-key map "\C-m" 'vc-git-stash-show-at-point)
 443     (define-key map "A" 'vc-git-stash-apply-at-point)
 444     (define-key map "P" 'vc-git-stash-pop-at-point)
 445     (define-key map "S" 'vc-git-stash-snapshot)
 446     map))
 447
 448 (defvar vc-git-stash-menu-map
 449   (let ((map (make-sparse-keymap "Git Stash")))
 450     (define-key map [de]
 451       '(menu-item "Delete stash" vc-git-stash-delete-at-point
 452                   :help "Delete the current stash"))
 453     (define-key map [ap]
 454       '(menu-item "Apply stash" vc-git-stash-apply-at-point
 455                   :help "Apply the current stash and keep it in the stash list"))
 456     (define-key map [po]
 457       '(menu-item "Apply and remove stash (pop)" vc-git-stash-pop-at-point
 458                   :help "Apply the current stash and remove it"))
 459     (define-key map [sh]
 460       '(menu-item "Show stash" vc-git-stash-show-at-point
 461                   :help "Show the contents of the current stash"))
 462     map))
 463
 464 (defun vc-git-dir-extra-headers (dir)
 465   (let ((str (with-output-to-string
 466                (with-current-buffer standard-output
 467                  (vc-git--out-ok "symbolic-ref" "HEAD"))))
 468         (stash (vc-git-stash-list))
 469         (stash-help-echo "Use M-x vc-git-stash to create stashes.")
 470         branch remote remote-url)
 471     (if (string-match "^\\(refs/heads/\\)?\\(.+\\)$" str)
 472         (progn
 473           (setq branch (match-string 2 str))
 474           (setq remote
 475                 (with-output-to-string
 476                   (with-current-buffer standard-output
 477                     (vc-git--out-ok "config"
 478                                     (concat "branch." branch ".remote")))))
 479           (when (string-match "\\([^\n]+\\)" remote)
 480             (setq remote (match-string 1 remote)))
 481           (when remote
 482             (setq remote-url
 483                   (with-output-to-string
 484                     (with-current-buffer standard-output
 485                       (vc-git--out-ok "config"
 486                                       (concat "remote." remote ".url"))))))
 487           (when (string-match "\\([^\n]+\\)" remote-url)
 488             (setq remote-url (match-string 1 remote-url))))
 489       (setq branch "not (detached HEAD)"))
 490     ;; FIXME: maybe use a different face when nothing is stashed.
 491     (concat
 492      (propertize "Branch     : " 'face 'font-lock-type-face)
 493      (propertize branch
 494                  'face 'font-lock-variable-name-face)
 495      (when remote
 496        (concat
 497         "\n"
 498         (propertize "Remote     : " 'face 'font-lock-type-face)
 499         (propertize remote-url
 500                     'face 'font-lock-variable-name-face)))
 501      "\n"
 502      (if stash
 503        (concat
 504         (propertize "Stash      :\n" 'face 'font-lock-type-face
 505                     'help-echo stash-help-echo)
 506         (mapconcat
 507          (lambda (x)
 508            (propertize x
 509                        'face 'font-lock-variable-name-face
 510                        'mouse-face 'highlight
 511                        'help-echo "mouse-3: Show stash menu\nRET: Show stash\nA: Apply stash\nP: Apply and remove stash (pop)\nC-k: Delete stash"
 512                        'keymap vc-git-stash-map))
 513          stash "\n"))
 514        (concat
 515         (propertize "Stash      : " 'face 'font-lock-type-face
 516                     'help-echo stash-help-echo)
 517         (propertize "Nothing stashed"
 518                     'help-echo stash-help-echo
 519                     'face 'font-lock-variable-name-face))))))
 520
 521 ;;; STATE-CHANGING FUNCTIONS
 522
 523 (defun vc-git-create-repo ()
 524   "Create a new Git repository."
 525   (vc-git-command nil 0 nil "init"))
 526
 527 (defun vc-git-register (files &optional rev comment)
 528   "Register FILES into the git version-control system."
 529   (let (flist dlist)
 530     (dolist (crt files)
 531       (if (file-directory-p crt)
 532           (push crt dlist)
 533         (push crt flist)))
 534     (when flist
 535       (vc-git-command nil 0 flist "update-index" "--add" "--"))
 536     (when dlist
 537       (vc-git-command nil 0 dlist "add"))))
 538
 539 (defalias 'vc-git-responsible-p 'vc-git-root)
 540
 541 (defun vc-git-unregister (file)
 542   (vc-git-command nil 0 file "rm" "-f" "--cached" "--"))
 543
 544
 545 (defun vc-git-checkin (files rev comment)
 546   (let ((coding-system-for-write git-commits-coding-system))
 547     (vc-git-command nil 0 files "commit"
 548                     "-m" comment "--only" "--")))
 549
 550 (defun vc-git-find-revision (file rev buffer)
 551   (let* (process-file-side-effects
 552          (coding-system-for-read 'binary)
 553          (coding-system-for-write 'binary)
 554          (fullname
 555           (let ((fn (vc-git--run-command-string
 556                      file "ls-files" "-z" "--full-name" "--")))
 557             ;; ls-files does not return anything when looking for a
 558             ;; revision of a file that has been renamed or removed.
 559             (if (string= fn "")
 560                 (file-relative-name file (vc-git-root default-directory))
 561               (substring fn 0 -1)))))
 562     (vc-git-command
 563      buffer 0
 564      nil
 565      "cat-file" "blob" (concat (if rev rev "HEAD") ":" fullname))))
 566
 567 (defun vc-git-checkout (file &optional editable rev)
 568   (vc-git-command nil 0 file "checkout" (or rev "HEAD")))
 569
 570 (defun vc-git-revert (file &optional contents-done)
 571   "Revert FILE to the version stored in the git repository."
 572   (if contents-done
 573       (vc-git-command nil 0 file "update-index" "--")
 574     (vc-git-command nil 0 file "reset" "-q" "--")
 575     (vc-git-command nil nil file "checkout" "-q" "--")))
 576
 577 ;;; HISTORY FUNCTIONS
 578
 579 (defun vc-git-print-log (files buffer &optional shortlog start-revision limit)
 580   "Get change log associated with FILES.
 581 Note that using SHORTLOG requires at least Git version 1.5.6,
 582 for the --graph option."
 583   (let ((coding-system-for-read git-commits-coding-system))
 584     ;; `vc-do-command' creates the buffer, but we need it before running
 585     ;; the command.
 586     (vc-setup-buffer buffer)
 587     ;; If the buffer exists from a previous invocation it might be
 588     ;; read-only.
 589     (let ((inhibit-read-only t))
 590       (with-current-buffer
 591           buffer
 592         (apply 'vc-git-command buffer
 593                'async files
 594                (append
 595                 '("log" "--no-color")
 596                 (when shortlog
 597                   '("--graph" "--decorate" "--date=short"
 598                     "--pretty=tformat:%d%h  %ad  %s" "--abbrev-commit"))
 599                 (when limit (list "-n" (format "%s" limit)))
 600                 (when start-revision (list start-revision))
 601                 '("--")))))))
 602
 603 (defvar log-view-message-re)
 604 (defvar log-view-file-re)
 605 (defvar log-view-font-lock-keywords)
 606 (defvar log-view-per-file-logs)
 607
 608 ;; Dynamically bound.
 609 (defvar vc-short-log)
 610
 611 (define-derived-mode vc-git-log-view-mode log-view-mode "Git-Log-View"
 612   (require 'add-log) ;; We need the faces add-log.
 613   ;; Don't have file markers, so use impossible regexp.
 614   (set (make-local-variable 'log-view-file-re) "\\`a\\`")
 615   (set (make-local-variable 'log-view-per-file-logs) nil)
 616   (set (make-local-variable 'log-view-message-re)
 617        (if vc-short-log
 618            "^\\(?:[*/\\| ]+ \\)?\\(?: ([^)]+)\\)?\\([0-9a-z]+\\)  \\([-a-z0-9]+\\)  \\(.*\\)"
 619          "^commit *\\([0-9a-z]+\\)"))
 620   (set (make-local-variable 'log-view-font-lock-keywords)
 621        (if vc-short-log
 622            '(
 623              ;; Same as log-view-message-re, except that we don't
 624              ;; want the shy group for the tag name.
 625              ("^\\(?:[*/\\| ]+ \\)?\\( ([^)]+)\\)?\\([0-9a-z]+\\)  \\([-a-z0-9]+\\)  \\(.*\\)"
 626               (1 'highlight nil lax)
 627               (2 'change-log-acknowledgement)
 628               (3 'change-log-date)))
 629        (append
 630         `((,log-view-message-re (1 'change-log-acknowledgement)))
 631         ;; Handle the case:
 632         ;; user: foo@bar
 633         '(("^Author:[ \t]+\\([A-Za-z0-9_.+-]+@[A-Za-z0-9_.-]+\\)"
 634            (1 'change-log-email))
 635           ;; Handle the case:
 636           ;; user: FirstName LastName <foo@bar>
 637           ("^Author:[ \t]+\\([^<(]+?\\)[ \t]*[(<]\\([A-Za-z0-9_.+-]+@[A-Za-z0-9_.-]+\\)[>)]"
 638            (1 'change-log-name)
 639            (2 'change-log-email))
 640           ("^ +\\(?:\\(?:[Aa]cked\\|[Ss]igned-[Oo]ff\\)-[Bb]y:\\)[ \t]+\\([A-Za-z0-9_.+-]+@[A-Za-z0-9_.-]+\\)"
 641            (1 'change-log-name))
 642           ("^ +\\(?:\\(?:[Aa]cked\\|[Ss]igned-[Oo]ff\\)-[Bb]y:\\)[ \t]+\\([^<(]+?\\)[ \t]*[(<]\\([A-Za-z0-9_.+-]+@[A-Za-z0-9_.-]+\\)[>)]"
 643            (1 'change-log-name)
 644            (2 'change-log-email))
 645           ("^Merge: \\([0-9a-z]+\\) \\([0-9a-z]+\\)"
 646            (1 'change-log-acknowledgement)
 647            (2 'change-log-acknowledgement))
 648           ("^Date:   \\(.+\\)" (1 'change-log-date))
 649             ("^summary:[ \t]+\\(.+\\)" (1 'log-view-message)))))))
 650
 651
 652 (defun vc-git-show-log-entry (revision)
 653   "Move to the log entry for REVISION.
 654 REVISION may have the form BRANCH, BRANCH~N,
 655 or BRANCH^ (where \"^\" can be repeated)."
 656   (goto-char (point-min))
 657   (prog1
 658       (when revision
 659         (search-forward
 660          (format "\ncommit %s" revision) nil t
 661          (cond ((string-match "~\\([0-9]\\)\\'" revision)
 662                 (1+ (string-to-number (match-string 1 revision))))
 663                ((string-match "\\^+\\'" revision)
 664                 (1+ (length (match-string 0 revision))))
 665                (t nil))))
 666     (beginning-of-line)))
 667
 668 (defun vc-git-diff (files &optional rev1 rev2 buffer)
 669   "Get a difference report using Git between two revisions of FILES."
 670   (let (process-file-side-effects)
 671     (apply #'vc-git-command (or buffer "*vc-diff*") 1 files
 672            (if (and rev1 rev2) "diff-tree" "diff-index")
 673            "--exit-code"
 674            (append (vc-switches 'git 'diff)
 675                    (list "-p" (or rev1 "HEAD") rev2 "--")))))
 676
 677 (defun vc-git-revision-table (files)
 678   ;; What about `files'?!?  --Stef
 679   (let (process-file-side-effects
 680         (table (list "HEAD")))
 681     (with-temp-buffer
 682       (vc-git-command t nil nil "for-each-ref" "--format=%(refname)")
 683       (goto-char (point-min))
 684       (while (re-search-forward "^refs/\\(heads\\|tags\\)/\\(.*\\)$" nil t)
 685         (push (match-string 2) table)))
 686     table))
 687
 688 (defun vc-git-revision-completion-table (files)
 689   (lexical-let ((files files)
 690                 table)
 691     (setq table (lazy-completion-table
 692                  table (lambda () (vc-git-revision-table files))))
 693     table))
 694
 695 (defun vc-git-annotate-command (file buf &optional rev)
 696   (let ((name (file-relative-name file)))
 697     (vc-git-command buf 'async nil "blame" "--date=iso" "-C" "-C" rev "--" name)))
 698
 699 (declare-function vc-annotate-convert-time "vc-annotate" (time))
 700
 701 (defun vc-git-annotate-time ()
 702   (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)
 703        (vc-annotate-convert-time
 704         (apply #'encode-time (mapcar (lambda (match)
 705                                        (string-to-number (match-string match)))
 706                                      '(6 5 4 3 2 1 7))))))
 707
 708 (defun vc-git-annotate-extract-revision-at-line ()
 709   (save-excursion
 710     (move-beginning-of-line 1)
 711     (when (looking-at "\\([0-9a-f^][0-9a-f]+\\) \\(\\([^(]+\\) \\)?")
 712       (let ((revision (match-string-no-properties 1)))
 713         (if (match-beginning 2)
 714             (let ((fname (match-string-no-properties 3)))
 715               ;; Remove trailing whitespace from the file name.
 716               (when (string-match " +\\'" fname)
 717                 (setq fname (substring fname 0 (match-beginning 0))))
 718               (cons revision
 719                     (expand-file-name fname (vc-git-root default-directory))))
 720           revision)))))
 721
 722 ;;; TAG SYSTEM
 723
 724 (defun vc-git-create-tag (dir name branchp)
 725   (let ((default-directory dir))
 726     (and (vc-git-command nil 0 nil "update-index" "--refresh")
 727          (if branchp
 728              (vc-git-command nil 0 nil "checkout" "-b" name)
 729            (vc-git-command nil 0 nil "tag" name)))))
 730
 731 (defun vc-git-retrieve-tag (dir name update)
 732   (let ((default-directory dir))
 733     (vc-git-command nil 0 nil "checkout" name)
 734     ;; FIXME: update buffers if `update' is true
 735     ))
 736
 737
 738 ;;; MISCELLANEOUS
 739
 740 (defun vc-git-previous-revision (file rev)
 741   "Git-specific version of `vc-previous-revision'."
 742   (if file
 743       (let* ((fname (file-relative-name file))
 744              (prev-rev (with-temp-buffer
 745                          (and
 746                           (vc-git--out-ok "rev-list" "-2" rev "--" fname)
 747                           (goto-char (point-max))
 748                           (bolp)
 749                           (zerop (forward-line -1))
 750                           (not (bobp))
 751                           (buffer-substring-no-properties
 752                            (point)
 753                            (1- (point-max)))))))
 754         (or (vc-git-symbolic-commit prev-rev) prev-rev))
 755     (with-temp-buffer
 756       (and
 757        (vc-git--out-ok "rev-parse" (concat rev "^"))
 758        (buffer-substring-no-properties (point-min) (+ (point-min) 40))))))
 759
 760 (defun vc-git-next-revision (file rev)
 761   "Git-specific version of `vc-next-revision'."
 762   (let* ((default-directory (file-name-directory
 763                              (expand-file-name file)))
 764          (file (file-name-nondirectory file))
 765          (current-rev
 766           (with-temp-buffer
 767             (and
 768              (vc-git--out-ok "rev-list" "-1" rev "--" file)
 769              (goto-char (point-max))
 770              (bolp)
 771              (zerop (forward-line -1))
 772              (bobp)
 773              (buffer-substring-no-properties
 774               (point)
 775               (1- (point-max))))))
 776          (next-rev
 777           (and current-rev
 778                (with-temp-buffer
 779                  (and
 780                   (vc-git--out-ok "rev-list" "HEAD" "--" file)
 781                   (goto-char (point-min))
 782                   (search-forward current-rev nil t)
 783                   (zerop (forward-line -1))
 784                   (buffer-substring-no-properties
 785                    (point)
 786                    (progn (forward-line 1) (1- (point)))))))))
 787     (or (vc-git-symbolic-commit next-rev) next-rev)))
 788
 789 (defun vc-git-delete-file (file)
 790   (vc-git-command nil 0 file "rm" "-f" "--"))
 791
 792 (defun vc-git-rename-file (old new)
 793   (vc-git-command nil 0 (list old new) "mv" "-f" "--"))
 794
 795 (defvar vc-git-extra-menu-map
 796   (let ((map (make-sparse-keymap)))
 797     (define-key map [git-grep]
 798       '(menu-item "Git grep..." vc-git-grep
 799                   :help "Run the `git grep' command"))
 800     (define-key map [git-sn]
 801       '(menu-item "Stash a snapshot" vc-git-stash-snapshot
 802                   :help "Stash the current state of the tree and keep the current state"))
 803     (define-key map [git-st]
 804       '(menu-item "Create Stash..." vc-git-stash
 805                   :help "Stash away changes"))
 806     (define-key map [git-ss]
 807       '(menu-item "Show Stash..." vc-git-stash-show
 808                   :help "Show stash contents"))
 809     map))
 810
 811 (defun vc-git-extra-menu () vc-git-extra-menu-map)
 812
 813 (defun vc-git-extra-status-menu () vc-git-extra-menu-map)
 814
 815 (defun vc-git-root (file)
 816   (vc-find-root file ".git"))
 817
 818 ;; Derived from `lgrep'.
 819 (defun vc-git-grep (regexp &optional files dir)
 820   "Run git grep, searching for REGEXP in FILES in directory DIR.
 821 The search is limited to file names matching shell pattern FILES.
 822 FILES may use abbreviations defined in `grep-files-aliases', e.g.
 823 entering `ch' is equivalent to `*.[ch]'.
 824
 825 With \\[universal-argument] prefix, you can edit the constructed shell command line
 826 before it is executed.
 827 With two \\[universal-argument] prefixes, directly edit and run `grep-command'.
 828
 829 Collect output in a buffer.  While git grep runs asynchronously, you
 830 can use \\[next-error] (M-x next-error), or \\<grep-mode-map>\\[compile-goto-error] \
 831 in the grep output buffer,
 832 to go to the lines where grep found matches.
 833
 834 This command shares argument histories with \\[rgrep] and \\[grep]."
 835   (interactive
 836    (progn
 837      (grep-compute-defaults)
 838      (cond
 839       ((equal current-prefix-arg '(16))
 840        (list (read-from-minibuffer "Run: " "git grep"
 841                                    nil nil 'grep-history)
 842              nil))
 843       (t (let* ((regexp (grep-read-regexp))
 844                 (files (grep-read-files regexp))
 845                 (dir (read-directory-name "In directory: "
 846                                           nil default-directory t)))
 847            (list regexp files dir))))))
 848   (require 'grep)
 849   (when (and (stringp regexp) (> (length regexp) 0))
 850     (let ((command regexp))
 851       (if (null files)
 852           (if (string= command "git grep")
 853               (setq command nil))
 854         (setq dir (file-name-as-directory (expand-file-name dir)))
 855         (setq command
 856               (grep-expand-template "git grep -n -e <R> -- <F>" regexp files))
 857         (when command
 858           (if (equal current-prefix-arg '(4))
 859               (setq command
 860                     (read-from-minibuffer "Confirm: "
 861                                           command nil nil 'grep-history))
 862             (add-to-history 'grep-history command))))
 863       (when command
 864         (let ((default-directory dir)
 865               (compilation-environment '("PAGER=")))
 866           ;; Setting process-setup-function makes exit-message-function work
 867           ;; even when async processes aren't supported.
 868           (compilation-start command 'grep-mode))
 869         (if (eq next-error-last-buffer (current-buffer))
 870             (setq default-directory dir))))))
 871
 872 (defun vc-git-stash (name)
 873   "Create a stash."
 874   (interactive "sStash name: ")
 875   (let ((root (vc-git-root default-directory)))
 876     (when root
 877       (vc-git--call nil "stash" "save" name)
 878       (vc-resynch-buffer root t t))))
 879
 880 (defun vc-git-stash-show (name)
 881   "Show the contents of stash NAME."
 882   (interactive "sStash name: ")
 883   (vc-setup-buffer "*vc-git-stash*")
 884   (vc-git-command "*vc-git-stash*" 'async nil "stash" "show" "-p" name)
 885   (set-buffer "*vc-git-stash*")
 886   (diff-mode)
 887   (setq buffer-read-only t)
 888   (pop-to-buffer (current-buffer)))
 889
 890 (defun vc-git-stash-apply (name)
 891   "Apply stash NAME."
 892   (interactive "sApply stash: ")
 893   (vc-git-command "*vc-git-stash*" 0 nil "stash" "apply" "-q" name)
 894   (vc-resynch-buffer (vc-git-root default-directory) t t))
 895
 896 (defun vc-git-stash-pop (name)
 897   "Pop stash NAME."
 898   (interactive "sPop stash: ")
 899   (vc-git-command "*vc-git-stash*" 0 nil "stash" "pop" "-q" name)
 900   (vc-resynch-buffer (vc-git-root default-directory) t t))
 901
 902 (defun vc-git-stash-snapshot ()
 903   "Create a stash with the current tree state."
 904   (interactive)
 905   (vc-git--call nil "stash" "save"
 906                 (let ((ct (current-time)))
 907                   (concat
 908                    (format-time-string "Snapshot on %Y-%m-%d" ct)
 909                    (format-time-string " at %H:%M" ct))))
 910   (vc-git-command "*vc-git-stash*" 0 nil "stash" "apply" "-q" "stash@{0}")
 911   (vc-resynch-buffer (vc-git-root default-directory) t t))
 912
 913 (defun vc-git-stash-list ()
 914   (delete
 915    ""
 916    (split-string
 917     (replace-regexp-in-string
 918      "^stash@" "             " (vc-git--run-command-string nil "stash" "list"))
 919     "\n")))
 920
 921 (defun vc-git-stash-get-at-point (point)
 922   (save-excursion
 923     (goto-char point)
 924     (beginning-of-line)
 925     (if (looking-at "^ +\\({[0-9]+}\\):")
 926         (match-string 1)
 927       (error "Cannot find stash at point"))))
 928
 929 (defun vc-git-stash-delete-at-point ()
 930   (interactive)
 931   (let ((stash (vc-git-stash-get-at-point (point))))
 932     (when (y-or-n-p (format "Remove stash %s ? " stash))
 933       (vc-git--run-command-string nil "stash" "drop" (format "stash@%s" stash))
 934       (vc-dir-refresh))))
 935
 936 (defun vc-git-stash-show-at-point ()
 937   (interactive)
 938   (vc-git-stash-show (format "stash@%s" (vc-git-stash-get-at-point (point)))))
 939
 940 (defun vc-git-stash-apply-at-point ()
 941   (interactive)
 942   (vc-git-stash-apply (format "stash@%s" (vc-git-stash-get-at-point (point)))))
 943
 944 (defun vc-git-stash-pop-at-point ()
 945   (interactive)
 946   (vc-git-stash-pop (format "stash@%s" (vc-git-stash-get-at-point (point)))))
 947
 948 (defun vc-git-stash-menu (e)
 949   (interactive "e")
 950   (vc-dir-at-event e (popup-menu vc-git-stash-menu-map e)))
 951
 952 \f
 953 ;;; Internal commands
 954
 955 (defun vc-git-command (buffer okstatus file-or-list &rest flags)
 956   "A wrapper around `vc-do-command' for use in vc-git.el.
 957 The difference to vc-do-command is that this function always invokes `git'."
 958   (apply 'vc-do-command (or buffer "*vc*") okstatus "git" file-or-list flags))
 959
 960 (defun vc-git--empty-db-p ()
 961   "Check if the git db is empty (no commit done yet)."
 962   (let (process-file-side-effects)
 963     (not (eq 0 (vc-git--call nil "rev-parse" "--verify" "HEAD")))))
 964
 965 (defun vc-git--call (buffer command &rest args)
 966   ;; We don't need to care the arguments.  If there is a file name, it
 967   ;; is always a relative one.  This works also for remote
 968   ;; directories.
 969   (apply 'process-file "git" nil buffer nil command args))
 970
 971 (defun vc-git--out-ok (command &rest args)
 972   (zerop (apply 'vc-git--call '(t nil) command args)))
 973
 974 (defun vc-git--run-command-string (file &rest args)
 975   "Run a git command on FILE and return its output as string.
 976 FILE can be nil."
 977   (let* ((ok t)
 978          (str (with-output-to-string
 979                 (with-current-buffer standard-output
 980                   (unless (apply 'vc-git--out-ok
 981                                  (if file
 982                                      (append args (list (file-relative-name
 983                                                          file)))
 984                                    args))
 985                     (setq ok nil))))))
 986     (and ok str)))
 987
 988 (defun vc-git-symbolic-commit (commit)
 989   "Translate COMMIT string into symbolic form.
 990 Returns nil if not possible."
 991   (and commit
 992        (let ((name (with-temp-buffer
 993                      (and
 994                       (vc-git--out-ok "name-rev" "--name-only" commit)
 995                       (goto-char (point-min))
 996                       (= (forward-line 2) 1)
 997                       (bolp)
 998                       (buffer-substring-no-properties (point-min)
 999                                                       (1- (point-max)))))))
1000          (and name (not (string= name "undefined")) name))))
1001
1002 (provide 'vc-git)
1003
1004 ;; arch-tag: bd10664a-0e5b-48f5-a877-6c17b135be12
1005 ;;; vc-git.el ends here