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