vc-git.el 36 KB
Newer Older
Dan Nicolaescu's avatar
Dan Nicolaescu committed
1 2
;;; vc-git.el --- VC backend for the git version control system

Glenn Morris's avatar
Glenn Morris committed
3
;; Copyright (C) 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
Dan Nicolaescu's avatar
Dan Nicolaescu committed
4

5
;; Author: Alexandre Julliard <julliard@winehq.org>
Dan Nicolaescu's avatar
Dan Nicolaescu committed
6 7 8 9
;; Keywords: tools

;; This file is part of GNU Emacs.

10
;; GNU Emacs is free software: you can redistribute it and/or modify
Dan Nicolaescu's avatar
Dan Nicolaescu committed
11
;; it under the terms of the GNU General Public License as published by
12 13
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
Dan Nicolaescu's avatar
Dan Nicolaescu committed
14 15 16 17 18 19 20

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; 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/>.
Dan Nicolaescu's avatar
Dan Nicolaescu committed
22 23 24 25 26 27 28 29 30

;;; Commentary:

;; This file contains a VC backend for the git version control
;; system.
;;

;;; Installation:

31
;; To install: put this file on the load-path and add Git to the list
Dan Nicolaescu's avatar
Dan Nicolaescu committed
32 33 34
;; of supported backends in `vc-handled-backends'; the following line,
;; placed in your ~/.emacs, will accomplish this:
;;
35
;;     (add-to-list 'vc-handled-backends 'Git)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
36 37

;;; Todo:
38 39
;;  - check if more functions could use vc-git-command instead
;;     of start-process.
Dan Nicolaescu's avatar
Dan Nicolaescu committed
40
;;  - changelog generation
41 42 43

;; Implement the rest of the vc interface. See the comment at the
;; beginning of vc.el. The current status is:
44
;; ("??" means: "figure out what to do about it")
Dan Nicolaescu's avatar
Dan Nicolaescu committed
45
;;
46
;; FUNCTION NAME                                   STATUS
47
;; BACKEND PROPERTIES
48
;; * revision-granularity                          OK
49
;; STATE-QUERYING FUNCTIONS
50 51 52 53 54 55 56 57
;; * registered (file)                             OK
;; * state (file)                                  OK
;; - state-heuristic (file)                        NOT NEEDED
;; * working-revision (file)                       OK
;; - latest-on-branch-p (file)                     NOT NEEDED
;; * checkout-model (files)                        OK
;; - workfile-unchanged-p (file)                   OK
;; - mode-line-string (file)                       OK
58
;; STATE-CHANGING FUNCTIONS
59 60 61 62 63 64 65 66 67 68 69 70
;; * create-repo ()                                OK
;; * register (files &optional rev comment)        OK
;; - init-revision (file)                          NOT NEEDED
;; - responsible-p (file)                          OK
;; - could-register (file)                         NOT NEEDED, DEFAULT IS GOOD
;; - receive-file (file rev)                       NOT NEEDED
;; - unregister (file)                             OK
;; * checkin (files rev comment)                   OK
;; * find-revision (file rev buffer)               OK
;; * checkout (file &optional editable rev)        OK
;; * revert (file &optional contents-done)         OK
;; - rollback (files)                              COULD BE SUPPORTED
71 72 73 74 75 76
;; - merge (file rev1 rev2)                   It would be possible to merge
;;                                          changes into a single file, but when
;;                                          committing they wouldn't
;;                                          be identified as a merge
;;                                          by git, so it's probably
;;                                          not a good idea.
77 78
;; - merge-news (file)                     see `merge'
;; - steal-lock (file &optional revision)          NOT NEEDED
79
;; HISTORY FUNCTIONS
80
;; * print-log (files buffer &optional shortlog limit)   OK
81 82 83 84 85 86 87 88 89 90
;; - log-view-mode ()                              OK
;; - show-log-entry (revision)                     OK
;; - comment-history (file)                        ??
;; - update-changelog (files)                      COULD BE SUPPORTED
;; * diff (file &optional rev1 rev2 buffer)        OK
;; - revision-completion-table (files)             OK
;; - annotate-command (file buf &optional rev)     OK
;; - annotate-time ()                              OK
;; - annotate-current-time ()                      NOT NEEDED
;; - annotate-extract-revision-at-line ()          OK
91
;; TAG SYSTEM
92 93
;; - create-tag (dir name branchp)                 OK
;; - retrieve-tag (dir name update)                OK
94
;; MISCELLANEOUS
95 96 97 98 99 100 101 102 103
;; - make-version-backups-p (file)                 NOT NEEDED
;; - repository-hostname (dirname)                 NOT NEEDED
;; - previous-revision (file rev)                  OK
;; - next-revision (file rev)                      OK
;; - check-headers ()                              COULD BE SUPPORTED
;; - clear-headers ()                              NOT NEEDED
;; - delete-file (file)                            OK
;; - rename-file (old new)                         OK
;; - find-file-hook ()                             NOT NEEDED
Dan Nicolaescu's avatar
Dan Nicolaescu committed
104

