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