lisp/vc-git.el

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