my git interface

fgit.el

;;; fgit.el --- Functional Git interface for emacs
;; Copyright (C) 2010 by Hayashi Masahiro

;; Author: Hayashi Masahiro <[email protected]>
;; URL: 
;; Keywords: Emacs, Git, Frontend
;; Version: 0.0.1

;; fgit.el is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.

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

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING.  If not, write to
;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.

;;; Commentary:
;; 

;;; History:
;;

;;; Code:



(require 'anything)
(require 'git-emacs)




(defgroup fgit nil
  "Emacs git interface."
  :group 'tools
  :prefix "fgit-")

(defvar fgit-version "0.0.1"
  "Version of fgit.")



(defun fgit--branch-alist ()
  (with-temp-buffer
    (let (ret)
      (git--exec "branch" (current-buffer) nil "-a")
      (goto-char (point-min))
      (while (not (eobp))
	(when (looking-at "^\\(?:\\([*]\\)\\| \\) \\(.*\\)")
	  (setq ret (cons (cons (match-string 2) (and (match-string 1) t)) ret)))
	(forward-line 1))
      (nreverse ret))))

(defun fgit--branch-current ()
  (car (rassoc t (fgit--branch-alist))))

(defun fgit--branches ()
  (mapcar 'car (fgit--branch-alist)))

(defun fgit--checkout-branch (name)
  (with-temp-buffer
    (git--exec "checkout" (current-buffer) nil name))
  (fgit--mode-line-redraw-format))

(defun fgit--branch-create (name)
  (with-temp-buffer
    (git--exec "branch" (current-buffer) nil name)
    (git--exec "checkout" (current-buffer) nil name))
  (fgit--mode-line-redraw-format))

(defconst fgit--branch-source
  '(
    (
     (name . "Branches")
     (candidates . (lambda ()
		     (with-current-buffer anything-current-buffer
		       (fgit--branches))))
     (type . fgit-branches))
    (
     (name . "New branch")
     (dummy)
     (action . (lambda (name)
		 (with-current-buffer anything-current-buffer
		   (fgit--branch-create name)))))))

(add-to-list 'anything-type-attributes
	     '(fgit-branches (action ("Git Branches" . fgit--checkout-branch))))


(defun fgit--mode-line-string (directory)
  (let* ((default-directory (file-name-as-directory directory))
	 (branch (fgit--branch-current)))
    (when branch
      (format "Git:%s" branch))))

(defvar fgit--mode-line-in-dired nil)
(make-variable-buffer-local 'fgit--mode-line-in-dired)

(defun fgit--mode-line-install-format ()
  (unless (memq 'fgit--mode-line-in-dired mode-line-format)
    (let* ((cell (assq 'vc-mode mode-line-format))
	   (tail (member cell mode-line-format)))
      (setcdr tail (cons 'fgit--mode-line-in-dired (cdr tail))))))

(defun fgit--mode-line-redraw-format ()
  (setq fgit--mode-line-in-dired (fgit--mode-line-string default-directory))
  (force-mode-line-update))

(defun fgit-mode-line ()
  (fgit--mode-line-install-format)
  (fgit--mode-line-redraw-format))

(add-hook 'dired-mode-hook 'fgit-mode-line)



(defun fgit-branch ()
  (interactive)
  (anything fgit--branch-source))



(define-key git-global-map "b" 'fgit-branch)


(provide 'fgit)

;;; fgit.el ends here