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