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