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