alarm-vc.el

   1
   2 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   3 ;; This program is free software; you can redistribute it and/or         ;;
   4 ;; modify it under the terms of the GNU General Public License as        ;;
   5 ;; published by the Free Software Foundation; either version 3, or (at   ;;
   6 ;; your option) any later version.                                       ;;
   7 ;;                                                                       ;;
   8 ;; This program is distributed in the hope that it will be useful, but   ;;
   9 ;; WITHOUT ANY WARRANTY; without even the implied warranty of            ;;
  10 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU      ;;
  11 ;; General Public License for more details.                              ;;
  12 ;;                                                                       ;;
  13 ;; You should have received a copy of the GNU General Public License     ;;
  14 ;; along with this program. If not, see <http://www.gnu.org/licenses/>.  ;;
  15 ;;                                                                       ;;
  16 ;; Written by and Copyright (C) Francois Fleuret                         ;;
  17 ;; Contact <francois@fleuret.org> for comments & bug reports             ;;
  18 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  19
  20 ;; These functions display an alarm in the mode-line if the file in
  21 ;; the current buffer is not under CVS, subversion or GIT while the
  22 ;; directory is. You just have to put (load "alarm-vc") in your
  23 ;; ~/.emacs to make the thing work.
  24
  25 ;; I also have (setq alarm-vc-mode-exceptions "^VM") to prevent alarms
  26 ;; to be displayed in my VM buffers
  27
  28 ;; Jan 9th 2009
  29
  30 (require 'vc-cvs nil t)
  31 (require 'vc-svn nil t)
  32 (require 'vc-git nil t)
  33
  34 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  35
  36 (defface alarm-vc-face
  37   '((((background light)) (:background "yellow"))
  38     (((background dark)) (:background "yellow")))
  39   "The face for the alarm-vc modeline message.")
  40
  41 (defcustom alarm-vc-mode-exceptions nil
  42   "*Regexp defining the mode names which should be ignored by
  43 alarm-vc."
  44   :type 'string)
  45
  46 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  47
  48 (make-variable-buffer-local 'alarm-vc-string)
  49
  50 (defun alarm-vc-mode-line ()
  51   ;; We check the mode name here since it can change after the opening
  52   ;; of the file, hence after we have computed alarm-vc-string
  53   (unless
  54       (and alarm-vc-mode-exceptions
  55            (string-match alarm-vc-mode-exceptions mode-name))
  56     alarm-vc-string))
  57
  58 (defun alarm-vc-check ()
  59   "Adds an alarm in the modeline if the file in the current
  60 buffer is not under some VC system while it looks like it
  61 should."
  62
  63   (if buffer-file-name
  64
  65       (let ((id
  66              (concat
  67
  68               ;; cvs
  69               (if (and (fboundp 'vc-cvs-registered)
  70                        (vc-cvs-responsible-p buffer-file-name)
  71                        (not (vc-cvs-registered buffer-file-name)))
  72                   " cvs")
  73
  74               ;; Subversion
  75               (if (and (fboundp 'vc-svn-registered)
  76                        (vc-svn-responsible-p buffer-file-name)
  77                        (not (vc-svn-registered buffer-file-name)))
  78                   " svn")
  79
  80               ;; git
  81               (if (and (fboundp 'vc-git-registered)
  82                        ;; does not exist in old emacs
  83                        (fboundp 'vc-git-responsible-p)
  84                        (vc-git-responsible-p buffer-file-name)
  85                        (not (vc-git-registered buffer-file-name)))
  86                   " git")
  87
  88               )))
  89
  90         (setq alarm-vc-string
  91               (if (string= id "") ""
  92                 (concat " "
  93                         (propertize (concat "Not under" id) 'face 'alarm-vc-face)
  94                         " ")
  95                 ))
  96
  97         ))
  98
  99   ;; Returns nil so that the file is not considered as saved when
 100   ;; the function is called by write-file-functions
 101
 102   nil)
 103
 104 (setq global-mode-string (cons '(:eval (alarm-vc-mode-line)) global-mode-string))
 105
 106 ;; Refreshes the alarm when opening or saving a file
 107
 108 (add-hook 'find-file-hooks 'alarm-vc-check)
 109 (add-hook 'write-file-hooks 'alarm-vc-check)
 110
 111 ;; Since there is no hook called when one register a file through
 112 ;; version control, we need an advice.
 113
 114 (defadvice vc-register (after alarm-vc-check nil activate)
 115   (alarm-vc-check))
 116
 117 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;