;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; This program 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, or (at   ;;
;; your option) any later version.                                       ;;
;;                                                                       ;;
;; This program 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 this program. If not, see <http://www.gnu.org/licenses/>.  ;;
;;                                                                       ;;
;; Written by and Copyright (C) Francois Fleuret                         ;;
;; Contact <francois@fleuret.org> for comments & bug reports             ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; These functions display an alarm in the mode-line if the file in
;; the current buffer is not under CVS, subversion or GIT while the
;; directory is. You just have to put (load "alarm-vc") in your
;; ~/.emacs to make the thing work.

;; I also have (setq alarm-vc-mode-exceptions "^VM") to prevent alarms
;; to be displayed in my VM buffers

;; Jan 9th 2009

(require 'vc-cvs nil t)
(require 'vc-svn nil t)
(require 'vc-git nil t)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defface alarm-vc-face
  '((((background light)) (:background "yellow"))
    (((background dark)) (:background "yellow")))
  "The face for the alarm-vc modeline message.")

(defcustom alarm-vc-mode-exceptions nil
  "*Regexp defining the mode names which should be ignored by
alarm-vc."
  :type 'string)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(make-variable-buffer-local 'alarm-vc-string)

(defun alarm-vc-mode-line ()
  ;; We check the mode name here since it can change after the opening
  ;; of the file, hence after we have computed alarm-vc-string
  (unless
      (and alarm-vc-mode-exceptions
           (string-match alarm-vc-mode-exceptions mode-name))
    alarm-vc-string))

(defun alarm-vc-check ()
  "Adds an alarm in the modeline if the file in the current
buffer is not under some VC system while it looks like it
should."

  (if buffer-file-name

      (let ((id
             (concat

              ;; cvs
              (if (and (fboundp 'vc-cvs-registered)
                       (vc-cvs-responsible-p buffer-file-name)
                       (not (vc-cvs-registered buffer-file-name)))
                  " cvs")

              ;; Subversion
              (if (and (fboundp 'vc-svn-registered)
                       (vc-svn-responsible-p buffer-file-name)
                       (not (vc-svn-registered buffer-file-name)))
                  " svn")

              ;; git
              (if (and (fboundp 'vc-git-registered)
                       ;; does not exist in old emacs
                       (fboundp 'vc-git-responsible-p)
                       (vc-git-responsible-p buffer-file-name)
                       (not (vc-git-registered buffer-file-name)))
                  " git")

              )))

        (setq alarm-vc-string
              (if (string= id "") ""
                (concat " "
                        (propertize (concat "Not under" id) 'face 'alarm-vc-face)
                        " ")
                ))

        ))

  ;; Returns nil so that the file is not considered as saved when
  ;; the function is called by write-file-functions

  nil)

(setq global-mode-string (cons '(:eval (alarm-vc-mode-line)) global-mode-string))

;; Refreshes the alarm when opening or saving a file

(add-hook 'find-file-hooks 'alarm-vc-check)
(add-hook 'write-file-hooks 'alarm-vc-check)

;; Since there is no hook called when one register a file through
;; version control, we need an advice.

(defadvice vc-register (after alarm-vc-check nil activate)
  (alarm-vc-check))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;