105 106 107
(eval-when-compile
  (require 'cl)
  (require 'vc)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
108
  (require 'vc-dir)
109
  (require 'grep))
Dan Nicolaescu's avatar
Dan Nicolaescu committed
110

111
(defcustom vc-git-diff-switches t
112 113
  "String or list of strings specifying switches for Git diff under VC.
If nil, use the value of `vc-diff-switches'.  If t, use no switches."
114 115 116
  :type '(choice (const :tag "Unspecified" nil)
		 (const :tag "None" t)
		 (string :tag "Argument String")
117
		 (repeat :tag "Argument List" :value ("") string))
118 119 120
  :version "23.1"
  :group 'vc)

121 122 123 124 125 126 127
(defcustom vc-git-add-signoff nil
  "Add a Signed-off-by line when committing."
  :type 'boolean
  :version "23.2"
  :group 'vc)


Dan Nicolaescu's avatar
Dan Nicolaescu committed
128 129 130
(defvar git-commits-coding-system 'utf-8
  "Default coding system for git commits.")

131 132
;;; BACKEND PROPERTIES

133 134
(defun vc-git-revision-granularity () 'repository)
(defun vc-git-checkout-model (files) 'implicit)
135 136 137 138 139 140 141 142 143 144

;;; STATE-QUERYING FUNCTIONS

;;;###autoload (defun vc-git-registered (file)
;;;###autoload   "Return non-nil if FILE is registered with git."
;;;###autoload   (if (vc-find-root file ".git")       ; short cut
;;;###autoload       (progn
;;;###autoload         (load "vc-git")
;;;###autoload         (vc-git-registered file))))

Dan Nicolaescu's avatar
Dan Nicolaescu committed
145 146
(defun vc-git-registered (file)
  "Check whether FILE is registered with git."
147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166
  (let ((dir (vc-git-root file)))
    (when dir
      (with-temp-buffer
	(let* (process-file-side-effects
	       ;; Do not use the `file-name-directory' here: git-ls-files
	       ;; sometimes fails to return the correct status for relative
	       ;; path specs.
	       ;; See also: http://marc.info/?l=git&m=125787684318129&w=2
	       (name (file-relative-name file dir))
	       (str (ignore-errors
		     (cd dir)
		     (vc-git--out-ok "ls-files" "-c" "-z" "--" name)
		     ;; if result is empty, use ls-tree to check for deleted file
		     (when (eq (point-min) (point-max))
		       (vc-git--out-ok "ls-tree" "--name-only" "-z" "HEAD" "--" name))
		     (buffer-string))))
	  (and str
	       (> (length str) (length name))
	       (string= (substring str 0 (1+ (length name)))
			(concat name "\0"))))))))
167

