Warning, /sdk/kde-dev-scripts/kde-emacs/git.el is written in an unsupported language. File is not indexed.

0001 ;;; git.el --- A user interface for git
0002 
0003 ;; Copyright (C) 2005, 2006, 2007, 2008, 2009 Alexandre Julliard <julliard@winehq.org>
0004 
0005 ;; Version: 1.0
0006 
0007 ;; This program is free software; you can redistribute it and/or
0008 ;; modify it under the terms of the GNU General Public License as
0009 ;; published by the Free Software Foundation; either version 2 of
0010 ;; the License, or (at your option) any later version.
0011 ;;
0012 ;; This program is distributed in the hope that it will be
0013 ;; useful, but WITHOUT ANY WARRANTY; without even the implied
0014 ;; warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
0015 ;; PURPOSE.  See the GNU General Public License for more details.
0016 ;;
0017 ;; You should have received a copy of the GNU General Public
0018 ;; License along with this program; if not, write to the Free
0019 ;; Software Foundation, Inc., 59 Temple Place, Suite 330, Boston,
0020 ;; MA 02111-1307 USA
0021 
0022 ;;; Commentary:
0023 
0024 ;; This file contains an interface for the git version control
0025 ;; system. It provides easy access to the most frequently used git
0026 ;; commands. The user interface is as far as possible identical to
0027 ;; that of the PCL-CVS mode.
0028 ;;
0029 ;; To install: put this file on the load-path and place the following
0030 ;; in your .emacs file:
0031 ;;
0032 ;;    (require 'git)
0033 ;;
0034 ;; To start: `M-x git-status'
0035 ;;
0036 ;; TODO
0037 ;;  - diff against other branch
0038 ;;  - renaming files from the status buffer
0039 ;;  - creating tags
0040 ;;  - fetch/pull
0041 ;;  - revlist browser
0042 ;;  - git-show-branch browser
0043 ;;
0044 
0045 ;;; Compatibility:
0046 ;;
0047 ;; This file works on GNU Emacs 21 or later. It may work on older
0048 ;; versions but this is not guaranteed.
0049 ;;
0050 ;; It may work on XEmacs 21, provided that you first install the ewoc
0051 ;; and log-edit packages.
0052 ;;
0053 
0054 (eval-when-compile (require 'cl))
0055 (require 'ewoc)
0056 (require 'log-edit)
0057 (require 'easymenu)
0058 
0059 
0060 ;;;; Customizations
0061 ;;;; ------------------------------------------------------------
0062 
0063 (defgroup git nil
0064   "A user interface for the git versioning system."
0065   :group 'tools)
0066 
0067 (defcustom git-committer-name nil
0068   "User name to use for commits.
0069 The default is to fall back to the repository config,
0070 then to `add-log-full-name' and then to `user-full-name'."
0071   :group 'git
0072   :type '(choice (const :tag "Default" nil)
0073                  (string :tag "Name")))
0074 
0075 (defcustom git-committer-email nil
0076   "Email address to use for commits.
0077 The default is to fall back to the git repository config,
0078 then to `add-log-mailing-address' and then to `user-mail-address'."
0079   :group 'git
0080   :type '(choice (const :tag "Default" nil)
0081                  (string :tag "Email")))
0082 
0083 (defcustom git-commits-coding-system nil
0084   "Default coding system for the log message of git commits."
0085   :group 'git
0086   :type '(choice (const :tag "From repository config" nil)
0087                  (coding-system)))
0088 
0089 (defcustom git-append-signed-off-by nil
0090   "Whether to append a Signed-off-by line to the commit message before editing."
0091   :group 'git
0092   :type 'boolean)
0093 
0094 (defcustom git-reuse-status-buffer t
0095   "Whether `git-status' should try to reuse an existing buffer
0096 if there is already one that displays the same directory."
0097   :group 'git
0098   :type 'boolean)
0099 
0100 (defcustom git-per-dir-ignore-file ".gitignore"
0101   "Name of the per-directory ignore file."
0102   :group 'git
0103   :type 'string)
0104 
0105 (defcustom git-show-uptodate nil
0106   "Whether to display up-to-date files."
0107   :group 'git
0108   :type 'boolean)
0109 
0110 (defcustom git-show-ignored nil
0111   "Whether to display ignored files."
0112   :group 'git
0113   :type 'boolean)
0114 
0115 (defcustom git-show-unknown t
0116   "Whether to display unknown files."
0117   :group 'git
0118   :type 'boolean)
0119 
0120 
0121 (defface git-status-face
0122   '((((class color) (background light)) (:foreground "purple"))
0123     (((class color) (background dark)) (:foreground "salmon")))
0124   "Git mode face used to highlight added and modified files."
0125   :group 'git)
0126 
0127 (defface git-unmerged-face
0128   '((((class color) (background light)) (:foreground "red" :bold t))
0129     (((class color) (background dark)) (:foreground "red" :bold t)))
0130   "Git mode face used to highlight unmerged files."
0131   :group 'git)
0132 
0133 (defface git-unknown-face
0134   '((((class color) (background light)) (:foreground "goldenrod" :bold t))
0135     (((class color) (background dark)) (:foreground "goldenrod" :bold t)))
0136   "Git mode face used to highlight unknown files."
0137   :group 'git)
0138 
0139 (defface git-uptodate-face
0140   '((((class color) (background light)) (:foreground "grey60"))
0141     (((class color) (background dark)) (:foreground "grey40")))
0142   "Git mode face used to highlight up-to-date files."
0143   :group 'git)
0144 
0145 (defface git-ignored-face
0146   '((((class color) (background light)) (:foreground "grey60"))
0147     (((class color) (background dark)) (:foreground "grey40")))
0148   "Git mode face used to highlight ignored files."
0149   :group 'git)
0150 
0151 (defface git-mark-face
0152   '((((class color) (background light)) (:foreground "red" :bold t))
0153     (((class color) (background dark)) (:foreground "tomato" :bold t)))
0154   "Git mode face used for the file marks."
0155   :group 'git)
0156 
0157 (defface git-header-face
0158   '((((class color) (background light)) (:foreground "blue"))
0159     (((class color) (background dark)) (:foreground "blue")))
0160   "Git mode face used for commit headers."
0161   :group 'git)
0162 
0163 (defface git-separator-face
0164   '((((class color) (background light)) (:foreground "brown"))
0165     (((class color) (background dark)) (:foreground "brown")))
0166   "Git mode face used for commit separator."
0167   :group 'git)
0168 
0169 (defface git-permission-face
0170   '((((class color) (background light)) (:foreground "green" :bold t))
0171     (((class color) (background dark)) (:foreground "green" :bold t)))
0172   "Git mode face used for permission changes."
0173   :group 'git)
0174 
0175 
0176 ;;;; Utilities
0177 ;;;; ------------------------------------------------------------
0178 
0179 (defconst git-log-msg-separator "--- log message follows this line ---")
0180 
0181 (defvar git-log-edit-font-lock-keywords
0182   `(("^\\(Author:\\|Date:\\|Merge:\\|Signed-off-by:\\)\\(.*\\)$"
0183      (1 font-lock-keyword-face)
0184      (2 font-lock-function-name-face))
0185     (,(concat "^\\(" (regexp-quote git-log-msg-separator) "\\)$")
0186      (1 font-lock-comment-face))))
0187 
0188 (defun git-get-env-strings (env)
0189   "Build a list of NAME=VALUE strings from a list of environment strings."
0190   (mapcar (lambda (entry) (concat (car entry) "=" (cdr entry))) env))
0191 
0192 (defun git-call-process (buffer &rest args)
0193   "Wrapper for call-process that sets environment strings."
0194   (apply #'call-process "git" nil buffer nil args))
0195 
0196 (defun git-call-process-display-error (&rest args)
0197   "Wrapper for call-process that displays error messages."
0198   (let* ((dir default-directory)
0199          (buffer (get-buffer-create "*Git Command Output*"))
0200          (ok (with-current-buffer buffer
0201                (let ((default-directory dir)
0202                      (buffer-read-only nil))
0203                  (erase-buffer)
0204                  (eq 0 (apply #'git-call-process (list buffer t) args))))))
0205     (unless ok (display-message-or-buffer buffer))
0206     ok))
0207 
0208 (defun git-call-process-string (&rest args)
0209   "Wrapper for call-process that returns the process output as a string,
0210 or nil if the git command failed."
0211   (with-temp-buffer
0212     (and (eq 0 (apply #'git-call-process t args))
0213          (buffer-string))))
0214 
0215 (defun git-call-process-string-display-error (&rest args)
0216   "Wrapper for call-process that displays error message and returns
0217 the process output as a string, or nil if the git command failed."
0218   (with-temp-buffer
0219     (if (eq 0 (apply #'git-call-process (list t t) args))
0220         (buffer-string)
0221       (display-message-or-buffer (current-buffer))
0222       nil)))
0223 
0224 (defun git-run-process-region (buffer start end program args)
0225   "Run a git process with a buffer region as input."
0226   (let ((output-buffer (current-buffer))
0227         (dir default-directory))
0228     (with-current-buffer buffer
0229       (cd dir)
0230       (apply #'call-process-region start end program
0231              nil (list output-buffer t) nil args))))
0232 
0233 (defun git-run-command-buffer (buffer-name &rest args)
0234   "Run a git command, sending the output to a buffer named BUFFER-NAME."
0235   (let ((dir default-directory)
0236         (buffer (get-buffer-create buffer-name)))
0237     (message "Running git %s..." (car args))
0238     (with-current-buffer buffer
0239       (let ((default-directory dir)
0240             (buffer-read-only nil))
0241         (erase-buffer)
0242         (apply #'git-call-process buffer args)))
0243     (message "Running git %s...done" (car args))
0244     buffer))
0245 
0246 (defun git-run-command-region (buffer start end env &rest args)
0247   "Run a git command with specified buffer region as input."
0248   (with-temp-buffer
0249     (if (eq 0 (if env
0250                   (git-run-process-region
0251                    buffer start end "env"
0252                    (append (git-get-env-strings env) (list "git") args))
0253                 (git-run-process-region buffer start end "git" args)))
0254         (buffer-string)
0255       (display-message-or-buffer (current-buffer))
0256       nil)))
0257 
0258 (defun git-run-hook (hook env &rest args)
0259   "Run a git hook and display its output if any."
0260   (let ((dir default-directory)
0261         (hook-name (expand-file-name (concat ".git/hooks/" hook))))
0262     (or (not (file-executable-p hook-name))
0263         (let (status (buffer (get-buffer-create "*Git Hook Output*")))
0264           (with-current-buffer buffer
0265             (erase-buffer)
0266             (cd dir)
0267             (setq status
0268                   (if env
0269                       (apply #'call-process "env" nil (list buffer t) nil
0270                              (append (git-get-env-strings env) (list hook-name) args))
0271                     (apply #'call-process hook-name nil (list buffer t) nil args))))
0272           (display-message-or-buffer buffer)
0273           (eq 0 status)))))
0274 
0275 (defun git-get-string-sha1 (string)
0276   "Read a SHA1 from the specified string."
0277   (and string
0278        (string-match "[0-9a-f]\\{40\\}" string)
0279        (match-string 0 string)))
0280 
0281 (defun git-get-committer-name ()
0282   "Return the name to use as GIT_COMMITTER_NAME."
0283   ; copied from log-edit
0284   (or git-committer-name
0285       (git-config "user.name")
0286       (and (boundp 'add-log-full-name) add-log-full-name)
0287       (and (fboundp 'user-full-name) (user-full-name))
0288       (and (boundp 'user-full-name) user-full-name)))
0289 
0290 (defun git-get-committer-email ()
0291   "Return the email address to use as GIT_COMMITTER_EMAIL."
0292   ; copied from log-edit
0293   (or git-committer-email
0294       (git-config "user.email")
0295       (and (boundp 'add-log-mailing-address) add-log-mailing-address)
0296       (and (fboundp 'user-mail-address) (user-mail-address))
0297       (and (boundp 'user-mail-address) user-mail-address)))
0298 
0299 (defun git-get-commits-coding-system ()
0300   "Return the coding system to use for commits."
0301   (let ((repo-config (git-config "i18n.commitencoding")))
0302     (or git-commits-coding-system
0303         (and repo-config
0304              (fboundp 'locale-charset-to-coding-system)
0305              (locale-charset-to-coding-system repo-config))
0306       'utf-8)))
0307 
0308 (defun git-get-logoutput-coding-system ()
0309   "Return the coding system used for git-log output."
0310   (let ((repo-config (or (git-config "i18n.logoutputencoding")
0311                          (git-config "i18n.commitencoding"))))
0312     (or git-commits-coding-system
0313         (and repo-config
0314              (fboundp 'locale-charset-to-coding-system)
0315              (locale-charset-to-coding-system repo-config))
0316       'utf-8)))
0317 
0318 (defun git-escape-file-name (name)
0319   "Escape a file name if necessary."
0320   (if (string-match "[\n\t\"\\]" name)
0321       (concat "\""
0322               (mapconcat (lambda (c)
0323                    (case c
0324                      (?\n "\\n")
0325                      (?\t "\\t")
0326                      (?\\ "\\\\")
0327                      (?\" "\\\"")
0328                      (t (char-to-string c))))
0329                  name "")
0330               "\"")
0331     name))
0332 
0333 (defun git-success-message (text files)
0334   "Print a success message after having handled FILES."
0335   (let ((n (length files)))
0336     (if (equal n 1)
0337         (message "%s %s" text (car files))
0338       (message "%s %d files" text n))))
0339 
0340 (defun git-get-top-dir (dir)
0341   "Retrieve the top-level directory of a git tree."
0342   (let ((cdup (with-output-to-string
0343                 (with-current-buffer standard-output
0344                   (cd dir)
0345                   (unless (eq 0 (git-call-process t "rev-parse" "--show-cdup"))
0346                     (error "cannot find top-level git tree for %s." dir))))))
0347     (expand-file-name (concat (file-name-as-directory dir)
0348                               (car (split-string cdup "\n"))))))
0349 
0350 ;stolen from pcl-cvs
0351 (defun git-append-to-ignore (file)
0352   "Add a file name to the ignore file in its directory."
0353   (let* ((fullname (expand-file-name file))
0354          (dir (file-name-directory fullname))
0355          (name (file-name-nondirectory fullname))
0356          (ignore-name (expand-file-name git-per-dir-ignore-file dir))
0357          (created (not (file-exists-p ignore-name))))
0358   (save-window-excursion
0359     (set-buffer (find-file-noselect ignore-name))
0360     (goto-char (point-max))
0361     (unless (zerop (current-column)) (insert "\n"))
0362     (insert "/" name "\n")
0363     (sort-lines nil (point-min) (point-max))
0364     (save-buffer))
0365   (when created
0366     (git-call-process nil "update-index" "--add" "--" (file-relative-name ignore-name)))
0367   (git-update-status-files (list (file-relative-name ignore-name)))))
0368 
0369 ; propertize definition for XEmacs, stolen from erc-compat
0370 (eval-when-compile
0371   (unless (fboundp 'propertize)
0372     (defun propertize (string &rest props)
0373       (let ((string (copy-sequence string)))
0374         (while props
0375           (put-text-property 0 (length string) (nth 0 props) (nth 1 props) string)
0376           (setq props (cddr props)))
0377         string))))
0378 
0379 ;;;; Wrappers for basic git commands
0380 ;;;; ------------------------------------------------------------
0381 
0382 (defun git-rev-parse (rev)
0383   "Parse a revision name and return its SHA1."
0384   (git-get-string-sha1
0385    (git-call-process-string "rev-parse" rev)))
0386 
0387 (defun git-config (key)
0388   "Retrieve the value associated to KEY in the git repository config file."
0389   (let ((str (git-call-process-string "config" key)))
0390     (and str (car (split-string str "\n")))))
0391 
0392 (defun git-symbolic-ref (ref)
0393   "Wrapper for the git-symbolic-ref command."
0394   (let ((str (git-call-process-string "symbolic-ref" ref)))
0395     (and str (car (split-string str "\n")))))
0396 
0397 (defun git-update-ref (ref newval &optional oldval reason)
0398   "Update a reference by calling git-update-ref."
0399   (let ((args (and oldval (list oldval))))
0400     (when newval (push newval args))
0401     (push ref args)
0402     (when reason
0403      (push reason args)
0404      (push "-m" args))
0405     (unless newval (push "-d" args))
0406     (apply 'git-call-process-display-error "update-ref" args)))
0407 
0408 (defun git-for-each-ref (&rest specs)
0409   "Return a list of refs using git-for-each-ref.
0410 Each entry is a cons of (SHORT-NAME . FULL-NAME)."
0411   (let (refs)
0412     (with-temp-buffer
0413       (apply #'git-call-process t "for-each-ref" "--format=%(refname)" specs)
0414       (goto-char (point-min))
0415       (while (re-search-forward "^[^/\n]+/[^/\n]+/\\(.+\\)$" nil t)
0416         (push (cons (match-string 1) (match-string 0)) refs)))
0417     (nreverse refs)))
0418 
0419 (defun git-read-tree (tree &optional index-file)
0420   "Read a tree into the index file."
0421   (let ((process-environment
0422          (append (and index-file (list (concat "GIT_INDEX_FILE=" index-file))) process-environment)))
0423     (apply 'git-call-process-display-error "read-tree" (if tree (list tree)))))
0424 
0425 (defun git-write-tree (&optional index-file)
0426   "Call git-write-tree and return the resulting tree SHA1 as a string."
0427   (let ((process-environment
0428          (append (and index-file (list (concat "GIT_INDEX_FILE=" index-file))) process-environment)))
0429     (git-get-string-sha1
0430      (git-call-process-string-display-error "write-tree"))))
0431 
0432 (defun git-commit-tree (buffer tree parent)
0433   "Create a commit and possibly update HEAD.
0434 Create a commit with the message in BUFFER using the tree with hash TREE.
0435 Use PARENT as the parent of the new commit. If PARENT is the current \"HEAD\",
0436 update the \"HEAD\" reference to the new commit."
0437   (let ((author-name (git-get-committer-name))
0438         (author-email (git-get-committer-email))
0439         (subject "commit (initial): ")
0440         author-date log-start log-end args coding-system-for-write)
0441     (when parent
0442       (setq subject "commit: ")
0443       (push "-p" args)
0444       (push parent args))
0445     (with-current-buffer buffer
0446       (goto-char (point-min))
0447       (if
0448           (setq log-start (re-search-forward (concat "^" (regexp-quote git-log-msg-separator) "\n") nil t))
0449           (save-restriction
0450             (narrow-to-region (point-min) log-start)
0451             (goto-char (point-min))
0452             (when (re-search-forward "^Author: +\\(.*?\\) *<\\(.*\\)> *$" nil t)
0453               (setq author-name (match-string 1)
0454                     author-email (match-string 2)))
0455             (goto-char (point-min))
0456             (when (re-search-forward "^Date: +\\(.*\\)$" nil t)
0457               (setq author-date (match-string 1)))
0458             (goto-char (point-min))
0459             (when (re-search-forward "^Merge: +\\(.*\\)" nil t)
0460               (setq subject "commit (merge): ")
0461               (dolist (parent (split-string (match-string 1) " +" t))
0462                 (push "-p" args)
0463                 (push parent args))))
0464         (setq log-start (point-min)))
0465       (setq log-end (point-max))
0466       (goto-char log-start)
0467       (when (re-search-forward ".*$" nil t)
0468         (setq subject (concat subject (match-string 0))))
0469       (setq coding-system-for-write buffer-file-coding-system))
0470     (let ((commit
0471            (git-get-string-sha1
0472             (let ((env `(("GIT_AUTHOR_NAME" . ,author-name)
0473                          ("GIT_AUTHOR_EMAIL" . ,author-email)
0474                          ("GIT_COMMITTER_NAME" . ,(git-get-committer-name))
0475                          ("GIT_COMMITTER_EMAIL" . ,(git-get-committer-email)))))
0476               (when author-date (push `("GIT_AUTHOR_DATE" . ,author-date) env))
0477               (apply #'git-run-command-region
0478                      buffer log-start log-end env
0479                      "commit-tree" tree (nreverse args))))))
0480       (when commit (git-update-ref "HEAD" commit parent subject))
0481       commit)))
0482 
0483 (defun git-empty-db-p ()
0484   "Check if the git db is empty (no commit done yet)."
0485   (not (eq 0 (git-call-process nil "rev-parse" "--verify" "HEAD"))))
0486 
0487 (defun git-get-merge-heads ()
0488   "Retrieve the merge heads from the MERGE_HEAD file if present."
0489   (let (heads)
0490     (when (file-readable-p ".git/MERGE_HEAD")
0491       (with-temp-buffer
0492         (insert-file-contents ".git/MERGE_HEAD" nil nil nil t)
0493         (goto-char (point-min))
0494         (while (re-search-forward "[0-9a-f]\\{40\\}" nil t)
0495           (push (match-string 0) heads))))
0496     (nreverse heads)))
0497 
0498 (defun git-get-commit-description (commit)
0499   "Get a one-line description of COMMIT."
0500   (let ((coding-system-for-read (git-get-logoutput-coding-system)))
0501     (let ((descr (git-call-process-string "log" "--max-count=1" "--pretty=oneline" commit)))
0502       (if (and descr (string-match "\\`\\([0-9a-f]\\{40\\}\\) *\\(.*\\)$" descr))
0503           (concat (substring (match-string 1 descr) 0 10) " - " (match-string 2 descr))
0504         descr))))
0505 
0506 ;;;; File info structure
0507 ;;;; ------------------------------------------------------------
0508 
0509 ; fileinfo structure stolen from pcl-cvs
0510 (defstruct (git-fileinfo
0511             (:copier nil)
0512             (:constructor git-create-fileinfo (state name &optional old-perm new-perm rename-state orig-name marked))
0513             (:conc-name git-fileinfo->))
0514   marked              ;; t/nil
0515   state               ;; current state
0516   name                ;; file name
0517   old-perm new-perm   ;; permission flags
0518   rename-state        ;; rename or copy state
0519   orig-name           ;; original name for renames or copies
0520   needs-update        ;; whether file needs to be updated
0521   needs-refresh)      ;; whether file needs to be refreshed
0522 
0523 (defvar git-status nil)
0524 
0525 (defun git-set-fileinfo-state (info state)
0526   "Set the state of a file info."
0527   (unless (eq (git-fileinfo->state info) state)
0528     (setf (git-fileinfo->state info) state
0529           (git-fileinfo->new-perm info) (git-fileinfo->old-perm info)
0530           (git-fileinfo->rename-state info) nil
0531           (git-fileinfo->orig-name info) nil
0532           (git-fileinfo->needs-update info) nil
0533           (git-fileinfo->needs-refresh info) t)))
0534 
0535 (defun git-status-filenames-map (status func files &rest args)
0536   "Apply FUNC to the status files names in the FILES list.
0537 The list must be sorted."
0538   (when files
0539     (let ((file (pop files))
0540           (node (ewoc-nth status 0)))
0541       (while (and file node)
0542         (let* ((info (ewoc-data node))
0543                (name (git-fileinfo->name info)))
0544           (if (string-lessp name file)
0545               (setq node (ewoc-next status node))
0546             (if (string-equal name file)
0547                 (apply func info args))
0548             (setq file (pop files))))))))
0549 
0550 (defun git-set-filenames-state (status files state)
0551   "Set the state of a list of named files. The list must be sorted"
0552   (when files
0553     (git-status-filenames-map status #'git-set-fileinfo-state files state)
0554     (unless state  ;; delete files whose state has been set to nil
0555       (ewoc-filter status (lambda (info) (git-fileinfo->state info))))))
0556 
0557 (defun git-state-code (code)
0558   "Convert from a string to a added/deleted/modified state."
0559   (case (string-to-char code)
0560     (?M 'modified)
0561     (?? 'unknown)
0562     (?A 'added)
0563     (?D 'deleted)
0564     (?U 'unmerged)
0565     (?T 'modified)
0566     (t nil)))
0567 
0568 (defun git-status-code-as-string (code)
0569   "Format a git status code as string."
0570   (case code
0571     ('modified (propertize "Modified" 'face 'git-status-face))
0572     ('unknown  (propertize "Unknown " 'face 'git-unknown-face))
0573     ('added    (propertize "Added   " 'face 'git-status-face))
0574     ('deleted  (propertize "Deleted " 'face 'git-status-face))
0575     ('unmerged (propertize "Unmerged" 'face 'git-unmerged-face))
0576     ('uptodate (propertize "Uptodate" 'face 'git-uptodate-face))
0577     ('ignored  (propertize "Ignored " 'face 'git-ignored-face))
0578     (t "?       ")))
0579 
0580 (defun git-file-type-as-string (old-perm new-perm)
0581   "Return a string describing the file type based on its permissions."
0582   (let* ((old-type (lsh (or old-perm 0) -9))
0583          (new-type (lsh (or new-perm 0) -9))
0584          (str (case new-type
0585                 (64  ;; file
0586                  (case old-type
0587                    (64 nil)
0588                    (80 "   (type change symlink -> file)")
0589                    (112 "   (type change subproject -> file)")))
0590                  (80  ;; symlink
0591                   (case old-type
0592                     (64 "   (type change file -> symlink)")
0593                     (112 "   (type change subproject -> symlink)")
0594                     (t "   (symlink)")))
0595                   (112  ;; subproject
0596                    (case old-type
0597                      (64 "   (type change file -> subproject)")
0598                      (80 "   (type change symlink -> subproject)")
0599                      (t "   (subproject)")))
0600                   (72 nil)  ;; directory (internal, not a real git state)
0601                   (0  ;; deleted or unknown
0602                    (case old-type
0603                      (80 "   (symlink)")
0604                      (112 "   (subproject)")))
0605                   (t (format "   (unknown type %o)" new-type)))))
0606     (cond (str (propertize str 'face 'git-status-face))
0607           ((eq new-type 72) "/")
0608           (t ""))))
0609 
0610 (defun git-rename-as-string (info)
0611   "Return a string describing the copy or rename associated with INFO, or an empty string if none."
0612   (let ((state (git-fileinfo->rename-state info)))
0613     (if state
0614         (propertize
0615          (concat "   ("
0616                  (if (eq state 'copy) "copied from "
0617                    (if (eq (git-fileinfo->state info) 'added) "renamed from "
0618                      "renamed to "))
0619                  (git-escape-file-name (git-fileinfo->orig-name info))
0620                  ")") 'face 'git-status-face)
0621       "")))
0622 
0623 (defun git-permissions-as-string (old-perm new-perm)
0624   "Format a permission change as string."
0625   (propertize
0626    (if (or (not old-perm)
0627            (not new-perm)
0628            (eq 0 (logand ?\111 (logxor old-perm new-perm))))
0629        "  "
0630      (if (eq 0 (logand ?\111 old-perm)) "+x" "-x"))
0631   'face 'git-permission-face))
0632 
0633 (defun git-fileinfo-prettyprint (info)
0634   "Pretty-printer for the git-fileinfo structure."
0635   (let ((old-perm (git-fileinfo->old-perm info))
0636         (new-perm (git-fileinfo->new-perm info)))
0637     (insert (concat "   " (if (git-fileinfo->marked info) (propertize "*" 'face 'git-mark-face) " ")
0638                     " " (git-status-code-as-string (git-fileinfo->state info))
0639                     " " (git-permissions-as-string old-perm new-perm)
0640                     "  " (git-escape-file-name (git-fileinfo->name info))
0641                     (git-file-type-as-string old-perm new-perm)
0642                     (git-rename-as-string info)))))
0643 
0644 (defun git-update-node-fileinfo (node info)
0645   "Update the fileinfo of the specified node. The names are assumed to match already."
0646   (let ((data (ewoc-data node)))
0647     (setf
0648      ;; preserve the marked flag
0649      (git-fileinfo->marked info) (git-fileinfo->marked data)
0650      (git-fileinfo->needs-update data) nil)
0651     (when (not (equal info data))
0652       (setf (git-fileinfo->needs-refresh info) t
0653             (ewoc-data node) info))))
0654 
0655 (defun git-insert-info-list (status infolist files)
0656   "Insert a sorted list of file infos in the status buffer, replacing existing ones if any."
0657   (let* ((info (pop infolist))
0658          (node (ewoc-nth status 0))
0659          (name (and info (git-fileinfo->name info)))
0660          remaining)
0661     (while info
0662       (let ((nodename (and node (git-fileinfo->name (ewoc-data node)))))
0663         (while (and files (string-lessp (car files) name))
0664           (push (pop files) remaining))
0665         (when (and files (string-equal (car files) name))
0666           (setq files (cdr files)))
0667         (cond ((not nodename)
0668                (setq node (ewoc-enter-last status info))
0669                (setq info (pop infolist))
0670                (setq name (and info (git-fileinfo->name info))))
0671               ((string-lessp nodename name)
0672                (setq node (ewoc-next status node)))
0673               ((string-equal nodename name)
0674                ;; preserve the marked flag
0675                (git-update-node-fileinfo node info)
0676                (setq info (pop infolist))
0677                (setq name (and info (git-fileinfo->name info))))
0678               (t
0679                (setq node (ewoc-enter-before status node info))
0680                (setq info (pop infolist))
0681                (setq name (and info (git-fileinfo->name info)))))))
0682     (nconc (nreverse remaining) files)))
0683 
0684 (defun git-run-diff-index (status files)
0685   "Run git-diff-index on FILES and parse the results into STATUS.
0686 Return the list of files that haven't been handled."
0687   (let (infolist)
0688     (with-temp-buffer
0689       (apply #'git-call-process t "diff-index" "-z" "-M" "HEAD" "--" files)
0690       (goto-char (point-min))
0691       (while (re-search-forward
0692               ":\\([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"
0693               nil t 1)
0694         (let ((old-perm (string-to-number (match-string 1) 8))
0695               (new-perm (string-to-number (match-string 2) 8))
0696               (state (or (match-string 4) (match-string 6)))
0697               (name (or (match-string 5) (match-string 7)))
0698               (new-name (match-string 8)))
0699           (if new-name  ; copy or rename
0700               (if (eq ?C (string-to-char state))
0701                   (push (git-create-fileinfo 'added new-name old-perm new-perm 'copy name) infolist)
0702                 (push (git-create-fileinfo 'deleted name 0 0 'rename new-name) infolist)
0703                 (push (git-create-fileinfo 'added new-name old-perm new-perm 'rename name) infolist))
0704             (push (git-create-fileinfo (git-state-code state) name old-perm new-perm) infolist)))))
0705     (setq infolist (sort (nreverse infolist)
0706                          (lambda (info1 info2)
0707                            (string-lessp (git-fileinfo->name info1)
0708                                          (git-fileinfo->name info2)))))
0709     (git-insert-info-list status infolist files)))
0710 
0711 (defun git-find-status-file (status file)
0712   "Find a given file in the status ewoc and return its node."
0713   (let ((node (ewoc-nth status 0)))
0714     (while (and node (not (string= file (git-fileinfo->name (ewoc-data node)))))
0715       (setq node (ewoc-next status node)))
0716     node))
0717 
0718 (defun git-run-ls-files (status files default-state &rest options)
0719   "Run git-ls-files on FILES and parse the results into STATUS.
0720 Return the list of files that haven't been handled."
0721   (let (infolist)
0722     (with-temp-buffer
0723       (apply #'git-call-process t "ls-files" "-z" (append options (list "--") files))
0724       (goto-char (point-min))
0725       (while (re-search-forward "\\([^\0]*?\\)\\(/?\\)\0" nil t 1)
0726         (let ((name (match-string 1)))
0727           (push (git-create-fileinfo default-state name 0
0728                                      (if (string-equal "/" (match-string 2)) (lsh ?\110 9) 0))
0729                 infolist))))
0730     (setq infolist (nreverse infolist))  ;; assume it is sorted already
0731     (git-insert-info-list status infolist files)))
0732 
0733 (defun git-run-ls-files-cached (status files default-state)
0734   "Run git-ls-files -c on FILES and parse the results into STATUS.
0735 Return the list of files that haven't been handled."
0736   (let (infolist)
0737     (with-temp-buffer
0738       (apply #'git-call-process t "ls-files" "-z" "-s" "-c" "--" files)
0739       (goto-char (point-min))
0740       (while (re-search-forward "\\([0-7]\\{6\\}\\) [0-9a-f]\\{40\\} 0\t\\([^\0]+\\)\0" nil t)
0741         (let* ((new-perm (string-to-number (match-string 1) 8))
0742                (old-perm (if (eq default-state 'added) 0 new-perm))
0743                (name (match-string 2)))
0744           (push (git-create-fileinfo default-state name old-perm new-perm) infolist))))
0745     (setq infolist (nreverse infolist))  ;; assume it is sorted already
0746     (git-insert-info-list status infolist files)))
0747 
0748 (defun git-run-ls-unmerged (status files)
0749   "Run git-ls-files -u on FILES and parse the results into STATUS."
0750   (with-temp-buffer
0751     (apply #'git-call-process t "ls-files" "-z" "-u" "--" files)
0752     (goto-char (point-min))
0753     (let (unmerged-files)
0754       (while (re-search-forward "[0-7]\\{6\\} [0-9a-f]\\{40\\} [123]\t\\([^\0]+\\)\0" nil t)
0755         (push (match-string 1) unmerged-files))
0756       (setq unmerged-files (nreverse unmerged-files))  ;; assume it is sorted already
0757       (git-set-filenames-state status unmerged-files 'unmerged))))
0758 
0759 (defun git-get-exclude-files ()
0760   "Get the list of exclude files to pass to git-ls-files."
0761   (let (files
0762         (config (git-config "core.excludesfile")))
0763     (when (file-readable-p ".git/info/exclude")
0764       (push ".git/info/exclude" files))
0765     (when (and config (file-readable-p config))
0766       (push config files))
0767     files))
0768 
0769 (defun git-run-ls-files-with-excludes (status files default-state &rest options)
0770   "Run git-ls-files on FILES with appropriate --exclude-from options."
0771   (let ((exclude-files (git-get-exclude-files)))
0772     (apply #'git-run-ls-files status files default-state "--directory" "--no-empty-directory"
0773            (concat "--exclude-per-directory=" git-per-dir-ignore-file)
0774            (append options (mapcar (lambda (f) (concat "--exclude-from=" f)) exclude-files)))))
0775 
0776 (defun git-update-status-files (&optional files mark-files)
0777   "Update the status of FILES from the index.
0778 The FILES list must be sorted."
0779   (unless git-status (error "Not in git-status buffer."))
0780   ;; set the needs-update flag on existing files
0781   (if files
0782       (git-status-filenames-map
0783        git-status (lambda (info) (setf (git-fileinfo->needs-update info) t)) files)
0784     (ewoc-map (lambda (info) (setf (git-fileinfo->needs-update info) t) nil) git-status)
0785     (git-call-process nil "update-index" "--refresh")
0786     (when git-show-uptodate
0787       (git-run-ls-files-cached git-status nil 'uptodate)))
0788   (let ((remaining-files
0789           (if (git-empty-db-p) ; we need some special handling for an empty db
0790               (git-run-ls-files-cached git-status files 'added)
0791             (git-run-diff-index git-status files))))
0792     (git-run-ls-unmerged git-status files)
0793     (when (or remaining-files (and git-show-unknown (not files)))
0794       (setq remaining-files (git-run-ls-files-with-excludes git-status remaining-files 'unknown "-o")))
0795     (when (or remaining-files (and git-show-ignored (not files)))
0796       (setq remaining-files (git-run-ls-files-with-excludes git-status remaining-files 'ignored "-o" "-i")))
0797     (unless files
0798       (setq remaining-files (git-get-filenames (ewoc-collect git-status #'git-fileinfo->needs-update))))
0799     (when remaining-files
0800       (setq remaining-files (git-run-ls-files-cached git-status remaining-files 'uptodate)))
0801     (git-set-filenames-state git-status remaining-files nil)
0802     (when mark-files (git-mark-files git-status files))
0803     (git-refresh-files)
0804     (git-refresh-ewoc-hf git-status)))
0805 
0806 (defun git-mark-files (status files)
0807   "Mark all the specified FILES, and unmark the others."
0808   (let ((file (and files (pop files)))
0809         (node (ewoc-nth status 0)))
0810     (while node
0811       (let ((info (ewoc-data node)))
0812         (if (and file (string-equal (git-fileinfo->name info) file))
0813             (progn
0814               (unless (git-fileinfo->marked info)
0815                 (setf (git-fileinfo->marked info) t)
0816                 (setf (git-fileinfo->needs-refresh info) t))
0817               (setq file (pop files))
0818               (setq node (ewoc-next status node)))
0819           (when (git-fileinfo->marked info)
0820             (setf (git-fileinfo->marked info) nil)
0821             (setf (git-fileinfo->needs-refresh info) t))
0822           (if (and file (string-lessp file (git-fileinfo->name info)))
0823               (setq file (pop files))
0824             (setq node (ewoc-next status node))))))))
0825 
0826 (defun git-marked-files ()
0827   "Return a list of all marked files, or if none a list containing just the file at cursor position."
0828   (unless git-status (error "Not in git-status buffer."))
0829   (or (ewoc-collect git-status (lambda (info) (git-fileinfo->marked info)))
0830       (list (ewoc-data (ewoc-locate git-status)))))
0831 
0832 (defun git-marked-files-state (&rest states)
0833   "Return a sorted list of marked files that are in the specified states."
0834   (let ((files (git-marked-files))
0835         result)
0836     (dolist (info files)
0837       (when (memq (git-fileinfo->state info) states)
0838         (push info result)))
0839     (nreverse result)))
0840 
0841 (defun git-refresh-files ()
0842   "Refresh all files that need it and clear the needs-refresh flag."
0843   (unless git-status (error "Not in git-status buffer."))
0844   (ewoc-map
0845    (lambda (info)
0846      (let ((refresh (git-fileinfo->needs-refresh info)))
0847        (setf (git-fileinfo->needs-refresh info) nil)
0848        refresh))
0849    git-status)
0850   ; move back to goal column
0851   (when goal-column (move-to-column goal-column)))
0852 
0853 (defun git-refresh-ewoc-hf (status)
0854   "Refresh the ewoc header and footer."
0855   (let ((branch (git-symbolic-ref "HEAD"))
0856         (head (if (git-empty-db-p) "Nothing committed yet"
0857                 (git-get-commit-description "HEAD")))
0858         (merge-heads (git-get-merge-heads)))
0859     (ewoc-set-hf status
0860                  (format "Directory:  %s\nBranch:     %s\nHead:       %s%s\n"
0861                          default-directory
0862                          (if branch
0863                              (if (string-match "^refs/heads/" branch)
0864                                  (substring branch (match-end 0))
0865                                branch)
0866                            "none (detached HEAD)")
0867                          head
0868                          (if merge-heads
0869                              (concat "\nMerging:    "
0870                                      (mapconcat (lambda (str) (git-get-commit-description str)) merge-heads "\n            "))
0871                            ""))
0872                  (if (ewoc-nth status 0) "" "    No changes."))))
0873 
0874 (defun git-get-filenames (files)
0875   (mapcar (lambda (info) (git-fileinfo->name info)) files))
0876 
0877 (defun git-update-index (index-file files)
0878   "Run git-update-index on a list of files."
0879   (let ((process-environment (append (and index-file (list (concat "GIT_INDEX_FILE=" index-file)))
0880                                      process-environment))
0881         added deleted modified)
0882     (dolist (info files)
0883       (case (git-fileinfo->state info)
0884         ('added (push info added))
0885         ('deleted (push info deleted))
0886         ('modified (push info modified))))
0887     (and
0888      (or (not added) (apply #'git-call-process-display-error "update-index" "--add" "--" (git-get-filenames added)))
0889      (or (not deleted) (apply #'git-call-process-display-error "update-index" "--remove" "--" (git-get-filenames deleted)))
0890      (or (not modified) (apply #'git-call-process-display-error "update-index" "--" (git-get-filenames modified))))))
0891 
0892 (defun git-run-pre-commit-hook ()
0893   "Run the pre-commit hook if any."
0894   (unless git-status (error "Not in git-status buffer."))
0895   (let ((files (git-marked-files-state 'added 'deleted 'modified)))
0896     (or (not files)
0897         (not (file-executable-p ".git/hooks/pre-commit"))
0898         (let ((index-file (make-temp-file "gitidx")))
0899           (unwind-protect
0900             (let ((head-tree (unless (git-empty-db-p) (git-rev-parse "HEAD^{tree}"))))
0901               (git-read-tree head-tree index-file)
0902               (git-update-index index-file files)
0903               (git-run-hook "pre-commit" `(("GIT_INDEX_FILE" . ,index-file))))
0904           (delete-file index-file))))))
0905 
0906 (defun git-do-commit ()
0907   "Perform the actual commit using the current buffer as log message."
0908   (interactive)
0909   (let ((buffer (current-buffer))
0910         (index-file (make-temp-file "gitidx")))
0911     (with-current-buffer log-edit-parent-buffer
0912       (if (git-marked-files-state 'unmerged)
0913           (message "You cannot commit unmerged files, resolve them first.")
0914         (unwind-protect
0915             (let ((files (git-marked-files-state 'added 'deleted 'modified))
0916                   head tree head-tree)
0917               (unless (git-empty-db-p)
0918                 (setq head (git-rev-parse "HEAD")
0919                       head-tree (git-rev-parse "HEAD^{tree}")))
0920               (message "Running git commit...")
0921               (when
0922                   (and
0923                    (git-read-tree head-tree index-file)
0924                    (git-update-index nil files)         ;update both the default index
0925                    (git-update-index index-file files)  ;and the temporary one
0926                    (setq tree (git-write-tree index-file)))
0927                 (if (or (not (string-equal tree head-tree))
0928                         (yes-or-no-p "The tree was not modified, do you really want to perform an empty commit? "))
0929                     (let ((commit (git-commit-tree buffer tree head)))
0930                       (when commit
0931                         (condition-case nil (delete-file ".git/MERGE_HEAD") (error nil))
0932                         (condition-case nil (delete-file ".git/MERGE_MSG") (error nil))
0933                         (with-current-buffer buffer (erase-buffer))
0934                         (git-update-status-files (git-get-filenames files))
0935                         (git-call-process nil "rerere")
0936                         (git-call-process nil "gc" "--auto")
0937                         (message "Committed %s." commit)
0938                         (git-run-hook "post-commit" nil)))
0939                   (message "Commit aborted."))))
0940           (delete-file index-file))))))
0941 
0942 
0943 ;;;; Interactive functions
0944 ;;;; ------------------------------------------------------------
0945 
0946 (defun git-mark-file ()
0947   "Mark the file that the cursor is on and move to the next one."
0948   (interactive)
0949   (unless git-status (error "Not in git-status buffer."))
0950   (let* ((pos (ewoc-locate git-status))
0951          (info (ewoc-data pos)))
0952     (setf (git-fileinfo->marked info) t)
0953     (ewoc-invalidate git-status pos)
0954     (ewoc-goto-next git-status 1)))
0955 
0956 (defun git-unmark-file ()
0957   "Unmark the file that the cursor is on and move to the next one."
0958   (interactive)
0959   (unless git-status (error "Not in git-status buffer."))
0960   (let* ((pos (ewoc-locate git-status))
0961          (info (ewoc-data pos)))
0962     (setf (git-fileinfo->marked info) nil)
0963     (ewoc-invalidate git-status pos)
0964     (ewoc-goto-next git-status 1)))
0965 
0966 (defun git-unmark-file-up ()
0967   "Unmark the file that the cursor is on and move to the previous one."
0968   (interactive)
0969   (unless git-status (error "Not in git-status buffer."))
0970   (let* ((pos (ewoc-locate git-status))
0971          (info (ewoc-data pos)))
0972     (setf (git-fileinfo->marked info) nil)
0973     (ewoc-invalidate git-status pos)
0974     (ewoc-goto-prev git-status 1)))
0975 
0976 (defun git-mark-all ()
0977   "Mark all files."
0978   (interactive)
0979   (unless git-status (error "Not in git-status buffer."))
0980   (ewoc-map (lambda (info) (unless (git-fileinfo->marked info)
0981                              (setf (git-fileinfo->marked info) t))) git-status)
0982   ; move back to goal column after invalidate
0983   (when goal-column (move-to-column goal-column)))
0984 
0985 (defun git-unmark-all ()
0986   "Unmark all files."
0987   (interactive)
0988   (unless git-status (error "Not in git-status buffer."))
0989   (ewoc-map (lambda (info) (when (git-fileinfo->marked info)
0990                              (setf (git-fileinfo->marked info) nil)
0991                              t)) git-status)
0992   ; move back to goal column after invalidate
0993   (when goal-column (move-to-column goal-column)))
0994 
0995 (defun git-toggle-all-marks ()
0996   "Toggle all file marks."
0997   (interactive)
0998   (unless git-status (error "Not in git-status buffer."))
0999   (ewoc-map (lambda (info) (setf (git-fileinfo->marked info) (not (git-fileinfo->marked info))) t) git-status)
1000   ; move back to goal column after invalidate
1001   (when goal-column (move-to-column goal-column)))
1002 
1003 (defun git-next-file (&optional n)
1004   "Move the selection down N files."
1005   (interactive "p")
1006   (unless git-status (error "Not in git-status buffer."))
1007   (ewoc-goto-next git-status n))
1008 
1009 (defun git-prev-file (&optional n)
1010   "Move the selection up N files."
1011   (interactive "p")
1012   (unless git-status (error "Not in git-status buffer."))
1013   (ewoc-goto-prev git-status n))
1014 
1015 (defun git-next-unmerged-file (&optional n)
1016   "Move the selection down N unmerged files."
1017   (interactive "p")
1018   (unless git-status (error "Not in git-status buffer."))
1019   (let* ((last (ewoc-locate git-status))
1020          (node (ewoc-next git-status last)))
1021     (while (and node (> n 0))
1022       (when (eq 'unmerged (git-fileinfo->state (ewoc-data node)))
1023         (setq n (1- n))
1024         (setq last node))
1025       (setq node (ewoc-next git-status node)))
1026     (ewoc-goto-node git-status last)))
1027 
1028 (defun git-prev-unmerged-file (&optional n)
1029   "Move the selection up N unmerged files."
1030   (interactive "p")
1031   (unless git-status (error "Not in git-status buffer."))
1032   (let* ((last (ewoc-locate git-status))
1033          (node (ewoc-prev git-status last)))
1034     (while (and node (> n 0))
1035       (when (eq 'unmerged (git-fileinfo->state (ewoc-data node)))
1036         (setq n (1- n))
1037         (setq last node))
1038       (setq node (ewoc-prev git-status node)))
1039     (ewoc-goto-node git-status last)))
1040 
1041 (defun git-insert-file (file)
1042   "Insert file(s) into the git-status buffer."
1043   (interactive "fInsert file: ")
1044   (git-update-status-files (list (file-relative-name file))))
1045 
1046 (defun git-add-file ()
1047   "Add marked file(s) to the index cache."
1048   (interactive)
1049   (let ((files (git-get-filenames (git-marked-files-state 'unknown 'ignored 'unmerged))))
1050     ;; FIXME: add support for directories
1051     (unless files
1052       (push (file-relative-name (read-file-name "File to add: " nil nil t)) files))
1053     (when (apply 'git-call-process-display-error "update-index" "--add" "--" files)
1054       (git-update-status-files files)
1055       (git-success-message "Added" files))))
1056 
1057 (defun git-ignore-file ()
1058   "Add marked file(s) to the ignore list."
1059   (interactive)
1060   (let ((files (git-get-filenames (git-marked-files-state 'unknown))))
1061     (unless files
1062       (push (file-relative-name (read-file-name "File to ignore: " nil nil t)) files))
1063     (dolist (f files) (git-append-to-ignore f))
1064     (git-update-status-files files)
1065     (git-success-message "Ignored" files)))
1066 
1067 (defun git-remove-file ()
1068   "Remove the marked file(s)."
1069   (interactive)
1070   (let ((files (git-get-filenames (git-marked-files-state 'added 'modified 'unknown 'uptodate 'ignored))))
1071     (unless files
1072       (push (file-relative-name (read-file-name "File to remove: " nil nil t)) files))
1073     (if (yes-or-no-p
1074          (if (cdr files)
1075              (format "Remove %d files? " (length files))
1076            (format "Remove %s? " (car files))))
1077         (progn
1078           (dolist (name files)
1079             (ignore-errors
1080               (if (file-directory-p name)
1081                   (delete-directory name)
1082                 (delete-file name))))
1083           (when (apply 'git-call-process-display-error "update-index" "--remove" "--" files)
1084             (git-update-status-files files)
1085             (git-success-message "Removed" files)))
1086       (message "Aborting"))))
1087 
1088 (defun git-revert-file ()
1089   "Revert changes to the marked file(s)."
1090   (interactive)
1091   (let ((files (git-marked-files-state 'added 'deleted 'modified 'unmerged))
1092         added modified)
1093     (when (and files
1094                (yes-or-no-p
1095                 (if (cdr files)
1096                     (format "Revert %d files? " (length files))
1097                   (format "Revert %s? " (git-fileinfo->name (car files))))))
1098       (dolist (info files)
1099         (case (git-fileinfo->state info)
1100           ('added (push (git-fileinfo->name info) added))
1101           ('deleted (push (git-fileinfo->name info) modified))
1102           ('unmerged (push (git-fileinfo->name info) modified))
1103           ('modified (push (git-fileinfo->name info) modified))))
1104       ;; check if a buffer contains one of the files and isn't saved
1105       (dolist (file modified)
1106         (let ((buffer (get-file-buffer file)))
1107           (when (and buffer (buffer-modified-p buffer))
1108             (error "Buffer %s is modified. Please kill or save modified buffers before reverting." (buffer-name buffer)))))
1109       (let ((ok (and
1110                  (or (not added)
1111                      (apply 'git-call-process-display-error "update-index" "--force-remove" "--" added))
1112                  (or (not modified)
1113                      (apply 'git-call-process-display-error "checkout" "HEAD" modified))))
1114             (names (git-get-filenames files)))
1115         (git-update-status-files names)
1116         (when ok
1117           (dolist (file modified)
1118             (let ((buffer (get-file-buffer file)))
1119               (when buffer (with-current-buffer buffer (revert-buffer t t t)))))
1120           (git-success-message "Reverted" names))))))
1121 
1122 (defun git-remove-handled ()
1123   "Remove handled files from the status list."
1124   (interactive)
1125   (ewoc-filter git-status
1126                (lambda (info)
1127                  (case (git-fileinfo->state info)
1128                    ('ignored git-show-ignored)
1129                    ('uptodate git-show-uptodate)
1130                    ('unknown git-show-unknown)
1131                    (t t))))
1132   (unless (ewoc-nth git-status 0)  ; refresh header if list is empty
1133     (git-refresh-ewoc-hf git-status)))
1134 
1135 (defun git-toggle-show-uptodate ()
1136   "Toogle the option for showing up-to-date files."
1137   (interactive)
1138   (if (setq git-show-uptodate (not git-show-uptodate))
1139       (git-refresh-status)
1140     (git-remove-handled)))
1141 
1142 (defun git-toggle-show-ignored ()
1143   "Toogle the option for showing ignored files."
1144   (interactive)
1145   (if (setq git-show-ignored (not git-show-ignored))
1146       (progn
1147         (message "Inserting ignored files...")
1148         (git-run-ls-files-with-excludes git-status nil 'ignored "-o" "-i")
1149         (git-refresh-files)
1150         (git-refresh-ewoc-hf git-status)
1151         (message "Inserting ignored files...done"))
1152     (git-remove-handled)))
1153 
1154 (defun git-toggle-show-unknown ()
1155   "Toogle the option for showing unknown files."
1156   (interactive)
1157   (if (setq git-show-unknown (not git-show-unknown))
1158       (progn
1159         (message "Inserting unknown files...")
1160         (git-run-ls-files-with-excludes git-status nil 'unknown "-o")
1161         (git-refresh-files)
1162         (git-refresh-ewoc-hf git-status)
1163         (message "Inserting unknown files...done"))
1164     (git-remove-handled)))
1165 
1166 (defun git-expand-directory (info)
1167   "Expand the directory represented by INFO to list its files."
1168   (when (eq (lsh (git-fileinfo->new-perm info) -9) ?\110)
1169     (let ((dir (git-fileinfo->name info)))
1170       (git-set-filenames-state git-status (list dir) nil)
1171       (git-run-ls-files-with-excludes git-status (list (concat dir "/")) 'unknown "-o")
1172       (git-refresh-files)
1173       (git-refresh-ewoc-hf git-status)
1174       t)))
1175 
1176 (defun git-setup-diff-buffer (buffer)
1177   "Setup a buffer for displaying a diff."
1178   (let ((dir default-directory))
1179     (with-current-buffer buffer
1180       (diff-mode)
1181       (goto-char (point-min))
1182       (setq default-directory dir)
1183       (setq buffer-read-only t)))
1184   (display-buffer buffer)
1185   ; shrink window only if it displays the status buffer
1186   (when (eq (window-buffer) (current-buffer))
1187     (shrink-window-if-larger-than-buffer)))
1188 
1189 (defun git-diff-file ()
1190   "Diff the marked file(s) against HEAD."
1191   (interactive)
1192   (let ((files (git-marked-files)))
1193     (git-setup-diff-buffer
1194      (apply #'git-run-command-buffer "*git-diff*" "diff-index" "-p" "-M" "HEAD" "--" (git-get-filenames files)))))
1195 
1196 (defun git-diff-file-merge-head (arg)
1197   "Diff the marked file(s) against the first merge head (or the nth one with a numeric prefix)."
1198   (interactive "p")
1199   (let ((files (git-marked-files))
1200         (merge-heads (git-get-merge-heads)))
1201     (unless merge-heads (error "No merge in progress"))
1202     (git-setup-diff-buffer
1203      (apply #'git-run-command-buffer "*git-diff*" "diff-index" "-p" "-M"
1204             (or (nth (1- arg) merge-heads) "HEAD") "--" (git-get-filenames files)))))
1205 
1206 (defun git-diff-unmerged-file (stage)
1207   "Diff the marked unmerged file(s) against the specified stage."
1208   (let ((files (git-marked-files)))
1209     (git-setup-diff-buffer
1210      (apply #'git-run-command-buffer "*git-diff*" "diff-files" "-p" stage "--" (git-get-filenames files)))))
1211 
1212 (defun git-diff-file-base ()
1213   "Diff the marked unmerged file(s) against the common base file."
1214   (interactive)
1215   (git-diff-unmerged-file "-1"))
1216 
1217 (defun git-diff-file-mine ()
1218   "Diff the marked unmerged file(s) against my pre-merge version."
1219   (interactive)
1220   (git-diff-unmerged-file "-2"))
1221 
1222 (defun git-diff-file-other ()
1223   "Diff the marked unmerged file(s) against the other's pre-merge version."
1224   (interactive)
1225   (git-diff-unmerged-file "-3"))
1226 
1227 (defun git-diff-file-combined ()
1228   "Do a combined diff of the marked unmerged file(s)."
1229   (interactive)
1230   (git-diff-unmerged-file "-c"))
1231 
1232 (defun git-diff-file-idiff ()
1233   "Perform an interactive diff on the current file."
1234   (interactive)
1235   (let ((files (git-marked-files-state 'added 'deleted 'modified)))
1236     (unless (eq 1 (length files))
1237       (error "Cannot perform an interactive diff on multiple files."))
1238     (let* ((filename (car (git-get-filenames files)))
1239            (buff1 (find-file-noselect filename))
1240            (buff2 (git-run-command-buffer (concat filename ".~HEAD~") "cat-file" "blob" (concat "HEAD:" filename))))
1241       (ediff-buffers buff1 buff2))))
1242 
1243 (defun git-log-file ()
1244   "Display a log of changes to the marked file(s)."
1245   (interactive)
1246   (let* ((files (git-marked-files))
1247          (coding-system-for-read git-commits-coding-system)
1248          (buffer (apply #'git-run-command-buffer "*git-log*" "rev-list" "--pretty" "HEAD" "--" (git-get-filenames files))))
1249     (with-current-buffer buffer
1250       ; (git-log-mode)  FIXME: implement log mode
1251       (goto-char (point-min))
1252       (setq buffer-read-only t))
1253     (display-buffer buffer)))
1254 
1255 (defun git-log-edit-files ()
1256   "Return a list of marked files for use in the log-edit buffer."
1257   (with-current-buffer log-edit-parent-buffer
1258     (git-get-filenames (git-marked-files-state 'added 'deleted 'modified))))
1259 
1260 (defun git-log-edit-diff ()
1261   "Run a diff of the current files being committed from a log-edit buffer."
1262   (with-current-buffer log-edit-parent-buffer
1263     (git-diff-file)))
1264 
1265 (defun git-append-sign-off (name email)
1266   "Append a Signed-off-by entry to the current buffer, avoiding duplicates."
1267   (let ((sign-off (format "Signed-off-by: %s <%s>" name email))
1268         (case-fold-search t))
1269     (goto-char (point-min))
1270     (unless (re-search-forward (concat "^" (regexp-quote sign-off)) nil t)
1271       (goto-char (point-min))
1272       (unless (re-search-forward "^Signed-off-by: " nil t)
1273         (setq sign-off (concat "\n" sign-off)))
1274       (goto-char (point-max))
1275       (insert sign-off "\n"))))
1276 
1277 (defun git-setup-log-buffer (buffer &optional merge-heads author-name author-email subject date msg)
1278   "Setup the log buffer for a commit."
1279   (unless git-status (error "Not in git-status buffer."))
1280   (let ((dir default-directory)
1281         (committer-name (git-get-committer-name))
1282         (committer-email (git-get-committer-email))
1283         (sign-off git-append-signed-off-by))
1284     (with-current-buffer buffer
1285       (cd dir)
1286       (erase-buffer)
1287       (insert
1288        (propertize
1289         (format "Author: %s <%s>\n%s%s"
1290                 (or author-name committer-name)
1291                 (or author-email committer-email)
1292                 (if date (format "Date: %s\n" date) "")
1293                 (if merge-heads
1294                     (format "Merge: %s\n"
1295                             (mapconcat 'identity merge-heads " "))
1296                   ""))
1297         'face 'git-header-face)
1298        (propertize git-log-msg-separator 'face 'git-separator-face)
1299        "\n")
1300       (when subject (insert subject "\n\n"))
1301       (cond (msg (insert msg "\n"))
1302             ((file-readable-p ".git/rebase-apply/msg")
1303              (insert-file-contents ".git/rebase-apply/msg"))
1304             ((file-readable-p ".git/MERGE_MSG")
1305              (insert-file-contents ".git/MERGE_MSG")))
1306       ; delete empty lines at end
1307       (goto-char (point-min))
1308       (when (re-search-forward "\n+\\'" nil t)
1309         (replace-match "\n" t t))
1310       (when sign-off (git-append-sign-off committer-name committer-email)))
1311     buffer))
1312 
1313 (define-derived-mode git-log-edit-mode log-edit-mode "Git-Log-Edit"
1314   "Major mode for editing git log messages.
1315 
1316 Set up git-specific `font-lock-keywords' for `log-edit-mode'."
1317   (set (make-local-variable 'font-lock-defaults)
1318        '(git-log-edit-font-lock-keywords t t)))
1319 
1320 (defun git-commit-file ()
1321   "Commit the marked file(s), asking for a commit message."
1322   (interactive)
1323   (unless git-status (error "Not in git-status buffer."))
1324   (when (git-run-pre-commit-hook)
1325     (let ((buffer (get-buffer-create "*git-commit*"))
1326           (coding-system (git-get-commits-coding-system))
1327           author-name author-email subject date)
1328       (when (eq 0 (buffer-size buffer))
1329         (when (file-readable-p ".git/rebase-apply/info")
1330           (with-temp-buffer
1331             (insert-file-contents ".git/rebase-apply/info")
1332             (goto-char (point-min))
1333             (when (re-search-forward "^Author: \\(.*\\)\nEmail: \\(.*\\)$" nil t)
1334               (setq author-name (match-string 1))
1335               (setq author-email (match-string 2)))
1336             (goto-char (point-min))
1337             (when (re-search-forward "^Subject: \\(.*\\)$" nil t)
1338               (setq subject (match-string 1)))
1339             (goto-char (point-min))
1340             (when (re-search-forward "^Date: \\(.*\\)$" nil t)
1341               (setq date (match-string 1)))))
1342         (git-setup-log-buffer buffer (git-get-merge-heads) author-name author-email subject date))
1343       (if (boundp 'log-edit-diff-function)
1344           (log-edit 'git-do-commit nil '((log-edit-listfun . git-log-edit-files)
1345                                          (log-edit-diff-function . git-log-edit-diff)) buffer 'git-log-edit-mode)
1346         (log-edit 'git-do-commit nil 'git-log-edit-files buffer
1347                   'git-log-edit-mode))
1348       (setq paragraph-separate (concat (regexp-quote git-log-msg-separator) "$\\|Author: \\|Date: \\|Merge: \\|Signed-off-by: \\|\f\\|[         ]*$"))
1349       (setq buffer-file-coding-system coding-system)
1350       (re-search-forward (regexp-quote (concat git-log-msg-separator "\n")) nil t))))
1351 
1352 (defun git-setup-commit-buffer (commit)
1353   "Setup the commit buffer with the contents of COMMIT."
1354   (let (parents author-name author-email subject date msg)
1355     (with-temp-buffer
1356       (let ((coding-system (git-get-logoutput-coding-system)))
1357         (git-call-process t "log" "-1" "--pretty=medium" "--abbrev=40" commit)
1358         (goto-char (point-min))
1359         (when (re-search-forward "^Merge: *\\(.*\\)$" nil t)
1360           (setq parents (cdr (split-string (match-string 1) " +"))))
1361         (when (re-search-forward "^Author: *\\(.*\\) <\\(.*\\)>$" nil t)
1362           (setq author-name (match-string 1))
1363           (setq author-email (match-string 2)))
1364         (when (re-search-forward "^Date: *\\(.*\\)$" nil t)
1365           (setq date (match-string 1)))
1366         (while (re-search-forward "^    \\(.*\\)$" nil t)
1367           (push (match-string 1) msg))
1368         (setq msg (nreverse msg))
1369         (setq subject (pop msg))
1370         (while (and msg (zerop (length (car msg))) (pop msg)))))
1371     (git-setup-log-buffer (get-buffer-create "*git-commit*")
1372                           parents author-name author-email subject date
1373                           (mapconcat #'identity msg "\n"))))
1374 
1375 (defun git-get-commit-files (commit)
1376   "Retrieve a sorted list of files modified by COMMIT."
1377   (let (files)
1378     (with-temp-buffer
1379       (git-call-process t "diff-tree" "-m" "-r" "-z" "--name-only" "--no-commit-id" "--root" commit)
1380       (goto-char (point-min))
1381       (while (re-search-forward "\\([^\0]*\\)\0" nil t 1)
1382         (push (match-string 1) files)))
1383     (sort files #'string-lessp)))
1384 
1385 (defun git-read-commit-name (prompt &optional default)
1386   "Ask for a commit name, with completion for local branch, remote branch and tag."
1387   (completing-read prompt
1388                    (list* "HEAD" "ORIG_HEAD" "FETCH_HEAD" (mapcar #'car (git-for-each-ref)))
1389                    nil nil nil nil default))
1390 
1391 (defun git-checkout (branch &optional merge)
1392   "Checkout a branch, tag, or any commit.
1393 Use a prefix arg if git should merge while checking out."
1394   (interactive
1395    (list (git-read-commit-name "Checkout: ")
1396          current-prefix-arg))
1397   (unless git-status (error "Not in git-status buffer."))
1398   (let ((args (list branch "--")))
1399     (when merge (push "-m" args))
1400     (when (apply #'git-call-process-display-error "checkout" args)
1401       (git-update-status-files))))
1402 
1403 (defun git-branch (branch)
1404   "Create a branch from the current HEAD and switch to it."
1405   (interactive (list (git-read-commit-name "Branch: ")))
1406   (unless git-status (error "Not in git-status buffer."))
1407   (if (git-rev-parse (concat "refs/heads/" branch))
1408       (if (yes-or-no-p (format "Branch %s already exists, replace it? " branch))
1409           (and (git-call-process-display-error "branch" "-f" branch)
1410                (git-call-process-display-error "checkout" branch))
1411         (message "Canceled."))
1412     (git-call-process-display-error "checkout" "-b" branch))
1413     (git-refresh-ewoc-hf git-status))
1414 
1415 (defun git-amend-commit ()
1416   "Undo the last commit on HEAD, and set things up to commit an
1417 amended version of it."
1418   (interactive)
1419   (unless git-status (error "Not in git-status buffer."))
1420   (when (git-empty-db-p) (error "No commit to amend."))
1421   (let* ((commit (git-rev-parse "HEAD"))
1422          (files (git-get-commit-files commit)))
1423     (when (if (git-rev-parse "HEAD^")
1424               (git-call-process-display-error "reset" "--soft" "HEAD^")
1425             (and (git-update-ref "ORIG_HEAD" commit)
1426                  (git-update-ref "HEAD" nil commit)))
1427       (git-update-status-files files t)
1428       (git-setup-commit-buffer commit)
1429       (git-commit-file))))
1430 
1431 (defun git-cherry-pick-commit (arg)
1432   "Cherry-pick a commit."
1433   (interactive (list (git-read-commit-name "Cherry-pick commit: ")))
1434   (unless git-status (error "Not in git-status buffer."))
1435   (let ((commit (git-rev-parse (concat arg "^0"))))
1436     (unless commit (error "Not a valid commit '%s'." arg))
1437     (when (git-rev-parse (concat commit "^2"))
1438       (error "Cannot cherry-pick a merge commit."))
1439     (let ((files (git-get-commit-files commit))
1440           (ok (git-call-process-display-error "cherry-pick" "-n" commit)))
1441       (git-update-status-files files ok)
1442       (with-current-buffer (git-setup-commit-buffer commit)
1443         (goto-char (point-min))
1444         (if (re-search-forward "^\n*Signed-off-by:" nil t 1)
1445             (goto-char (match-beginning 0))
1446           (goto-char (point-max)))
1447         (insert "(cherry picked from commit " commit ")\n"))
1448       (when ok (git-commit-file)))))
1449 
1450 (defun git-revert-commit (arg)
1451   "Revert a commit."
1452   (interactive (list (git-read-commit-name "Revert commit: ")))
1453   (unless git-status (error "Not in git-status buffer."))
1454   (let ((commit (git-rev-parse (concat arg "^0"))))
1455     (unless commit (error "Not a valid commit '%s'." arg))
1456     (when (git-rev-parse (concat commit "^2"))
1457       (error "Cannot revert a merge commit."))
1458     (let ((files (git-get-commit-files commit))
1459           (subject (git-get-commit-description commit))
1460           (ok (git-call-process-display-error "revert" "-n" commit)))
1461       (git-update-status-files files ok)
1462       (when (string-match "^[0-9a-f]+ - \\(.*\\)$" subject)
1463         (setq subject (match-string 1 subject)))
1464       (git-setup-log-buffer (get-buffer-create "*git-commit*")
1465                             (git-get-merge-heads) nil nil (format "Revert \"%s\"" subject) nil
1466                             (format "This reverts commit %s.\n" commit))
1467       (when ok (git-commit-file)))))
1468 
1469 (defun git-find-file ()
1470   "Visit the current file in its own buffer."
1471   (interactive)
1472   (unless git-status (error "Not in git-status buffer."))
1473   (let ((info (ewoc-data (ewoc-locate git-status))))
1474     (unless (git-expand-directory info)
1475       (find-file (git-fileinfo->name info))
1476       (when (eq 'unmerged (git-fileinfo->state info))
1477         (smerge-mode 1)))))
1478 
1479 (defun git-find-file-other-window ()
1480   "Visit the current file in its own buffer in another window."
1481   (interactive)
1482   (unless git-status (error "Not in git-status buffer."))
1483   (let ((info (ewoc-data (ewoc-locate git-status))))
1484     (find-file-other-window (git-fileinfo->name info))
1485     (when (eq 'unmerged (git-fileinfo->state info))
1486       (smerge-mode))))
1487 
1488 (defun git-find-file-imerge ()
1489   "Visit the current file in interactive merge mode."
1490   (interactive)
1491   (unless git-status (error "Not in git-status buffer."))
1492   (let ((info (ewoc-data (ewoc-locate git-status))))
1493     (find-file (git-fileinfo->name info))
1494     (smerge-ediff)))
1495 
1496 (defun git-view-file ()
1497   "View the current file in its own buffer."
1498   (interactive)
1499   (unless git-status (error "Not in git-status buffer."))
1500   (let ((info (ewoc-data (ewoc-locate git-status))))
1501     (view-file (git-fileinfo->name info))))
1502 
1503 (defun git-refresh-status ()
1504   "Refresh the git status buffer."
1505   (interactive)
1506   (unless git-status (error "Not in git-status buffer."))
1507   (message "Refreshing git status...")
1508   (git-update-status-files)
1509   (message "Refreshing git status...done"))
1510 
1511 (defun git-status-quit ()
1512   "Quit git-status mode."
1513   (interactive)
1514   (bury-buffer))
1515 
1516 ;;;; Major Mode
1517 ;;;; ------------------------------------------------------------
1518 
1519 (defvar git-status-mode-hook nil
1520   "Run after `git-status-mode' is setup.")
1521 
1522 (defvar git-status-mode-map nil
1523   "Keymap for git major mode.")
1524 
1525 (defvar git-status nil
1526   "List of all files managed by the git-status mode.")
1527 
1528 (unless git-status-mode-map
1529   (let ((map (make-keymap))
1530         (commit-map (make-sparse-keymap))
1531         (diff-map (make-sparse-keymap))
1532         (toggle-map (make-sparse-keymap)))
1533     (suppress-keymap map)
1534     (define-key map "?"   'git-help)
1535     (define-key map "h"   'git-help)
1536     (define-key map " "   'git-next-file)
1537     (define-key map "a"   'git-add-file)
1538     (define-key map "c"   'git-commit-file)
1539     (define-key map "\C-c" commit-map)
1540     (define-key map "d"    diff-map)
1541     (define-key map "="   'git-diff-file)
1542     (define-key map "f"   'git-find-file)
1543     (define-key map "\r"  'git-find-file)
1544     (define-key map "g"   'git-refresh-status)
1545     (define-key map "i"   'git-ignore-file)
1546     (define-key map "I"   'git-insert-file)
1547     (define-key map "l"   'git-log-file)
1548     (define-key map "m"   'git-mark-file)
1549     (define-key map "M"   'git-mark-all)
1550     (define-key map "n"   'git-next-file)
1551     (define-key map "N"   'git-next-unmerged-file)
1552     (define-key map "o"   'git-find-file-other-window)
1553     (define-key map "p"   'git-prev-file)
1554     (define-key map "P"   'git-prev-unmerged-file)
1555     (define-key map "q"   'git-status-quit)
1556     (define-key map "r"   'git-remove-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         ["Interactive Merge File" git-find-file-imerge t]
1599         ["Diff Against Common Base File" git-diff-file-base t]
1600         ["Diff Combined" git-diff-file-combined t]
1601         ["Diff Against Merge Head" git-diff-file-merge-head t]
1602         ["Diff Against Mine" git-diff-file-mine t]
1603         ["Diff Against Other" git-diff-file-other t])
1604       "--------"
1605       ["Add File" git-add-file t]
1606       ["Revert File" git-revert-file t]
1607       ["Ignore File" git-ignore-file t]
1608       ["Remove File" git-remove-file t]
1609       ["Insert File" git-insert-file t]
1610       "--------"
1611       ["Find File" git-find-file t]
1612       ["View File" git-view-file t]
1613       ["Diff File" git-diff-file t]
1614       ["Interactive Diff File" git-diff-file-idiff t]
1615       ["Log" git-log-file t]
1616       "--------"
1617       ["Mark" git-mark-file t]
1618       ["Mark All" git-mark-all t]
1619       ["Unmark" git-unmark-file t]
1620       ["Unmark All" git-unmark-all t]
1621       ["Toggle All Marks" git-toggle-all-marks t]
1622       ["Hide Handled Files" git-remove-handled t]
1623       "--------"
1624       ["Show Uptodate Files" git-toggle-show-uptodate :style toggle :selected git-show-uptodate]
1625       ["Show Ignored Files" git-toggle-show-ignored :style toggle :selected git-show-ignored]
1626       ["Show Unknown Files" git-toggle-show-unknown :style toggle :selected git-show-unknown]
1627       "--------"
1628       ["Quit" git-status-quit t])))
1629 
1630 
1631 ;; git mode should only run in the *git status* buffer
1632 (put 'git-status-mode 'mode-class 'special)
1633 
1634 (defun git-status-mode ()
1635   "Major mode for interacting with Git.
1636 Commands:
1637 \\{git-status-mode-map}"
1638   (kill-all-local-variables)
1639   (buffer-disable-undo)
1640   (setq mode-name "git status"
1641         major-mode 'git-status-mode
1642         goal-column 17
1643         buffer-read-only t)
1644   (use-local-map git-status-mode-map)
1645   (let ((buffer-read-only nil))
1646     (erase-buffer)
1647   (let ((status (ewoc-create 'git-fileinfo-prettyprint "" "")))
1648     (set (make-local-variable 'git-status) status))
1649   (set (make-local-variable 'list-buffers-directory) default-directory)
1650   (make-local-variable 'git-show-uptodate)
1651   (make-local-variable 'git-show-ignored)
1652   (make-local-variable 'git-show-unknown)
1653   (run-hooks 'git-status-mode-hook)))
1654 
1655 (defun git-find-status-buffer (dir)
1656   "Find the git status buffer handling a specified directory."
1657   (let ((list (buffer-list))
1658         (fulldir (expand-file-name dir))
1659         found)
1660     (while (and list (not found))
1661       (let ((buffer (car list)))
1662         (with-current-buffer buffer
1663           (when (and list-buffers-directory
1664                      (string-equal fulldir (expand-file-name list-buffers-directory))
1665                      (eq major-mode 'git-status-mode))
1666             (setq found buffer))))
1667       (setq list (cdr list)))
1668     found))
1669 
1670 (defun git-status (dir)
1671   "Entry point into git-status mode."
1672   (interactive "DSelect directory: ")
1673   (setq dir (git-get-top-dir dir))
1674   (if (file-exists-p (concat (file-name-as-directory dir) ".git"))
1675       (let ((buffer (or (and git-reuse-status-buffer (git-find-status-buffer dir))
1676                         (create-file-buffer (expand-file-name "*git-status*" dir)))))
1677         (switch-to-buffer buffer)
1678         (cd dir)
1679         (git-status-mode)
1680         (git-refresh-status)
1681         (goto-char (point-min))
1682         (add-hook 'after-save-hook 'git-update-saved-file))
1683     (message "%s is not a git working tree." dir)))
1684 
1685 (defun git-update-saved-file ()
1686   "Update the corresponding git-status buffer when a file is saved.
1687 Meant to be used in `after-save-hook'."
1688   (let* ((file (expand-file-name buffer-file-name))
1689          (dir (condition-case nil (git-get-top-dir (file-name-directory file)) (error nil)))
1690          (buffer (and dir (git-find-status-buffer dir))))
1691     (when buffer
1692       (with-current-buffer buffer
1693         (let ((filename (file-relative-name file dir)))
1694           ; skip files located inside the .git directory
1695           (unless (string-match "^\\.git/" filename)
1696             (git-call-process nil "add" "--refresh" "--" filename)
1697             (git-update-status-files (list filename))))))))
1698 
1699 (defun git-help ()
1700   "Display help for Git mode."
1701   (interactive)
1702   (describe-function 'git-status-mode))
1703 
1704 (provide 'git)
1705 ;;; git.el ends here