git-mode-line-dot.el

;;; git-mode-line-dot.el --- Show a dot for git status in the mode line

(eval-when-compile (require 'cl))
(require 'vc-git)
(add-to-list 'vc-handled-backends 'Git)

(defvar git-mode-line-dot-state-mark-modeline t
  "modeline mark display or not") 

(defun git-mode-line-dot-update-modeline ()
  "Update modeline state dot mark properly"
  (when (and buffer-file-name (git-mode-line-dot-in-vc-mode?))
    (git-mode-line-dot-update-state-mark
     (git-mode-line-dot-interprete-state-mode-color
      (vc-git-state buffer-file-name)))))

(defun git-mode-line-dot-update-state-mark (color)
  (git-mode-line-dot-uninstall-state-mark-modeline)
  (git-mode-line-dot-install-state-mark-modeline color))

(defun git-mode-line-dot-uninstall-state-mark-modeline ()
  (setq mode-line-format
        (remove-if #'(lambda (mode) (eq (car-safe mode)
                                        'git-mode-line-dot-state-mark-modeline))
                   mode-line-format))
  (force-mode-line-update t))

(defun git-mode-line-dot-install-state-mark-modeline (color)
  (push `(git-mode-line-dot-state-mark-modeline
          ,(git-mode-line-dot-state-mark-modeline-dot color))
        mode-line-format)
  (force-mode-line-update t))

(defun git-substring-no-properties (string &optional from to)
  (if (fboundp 'substring-no-properties)
      (substring-no-properties string from to)
    (substring string (or from 0) to)))

(defun git-mode-line-dot-in-vc-mode? ()
  "Is vc-git active?"
  (interactive)
  (and vc-mode (string-match "^ GIT" (git-substring-no-properties vc-mode))))

(defun git-mode-line-dot-state-mark-modeline-dot (color)
  (propertize "    "
              'display
              `(image :type xpm
                      :data ,(format "/* XPM */
static char * data[] = {
\"18 13 3 1\",
\"  c None\",
\"+ c #000000\",
\". c %s\",
\"                  \",
\"       +++++      \",
\"      +.....+     \",
\"     +.......+    \",
\"    +.........+   \",
\"    +.........+   \",
\"    +.........+   \",
\"    +.........+   \",
\"    +.........+   \",
\"     +.......+    \",
\"      +.....+     \",
\"       +++++      \",
\"                  \"};"
                                     color)
                      :ascent center)))

(defsubst git-mode-line-dot-interprete-state-mode-color (stat)
  "Interpret vc-git-state symbol to mode line color"
  (case stat
    ('edited "tomato")
    ('up-to-date "GreenYellow")
    ('unknown  "gray")
    ('added    "blue")
    ('deleted  "red")
    ('unmerged "purple")
    (t "red")))

(defadvice vc-mode-line (after git-mode-line-dot-vc-mode-line activate)
  (git-mode-line-dot-update-modeline))

(provide 'git-mode-line-dot)