168 169 170 171 172 173 174 175 176
(defun vc-git--state-code (code)
  "Convert from a string to a added/deleted/modified state."
  (case (string-to-char code)
    (?M 'edited)
    (?A 'added)
    (?D 'removed)
    (?U 'edited)     ;; FIXME
    (?T 'edited)))   ;; FIXME

Dan Nicolaescu's avatar
Dan Nicolaescu committed
177
(defun vc-git-state (file)
178
  "Git-specific version of `vc-state'."
179
  ;; FIXME: This can't set 'ignored yet
180 181 182 183 184 185 186 187
  (if (not (vc-git-registered file))
      'unregistered
    (vc-git--call nil "add" "--refresh" "--" (file-relative-name file))
    (let ((diff (vc-git--run-command-string file "diff-index" "-z" "HEAD" "--")))
      (if (and diff (string-match ":[0-7]\\{6\\} [0-7]\\{6\\} [0-9a-f]\\{40\\} [0-9a-f]\\{40\\} \\([ADMUT]\\)\0[^\0]+\0"
				  diff))
	  (vc-git--state-code (match-string 1 diff))
	(if (vc-git--empty-db-p) 'added 'up-to-date)))))
Dan Nicolaescu's avatar
Dan Nicolaescu committed
188

Eric S. Raymond's avatar
Eric S. Raymond committed
189 190
(defun vc-git-working-revision (file)
  "Git-specific version of `vc-working-revision'."
191 192 193 194
  (let* (process-file-side-effects
	 (str (with-output-to-string
		(with-current-buffer standard-output
		  (vc-git--out-ok "symbolic-ref" "HEAD")))))
Dan Nicolaescu's avatar
Dan Nicolaescu committed
195 196 197 198 199
    (if (string-match "^\\(refs/heads/\\)?\\(.+\\)$" str)
        (match-string 2 str)
      str)))

(defun vc-git-workfile-unchanged-p (file)
200
  (eq 'up-to-date (vc-git-state file)))
Dan Nicolaescu's avatar
Dan Nicolaescu committed
201

202 203
(defun vc-git-mode-line-string (file)
  "Return string for placement into the modeline for FILE."
Eric S. Raymond's avatar
Eric S. Raymond committed
204
  (let* ((branch (vc-git-working-revision file))
205 206 207 208 209 210 211 212 213
         (def-ml (vc-default-mode-line-string 'Git file))
         (help-echo (get-text-property 0 'help-echo def-ml)))
    (if (zerop (length branch))
        (propertize
         (concat def-ml "!")
         'help-echo (concat help-echo "\nNo current branch (detached HEAD)"))
      (propertize def-ml
                  'help-echo (concat help-echo "\nCurrent branch: " branch)))))

214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268
(defstruct (vc-git-extra-fileinfo
            (:copier nil)
            (:constructor vc-git-create-extra-fileinfo (old-perm new-perm &optional rename-state orig-name))
            (:conc-name vc-git-extra-fileinfo->))
  old-perm new-perm   ;; permission flags
  rename-state        ;; rename or copy state
  orig-name)          ;; original name for renames or copies

(defun vc-git-escape-file-name (name)
  "Escape a file name if necessary."
  (if (string-match "[\n\t\"\\]" name)
      (concat "\""
              (mapconcat (lambda (c)
                   (case c
                     (?\n "\\n")
                     (?\t "\\t")
                     (?\\ "\\\\")
                     (?\" "\\\"")
                     (t (char-to-string c))))
                 name "")
              "\"")
    name))

(defun vc-git-file-type-as-string (old-perm new-perm)
  "Return a string describing the file type based on its permissions."
  (let* ((old-type (lsh (or old-perm 0) -9))
	 (new-type (lsh (or new-perm 0) -9))
	 (str (case new-type
		(?\100  ;; file
		 (case old-type
		   (?\100 nil)
		   (?\120 "   (type change symlink -> file)")
		   (?\160 "   (type change subproject -> file)")))
		 (?\120  ;; symlink
		  (case old-type
		    (?\100 "   (type change file -> symlink)")
		    (?\160 "   (type change subproject -> symlink)")
		    (t "   (symlink)")))
		  (?\160  ;; subproject
		   (case old-type
		     (?\100 "   (type change file -> subproject)")
		     (?\120 "   (type change symlink -> subproject)")
		     (t "   (subproject)")))
                  (?\110 nil)  ;; directory (internal, not a real git state)
		  (?\000  ;; deleted or unknown
		   (case old-type
		     (?\120 "   (symlink)")
		     (?\160 "   (subproject)")))
		  (t (format "   (unknown type %o)" new-type)))))
    (cond (str (propertize str 'face 'font-lock-comment-face))
          ((eq new-type ?\110) "/")
          (t ""))))

(defun vc-git-rename-as-string (state extra)
  "Return a string describing the copy or rename associated with INFO, or an empty string if none."
269
  (let ((rename-state (when extra
270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290
			(vc-git-extra-fileinfo->rename-state extra))))
    (if rename-state
        (propertize
         (concat "   ("
                 (if (eq rename-state 'copy) "copied from "
                   (if (eq state 'added) "renamed from "
                     "renamed to "))
                 (vc-git-escape-file-name (vc-git-extra-fileinfo->orig-name extra))
                 ")") 'face 'font-lock-comment-face)
      "")))

(defun vc-git-permissions-as-string (old-perm new-perm)
  "Format a permission change as string."
  (propertize
   (if (or (not old-perm)
           (not new-perm)
           (eq 0 (logand ?\111 (logxor old-perm new-perm))))
       "  "
     (if (eq 0 (logand ?\111 old-perm)) "+x" "-x"))
  'face 'font-lock-type-face))

291
(defun vc-git-dir-printer (info)
Stefan Monnier's avatar
Stefan Monnier committed
292
  "Pretty-printer for the vc-dir-fileinfo structure."
293 294
  (let* ((isdir (vc-dir-fileinfo->directory info))
	 (state (if isdir "" (vc-dir-fileinfo->state info)))
Stefan Monnier's avatar
Stefan Monnier committed
295
         (extra (vc-dir-fileinfo->extra info))
296 297 298 299
         (old-perm (when extra (vc-git-extra-fileinfo->old-perm extra)))
         (new-perm (when extra (vc-git-extra-fileinfo->new-perm extra))))
    (insert
     "  "
Stefan Monnier's avatar
Stefan Monnier committed
300
     (propertize (format "%c" (if (vc-dir-fileinfo->marked info) ?* ? ))
301 302 303 304 305 306 307 308 309
                 'face 'font-lock-type-face)
     "  "
     (propertize
      (format "%-12s" state)
      'face (cond ((eq state 'up-to-date) 'font-lock-builtin-face)
		  ((eq state 'missing) 'font-lock-warning-face)
		  (t 'font-lock-variable-name-face))
      'mouse-face 'highlight)
     "  " (vc-git-permissions-as-string old-perm new-perm)
310
     "    "
Stefan Monnier's avatar
Stefan Monnier committed
311
     (propertize (vc-git-escape-file-name (vc-dir-fileinfo->name info))
312 313 314 315 316
                 'face (if isdir 'font-lock-comment-delimiter-face 'font-lock-function-name-face)
		 'help-echo
		 (if isdir
		     "Directory\nVC operations can be applied to it\nmouse-3: Pop-up menu"
		   "File\nmouse-3: Pop-up menu")
317
		 'keymap vc-dir-filename-mouse-map
318
		 'mouse-face 'highlight)
319 320 321
     (vc-git-file-type-as-string old-perm new-perm)
     (vc-git-rename-as-string state extra))))

322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373
(defun vc-git-after-dir-status-stage (stage files update-function)
  "Process sentinel for the various dir-status stages."
  (let (remaining next-stage result)
    (goto-char (point-min))
    (case stage
      ('update-index
       (setq next-stage (if (vc-git--empty-db-p) 'ls-files-added
                          (if files 'ls-files-up-to-date 'diff-index))))
      ('ls-files-added
       (setq next-stage 'ls-files-unknown)
       (while (re-search-forward "\\([0-7]\\{6\\}\\) [0-9a-f]\\{40\\} 0\t\\([^\0]+\\)\0" nil t)
         (let ((new-perm (string-to-number (match-string 1) 8))
               (name (match-string 2)))
           (push (list name 'added (vc-git-create-extra-fileinfo 0 new-perm)) result))))
      ('ls-files-up-to-date
       (setq next-stage 'diff-index)
       (while (re-search-forward "\\([0-7]\\{6\\}\\) [0-9a-f]\\{40\\} 0\t\\([^\0]+\\)\0" nil t)
         (let ((perm (string-to-number (match-string 1) 8))
               (name (match-string 2)))
           (push (list name 'up-to-date (vc-git-create-extra-fileinfo perm perm)) result))))
      ('ls-files-unknown
       (when files (setq next-stage 'ls-files-ignored))
       (while (re-search-forward "\\([^\0]*?\\)\0" nil t 1)
         (push (list (match-string 1) 'unregistered (vc-git-create-extra-fileinfo 0 0)) result)))
      ('ls-files-ignored
       (while (re-search-forward "\\([^\0]*?\\)\0" nil t 1)
         (push (list (match-string 1) 'ignored (vc-git-create-extra-fileinfo 0 0)) result)))
      ('diff-index
       (setq next-stage 'ls-files-unknown)
       (while (re-search-forward
               ":\\([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"
               nil t 1)
         (let ((old-perm (string-to-number (match-string 1) 8))
               (new-perm (string-to-number (match-string 2) 8))
               (state (or (match-string 4) (match-string 6)))
               (name (or (match-string 5) (match-string 7)))
               (new-name (match-string 8)))
           (if new-name  ; copy or rename
               (if (eq ?C (string-to-char state))
                   (push (list new-name 'added (vc-git-create-extra-fileinfo old-perm new-perm 'copy name)) result)
                 (push (list name 'removed (vc-git-create-extra-fileinfo 0 0 'rename new-name)) result)
                 (push (list new-name 'added (vc-git-create-extra-fileinfo old-perm new-perm 'rename name)) result))
             (push (list name (vc-git--state-code state) (vc-git-create-extra-fileinfo old-perm new-perm)) result))))))
    (when result
      (setq result (nreverse result))
      (when files
        (dolist (entry result) (setq files (delete (car entry) files)))
        (unless files (setq next-stage nil))))
    (when (or result (not next-stage)) (funcall update-function result next-stage))
    (when next-stage (vc-git-dir-status-goto-stage next-stage files update-function))))

(defun vc-git-dir-status-goto-stage (stage files update-function)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
374
  (erase-buffer)
375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391
  (case stage
    ('update-index
     (if files
         (vc-git-command (current-buffer) 'async files "add" "--refresh" "--")
       (vc-git-command (current-buffer) 'async nil "update-index" "--refresh")))
    ('ls-files-added
     (vc-git-command (current-buffer) 'async files "ls-files" "-z" "-c" "-s" "--"))
    ('ls-files-up-to-date
     (vc-git-command (current-buffer) 'async files "ls-files" "-z" "-c" "-s" "--"))
    ('ls-files-unknown
     (vc-git-command (current-buffer) 'async files "ls-files" "-z" "-o"
                     "--directory" "--no-empty-directory" "--exclude-standard" "--"))
    ('ls-files-ignored
     (vc-git-command (current-buffer) 'async files "ls-files" "-z" "-o" "-i"
                     "--directory" "--no-empty-directory" "--exclude-standard" "--"))
    ('diff-index
     (vc-git-command (current-buffer) 'async files "diff-index" "-z" "-M" "HEAD" "--")))
Dan Nicolaescu's avatar
Dan Nicolaescu committed
392
  (vc-exec-after
393
   `(vc-git-after-dir-status-stage (quote ,stage) (quote ,files) (quote ,update-function))))
Dan Nicolaescu's avatar
Dan Nicolaescu committed
394

395
(defun vc-git-dir-status (dir update-function)
396
  "Return a list of (FILE STATE EXTRA) entries for DIR."
397 398
  ;; Further things that would have to be fixed later:
  ;; - how to handle unregistered directories
Stefan Monnier's avatar
Stefan Monnier committed
399
  ;; - how to support vc-dir on a subdir of the project tree
400 401 402 403 404
  (vc-git-dir-status-goto-stage 'update-index nil update-function))

(defun vc-git-dir-status-files (dir files default-state update-function)
  "Return a list of (FILE STATE EXTRA) entries for FILES in DIR."
  (vc-git-dir-status-goto-stage 'update-index files update-function))
405

406 407
(defvar vc-git-stash-map
  (let ((map (make-sparse-keymap)))
408 409 410 411
    ;; Turn off vc-dir marking
    (define-key map [mouse-2] 'ignore)

    (define-key map [down-mouse-3] 'vc-git-stash-menu)
412 413 414
    (define-key map "\C-k" 'vc-git-stash-delete-at-point)
    (define-key map "=" 'vc-git-stash-show-at-point)
    (define-key map "\C-m" 'vc-git-stash-show-at-point)
415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432
    (define-key map "A" 'vc-git-stash-apply-at-point)
    (define-key map "P" 'vc-git-stash-pop-at-point)
    map))

(defvar vc-git-stash-menu-map
  (let ((map (make-sparse-keymap "Git Stash")))
    (define-key map [de]
      '(menu-item "Delete stash" vc-git-stash-delete-at-point
		  :help "Delete the current stash"))
    (define-key map [ap]
      '(menu-item "Apply stash" vc-git-stash-apply-at-point
		  :help "Apply the current stash and keep it in the stash list"))
    (define-key map [po]
      '(menu-item "Apply and remove stash (pop)" vc-git-stash-pop-at-point
		  :help "Apply the current stash and remove it"))
    (define-key map [sh]
      '(menu-item "Show stash" vc-git-stash-show-at-point
		  :help "Show the contents of the current stash"))
433 434
    map))

435
(defun vc-git-dir-extra-headers (dir)
436 437
  (let ((str (with-output-to-string
               (with-current-buffer standard-output
438
                 (vc-git--out-ok "symbolic-ref" "HEAD"))))
439
	(stash (vc-git-stash-list))
440
	(stash-help-echo "Use M-x vc-git-stash to create stashes.")
441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457
	branch remote remote-url)
    (if (string-match "^\\(refs/heads/\\)?\\(.+\\)$" str)
	(progn
	  (setq branch (match-string 2 str))
	  (setq remote
		(with-output-to-string
		  (with-current-buffer standard-output
		    (vc-git--out-ok "config" (concat "branch." branch ".remote")))))
	  (when (string-match "\\([^\n]+\\)" remote)
	    (setq remote (match-string 1 remote)))
	  (when remote
	    (setq remote-url
		  (with-output-to-string
		    (with-current-buffer standard-output
		      (vc-git--out-ok "config" (concat "remote." remote ".url"))))))
	  (when (string-match "\\([^\n]+\\)" remote-url)
	    (setq remote-url (match-string 1 remote-url))))
458
      (setq branch "not (detached HEAD)"))
459
    ;; FIXME: maybe use a different face when nothing is stashed.
460 461
    (concat
     (propertize "Branch     : " 'face 'font-lock-type-face)
462 463 464 465 466 467 468 469
     (propertize branch
		 'face 'font-lock-variable-name-face)
     (when remote
       (concat
	"\n"
	(propertize "Remote     : " 'face 'font-lock-type-face)
	(propertize remote-url
		    'face 'font-lock-variable-name-face)))
470
     "\n"
471 472
     (if stash
       (concat
473 474
	(propertize "Stash      :\n" 'face 'font-lock-type-face
		    'help-echo stash-help-echo)
475 476 477 478 479
	(mapconcat
	 (lambda (x)
	   (propertize x
		       'face 'font-lock-variable-name-face
		       'mouse-face 'highlight
480
		       'help-echo "mouse-3: Show stash menu\nRET: Show stash\nA: Apply stash\nP: Apply and remove stash (pop)\nC-k: Delete stash"
481 482 483
		       'keymap vc-git-stash-map))
	 stash "\n"))
       (concat
484 485
	(propertize "Stash      : " 'face 'font-lock-type-face
		    'help-echo stash-help-echo)
486
	(propertize "Nothing stashed"
487
		    'help-echo stash-help-echo
488
		    'face 'font-lock-variable-name-face))))))
489

490 491 492
;;; STATE-CHANGING FUNCTIONS

(defun vc-git-create-repo ()
493
  "Create a new Git repository."
494
  (vc-git-command nil 0 nil "init"))
495

496
(defun vc-git-register (files &optional rev comment)
497 498 499 500 501 502 503 504 505 506
  "Register FILES into the git version-control system."
  (let (flist dlist)
    (dolist (crt files)
      (if (file-directory-p crt)
	  (push crt dlist)
	(push crt flist)))
    (when flist
      (vc-git-command nil 0 flist "update-index" "--add" "--"))
    (when dlist
      (vc-git-command nil 0 dlist "add"))))
Dan Nicolaescu's avatar
Dan Nicolaescu committed
507

508 509
(defalias 'vc-git-responsible-p 'vc-git-root)

510 511
(defun vc-git-unregister (file)
  (vc-git-command nil 0 file "rm" "-f" "--cached" "--"))
512

513

514
(defun vc-git-checkin (files rev comment)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
515
  (let ((coding-system-for-write git-commits-coding-system))
516
    (vc-git-command nil 0 files "commit"
Dan Nicolaescu's avatar
Dan Nicolaescu committed
517
		    (if vc-git-add-signoff "-s") "-m" comment "--only" "--")))
Dan Nicolaescu's avatar
Dan Nicolaescu committed
518

Eric S. Raymond's avatar
Eric S. Raymond committed
519
(defun vc-git-find-revision (file rev buffer)
520 521 522 523 524 525 526
  (let* (process-file-side-effects
	 (coding-system-for-read 'binary)
	 (coding-system-for-write 'binary)
	 (fullname (substring
		    (vc-git--run-command-string
		     file "ls-files" "-z" "--full-name" "--")
		    0 -1)))
527 528
    (vc-git-command
     buffer 0
529
     (concat (if rev rev "HEAD") ":" fullname) "cat-file" "blob")))
530 531

(defun vc-git-checkout (file &optional editable rev)
532
  (vc-git-command nil 0 file "checkout" (or rev "HEAD")))
Dan Nicolaescu's avatar
Dan Nicolaescu committed
533 534 535 536

(defun vc-git-revert (file &optional contents-done)
  "Revert FILE to the version stored in the git repository."
  (if contents-done
537
      (vc-git-command nil 0 file "update-index" "--")
538 539
    (vc-git-command nil 0 file "reset" "-q" "--")
    (vc-git-command nil nil file "checkout" "-q" "--")))
Dan Nicolaescu's avatar
Dan Nicolaescu committed
540

541 542
;;; HISTORY FUNCTIONS

543
(defun vc-git-print-log (files buffer &optional shortlog limit)
544
  "Get change log associated with FILES."
545
  (let ((coding-system-for-read git-commits-coding-system))
546 547 548 549 550 551
    ;; `vc-do-command' creates the buffer, but we need it before running
    ;; the command.
    (vc-setup-buffer buffer)
    ;; If the buffer exists from a previous invocation it might be
    ;; read-only.
    (let ((inhibit-read-only t))
552 553
      (with-current-buffer
          buffer
554
	(if shortlog
555
	(vc-git-command buffer 'async files
556 557 558 559 560
			    "log" ;; "--graph"
			    "--date=short" "--pretty=format:%h  %ad  %s" "--abbrev-commit"
			    "--")
	  (vc-git-command buffer 'async files
			  "rev-list" ;; "--graph"
561 562
			  "--pretty" "HEAD" "--")))
        (when limit 'limit-unsupported))))
563 564 565 566

(defvar log-view-message-re)
(defvar log-view-file-re)
(defvar log-view-font-lock-keywords)
567
(defvar log-view-per-file-logs)
568

569 570 571
;; Dynamically bound.
(defvar vc-short-log)

572
(define-derived-mode vc-git-log-view-mode log-view-mode "Git-Log-View"
573 574
  (require 'add-log) ;; we need the faces add-log
  ;; Don't have file markers, so use impossible regexp.
575 576
  (set (make-local-variable 'log-view-file-re) "\\`a\\`")
  (set (make-local-variable 'log-view-per-file-logs) nil)
577
  (set (make-local-variable 'log-view-message-re)
578 579
       (if vc-short-log
	 "^\\(?:[*/\\| ]+ \\)?\\([0-9a-z]+\\)  \\([-a-z0-9]+\\)  \\(.*\\)"
580
	 "^commit *\\([0-9a-z]+\\)"))
581
  (set (make-local-variable 'log-view-font-lock-keywords)
582 583 584 585 586
       (if vc-short-log
	   (append
	    `((,log-view-message-re
	       (1 'change-log-acknowledgement)
	       (2 'change-log-date))))
587
       (append
588
        `((,log-view-message-re  (1 'change-log-acknowledgement)))
Thien-Thi Nguyen's avatar
Thien-Thi Nguyen committed
589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606
        ;; Handle the case:
        ;; user: foo@bar
        '(("^Author:[ \t]+\\([A-Za-z0-9_.+-]+@[A-Za-z0-9_.-]+\\)"
           (1 'change-log-email))
          ;; Handle the case:
          ;; user: FirstName LastName <foo@bar>
          ("^Author:[ \t]+\\([^<(]+?\\)[ \t]*[(<]\\([A-Za-z0-9_.+-]+@[A-Za-z0-9_.-]+\\)[>)]"
           (1 'change-log-name)
           (2 'change-log-email))
          ("^ +\\(?:\\(?:[Aa]cked\\|[Ss]igned-[Oo]ff\\)-[Bb]y:\\)[ \t]+\\([A-Za-z0-9_.+-]+@[A-Za-z0-9_.-]+\\)"
           (1 'change-log-name))
          ("^ +\\(?:\\(?:[Aa]cked\\|[Ss]igned-[Oo]ff\\)-[Bb]y:\\)[ \t]+\\([^<(]+?\\)[ \t]*[(<]\\([A-Za-z0-9_.+-]+@[A-Za-z0-9_.-]+\\)[>)]"
           (1 'change-log-name)
           (2 'change-log-email))
          ("^Merge: \\([0-9a-z]+\\) \\([0-9a-z]+\\)"
           (1 'change-log-acknowledgement)
           (2 'change-log-acknowledgement))
          ("^Date:   \\(.+\\)" (1 'change-log-date))
607 608
	    ("^summary:[ \t]+\\(.+\\)" (1 'log-view-message)))))))

Dan Nicolaescu's avatar
Dan Nicolaescu committed
609

610 611 612 613 614
(defun vc-git-show-log-entry (revision)
  "Move to the log entry for REVISION.
REVISION may have the form BRANCH, BRANCH~N,
or BRANCH^ (where \"^\" can be repeated)."
  (goto-char (point-min))
615
  (when revision
616
    (search-forward (format "\ncommit %s" revision) nil t
617 618 619 620 621
		    (cond ((string-match "~\\([0-9]\\)$" revision)
			   (1+ (string-to-number (match-string 1 revision))))
			  ((string-match "\\^+$" revision)
			   (1+ (length (match-string 0 revision))))
			  (t nil))))
622 623
  (beginning-of-line))

624
(defun vc-git-diff (files &optional rev1 rev2 buffer)
625
  "Get a difference report using Git between two revisions of FILES."
626 627 628 629 630 631
  (let (process-file-side-effects)
    (apply #'vc-git-command (or buffer "*vc-diff*") 1 files
	   (if (and rev1 rev2) "diff-tree" "diff-index")
	   "--exit-code"
	   (append (vc-switches 'git 'diff)
		   (list "-p" (or rev1 "HEAD") rev2 "--")))))
Dan Nicolaescu's avatar
Dan Nicolaescu committed
632

633 634
(defun vc-git-revision-table (files)
  ;; What about `files'?!?  --Stef
635 636
  (let (process-file-side-effects
	(table (list "HEAD")))
637 638 639 640 641 642 643
    (with-temp-buffer
      (vc-git-command t nil nil "for-each-ref" "--format=%(refname)")
      (goto-char (point-min))
      (while (re-search-forward "^refs/\\(heads\\|tags\\)/\\(.*\\)$" nil t)
        (push (match-string 2) table)))
    table))

644 645
(defun vc-git-revision-completion-table (files)
  (lexical-let ((files files)
646 647
                table)
    (setq table (lazy-completion-table
648
                 table (lambda () (vc-git-revision-table files))))
649 650
    table))

Dan Nicolaescu's avatar
Dan Nicolaescu committed
651 652
(defun vc-git-annotate-command (file buf &optional rev)
  (let ((name (file-relative-name file)))
653
    (vc-git-command buf 'async name "blame" "--date=iso" "-C" "-C" rev)))
Dan Nicolaescu's avatar
Dan Nicolaescu committed
654

655 656
(declare-function vc-annotate-convert-time "vc-annotate" (time))

Dan Nicolaescu's avatar
Dan Nicolaescu committed
657
(defun vc-git-annotate-time ()
658
  (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)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
659
       (vc-annotate-convert-time
Thien-Thi Nguyen's avatar
Thien-Thi Nguyen committed
660 661 662
        (apply #'encode-time (mapcar (lambda (match)
                                       (string-to-number (match-string match)))
                                     '(6 5 4 3 2 1 7))))))
Dan Nicolaescu's avatar
Dan Nicolaescu committed
663

664
(defun vc-git-annotate-extract-revision-at-line ()
Thien-Thi Nguyen's avatar
Thien-Thi Nguyen committed
665 666
  (save-excursion
    (move-beginning-of-line 1)
667 668 669 670 671
    (when (looking-at "\\([0-9a-f^][0-9a-f]+\\) \\(\\([^(]+\\) \\)?")
      (let ((revision (match-string-no-properties 1)))
	(if (match-beginning 2)
	  (cons revision (expand-file-name (match-string-no-properties 3)))
	  revision)))))
672

673
;;; TAG SYSTEM
674

675
(defun vc-git-create-tag (dir name branchp)
676 677 678 679 680 681
  (let ((default-directory dir))
    (and (vc-git-command nil 0 nil "update-index" "--refresh")
         (if branchp
             (vc-git-command nil 0 nil "checkout" "-b" name)
           (vc-git-command nil 0 nil "tag" name)))))

682
(defun vc-git-retrieve-tag (dir name update)
683 684 685 686 687 688
  (let ((default-directory dir))
    (vc-git-command nil 0 nil "checkout" name)
    ;; FIXME: update buffers if `update' is true
    ))


689
;;; MISCELLANEOUS
Dan Nicolaescu's avatar
Dan Nicolaescu committed
690

691 692
(defun vc-git-previous-revision (file rev)
  "Git-specific version of `vc-previous-revision'."
693
  (if file
694 695 696 697 698 699 700 701 702 703 704 705 706
      (let* ((default-directory (file-name-directory (expand-file-name file)))
             (file (file-name-nondirectory file))
             (prev-rev (with-temp-buffer
                         (and
                          (vc-git--out-ok "rev-list" "-2" rev "--" file)
                          (goto-char (point-max))
                          (bolp)
                          (zerop (forward-line -1))
                          (not (bobp))
                          (buffer-substring-no-properties
                           (point)
                           (1- (point-max)))))))
        (or (vc-git-symbolic-commit prev-rev) prev-rev))
707 708 709 710
    (with-temp-buffer
      (and
       (vc-git--out-ok "rev-parse" (concat rev "^"))
       (buffer-substring-no-properties (point-min) (+ (point-min) 40))))))
Dan Nicolaescu's avatar
Dan Nicolaescu committed
711

712 713
(defun vc-git-next-revision (file rev)
  "Git-specific version of `vc-next-revision'."
Dan Nicolaescu's avatar
Dan Nicolaescu committed
714 715
  (let* ((default-directory (file-name-directory
			     (expand-file-name file)))
Thien-Thi Nguyen's avatar
Thien-Thi Nguyen committed
716 717 718 719
         (file (file-name-nondirectory file))
         (current-rev
          (with-temp-buffer
            (and
720
             (vc-git--out-ok "rev-list" "-1" rev "--" file)
Thien-Thi Nguyen's avatar
Thien-Thi Nguyen committed
721 722 723 724 725 726
             (goto-char (point-max))
             (bolp)
             (zerop (forward-line -1))
             (bobp)
             (buffer-substring-no-properties
              (point)
727 728 729 730 731 732 733 734 735 736 737 738 739
              (1- (point-max))))))
         (next-rev
          (and current-rev
               (with-temp-buffer
                 (and
                  (vc-git--out-ok "rev-list" "HEAD" "--" file)
                  (goto-char (point-min))
                  (search-forward current-rev nil t)
                  (zerop (forward-line -1))
                  (buffer-substring-no-properties
                   (point)
                   (progn (forward-line 1) (1- (point)))))))))
    (or (vc-git-symbolic-commit next-rev) next-rev)))
Dan Nicolaescu's avatar
Dan Nicolaescu committed
740

741 742
(defun vc-git-delete-file (file)
  (vc-git-command nil 0 file "rm" "-f" "--"))
743

744 745
(defun vc-git-rename-file (old new)
  (vc-git-command nil 0 (list old new) "mv" "-f" "--"))
746

747 748 749 750 751
(defvar vc-git-extra-menu-map
  (let ((map (make-sparse-keymap)))
    (define-key map [git-grep]
      '(menu-item "Git grep..." vc-git-grep
		  :help "Run the `git grep' command"))
752 753 754 755 756 757
    (define-key map [git-st]
      '(menu-item "Stash..." vc-git-stash
		  :help "Stash away changes"))
    (define-key map [git-ss]
      '(menu-item "Show Stash..." vc-git-stash-show
		  :help "Show stash contents"))
758 759 760 761
    (define-key map [git-sig]
      '(menu-item "Add Signed-off-by on commit" vc-git-toggle-signoff
	      :help "Add Add Signed-off-by when commiting (i.e. add the -s flag)"
	      :button (:toggle . vc-git-add-signoff)))
762 763 764 765 766 767
    map))

(defun vc-git-extra-menu () vc-git-extra-menu-map)

(defun vc-git-extra-status-menu () vc-git-extra-menu-map)

768 769 770
(defun vc-git-root (file)
  (vc-find-root file ".git"))

771 772 773 774
(defun vc-git-toggle-signoff ()
  (interactive)
  (setq vc-git-add-signoff (not vc-git-add-signoff)))

775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827
;; Derived from `lgrep'.
(defun vc-git-grep (regexp &optional files dir)
  "Run git grep, searching for REGEXP in FILES in directory DIR.
The search is limited to file names matching shell pattern FILES.
FILES may use abbreviations defined in `grep-files-aliases', e.g.
entering `ch' is equivalent to `*.[ch]'.

With \\[universal-argument] prefix, you can edit the constructed shell command line
before it is executed.
With two \\[universal-argument] prefixes, directly edit and run `grep-command'.

Collect output in a buffer.  While git grep runs asynchronously, you
can use \\[next-error] (M-x next-error), or \\<grep-mode-map>\\[compile-goto-error] \
in the grep output buffer,
to go to the lines where grep found matches.

This command shares argument histories with \\[rgrep] and \\[grep]."
  (interactive
   (progn
     (grep-compute-defaults)
     (cond
      ((equal current-prefix-arg '(16))
       (list (read-from-minibuffer "Run: " "git grep"
				   nil nil 'grep-history)
	     nil))
      (t (let* ((regexp (grep-read-regexp))
		(files (grep-read-files regexp))
		(dir (read-directory-name "In directory: "
					  nil default-directory t)))
	   (list regexp files dir))))))
  (require 'grep)
  (when (and (stringp regexp) (> (length regexp) 0))
    (let ((command regexp))
      (if (null files)
	  (if (string= command "git grep")
	      (setq command nil))
	(setq dir (file-name-as-directory (expand-file-name dir)))
	(setq command
	      (grep-expand-template "git grep -n -e <R> -- <F>" regexp files))
	(when command
	  (if (equal current-prefix-arg '(4))
	      (setq command
		    (read-from-minibuffer "Confirm: "
					  command nil nil 'grep-history))
	    (add-to-history 'grep-history command))))
      (when command
	(let ((default-directory dir)
	      (compilation-environment '("PAGER=")))
	  ;; Setting process-setup-function makes exit-message-function work
	  ;; even when async processes aren't supported.
	  (compilation-start command 'grep-mode))
	(if (eq next-error-last-buffer (current-buffer))
	    (setq default-directory dir))))))
828

829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846
(defun vc-git-stash (name)
  "Create a stash."
  (interactive "sStash name: ")
  (let ((root (vc-git-root default-directory)))
    (when root
      (vc-git--call nil "stash" "save" name)
      (vc-resynch-buffer root t t))))

(defun vc-git-stash-show (name)
  "Show the contents of stash NAME."
  (interactive "sStash name: ")
  (vc-setup-buffer "*vc-git-stash*")
  (vc-git-command "*vc-git-stash*" 'async nil "stash" "show" "-p" name)
  (set-buffer "*vc-git-stash*")
  (diff-mode)
  (setq buffer-read-only t)
  (pop-to-buffer (current-buffer)))

847 848 849 850 851 852 853 854 855 856 857 858
(defun vc-git-stash-apply (name)
  "Apply stash NAME."
  (interactive "sApply stash: ")
  (vc-git-command "*vc-git-stash*" 0 nil "stash" "apply" "-q" name)
  (vc-resynch-buffer (vc-git-root default-directory) t t))

(defun vc-git-stash-pop (name)
  "Pop stash NAME."
  (interactive "sPop stash: ")
  (vc-git-command "*vc-git-stash*" 0 nil "stash" "pop" "-q" name)
  (vc-resynch-buffer (vc-git-root default-directory) t t))

859
(defun vc-git-stash-list ()
860 861 862 863 864 865 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885
  (delete
   ""
   (split-string
    (replace-regexp-in-string
     "^stash@" "             " (vc-git--run-command-string nil "stash" "list"))
    "\n")))

(defun vc-git-stash-get-at-point (point)
  (save-excursion
    (goto-char point)
    (beginning-of-line)
    (if (looking-at "^ +\\({[0-9]+}\\):")
	(match-string 1)
      (error "Cannot find stash at point"))))

(defun vc-git-stash-delete-at-point ()
  (interactive)
  (let ((stash (vc-git-stash-get-at-point (point))))
    (when (y-or-n-p (format "Remove stash %s ?" stash))
      (vc-git--run-command-string nil "stash" "drop" (format "stash@%s" stash))
      (vc-dir-refresh))))

(defun vc-git-stash-show-at-point ()
  (interactive)
  (vc-git-stash-show (format "stash@%s" (vc-git-stash-get-at-point (point)))))

886 887 888 889 890 891 892 893 894 895 896 897
(defun vc-git-stash-apply-at-point ()
  (interactive)
  (vc-git-stash-apply (format "stash@%s" (vc-git-stash-get-at-point (point)))))

(defun vc-git-stash-pop-at-point ()
  (interactive)
  (vc-git-stash-pop (format "stash@%s" (vc-git-stash-get-at-point (point)))))

(defun vc-git-stash-menu (e)
  (interactive "e")
  (vc-dir-at-event e (popup-menu vc-git-stash-menu-map e)))

Dan Nicolaescu's avatar
Dan Nicolaescu committed
898

899
;;; Internal commands
Dan Nicolaescu's avatar
Dan Nicolaescu committed
900

901
(defun vc-git-command (buffer okstatus file-or-list &rest flags)
902 903
  "A wrapper around `vc-do-command' for use in vc-git.el.
The difference to vc-do-command is that this function always invokes `git'."
904
  (apply 'vc-do-command (or buffer "*vc*") okstatus "git" file-or-list flags))
905

Dan Nicolaescu's avatar
Dan Nicolaescu committed
906 907
(defun vc-git--empty-db-p ()
  "Check if the git db is empty (no commit done yet)."
908 909
  (let (process-file-side-effects)
    (not (eq 0 (vc-git--call nil "rev-parse" "--verify" "HEAD")))))
Dan Nicolaescu's avatar
Dan Nicolaescu committed
910

911
(defun vc-git--call (buffer command &rest args)
912 913 914 915
  ;; We don't need to care the arguments.  If there is a file name, it
  ;; is always a relative one.  This works also for remote
  ;; directories.
  (apply 'process-file "git" nil buffer nil command args))
916 917 918 919

(defun vc-git--out-ok (command &rest args)
  (zerop (apply 'vc-git--call '(t nil) command args)))

Dan Nicolaescu's avatar
Dan Nicolaescu committed
920
(defun vc-git--run-command-string (file &rest args)
921 922
  "Run a git command on FILE and return its output as string.
FILE can be nil."
Dan Nicolaescu's avatar
Dan Nicolaescu committed
923 924 925
  (let* ((ok t)
         (str (with-output-to-string
                (with-current-buffer standard-output
926
                  (unless (apply 'vc-git--out-ok
927 928 929 930
				 (if file
				     (append args (list (file-relative-name
							 file)))
				   args))
Dan Nicolaescu's avatar
Dan Nicolaescu committed
931 932 933 934 935 936 937
                    (setq ok nil))))))
    (and ok str)))

(defun vc-git-symbolic-commit (commit)
  "Translate COMMIT string into symbolic form.
Returns nil if not possible."
  (and commit
938 939 940 941 942 943 944 945
       (let ((name (with-temp-buffer
                     (and
                      (vc-git--out-ok "name-rev" "--name-only" commit)
                      (goto-char (point-min))
                      (= (forward-line 2) 1)
                      (bolp)
                      (buffer-substring-no-properties (point-min) (1- (point-max)))))))
         (and name (not (string= name "undefined")) name))))
Dan Nicolaescu's avatar
Dan Nicolaescu committed
946 947

(provide 'vc-git)
948

Miles Bader's avatar
Miles Bader committed
949
;; arch-tag: bd10664a-0e5b-48f5-a877-6c17b135be12
950
;;; vc-git.el ends here