Merge 'build-in git-mktree'
[git] / contrib / emacs / git.el
1 ;;; git.el --- A user interface for git
2
3 ;; Copyright (C) 2005, 2006, 2007, 2008, 2009 Alexandre Julliard <julliard@winehq.org>
4
5 ;; Version: 1.0
6
7 ;; This program is free software; you can redistribute it and/or
8 ;; modify it under the terms of the GNU General Public License as
9 ;; published by the Free Software Foundation; either version 2 of
10 ;; the License, or (at your option) any later version.
11 ;;
12 ;; This program is distributed in the hope that it will be
13 ;; useful, but WITHOUT ANY WARRANTY; without even the implied
14 ;; warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
15 ;; PURPOSE.  See the GNU General Public License for more details.
16 ;;
17 ;; You should have received a copy of the GNU General Public
18 ;; License along with this program; if not, write to the Free
19 ;; Software Foundation, Inc., 59 Temple Place, Suite 330, Boston,
20 ;; MA 02111-1307 USA
21
22 ;;; Commentary:
23
24 ;; This file contains an interface for the git version control
25 ;; system. It provides easy access to the most frequently used git
26 ;; commands. The user interface is as far as possible identical to
27 ;; that of the PCL-CVS mode.
28 ;;
29 ;; To install: put this file on the load-path and place the following
30 ;; in your .emacs file:
31 ;;
32 ;;    (require 'git)
33 ;;
34 ;; To start: `M-x git-status'
35 ;;
36 ;; TODO
37 ;;  - diff against other branch
38 ;;  - renaming files from the status buffer
39 ;;  - creating tags
40 ;;  - fetch/pull
41 ;;  - revlist browser
42 ;;  - git-show-branch browser
43 ;;
44
45 ;;; Compatibility:
46 ;;
47 ;; This file works on GNU Emacs 21 or later. It may work on older
48 ;; versions but this is not guaranteed.
49 ;;
50 ;; It may work on XEmacs 21, provided that you first install the ewoc
51 ;; and log-edit packages.
52 ;;
53
54 (eval-when-compile (require 'cl))
55 (require 'ewoc)
56 (require 'log-edit)
57 (require 'easymenu)
58
59
60 ;;;; Customizations
61 ;;;; ------------------------------------------------------------
62
63 (defgroup git nil
64   "A user interface for the git versioning system."
65   :group 'tools)
66
67 (defcustom git-committer-name nil
68   "User name to use for commits.
69 The default is to fall back to the repository config,
70 then to `add-log-full-name' and then to `user-full-name'."
71   :group 'git
72   :type '(choice (const :tag "Default" nil)
73                  (string :tag "Name")))
74
75 (defcustom git-committer-email nil
76   "Email address to use for commits.
77 The default is to fall back to the git repository config,
78 then to `add-log-mailing-address' and then to `user-mail-address'."
79   :group 'git
80   :type '(choice (const :tag "Default" nil)
81                  (string :tag "Email")))
82
83 (defcustom git-commits-coding-system nil
84   "Default coding system for the log message of git commits."
85   :group 'git
86   :type '(choice (const :tag "From repository config" nil)
87                  (coding-system)))
88
89 (defcustom git-append-signed-off-by nil
90   "Whether to append a Signed-off-by line to the commit message before editing."
91   :group 'git
92   :type 'boolean)
93
94 (defcustom git-reuse-status-buffer t
95   "Whether `git-status' should try to reuse an existing buffer
96 if there is already one that displays the same directory."
97   :group 'git
98   :type 'boolean)
99
100 (defcustom git-per-dir-ignore-file ".gitignore"
101   "Name of the per-directory ignore file."
102   :group 'git
103   :type 'string)
104
105 (defcustom git-show-uptodate nil
106   "Whether to display up-to-date files."
107   :group 'git
108   :type 'boolean)
109
110 (defcustom git-show-ignored nil
111   "Whether to display ignored files."
112   :group 'git
113   :type 'boolean)
114
115 (defcustom git-show-unknown t
116   "Whether to display unknown files."
117   :group 'git
118   :type 'boolean)
119
120
121 (defface git-status-face
122   '((((class color) (background light)) (:foreground "purple"))
123     (((class color) (background dark)) (:foreground "salmon")))
124   "Git mode face used to highlight added and modified files."
125   :group 'git)
126
127 (defface git-unmerged-face
128   '((((class color) (background light)) (:foreground "red" :bold t))
129     (((class color) (background dark)) (:foreground "red" :bold t)))
130   "Git mode face used to highlight unmerged files."
131   :group 'git)
132
133 (defface git-unknown-face
134   '((((class color) (background light)) (:foreground "goldenrod" :bold t))
135     (((class color) (background dark)) (:foreground "goldenrod" :bold t)))
136   "Git mode face used to highlight unknown files."
137   :group 'git)
138
139 (defface git-uptodate-face
140   '((((class color) (background light)) (:foreground "grey60"))
141     (((class color) (background dark)) (:foreground "grey40")))
142   "Git mode face used to highlight up-to-date files."
143   :group 'git)
144
145 (defface git-ignored-face
146   '((((class color) (background light)) (:foreground "grey60"))
147     (((class color) (background dark)) (:foreground "grey40")))
148   "Git mode face used to highlight ignored files."
149   :group 'git)
150
151 (defface git-mark-face
152   '((((class color) (background light)) (:foreground "red" :bold t))
153     (((class color) (background dark)) (:foreground "tomato" :bold t)))
154   "Git mode face used for the file marks."
155   :group 'git)
156
157 (defface git-header-face
158   '((((class color) (background light)) (:foreground "blue"))
159     (((class color) (background dark)) (:foreground "blue")))
160   "Git mode face used for commit headers."
161   :group 'git)
162
163 (defface git-separator-face
164   '((((class color) (background light)) (:foreground "brown"))
165     (((class color) (background dark)) (:foreground "brown")))
166   "Git mode face used for commit separator."
167   :group 'git)
168
169 (defface git-permission-face
170   '((((class color) (background light)) (:foreground "green" :bold t))
171     (((class color) (background dark)) (:foreground "green" :bold t)))
172   "Git mode face used for permission changes."
173   :group 'git)
174
175
176 ;;;; Utilities
177 ;;;; ------------------------------------------------------------
178
179 (defconst git-log-msg-separator "--- log message follows this line ---")
180
181 (defvar git-log-edit-font-lock-keywords
182   `(("^\\(Author:\\|Date:\\|Merge:\\|Signed-off-by:\\)\\(.*\\)$"
183      (1 font-lock-keyword-face)
184      (2 font-lock-function-name-face))
185     (,(concat "^\\(" (regexp-quote git-log-msg-separator) "\\)$")
186      (1 font-lock-comment-face))))
187
188 (defun git-get-env-strings (env)
189   "Build a list of NAME=VALUE strings from a list of environment strings."
190   (mapcar (lambda (entry) (concat (car entry) "=" (cdr entry))) env))
191
192 (defun git-call-process (buffer &rest args)
193   "Wrapper for call-process that sets environment strings."
194   (apply #'call-process "git" nil buffer nil args))
195
196 (defun git-call-process-display-error (&rest args)
197   "Wrapper for call-process that displays error messages."
198   (let* ((dir default-directory)
199          (buffer (get-buffer-create "*Git Command Output*"))
200          (ok (with-current-buffer buffer
201                (let ((default-directory dir)
202                      (buffer-read-only nil))
203                  (erase-buffer)
204                  (eq 0 (apply #'git-call-process (list buffer t) args))))))
205     (unless ok (display-message-or-buffer buffer))
206     ok))
207
208 (defun git-call-process-string (&rest args)
209   "Wrapper for call-process that returns the process output as a string,
210 or nil if the git command failed."
211   (with-temp-buffer
212     (and (eq 0 (apply #'git-call-process t args))
213          (buffer-string))))
214
215 (defun git-call-process-string-display-error (&rest args)
216   "Wrapper for call-process that displays error message and returns
217 the process output as a string, or nil if the git command failed."
218   (with-temp-buffer
219     (if (eq 0 (apply #'git-call-process (list t t) args))
220         (buffer-string)
221       (display-message-or-buffer (current-buffer))
222       nil)))
223
224 (defun git-run-process-region (buffer start end program args)
225   "Run a git process with a buffer region as input."
226   (let ((output-buffer (current-buffer))
227         (dir default-directory))
228     (with-current-buffer buffer
229       (cd dir)
230       (apply #'call-process-region start end program
231              nil (list output-buffer t) nil args))))
232
233 (defun git-run-command-buffer (buffer-name &rest args)
234   "Run a git command, sending the output to a buffer named BUFFER-NAME."
235   (let ((dir default-directory)
236         (buffer (get-buffer-create buffer-name)))
237     (message "Running git %s..." (car args))
238     (with-current-buffer buffer
239       (let ((default-directory dir)
240             (buffer-read-only nil))
241         (erase-buffer)
242         (apply #'git-call-process buffer args)))
243     (message "Running git %s...done" (car args))
244     buffer))
245
246 (defun git-run-command-region (buffer start end env &rest args)
247   "Run a git command with specified buffer region as input."
248   (with-temp-buffer
249     (if (eq 0 (if env
250                   (git-run-process-region
251                    buffer start end "env"
252                    (append (git-get-env-strings env) (list "git") args))
253                 (git-run-process-region buffer start end "git" args)))
254         (buffer-string)
255       (display-message-or-buffer (current-buffer))
256       nil)))
257
258 (defun git-run-hook (hook env &rest args)
259   "Run a git hook and display its output if any."
260   (let ((dir default-directory)
261         (hook-name (expand-file-name (concat ".git/hooks/" hook))))
262     (or (not (file-executable-p hook-name))
263         (let (status (buffer (get-buffer-create "*Git Hook Output*")))
264           (with-current-buffer buffer
265             (erase-buffer)
266             (cd dir)
267             (setq status
268                   (if env
269                       (apply #'call-process "env" nil (list buffer t) nil
270                              (append (git-get-env-strings env) (list hook-name) args))
271                     (apply #'call-process hook-name nil (list buffer t) nil args))))
272           (display-message-or-buffer buffer)
273           (eq 0 status)))))
274
275 (defun git-get-string-sha1 (string)
276   "Read a SHA1 from the specified string."
277   (and string
278        (string-match "[0-9a-f]\\{40\\}" string)
279        (match-string 0 string)))
280
281 (defun git-get-committer-name ()
282   "Return the name to use as GIT_COMMITTER_NAME."
283   ; copied from log-edit
284   (or git-committer-name
285       (git-config "user.name")
286       (and (boundp 'add-log-full-name) add-log-full-name)
287       (and (fboundp 'user-full-name) (user-full-name))
288       (and (boundp 'user-full-name) user-full-name)))
289
290 (defun git-get-committer-email ()
291   "Return the email address to use as GIT_COMMITTER_EMAIL."
292   ; copied from log-edit
293   (or git-committer-email
294       (git-config "user.email")
295       (and (boundp 'add-log-mailing-address) add-log-mailing-address)
296       (and (fboundp 'user-mail-address) (user-mail-address))
297       (and (boundp 'user-mail-address) user-mail-address)))
298
299 (defun git-get-commits-coding-system ()
300   "Return the coding system to use for commits."
301   (let ((repo-config (git-config "i18n.commitencoding")))
302     (or git-commits-coding-system
303         (and repo-config
304              (fboundp 'locale-charset-to-coding-system)
305              (locale-charset-to-coding-system repo-config))
306       'utf-8)))
307
308 (defun git-get-logoutput-coding-system ()
309   "Return the coding system used for git-log output."
310   (let ((repo-config (or (git-config "i18n.logoutputencoding")
311                          (git-config "i18n.commitencoding"))))
312     (or git-commits-coding-system
313         (and repo-config
314              (fboundp 'locale-charset-to-coding-system)
315              (locale-charset-to-coding-system repo-config))
316       'utf-8)))
317
318 (defun git-escape-file-name (name)
319   "Escape a file name if necessary."
320   (if (string-match "[\n\t\"\\]" name)
321       (concat "\""
322               (mapconcat (lambda (c)
323                    (case c
324                      (?\n "\\n")
325                      (?\t "\\t")
326                      (?\\ "\\\\")
327                      (?\" "\\\"")
328                      (t (char-to-string c))))
329                  name "")
330               "\"")
331     name))
332
333 (defun git-success-message (text files)
334   "Print a success message after having handled FILES."
335   (let ((n (length files)))
336     (if (equal n 1)
337         (message "%s %s" text (car files))
338       (message "%s %d files" text n))))
339
340 (defun git-get-top-dir (dir)
341   "Retrieve the top-level directory of a git tree."
342   (let ((cdup (with-output-to-string
343                 (with-current-buffer standard-output
344                   (cd dir)
345                   (unless (eq 0 (git-call-process t "rev-parse" "--show-cdup"))
346                     (error "cannot find top-level git tree for %s." dir))))))
347     (expand-file-name (concat (file-name-as-directory dir)
348                               (car (split-string cdup "\n"))))))
349
350 ;stolen from pcl-cvs
351 (defun git-append-to-ignore (file)
352   "Add a file name to the ignore file in its directory."
353   (let* ((fullname (expand-file-name file))
354          (dir (file-name-directory fullname))
355          (name (file-name-nondirectory fullname))
356          (ignore-name (expand-file-name git-per-dir-ignore-file dir))
357          (created (not (file-exists-p ignore-name))))
358   (save-window-excursion
359     (set-buffer (find-file-noselect ignore-name))
360     (goto-char (point-max))
361     (unless (zerop (current-column)) (insert "\n"))
362     (insert "/" name "\n")
363     (sort-lines nil (point-min) (point-max))
364     (save-buffer))
365   (when created
366     (git-call-process nil "update-index" "--add" "--" (file-relative-name ignore-name)))
367   (git-update-status-files (list (file-relative-name ignore-name)))))
368
369 ; propertize definition for XEmacs, stolen from erc-compat
370 (eval-when-compile
371   (unless (fboundp 'propertize)
372     (defun propertize (string &rest props)
373       (let ((string (copy-sequence string)))
374         (while props
375           (put-text-property 0 (length string) (nth 0 props) (nth 1 props) string)
376           (setq props (cddr props)))
377         string))))
378
379 ;;;; Wrappers for basic git commands
380 ;;;; ------------------------------------------------------------
381
382 (defun git-rev-parse (rev)
383   "Parse a revision name and return its SHA1."
384   (git-get-string-sha1
385    (git-call-process-string "rev-parse" rev)))
386
387 (defun git-config (key)
388   "Retrieve the value associated to KEY in the git repository config file."
389   (let ((str (git-call-process-string "config" key)))
390     (and str (car (split-string str "\n")))))
391
392 (defun git-symbolic-ref (ref)
393   "Wrapper for the git-symbolic-ref command."
394   (let ((str (git-call-process-string "symbolic-ref" ref)))
395     (and str (car (split-string str "\n")))))
396
397 (defun git-update-ref (ref newval &optional oldval reason)
398   "Update a reference by calling git-update-ref."
399   (let ((args (and oldval (list oldval))))
400     (when newval (push newval args))
401     (push ref args)
402     (when reason
403      (push reason args)
404      (push "-m" args))
405     (unless newval (push "-d" args))
406     (apply 'git-call-process-display-error "update-ref" args)))
407
408 (defun git-for-each-ref (&rest specs)
409   "Return a list of refs using git-for-each-ref.
410 Each entry is a cons of (SHORT-NAME . FULL-NAME)."
411   (let (refs)
412     (with-temp-buffer
413       (apply #'git-call-process t "for-each-ref" "--format=%(refname)" specs)
414       (goto-char (point-min))
415       (while (re-search-forward "^[^/\n]+/[^/\n]+/\\(.+\\)$" nil t)
416         (push (cons (match-string 1) (match-string 0)) refs)))
417     (nreverse refs)))
418
419 (defun git-read-tree (tree &optional index-file)
420   "Read a tree into the index file."
421   (let ((process-environment
422          (append (and index-file (list (concat "GIT_INDEX_FILE=" index-file))) process-environment)))
423     (apply 'git-call-process-display-error "read-tree" (if tree (list tree)))))
424
425 (defun git-write-tree (&optional index-file)
426   "Call git-write-tree and return the resulting tree SHA1 as a string."
427   (let ((process-environment
428          (append (and index-file (list (concat "GIT_INDEX_FILE=" index-file))) process-environment)))
429     (git-get-string-sha1
430      (git-call-process-string-display-error "write-tree"))))
431
432 (defun git-commit-tree (buffer tree head)
433   "Call git-commit-tree with buffer as input and return the resulting commit SHA1."
434   (let ((author-name (git-get-committer-name))
435         (author-email (git-get-committer-email))
436         (subject "commit (initial): ")
437         author-date log-start log-end args coding-system-for-write)
438     (when head
439       (setq subject "commit: ")
440       (push "-p" args)
441       (push head args))
442     (with-current-buffer buffer
443       (goto-char (point-min))
444       (if
445           (setq log-start (re-search-forward (concat "^" (regexp-quote git-log-msg-separator) "\n") nil t))
446           (save-restriction
447             (narrow-to-region (point-min) log-start)
448             (goto-char (point-min))
449             (when (re-search-forward "^Author: +\\(.*?\\) *<\\(.*\\)> *$" nil t)
450               (setq author-name (match-string 1)
451                     author-email (match-string 2)))
452             (goto-char (point-min))
453             (when (re-search-forward "^Date: +\\(.*\\)$" nil t)
454               (setq author-date (match-string 1)))
455             (goto-char (point-min))
456             (when (re-search-forward "^Merge: +\\(.*\\)" nil t)
457               (setq subject "commit (merge): ")
458               (dolist (parent (split-string (match-string 1) " +" t))
459                 (push "-p" args)
460                 (push parent args))))
461         (setq log-start (point-min)))
462       (setq log-end (point-max))
463       (goto-char log-start)
464       (when (re-search-forward ".*$" nil t)
465         (setq subject (concat subject (match-string 0))))
466       (setq coding-system-for-write buffer-file-coding-system))
467     (let ((commit
468            (git-get-string-sha1
469             (let ((env `(("GIT_AUTHOR_NAME" . ,author-name)
470                          ("GIT_AUTHOR_EMAIL" . ,author-email)
471                          ("GIT_COMMITTER_NAME" . ,(git-get-committer-name))
472                          ("GIT_COMMITTER_EMAIL" . ,(git-get-committer-email)))))
473               (when author-date (push `("GIT_AUTHOR_DATE" . ,author-date) env))
474               (apply #'git-run-command-region
475                      buffer log-start log-end env
476                      "commit-tree" tree (nreverse args))))))
477       (when commit (git-update-ref "HEAD" commit head subject))
478       commit)))
479
480 (defun git-empty-db-p ()
481   "Check if the git db is empty (no commit done yet)."
482   (not (eq 0 (git-call-process nil "rev-parse" "--verify" "HEAD"))))
483
484 (defun git-get-merge-heads ()
485   "Retrieve the merge heads from the MERGE_HEAD file if present."
486   (let (heads)
487     (when (file-readable-p ".git/MERGE_HEAD")
488       (with-temp-buffer
489         (insert-file-contents ".git/MERGE_HEAD" nil nil nil t)
490         (goto-char (point-min))
491         (while (re-search-forward "[0-9a-f]\\{40\\}" nil t)
492           (push (match-string 0) heads))))
493     (nreverse heads)))
494
495 (defun git-get-commit-description (commit)
496   "Get a one-line description of COMMIT."
497   (let ((coding-system-for-read (git-get-logoutput-coding-system)))
498     (let ((descr (git-call-process-string "log" "--max-count=1" "--pretty=oneline" commit)))
499       (if (and descr (string-match "\\`\\([0-9a-f]\\{40\\}\\) *\\(.*\\)$" descr))
500           (concat (substring (match-string 1 descr) 0 10) " - " (match-string 2 descr))
501         descr))))
502
503 ;;;; File info structure
504 ;;;; ------------------------------------------------------------
505
506 ; fileinfo structure stolen from pcl-cvs
507 (defstruct (git-fileinfo
508             (:copier nil)
509             (:constructor git-create-fileinfo (state name &optional old-perm new-perm rename-state orig-name marked))
510             (:conc-name git-fileinfo->))
511   marked              ;; t/nil
512   state               ;; current state
513   name                ;; file name
514   old-perm new-perm   ;; permission flags
515   rename-state        ;; rename or copy state
516   orig-name           ;; original name for renames or copies
517   needs-update        ;; whether file needs to be updated
518   needs-refresh)      ;; whether file needs to be refreshed
519
520 (defvar git-status nil)
521
522 (defun git-set-fileinfo-state (info state)
523   "Set the state of a file info."
524   (unless (eq (git-fileinfo->state info) state)
525     (setf (git-fileinfo->state info) state
526           (git-fileinfo->new-perm info) (git-fileinfo->old-perm info)
527           (git-fileinfo->rename-state info) nil
528           (git-fileinfo->orig-name info) nil
529           (git-fileinfo->needs-update info) nil
530           (git-fileinfo->needs-refresh info) t)))
531
532 (defun git-status-filenames-map (status func files &rest args)
533   "Apply FUNC to the status files names in the FILES list.
534 The list must be sorted."
535   (when files
536     (let ((file (pop files))
537           (node (ewoc-nth status 0)))
538       (while (and file node)
539         (let* ((info (ewoc-data node))
540                (name (git-fileinfo->name info)))
541           (if (string-lessp name file)
542               (setq node (ewoc-next status node))
543             (if (string-equal name file)
544                 (apply func info args))
545             (setq file (pop files))))))))
546
547 (defun git-set-filenames-state (status files state)
548   "Set the state of a list of named files. The list must be sorted"
549   (when files
550     (git-status-filenames-map status #'git-set-fileinfo-state files state)
551     (unless state  ;; delete files whose state has been set to nil
552       (ewoc-filter status (lambda (info) (git-fileinfo->state info))))))
553
554 (defun git-state-code (code)
555   "Convert from a string to a added/deleted/modified state."
556   (case (string-to-char code)
557     (?M 'modified)
558     (?? 'unknown)
559     (?A 'added)
560     (?D 'deleted)
561     (?U 'unmerged)
562     (?T 'modified)
563     (t nil)))
564
565 (defun git-status-code-as-string (code)
566   "Format a git status code as string."
567   (case code
568     ('modified (propertize "Modified" 'face 'git-status-face))
569     ('unknown  (propertize "Unknown " 'face 'git-unknown-face))
570     ('added    (propertize "Added   " 'face 'git-status-face))
571     ('deleted  (propertize "Deleted " 'face 'git-status-face))
572     ('unmerged (propertize "Unmerged" 'face 'git-unmerged-face))
573     ('uptodate (propertize "Uptodate" 'face 'git-uptodate-face))
574     ('ignored  (propertize "Ignored " 'face 'git-ignored-face))
575     (t "?       ")))
576
577 (defun git-file-type-as-string (old-perm new-perm)
578   "Return a string describing the file type based on its permissions."
579   (let* ((old-type (lsh (or old-perm 0) -9))
580          (new-type (lsh (or new-perm 0) -9))
581          (str (case new-type
582                 (64  ;; file
583                  (case old-type
584                    (64 nil)
585                    (80 "   (type change symlink -> file)")
586                    (112 "   (type change subproject -> file)")))
587                  (80  ;; symlink
588                   (case old-type
589                     (64 "   (type change file -> symlink)")
590                     (112 "   (type change subproject -> symlink)")
591                     (t "   (symlink)")))
592                   (112  ;; subproject
593                    (case old-type
594                      (64 "   (type change file -> subproject)")
595                      (80 "   (type change symlink -> subproject)")
596                      (t "   (subproject)")))
597                   (72 nil)  ;; directory (internal, not a real git state)
598                   (0  ;; deleted or unknown
599                    (case old-type
600                      (80 "   (symlink)")
601                      (112 "   (subproject)")))
602                   (t (format "   (unknown type %o)" new-type)))))
603     (cond (str (propertize str 'face 'git-status-face))
604           ((eq new-type 72) "/")
605           (t ""))))
606
607 (defun git-rename-as-string (info)
608   "Return a string describing the copy or rename associated with INFO, or an empty string if none."
609   (let ((state (git-fileinfo->rename-state info)))
610     (if state
611         (propertize
612          (concat "   ("
613                  (if (eq state 'copy) "copied from "
614                    (if (eq (git-fileinfo->state info) 'added) "renamed from "
615                      "renamed to "))
616                  (git-escape-file-name (git-fileinfo->orig-name info))
617                  ")") 'face 'git-status-face)
618       "")))
619
620 (defun git-permissions-as-string (old-perm new-perm)
621   "Format a permission change as string."
622   (propertize
623    (if (or (not old-perm)
624            (not new-perm)
625            (eq 0 (logand ?\111 (logxor old-perm new-perm))))
626        "  "
627      (if (eq 0 (logand ?\111 old-perm)) "+x" "-x"))
628   'face 'git-permission-face))
629
630 (defun git-fileinfo-prettyprint (info)
631   "Pretty-printer for the git-fileinfo structure."
632   (let ((old-perm (git-fileinfo->old-perm info))
633         (new-perm (git-fileinfo->new-perm info)))
634     (insert (concat "   " (if (git-fileinfo->marked info) (propertize "*" 'face 'git-mark-face) " ")
635                     " " (git-status-code-as-string (git-fileinfo->state info))
636                     " " (git-permissions-as-string old-perm new-perm)
637                     "  " (git-escape-file-name (git-fileinfo->name info))
638                     (git-file-type-as-string old-perm new-perm)
639                     (git-rename-as-string info)))))
640
641 (defun git-update-node-fileinfo (node info)
642   "Update the fileinfo of the specified node. The names are assumed to match already."
643   (let ((data (ewoc-data node)))
644     (setf
645      ;; preserve the marked flag
646      (git-fileinfo->marked info) (git-fileinfo->marked data)
647      (git-fileinfo->needs-update data) nil)
648     (when (not (equal info data))
649       (setf (git-fileinfo->needs-refresh info) t
650             (ewoc-data node) info))))
651
652 (defun git-insert-info-list (status infolist files)
653   "Insert a sorted list of file infos in the status buffer, replacing existing ones if any."
654   (let* ((info (pop infolist))
655          (node (ewoc-nth status 0))
656          (name (and info (git-fileinfo->name info)))
657          remaining)
658     (while info
659       (let ((nodename (and node (git-fileinfo->name (ewoc-data node)))))
660         (while (and files (string-lessp (car files) name))
661           (push (pop files) remaining))
662         (when (and files (string-equal (car files) name))
663           (setq files (cdr files)))
664         (cond ((not nodename)
665                (setq node (ewoc-enter-last status info))
666                (setq info (pop infolist))
667                (setq name (and info (git-fileinfo->name info))))
668               ((string-lessp nodename name)
669                (setq node (ewoc-next status node)))
670               ((string-equal nodename name)
671                ;; preserve the marked flag
672                (git-update-node-fileinfo node info)
673                (setq info (pop infolist))
674                (setq name (and info (git-fileinfo->name info))))
675               (t
676                (setq node (ewoc-enter-before status node info))
677                (setq info (pop infolist))
678                (setq name (and info (git-fileinfo->name info)))))))
679     (nconc (nreverse remaining) files)))
680
681 (defun git-run-diff-index (status files)
682   "Run git-diff-index on FILES and parse the results into STATUS.
683 Return the list of files that haven't been handled."
684   (let (infolist)
685     (with-temp-buffer
686       (apply #'git-call-process t "diff-index" "-z" "-M" "HEAD" "--" files)
687       (goto-char (point-min))
688       (while (re-search-forward
689               ":\\([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"
690               nil t 1)
691         (let ((old-perm (string-to-number (match-string 1) 8))
692               (new-perm (string-to-number (match-string 2) 8))
693               (state (or (match-string 4) (match-string 6)))
694               (name (or (match-string 5) (match-string 7)))
695               (new-name (match-string 8)))
696           (if new-name  ; copy or rename
697               (if (eq ?C (string-to-char state))
698                   (push (git-create-fileinfo 'added new-name old-perm new-perm 'copy name) infolist)
699                 (push (git-create-fileinfo 'deleted name 0 0 'rename new-name) infolist)
700                 (push (git-create-fileinfo 'added new-name old-perm new-perm 'rename name) infolist))
701             (push (git-create-fileinfo (git-state-code state) name old-perm new-perm) infolist)))))
702     (setq infolist (sort (nreverse infolist)
703                          (lambda (info1 info2)
704                            (string-lessp (git-fileinfo->name info1)
705                                          (git-fileinfo->name info2)))))
706     (git-insert-info-list status infolist files)))
707
708 (defun git-find-status-file (status file)
709   "Find a given file in the status ewoc and return its node."
710   (let ((node (ewoc-nth status 0)))
711     (while (and node (not (string= file (git-fileinfo->name (ewoc-data node)))))
712       (setq node (ewoc-next status node)))
713     node))
714
715 (defun git-run-ls-files (status files default-state &rest options)
716   "Run git-ls-files on FILES and parse the results into STATUS.
717 Return the list of files that haven't been handled."
718   (let (infolist)
719     (with-temp-buffer
720       (apply #'git-call-process t "ls-files" "-z" (append options (list "--") files))
721       (goto-char (point-min))
722       (while (re-search-forward "\\([^\0]*?\\)\\(/?\\)\0" nil t 1)
723         (let ((name (match-string 1)))
724           (push (git-create-fileinfo default-state name 0
725                                      (if (string-equal "/" (match-string 2)) (lsh ?\110 9) 0))
726                 infolist))))
727     (setq infolist (nreverse infolist))  ;; assume it is sorted already
728     (git-insert-info-list status infolist files)))
729
730 (defun git-run-ls-files-cached (status files default-state)
731   "Run git-ls-files -c on FILES and parse the results into STATUS.
732 Return the list of files that haven't been handled."
733   (let (infolist)
734     (with-temp-buffer
735       (apply #'git-call-process t "ls-files" "-z" "-s" "-c" "--" files)
736       (goto-char (point-min))
737       (while (re-search-forward "\\([0-7]\\{6\\}\\) [0-9a-f]\\{40\\} 0\t\\([^\0]+\\)\0" nil t)
738         (let* ((new-perm (string-to-number (match-string 1) 8))
739                (old-perm (if (eq default-state 'added) 0 new-perm))
740                (name (match-string 2)))
741           (push (git-create-fileinfo default-state name old-perm new-perm) infolist))))
742     (setq infolist (nreverse infolist))  ;; assume it is sorted already
743     (git-insert-info-list status infolist files)))
744
745 (defun git-run-ls-unmerged (status files)
746   "Run git-ls-files -u on FILES and parse the results into STATUS."
747   (with-temp-buffer
748     (apply #'git-call-process t "ls-files" "-z" "-u" "--" files)
749     (goto-char (point-min))
750     (let (unmerged-files)
751       (while (re-search-forward "[0-7]\\{6\\} [0-9a-f]\\{40\\} [123]\t\\([^\0]+\\)\0" nil t)
752         (push (match-string 1) unmerged-files))
753       (setq unmerged-files (nreverse unmerged-files))  ;; assume it is sorted already
754       (git-set-filenames-state status unmerged-files 'unmerged))))
755
756 (defun git-get-exclude-files ()
757   "Get the list of exclude files to pass to git-ls-files."
758   (let (files
759         (config (git-config "core.excludesfile")))
760     (when (file-readable-p ".git/info/exclude")
761       (push ".git/info/exclude" files))
762     (when (and config (file-readable-p config))
763       (push config files))
764     files))
765
766 (defun git-run-ls-files-with-excludes (status files default-state &rest options)
767   "Run git-ls-files on FILES with appropriate --exclude-from options."
768   (let ((exclude-files (git-get-exclude-files)))
769     (apply #'git-run-ls-files status files default-state "--directory" "--no-empty-directory"
770            (concat "--exclude-per-directory=" git-per-dir-ignore-file)
771            (append options (mapcar (lambda (f) (concat "--exclude-from=" f)) exclude-files)))))
772
773 (defun git-update-status-files (&optional files mark-files)
774   "Update the status of FILES from the index.
775 The FILES list must be sorted."
776   (unless git-status (error "Not in git-status buffer."))
777   ;; set the needs-update flag on existing files
778   (if files
779       (git-status-filenames-map
780        git-status (lambda (info) (setf (git-fileinfo->needs-update info) t)) files)
781     (ewoc-map (lambda (info) (setf (git-fileinfo->needs-update info) t) nil) git-status)
782     (git-call-process nil "update-index" "--refresh")
783     (when git-show-uptodate
784       (git-run-ls-files-cached git-status nil 'uptodate)))
785   (let ((remaining-files
786           (if (git-empty-db-p) ; we need some special handling for an empty db
787               (git-run-ls-files-cached git-status files 'added)
788             (git-run-diff-index git-status files))))
789     (git-run-ls-unmerged git-status files)
790     (when (or remaining-files (and git-show-unknown (not files)))
791       (setq remaining-files (git-run-ls-files-with-excludes git-status remaining-files 'unknown "-o")))
792     (when (or remaining-files (and git-show-ignored (not files)))
793       (setq remaining-files (git-run-ls-files-with-excludes git-status remaining-files 'ignored "-o" "-i")))
794     (unless files
795       (setq remaining-files (git-get-filenames (ewoc-collect git-status #'git-fileinfo->needs-update))))
796     (when remaining-files
797       (setq remaining-files (git-run-ls-files-cached git-status remaining-files 'uptodate)))
798     (git-set-filenames-state git-status remaining-files nil)
799     (when mark-files (git-mark-files git-status files))
800     (git-refresh-files)
801     (git-refresh-ewoc-hf git-status)))
802
803 (defun git-mark-files (status files)
804   "Mark all the specified FILES, and unmark the others."
805   (let ((file (and files (pop files)))
806         (node (ewoc-nth status 0)))
807     (while node
808       (let ((info (ewoc-data node)))
809         (if (and file (string-equal (git-fileinfo->name info) file))
810             (progn
811               (unless (git-fileinfo->marked info)
812                 (setf (git-fileinfo->marked info) t)
813                 (setf (git-fileinfo->needs-refresh info) t))
814               (setq file (pop files))
815               (setq node (ewoc-next status node)))
816           (when (git-fileinfo->marked info)
817             (setf (git-fileinfo->marked info) nil)
818             (setf (git-fileinfo->needs-refresh info) t))
819           (if (and file (string-lessp file (git-fileinfo->name info)))
820               (setq file (pop files))
821             (setq node (ewoc-next status node))))))))
822
823 (defun git-marked-files ()
824   "Return a list of all marked files, or if none a list containing just the file at cursor position."
825   (unless git-status (error "Not in git-status buffer."))
826   (or (ewoc-collect git-status (lambda (info) (git-fileinfo->marked info)))
827       (list (ewoc-data (ewoc-locate git-status)))))
828
829 (defun git-marked-files-state (&rest states)
830   "Return a sorted list of marked files that are in the specified states."
831   (let ((files (git-marked-files))
832         result)
833     (dolist (info files)
834       (when (memq (git-fileinfo->state info) states)
835         (push info result)))
836     (nreverse result)))
837
838 (defun git-refresh-files ()
839   "Refresh all files that need it and clear the needs-refresh flag."
840   (unless git-status (error "Not in git-status buffer."))
841   (ewoc-map
842    (lambda (info)
843      (let ((refresh (git-fileinfo->needs-refresh info)))
844        (setf (git-fileinfo->needs-refresh info) nil)
845        refresh))
846    git-status)
847   ; move back to goal column
848   (when goal-column (move-to-column goal-column)))
849
850 (defun git-refresh-ewoc-hf (status)
851   "Refresh the ewoc header and footer."
852   (let ((branch (git-symbolic-ref "HEAD"))
853         (head (if (git-empty-db-p) "Nothing committed yet"
854                 (git-get-commit-description "HEAD")))
855         (merge-heads (git-get-merge-heads)))
856     (ewoc-set-hf status
857                  (format "Directory:  %s\nBranch:     %s\nHead:       %s%s\n"
858                          default-directory
859                          (if branch
860                              (if (string-match "^refs/heads/" branch)
861                                  (substring branch (match-end 0))
862                                branch)
863                            "none (detached HEAD)")
864                          head
865                          (if merge-heads
866                              (concat "\nMerging:    "
867                                      (mapconcat (lambda (str) (git-get-commit-description str)) merge-heads "\n            "))
868                            ""))
869                  (if (ewoc-nth status 0) "" "    No changes."))))
870
871 (defun git-get-filenames (files)
872   (mapcar (lambda (info) (git-fileinfo->name info)) files))
873
874 (defun git-update-index (index-file files)
875   "Run git-update-index on a list of files."
876   (let ((process-environment (append (and index-file (list (concat "GIT_INDEX_FILE=" index-file)))
877                                      process-environment))
878         added deleted modified)
879     (dolist (info files)
880       (case (git-fileinfo->state info)
881         ('added (push info added))
882         ('deleted (push info deleted))
883         ('modified (push info modified))))
884     (and
885      (or (not added) (apply #'git-call-process-display-error "update-index" "--add" "--" (git-get-filenames added)))
886      (or (not deleted) (apply #'git-call-process-display-error "update-index" "--remove" "--" (git-get-filenames deleted)))
887      (or (not modified) (apply #'git-call-process-display-error "update-index" "--" (git-get-filenames modified))))))
888
889 (defun git-run-pre-commit-hook ()
890   "Run the pre-commit hook if any."
891   (unless git-status (error "Not in git-status buffer."))
892   (let ((files (git-marked-files-state 'added 'deleted 'modified)))
893     (or (not files)
894         (not (file-executable-p ".git/hooks/pre-commit"))
895         (let ((index-file (make-temp-file "gitidx")))
896           (unwind-protect
897             (let ((head-tree (unless (git-empty-db-p) (git-rev-parse "HEAD^{tree}"))))
898               (git-read-tree head-tree index-file)
899               (git-update-index index-file files)
900               (git-run-hook "pre-commit" `(("GIT_INDEX_FILE" . ,index-file))))
901           (delete-file index-file))))))
902
903 (defun git-do-commit ()
904   "Perform the actual commit using the current buffer as log message."
905   (interactive)
906   (let ((buffer (current-buffer))
907         (index-file (make-temp-file "gitidx")))
908     (with-current-buffer log-edit-parent-buffer
909       (if (git-marked-files-state 'unmerged)
910           (message "You cannot commit unmerged files, resolve them first.")
911         (unwind-protect
912             (let ((files (git-marked-files-state 'added 'deleted 'modified))
913                   head tree head-tree)
914               (unless (git-empty-db-p)
915                 (setq head (git-rev-parse "HEAD")
916                       head-tree (git-rev-parse "HEAD^{tree}")))
917               (message "Running git commit...")
918               (when
919                   (and
920                    (git-read-tree head-tree index-file)
921                    (git-update-index nil files)         ;update both the default index
922                    (git-update-index index-file files)  ;and the temporary one
923                    (setq tree (git-write-tree index-file)))
924                 (if (or (not (string-equal tree head-tree))
925                         (yes-or-no-p "The tree was not modified, do you really want to perform an empty commit? "))
926                     (let ((commit (git-commit-tree buffer tree head)))
927                       (when commit
928                         (condition-case nil (delete-file ".git/MERGE_HEAD") (error nil))
929                         (condition-case nil (delete-file ".git/MERGE_MSG") (error nil))
930                         (with-current-buffer buffer (erase-buffer))
931                         (git-update-status-files (git-get-filenames files))
932                         (git-call-process nil "rerere")
933                         (git-call-process nil "gc" "--auto")
934                         (message "Committed %s." commit)
935                         (git-run-hook "post-commit" nil)))
936                   (message "Commit aborted."))))
937           (delete-file index-file))))))
938
939
940 ;;;; Interactive functions
941 ;;;; ------------------------------------------------------------
942
943 (defun git-mark-file ()
944   "Mark the file that the cursor is on and move to the next one."
945   (interactive)
946   (unless git-status (error "Not in git-status buffer."))
947   (let* ((pos (ewoc-locate git-status))
948          (info (ewoc-data pos)))
949     (setf (git-fileinfo->marked info) t)
950     (ewoc-invalidate git-status pos)
951     (ewoc-goto-next git-status 1)))
952
953 (defun git-unmark-file ()
954   "Unmark the file that the cursor is on and move to the next one."
955   (interactive)
956   (unless git-status (error "Not in git-status buffer."))
957   (let* ((pos (ewoc-locate git-status))
958          (info (ewoc-data pos)))
959     (setf (git-fileinfo->marked info) nil)
960     (ewoc-invalidate git-status pos)
961     (ewoc-goto-next git-status 1)))
962
963 (defun git-unmark-file-up ()
964   "Unmark the file that the cursor is on and move to the previous one."
965   (interactive)
966   (unless git-status (error "Not in git-status buffer."))
967   (let* ((pos (ewoc-locate git-status))
968          (info (ewoc-data pos)))
969     (setf (git-fileinfo->marked info) nil)
970     (ewoc-invalidate git-status pos)
971     (ewoc-goto-prev git-status 1)))
972
973 (defun git-mark-all ()
974   "Mark all files."
975   (interactive)
976   (unless git-status (error "Not in git-status buffer."))
977   (ewoc-map (lambda (info) (unless (git-fileinfo->marked info)
978                              (setf (git-fileinfo->marked info) t))) git-status)
979   ; move back to goal column after invalidate
980   (when goal-column (move-to-column goal-column)))
981
982 (defun git-unmark-all ()
983   "Unmark all files."
984   (interactive)
985   (unless git-status (error "Not in git-status buffer."))
986   (ewoc-map (lambda (info) (when (git-fileinfo->marked info)
987                              (setf (git-fileinfo->marked info) nil)
988                              t)) git-status)
989   ; move back to goal column after invalidate
990   (when goal-column (move-to-column goal-column)))
991
992 (defun git-toggle-all-marks ()
993   "Toggle all file marks."
994   (interactive)
995   (unless git-status (error "Not in git-status buffer."))
996   (ewoc-map (lambda (info) (setf (git-fileinfo->marked info) (not (git-fileinfo->marked info))) t) git-status)
997   ; move back to goal column after invalidate
998   (when goal-column (move-to-column goal-column)))
999
1000 (defun git-next-file (&optional n)
1001   "Move the selection down N files."
1002   (interactive "p")
1003   (unless git-status (error "Not in git-status buffer."))
1004   (ewoc-goto-next git-status n))
1005
1006 (defun git-prev-file (&optional n)
1007   "Move the selection up N files."
1008   (interactive "p")
1009   (unless git-status (error "Not in git-status buffer."))
1010   (ewoc-goto-prev git-status n))
1011
1012 (defun git-next-unmerged-file (&optional n)
1013   "Move the selection down N unmerged files."
1014   (interactive "p")
1015   (unless git-status (error "Not in git-status buffer."))
1016   (let* ((last (ewoc-locate git-status))
1017          (node (ewoc-next git-status last)))
1018     (while (and node (> n 0))
1019       (when (eq 'unmerged (git-fileinfo->state (ewoc-data node)))
1020         (setq n (1- n))
1021         (setq last node))
1022       (setq node (ewoc-next git-status node)))
1023     (ewoc-goto-node git-status last)))
1024
1025 (defun git-prev-unmerged-file (&optional n)
1026   "Move the selection up N unmerged files."
1027   (interactive "p")
1028   (unless git-status (error "Not in git-status buffer."))
1029   (let* ((last (ewoc-locate git-status))
1030          (node (ewoc-prev git-status last)))
1031     (while (and node (> n 0))
1032       (when (eq 'unmerged (git-fileinfo->state (ewoc-data node)))
1033         (setq n (1- n))
1034         (setq last node))
1035       (setq node (ewoc-prev git-status node)))
1036     (ewoc-goto-node git-status last)))
1037
1038 (defun git-insert-file (file)
1039   "Insert file(s) into the git-status buffer."
1040   (interactive "fInsert file: ")
1041   (git-update-status-files (list (file-relative-name file))))
1042
1043 (defun git-add-file ()
1044   "Add marked file(s) to the index cache."
1045   (interactive)
1046   (let ((files (git-get-filenames (git-marked-files-state 'unknown 'ignored))))
1047     ;; FIXME: add support for directories
1048     (unless files
1049       (push (file-relative-name (read-file-name "File to add: " nil nil t)) files))
1050     (when (apply 'git-call-process-display-error "update-index" "--add" "--" files)
1051       (git-update-status-files files)
1052       (git-success-message "Added" files))))
1053
1054 (defun git-ignore-file ()
1055   "Add marked file(s) to the ignore list."
1056   (interactive)
1057   (let ((files (git-get-filenames (git-marked-files-state 'unknown))))
1058     (unless files
1059       (push (file-relative-name (read-file-name "File to ignore: " nil nil t)) files))
1060     (dolist (f files) (git-append-to-ignore f))
1061     (git-update-status-files files)
1062     (git-success-message "Ignored" files)))
1063
1064 (defun git-remove-file ()
1065   "Remove the marked file(s)."
1066   (interactive)
1067   (let ((files (git-get-filenames (git-marked-files-state 'added 'modified 'unknown 'uptodate 'ignored))))
1068     (unless files
1069       (push (file-relative-name (read-file-name "File to remove: " nil nil t)) files))
1070     (if (yes-or-no-p
1071          (if (cdr files)
1072              (format "Remove %d files? " (length files))
1073            (format "Remove %s? " (car files))))
1074         (progn
1075           (dolist (name files)
1076             (ignore-errors
1077               (if (file-directory-p name)
1078                   (delete-directory name)
1079                 (delete-file name))))
1080           (when (apply 'git-call-process-display-error "update-index" "--remove" "--" files)
1081             (git-update-status-files files)
1082             (git-success-message "Removed" files)))
1083       (message "Aborting"))))
1084
1085 (defun git-revert-file ()
1086   "Revert changes to the marked file(s)."
1087   (interactive)
1088   (let ((files (git-marked-files-state 'added 'deleted 'modified 'unmerged))
1089         added modified)
1090     (when (and files
1091                (yes-or-no-p
1092                 (if (cdr files)
1093                     (format "Revert %d files? " (length files))
1094                   (format "Revert %s? " (git-fileinfo->name (car files))))))
1095       (dolist (info files)
1096         (case (git-fileinfo->state info)
1097           ('added (push (git-fileinfo->name info) added))
1098           ('deleted (push (git-fileinfo->name info) modified))
1099           ('unmerged (push (git-fileinfo->name info) modified))
1100           ('modified (push (git-fileinfo->name info) modified))))
1101       ;; check if a buffer contains one of the files and isn't saved
1102       (dolist (file modified)
1103         (let ((buffer (get-file-buffer file)))
1104           (when (and buffer (buffer-modified-p buffer))
1105             (error "Buffer %s is modified. Please kill or save modified buffers before reverting." (buffer-name buffer)))))
1106       (let ((ok (and
1107                  (or (not added)
1108                      (apply 'git-call-process-display-error "update-index" "--force-remove" "--" added))
1109                  (or (not modified)
1110                      (apply 'git-call-process-display-error "checkout" "HEAD" modified))))
1111             (names (git-get-filenames files)))
1112         (git-update-status-files names)
1113         (when ok
1114           (dolist (file modified)
1115             (let ((buffer (get-file-buffer file)))
1116               (when buffer (with-current-buffer buffer (revert-buffer t t t)))))
1117           (git-success-message "Reverted" names))))))
1118
1119 (defun git-resolve-file ()
1120   "Resolve conflicts in marked file(s)."
1121   (interactive)
1122   (let ((files (git-get-filenames (git-marked-files-state 'unmerged))))
1123     (when files
1124       (when (apply 'git-call-process-display-error "update-index" "--" files)
1125         (git-update-status-files files)
1126         (git-success-message "Resolved" files)))))
1127
1128 (defun git-remove-handled ()
1129   "Remove handled files from the status list."
1130   (interactive)
1131   (ewoc-filter git-status
1132                (lambda (info)
1133                  (case (git-fileinfo->state info)
1134                    ('ignored git-show-ignored)
1135                    ('uptodate git-show-uptodate)
1136                    ('unknown git-show-unknown)
1137                    (t t))))
1138   (unless (ewoc-nth git-status 0)  ; refresh header if list is empty
1139     (git-refresh-ewoc-hf git-status)))
1140
1141 (defun git-toggle-show-uptodate ()
1142   "Toogle the option for showing up-to-date files."
1143   (interactive)
1144   (if (setq git-show-uptodate (not git-show-uptodate))
1145       (git-refresh-status)
1146     (git-remove-handled)))
1147
1148 (defun git-toggle-show-ignored ()
1149   "Toogle the option for showing ignored files."
1150   (interactive)
1151   (if (setq git-show-ignored (not git-show-ignored))
1152       (progn
1153         (message "Inserting ignored files...")
1154         (git-run-ls-files-with-excludes git-status nil 'ignored "-o" "-i")
1155         (git-refresh-files)
1156         (git-refresh-ewoc-hf git-status)
1157         (message "Inserting ignored files...done"))
1158     (git-remove-handled)))
1159
1160 (defun git-toggle-show-unknown ()
1161   "Toogle the option for showing unknown files."
1162   (interactive)
1163   (if (setq git-show-unknown (not git-show-unknown))
1164       (progn
1165         (message "Inserting unknown files...")
1166         (git-run-ls-files-with-excludes git-status nil 'unknown "-o")
1167         (git-refresh-files)
1168         (git-refresh-ewoc-hf git-status)
1169         (message "Inserting unknown files...done"))
1170     (git-remove-handled)))
1171
1172 (defun git-expand-directory (info)
1173   "Expand the directory represented by INFO to list its files."
1174   (when (eq (lsh (git-fileinfo->new-perm info) -9) ?\110)
1175     (let ((dir (git-fileinfo->name info)))
1176       (git-set-filenames-state git-status (list dir) nil)
1177       (git-run-ls-files-with-excludes git-status (list (concat dir "/")) 'unknown "-o")
1178       (git-refresh-files)
1179       (git-refresh-ewoc-hf git-status)
1180       t)))
1181
1182 (defun git-setup-diff-buffer (buffer)
1183   "Setup a buffer for displaying a diff."
1184   (let ((dir default-directory))
1185     (with-current-buffer buffer
1186       (diff-mode)
1187       (goto-char (point-min))
1188       (setq default-directory dir)
1189       (setq buffer-read-only t)))
1190   (display-buffer buffer)
1191   ; shrink window only if it displays the status buffer
1192   (when (eq (window-buffer) (current-buffer))
1193     (shrink-window-if-larger-than-buffer)))
1194
1195 (defun git-diff-file ()
1196   "Diff the marked file(s) against HEAD."
1197   (interactive)
1198   (let ((files (git-marked-files)))
1199     (git-setup-diff-buffer
1200      (apply #'git-run-command-buffer "*git-diff*" "diff-index" "-p" "-M" "HEAD" "--" (git-get-filenames files)))))
1201
1202 (defun git-diff-file-merge-head (arg)
1203   "Diff the marked file(s) against the first merge head (or the nth one with a numeric prefix)."
1204   (interactive "p")
1205   (let ((files (git-marked-files))
1206         (merge-heads (git-get-merge-heads)))
1207     (unless merge-heads (error "No merge in progress"))
1208     (git-setup-diff-buffer
1209      (apply #'git-run-command-buffer "*git-diff*" "diff-index" "-p" "-M"
1210             (or (nth (1- arg) merge-heads) "HEAD") "--" (git-get-filenames files)))))
1211
1212 (defun git-diff-unmerged-file (stage)
1213   "Diff the marked unmerged file(s) against the specified stage."
1214   (let ((files (git-marked-files)))
1215     (git-setup-diff-buffer
1216      (apply #'git-run-command-buffer "*git-diff*" "diff-files" "-p" stage "--" (git-get-filenames files)))))
1217
1218 (defun git-diff-file-base ()
1219   "Diff the marked unmerged file(s) against the common base file."
1220   (interactive)
1221   (git-diff-unmerged-file "-1"))
1222
1223 (defun git-diff-file-mine ()
1224   "Diff the marked unmerged file(s) against my pre-merge version."
1225   (interactive)
1226   (git-diff-unmerged-file "-2"))
1227
1228 (defun git-diff-file-other ()
1229   "Diff the marked unmerged file(s) against the other's pre-merge version."
1230   (interactive)
1231   (git-diff-unmerged-file "-3"))
1232
1233 (defun git-diff-file-combined ()
1234   "Do a combined diff of the marked unmerged file(s)."
1235   (interactive)
1236   (git-diff-unmerged-file "-c"))
1237
1238 (defun git-diff-file-idiff ()
1239   "Perform an interactive diff on the current file."
1240   (interactive)
1241   (let ((files (git-marked-files-state 'added 'deleted 'modified)))
1242     (unless (eq 1 (length files))
1243       (error "Cannot perform an interactive diff on multiple files."))
1244     (let* ((filename (car (git-get-filenames files)))
1245            (buff1 (find-file-noselect filename))
1246            (buff2 (git-run-command-buffer (concat filename ".~HEAD~") "cat-file" "blob" (concat "HEAD:" filename))))
1247       (ediff-buffers buff1 buff2))))
1248
1249 (defun git-log-file ()
1250   "Display a log of changes to the marked file(s)."
1251   (interactive)
1252   (let* ((files (git-marked-files))
1253          (coding-system-for-read git-commits-coding-system)
1254          (buffer (apply #'git-run-command-buffer "*git-log*" "rev-list" "--pretty" "HEAD" "--" (git-get-filenames files))))
1255     (with-current-buffer buffer
1256       ; (git-log-mode)  FIXME: implement log mode
1257       (goto-char (point-min))
1258       (setq buffer-read-only t))
1259     (display-buffer buffer)))
1260
1261 (defun git-log-edit-files ()
1262   "Return a list of marked files for use in the log-edit buffer."
1263   (with-current-buffer log-edit-parent-buffer
1264     (git-get-filenames (git-marked-files-state 'added 'deleted 'modified))))
1265
1266 (defun git-log-edit-diff ()
1267   "Run a diff of the current files being committed from a log-edit buffer."
1268   (with-current-buffer log-edit-parent-buffer
1269     (git-diff-file)))
1270
1271 (defun git-append-sign-off (name email)
1272   "Append a Signed-off-by entry to the current buffer, avoiding duplicates."
1273   (let ((sign-off (format "Signed-off-by: %s <%s>" name email))
1274         (case-fold-search t))
1275     (goto-char (point-min))
1276     (unless (re-search-forward (concat "^" (regexp-quote sign-off)) nil t)
1277       (goto-char (point-min))
1278       (unless (re-search-forward "^Signed-off-by: " nil t)
1279         (setq sign-off (concat "\n" sign-off)))
1280       (goto-char (point-max))
1281       (insert sign-off "\n"))))
1282
1283 (defun git-setup-log-buffer (buffer &optional merge-heads author-name author-email subject date msg)
1284   "Setup the log buffer for a commit."
1285   (unless git-status (error "Not in git-status buffer."))
1286   (let ((dir default-directory)
1287         (committer-name (git-get-committer-name))
1288         (committer-email (git-get-committer-email))
1289         (sign-off git-append-signed-off-by))
1290     (with-current-buffer buffer
1291       (cd dir)
1292       (erase-buffer)
1293       (insert
1294        (propertize
1295         (format "Author: %s <%s>\n%s%s"
1296                 (or author-name committer-name)
1297                 (or author-email committer-email)
1298                 (if date (format "Date: %s\n" date) "")
1299                 (if merge-heads
1300                     (format "Merge: %s\n"
1301                             (mapconcat 'identity merge-heads " "))
1302                   ""))
1303         'face 'git-header-face)
1304        (propertize git-log-msg-separator 'face 'git-separator-face)
1305        "\n")
1306       (when subject (insert subject "\n\n"))
1307       (cond (msg (insert msg "\n"))
1308             ((file-readable-p ".git/rebase-apply/msg")
1309              (insert-file-contents ".git/rebase-apply/msg"))
1310             ((file-readable-p ".git/MERGE_MSG")
1311              (insert-file-contents ".git/MERGE_MSG")))
1312       ; delete empty lines at end
1313       (goto-char (point-min))
1314       (when (re-search-forward "\n+\\'" nil t)
1315         (replace-match "\n" t t))
1316       (when sign-off (git-append-sign-off committer-name committer-email)))
1317     buffer))
1318
1319 (defun git-commit-file ()
1320   "Commit the marked file(s), asking for a commit message."
1321   (interactive)
1322   (unless git-status (error "Not in git-status buffer."))
1323   (when (git-run-pre-commit-hook)
1324     (let ((buffer (get-buffer-create "*git-commit*"))
1325           (coding-system (git-get-commits-coding-system))
1326           author-name author-email subject date)
1327       (when (eq 0 (buffer-size buffer))
1328         (when (file-readable-p ".git/rebase-apply/info")
1329           (with-temp-buffer
1330             (insert-file-contents ".git/rebase-apply/info")
1331             (goto-char (point-min))
1332             (when (re-search-forward "^Author: \\(.*\\)\nEmail: \\(.*\\)$" nil t)
1333               (setq author-name (match-string 1))
1334               (setq author-email (match-string 2)))
1335             (goto-char (point-min))
1336             (when (re-search-forward "^Subject: \\(.*\\)$" nil t)
1337               (setq subject (match-string 1)))
1338             (goto-char (point-min))
1339             (when (re-search-forward "^Date: \\(.*\\)$" nil t)
1340               (setq date (match-string 1)))))
1341         (git-setup-log-buffer buffer (git-get-merge-heads) author-name author-email subject date))
1342       (if (boundp 'log-edit-diff-function)
1343           (log-edit 'git-do-commit nil '((log-edit-listfun . git-log-edit-files)
1344                                          (log-edit-diff-function . git-log-edit-diff)) buffer)
1345         (log-edit 'git-do-commit nil 'git-log-edit-files buffer))
1346       (setq font-lock-keywords (font-lock-compile-keywords git-log-edit-font-lock-keywords))
1347       (setq paragraph-separate (concat (regexp-quote git-log-msg-separator) "$\\|Author: \\|Date: \\|Merge: \\|Signed-off-by: \\|\f\\|[         ]*$"))
1348       (setq buffer-file-coding-system coding-system)
1349       (re-search-forward (regexp-quote (concat git-log-msg-separator "\n")) nil t))))
1350
1351 (defun git-setup-commit-buffer (commit)
1352   "Setup the commit buffer with the contents of COMMIT."
1353   (let (parents author-name author-email subject date msg)
1354     (with-temp-buffer
1355       (let ((coding-system (git-get-logoutput-coding-system)))
1356         (git-call-process t "log" "-1" "--pretty=medium" "--abbrev=40" commit)
1357         (goto-char (point-min))
1358         (when (re-search-forward "^Merge: *\\(.*\\)$" nil t)
1359           (setq parents (cdr (split-string (match-string 1) " +"))))
1360         (when (re-search-forward "^Author: *\\(.*\\) <\\(.*\\)>$" nil t)
1361           (setq author-name (match-string 1))
1362           (setq author-email (match-string 2)))
1363         (when (re-search-forward "^Date: *\\(.*\\)$" nil t)
1364           (setq date (match-string 1)))
1365         (while (re-search-forward "^    \\(.*\\)$" nil t)
1366           (push (match-string 1) msg))
1367         (setq msg (nreverse msg))
1368         (setq subject (pop msg))
1369         (while (and msg (zerop (length (car msg))) (pop msg)))))
1370     (git-setup-log-buffer (get-buffer-create "*git-commit*")
1371                           parents author-name author-email subject date
1372                           (mapconcat #'identity msg "\n"))))
1373
1374 (defun git-get-commit-files (commit)
1375   "Retrieve a sorted list of files modified by COMMIT."
1376   (let (files)
1377     (with-temp-buffer
1378       (git-call-process t "diff-tree" "-m" "-r" "-z" "--name-only" "--no-commit-id" "--root" commit)
1379       (goto-char (point-min))
1380       (while (re-search-forward "\\([^\0]*\\)\0" nil t 1)
1381         (push (match-string 1) files)))
1382     (sort files #'string-lessp)))
1383
1384 (defun git-read-commit-name (prompt &optional default)
1385   "Ask for a commit name, with completion for local branch, remote branch and tag."
1386   (completing-read prompt
1387                    (list* "HEAD" "ORIG_HEAD" "FETCH_HEAD" (mapcar #'car (git-for-each-ref)))
1388                    nil nil nil nil default))
1389
1390 (defun git-checkout (branch &optional merge)
1391   "Checkout a branch, tag, or any commit.
1392 Use a prefix arg if git should merge while checking out."
1393   (interactive
1394    (list (git-read-commit-name "Checkout: ")
1395          current-prefix-arg))
1396   (unless git-status (error "Not in git-status buffer."))
1397   (let ((args (list branch "--")))
1398     (when merge (push "-m" args))
1399     (when (apply #'git-call-process-display-error "checkout" args)
1400       (git-update-status-files))))
1401
1402 (defun git-branch (branch)
1403   "Create a branch from the current HEAD and switch to it."
1404   (interactive (list (git-read-commit-name "Branch: ")))
1405   (unless git-status (error "Not in git-status buffer."))
1406   (if (git-rev-parse (concat "refs/heads/" branch))
1407       (if (yes-or-no-p (format "Branch %s already exists, replace it? " branch))
1408           (and (git-call-process-display-error "branch" "-f" branch)
1409                (git-call-process-display-error "checkout" branch))
1410         (message "Canceled."))
1411     (git-call-process-display-error "checkout" "-b" branch))
1412     (git-refresh-ewoc-hf git-status))
1413
1414 (defun git-amend-commit ()
1415   "Undo the last commit on HEAD, and set things up to commit an
1416 amended version of it."
1417   (interactive)
1418   (unless git-status (error "Not in git-status buffer."))
1419   (when (git-empty-db-p) (error "No commit to amend."))
1420   (let* ((commit (git-rev-parse "HEAD"))
1421          (files (git-get-commit-files commit)))
1422     (when (if (git-rev-parse "HEAD^")
1423               (git-call-process-display-error "reset" "--soft" "HEAD^")
1424             (and (git-update-ref "ORIG_HEAD" commit)
1425                  (git-update-ref "HEAD" nil commit)))
1426       (git-update-status-files files t)
1427       (git-setup-commit-buffer commit)
1428       (git-commit-file))))
1429
1430 (defun git-cherry-pick-commit (arg)
1431   "Cherry-pick a commit."
1432   (interactive (list (git-read-commit-name "Cherry-pick commit: ")))
1433   (unless git-status (error "Not in git-status buffer."))
1434   (let ((commit (git-rev-parse (concat arg "^0"))))
1435     (unless commit (error "Not a valid commit '%s'." arg))
1436     (when (git-rev-parse (concat commit "^2"))
1437       (error "Cannot cherry-pick a merge commit."))
1438     (let ((files (git-get-commit-files commit))
1439           (ok (git-call-process-display-error "cherry-pick" "-n" commit)))
1440       (git-update-status-files files ok)
1441       (with-current-buffer (git-setup-commit-buffer commit)
1442         (goto-char (point-min))
1443         (if (re-search-forward "^\n*Signed-off-by:" nil t 1)
1444             (goto-char (match-beginning 0))
1445           (goto-char (point-max)))
1446         (insert "(cherry picked from commit " commit ")\n"))
1447       (when ok (git-commit-file)))))
1448
1449 (defun git-revert-commit (arg)
1450   "Revert a commit."
1451   (interactive (list (git-read-commit-name "Revert commit: ")))
1452   (unless git-status (error "Not in git-status buffer."))
1453   (let ((commit (git-rev-parse (concat arg "^0"))))
1454     (unless commit (error "Not a valid commit '%s'." arg))
1455     (when (git-rev-parse (concat commit "^2"))
1456       (error "Cannot revert a merge commit."))
1457     (let ((files (git-get-commit-files commit))
1458           (subject (git-get-commit-description commit))
1459           (ok (git-call-process-display-error "revert" "-n" commit)))
1460       (git-update-status-files files ok)
1461       (when (string-match "^[0-9a-f]+ - \\(.*\\)$" subject)
1462         (setq subject (match-string 1 subject)))
1463       (git-setup-log-buffer (get-buffer-create "*git-commit*")
1464                             (git-get-merge-heads) nil nil (format "Revert \"%s\"" subject) nil
1465                             (format "This reverts commit %s.\n" commit))
1466       (when ok (git-commit-file)))))
1467
1468 (defun git-find-file ()
1469   "Visit the current file in its own buffer."
1470   (interactive)
1471   (unless git-status (error "Not in git-status buffer."))
1472   (let ((info (ewoc-data (ewoc-locate git-status))))
1473     (unless (git-expand-directory info)
1474       (find-file (git-fileinfo->name info))
1475       (when (eq 'unmerged (git-fileinfo->state info))
1476         (smerge-mode 1)))))
1477
1478 (defun git-find-file-other-window ()
1479   "Visit the current file in its own buffer in another window."
1480   (interactive)
1481   (unless git-status (error "Not in git-status buffer."))
1482   (let ((info (ewoc-data (ewoc-locate git-status))))
1483     (find-file-other-window (git-fileinfo->name info))
1484     (when (eq 'unmerged (git-fileinfo->state info))
1485       (smerge-mode))))
1486
1487 (defun git-find-file-imerge ()
1488   "Visit the current file in interactive merge mode."
1489   (interactive)
1490   (unless git-status (error "Not in git-status buffer."))
1491   (let ((info (ewoc-data (ewoc-locate git-status))))
1492     (find-file (git-fileinfo->name info))
1493     (smerge-ediff)))
1494
1495 (defun git-view-file ()
1496   "View the current file in its own buffer."
1497   (interactive)
1498   (unless git-status (error "Not in git-status buffer."))
1499   (let ((info (ewoc-data (ewoc-locate git-status))))
1500     (view-file (git-fileinfo->name info))))
1501
1502 (defun git-refresh-status ()
1503   "Refresh the git status buffer."
1504   (interactive)
1505   (unless git-status (error "Not in git-status buffer."))
1506   (message "Refreshing git status...")
1507   (git-update-status-files)
1508   (message "Refreshing git status...done"))
1509
1510 (defun git-status-quit ()
1511   "Quit git-status mode."
1512   (interactive)
1513   (bury-buffer))
1514
1515 ;;;; Major Mode
1516 ;;;; ------------------------------------------------------------
1517
1518 (defvar git-status-mode-hook nil
1519   "Run after `git-status-mode' is setup.")
1520
1521 (defvar git-status-mode-map nil
1522   "Keymap for git major mode.")
1523
1524 (defvar git-status nil
1525   "List of all files managed by the git-status mode.")
1526
1527 (unless git-status-mode-map
1528   (let ((map (make-keymap))
1529         (commit-map (make-sparse-keymap))
1530         (diff-map (make-sparse-keymap))
1531         (toggle-map (make-sparse-keymap)))
1532     (suppress-keymap map)
1533     (define-key map "?"   'git-help)
1534     (define-key map "h"   'git-help)
1535     (define-key map " "   'git-next-file)
1536     (define-key map "a"   'git-add-file)
1537     (define-key map "c"   'git-commit-file)
1538     (define-key map "\C-c" commit-map)
1539     (define-key map "d"    diff-map)
1540     (define-key map "="   'git-diff-file)
1541     (define-key map "f"   'git-find-file)
1542     (define-key map "\r"  'git-find-file)
1543     (define-key map "g"   'git-refresh-status)
1544     (define-key map "i"   'git-ignore-file)
1545     (define-key map "I"   'git-insert-file)
1546     (define-key map "l"   'git-log-file)
1547     (define-key map "m"   'git-mark-file)
1548     (define-key map "M"   'git-mark-all)
1549     (define-key map "n"   'git-next-file)
1550     (define-key map "N"   'git-next-unmerged-file)
1551     (define-key map "o"   'git-find-file-other-window)
1552     (define-key map "p"   'git-prev-file)
1553     (define-key map "P"   'git-prev-unmerged-file)
1554     (define-key map "q"   'git-status-quit)
1555     (define-key map "r"   'git-remove-file)
1556     (define-key map "R"   'git-resolve-file)
1557     (define-key map "t"    toggle-map)
1558     (define-key map "T"   'git-toggle-all-marks)
1559     (define-key map "u"   'git-unmark-file)
1560     (define-key map "U"   'git-revert-file)
1561     (define-key map "v"   'git-view-file)
1562     (define-key map "x"   'git-remove-handled)
1563     (define-key map "\C-?" 'git-unmark-file-up)
1564     (define-key map "\M-\C-?" 'git-unmark-all)
1565     ; the commit submap
1566     (define-key commit-map "\C-a" 'git-amend-commit)
1567     (define-key commit-map "\C-b" 'git-branch)
1568     (define-key commit-map "\C-o" 'git-checkout)
1569     (define-key commit-map "\C-p" 'git-cherry-pick-commit)
1570     (define-key commit-map "\C-v" 'git-revert-commit)
1571     ; the diff submap
1572     (define-key diff-map "b" 'git-diff-file-base)
1573     (define-key diff-map "c" 'git-diff-file-combined)
1574     (define-key diff-map "=" 'git-diff-file)
1575     (define-key diff-map "e" 'git-diff-file-idiff)
1576     (define-key diff-map "E" 'git-find-file-imerge)
1577     (define-key diff-map "h" 'git-diff-file-merge-head)
1578     (define-key diff-map "m" 'git-diff-file-mine)
1579     (define-key diff-map "o" 'git-diff-file-other)
1580     ; the toggle submap
1581     (define-key toggle-map "u" 'git-toggle-show-uptodate)
1582     (define-key toggle-map "i" 'git-toggle-show-ignored)
1583     (define-key toggle-map "k" 'git-toggle-show-unknown)
1584     (define-key toggle-map "m" 'git-toggle-all-marks)
1585     (setq git-status-mode-map map))
1586   (easy-menu-define git-menu git-status-mode-map
1587     "Git Menu"
1588     `("Git"
1589       ["Refresh" git-refresh-status t]
1590       ["Commit" git-commit-file t]
1591       ["Checkout..." git-checkout t]
1592       ["New Branch..." git-branch t]
1593       ["Cherry-pick Commit..." git-cherry-pick-commit t]
1594       ["Revert Commit..." git-revert-commit t]
1595       ("Merge"
1596         ["Next Unmerged File" git-next-unmerged-file t]
1597         ["Prev Unmerged File" git-prev-unmerged-file t]
1598         ["Mark as Resolved" git-resolve-file t]
1599         ["Interactive Merge File" git-find-file-imerge t]
1600         ["Diff Against Common Base File" git-diff-file-base t]
1601         ["Diff Combined" git-diff-file-combined t]
1602         ["Diff Against Merge Head" git-diff-file-merge-head t]
1603         ["Diff Against Mine" git-diff-file-mine t]
1604         ["Diff Against Other" git-diff-file-other t])
1605       "--------"
1606       ["Add File" git-add-file t]
1607       ["Revert File" git-revert-file t]
1608       ["Ignore File" git-ignore-file t]
1609       ["Remove File" git-remove-file t]
1610       ["Insert File" git-insert-file t]
1611       "--------"
1612       ["Find File" git-find-file t]
1613       ["View File" git-view-file t]
1614       ["Diff File" git-diff-file t]
1615       ["Interactive Diff File" git-diff-file-idiff t]
1616       ["Log" git-log-file t]
1617       "--------"
1618       ["Mark" git-mark-file t]
1619       ["Mark All" git-mark-all t]
1620       ["Unmark" git-unmark-file t]
1621       ["Unmark All" git-unmark-all t]
1622       ["Toggle All Marks" git-toggle-all-marks t]
1623       ["Hide Handled Files" git-remove-handled t]
1624       "--------"
1625       ["Show Uptodate Files" git-toggle-show-uptodate :style toggle :selected git-show-uptodate]
1626       ["Show Ignored Files" git-toggle-show-ignored :style toggle :selected git-show-ignored]
1627       ["Show Unknown Files" git-toggle-show-unknown :style toggle :selected git-show-unknown]
1628       "--------"
1629       ["Quit" git-status-quit t])))
1630
1631
1632 ;; git mode should only run in the *git status* buffer
1633 (put 'git-status-mode 'mode-class 'special)
1634
1635 (defun git-status-mode ()
1636   "Major mode for interacting with Git.
1637 Commands:
1638 \\{git-status-mode-map}"
1639   (kill-all-local-variables)
1640   (buffer-disable-undo)
1641   (setq mode-name "git status"
1642         major-mode 'git-status-mode
1643         goal-column 17
1644         buffer-read-only t)
1645   (use-local-map git-status-mode-map)
1646   (let ((buffer-read-only nil))
1647     (erase-buffer)
1648   (let ((status (ewoc-create 'git-fileinfo-prettyprint "" "")))
1649     (set (make-local-variable 'git-status) status))
1650   (set (make-local-variable 'list-buffers-directory) default-directory)
1651   (make-local-variable 'git-show-uptodate)
1652   (make-local-variable 'git-show-ignored)
1653   (make-local-variable 'git-show-unknown)
1654   (run-hooks 'git-status-mode-hook)))
1655
1656 (defun git-find-status-buffer (dir)
1657   "Find the git status buffer handling a specified directory."
1658   (let ((list (buffer-list))
1659         (fulldir (expand-file-name dir))
1660         found)
1661     (while (and list (not found))
1662       (let ((buffer (car list)))
1663         (with-current-buffer buffer
1664           (when (and list-buffers-directory
1665                      (string-equal fulldir (expand-file-name list-buffers-directory))
1666                      (eq major-mode 'git-status-mode))
1667             (setq found buffer))))
1668       (setq list (cdr list)))
1669     found))
1670
1671 (defun git-status (dir)
1672   "Entry point into git-status mode."
1673   (interactive "DSelect directory: ")
1674   (setq dir (git-get-top-dir dir))
1675   (if (file-directory-p (concat (file-name-as-directory dir) ".git"))
1676       (let ((buffer (or (and git-reuse-status-buffer (git-find-status-buffer dir))
1677                         (create-file-buffer (expand-file-name "*git-status*" dir)))))
1678         (switch-to-buffer buffer)
1679         (cd dir)
1680         (git-status-mode)
1681         (git-refresh-status)
1682         (goto-char (point-min))
1683         (add-hook 'after-save-hook 'git-update-saved-file))
1684     (message "%s is not a git working tree." dir)))
1685
1686 (defun git-update-saved-file ()
1687   "Update the corresponding git-status buffer when a file is saved.
1688 Meant to be used in `after-save-hook'."
1689   (let* ((file (expand-file-name buffer-file-name))
1690          (dir (condition-case nil (git-get-top-dir (file-name-directory file)) (error nil)))
1691          (buffer (and dir (git-find-status-buffer dir))))
1692     (when buffer
1693       (with-current-buffer buffer
1694         (let ((filename (file-relative-name file dir)))
1695           ; skip files located inside the .git directory
1696           (unless (string-match "^\\.git/" filename)
1697             (git-call-process nil "add" "--refresh" "--" filename)
1698             (git-update-status-files (list filename))))))))
1699
1700 (defun git-help ()
1701   "Display help for Git mode."
1702   (interactive)
1703   (describe-function 'git-status-mode))
1704
1705 (provide 'git)
1706 ;;; git.el ends here