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