492a86256ff75fe0920cb232da0771e136b34c8b
[elisp.git] / 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 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;