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. ;;
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. ;;
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/>. ;;
16 ;; Written by and Copyright (C) Francois Fleuret ;;
17 ;; Contact <francois@fleuret.org> for comments & bug reports ;;
18 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
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.
25 ;; I also have (setq alarm-vc-mode-exceptions "^VM") to prevent alarms
26 ;; to be displayed in my VM buffers
30 (require 'vc-cvs nil t)
31 (require 'vc-svn nil t)
32 (require 'vc-git nil t)
34 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
36 (defface alarm-vc-face
37 '((((background light)) (:background "yellow"))
38 (((background dark)) (:background "yellow")))
39 "The face for the alarm-vc modeline message.")
41 (defcustom alarm-vc-mode-exceptions nil
42 "*Regexp defining the mode names which should be ignored by
46 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
48 (make-variable-buffer-local 'alarm-vc-string)
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
54 (and alarm-vc-mode-exceptions
55 (string-match alarm-vc-mode-exceptions mode-name))
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
69 (if (and (fboundp 'vc-cvs-registered)
70 (vc-cvs-responsible-p buffer-file-name)
71 (not (vc-cvs-registered buffer-file-name)))
75 (if (and (fboundp 'vc-svn-registered)
76 (vc-svn-responsible-p buffer-file-name)
77 (not (vc-svn-registered buffer-file-name)))
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)))
91 (if (string= id "") ""
93 (propertize (concat "Not under" id) 'face 'alarm-vc-face)
99 ;; Returns nil so that the file is not considered as saved when
100 ;; the function is called by write-file-functions
104 (setq global-mode-string (cons '(:eval (alarm-vc-mode-line)) global-mode-string))
106 ;; Refreshes the alarm when opening or saving a file
108 (add-hook 'find-file-hooks 'alarm-vc-check)
109 (add-hook 'write-file-hooks 'alarm-vc-check)
111 ;; Since there is no hook called when one register a file through
112 ;; version control, we need an advice.
114 (defadvice vc-register (after alarm-vc-check nil activate)
117 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;