Commit | Line | Data |
---|---|---|
aae56ea7 | 1 | ;;; vc-hooks.el --- resident support for version-control |
594722a8 ER |
2 | |
3 | ;; Copyright (C) 1992 Free Software Foundation, Inc. | |
4 | ||
5 | ;; Author: Eric S. Raymond <esr@snark.thyrsus.com> | |
7bc2b98b | 6 | ;; Version: 5.3 |
594722a8 ER |
7 | |
8 | ;; This file is part of GNU Emacs. | |
9 | ||
10 | ;; GNU Emacs is free software; you can redistribute it and/or modify | |
11 | ;; it under the terms of the GNU General Public License as published by | |
12 | ;; the Free Software Foundation; either version 2, or (at your option) | |
13 | ;; any later version. | |
14 | ||
15 | ;; GNU Emacs is distributed in the hope that it will be useful, | |
16 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
17 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
18 | ;; GNU General Public License for more details. | |
19 | ||
20 | ;; You should have received a copy of the GNU General Public License | |
21 | ;; along with GNU Emacs; see the file COPYING. If not, write to | |
22 | ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. | |
23 | ||
24 | ;;; Commentary: | |
25 | ||
26 | ;; See the commentary of vc.el. | |
27 | ||
28 | ;;; Code: | |
29 | ||
30 | (defvar vc-master-templates | |
31 | '(("%sRCS/%s,v" . RCS) ("%s%s,v" . RCS) ("%sRCS/%s" . RCS) | |
32 | ("%sSCCS/s.%s" . SCCS) ("%ss.%s". SCCS)) | |
33 | "*Where to look for version-control master files. | |
34 | The first pair corresponding to a given back end is used as a template | |
35 | when creating new masters.") | |
36 | ||
37 | (defvar vc-make-backup-files nil | |
38 | "*If non-nil, backups of registered files are made according to | |
39 | the make-backup-files variable. Otherwise, prevents backups being made.") | |
40 | ||
41 | ;; Tell Emacs about this new kind of minor mode | |
7bc2b98b ER |
42 | (if (not (assoc 'vc-mode minor-mode-alist)) |
43 | (setq minor-mode-alist (cons '(vc-mode vc-mode) | |
594722a8 ER |
44 | minor-mode-alist))) |
45 | ||
7bc2b98b | 46 | (make-variable-buffer-local 'vc-mode) |
c43e436c | 47 | (put 'vc-mode 'permanent-local t) |
594722a8 ER |
48 | |
49 | ;; We need a notion of per-file properties because the version | |
50 | ;; control state of a file is expensive to derive --- we don't | |
51 | ;; want to recompute it even on every find. | |
52 | ||
80169ab5 ER |
53 | (defmacro vc-error-occurred (&rest body) |
54 | (list 'condition-case nil (cons 'progn (append body '(nil))) '(error t))) | |
55 | ||
594722a8 ER |
56 | (defvar vc-file-prop-obarray [0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0] |
57 | "Obarray for per-file properties.") | |
58 | ||
59 | (defun vc-file-setprop (file property value) | |
60 | ;; set per-file property | |
61 | (put (intern file vc-file-prop-obarray) property value)) | |
62 | ||
63 | (defun vc-file-getprop (file property) | |
64 | ;; get per-file property | |
65 | (get (intern file vc-file-prop-obarray) property)) | |
66 | ||
67 | ;;; actual version-control code starts here | |
68 | ||
69 | (defun vc-registered (file) | |
18c8a18e PE |
70 | (let (handler handlers) |
71 | (if (boundp 'file-name-handler-alist) | |
72 | (save-match-data | |
73 | (setq handlers file-name-handler-alist) | |
74 | (while (and (consp handlers) (null handler)) | |
75 | (if (and (consp (car handlers)) | |
76 | (stringp (car (car handlers))) | |
77 | (string-match (car (car handlers)) file)) | |
78 | (setq handler (cdr (car handlers)))) | |
79 | (setq handlers (cdr handlers))))) | |
80 | (if handler | |
81 | (funcall handler 'vc-registered file) | |
82 | ;; Search for a master corresponding to the given file | |
83 | (let ((dirname (or (file-name-directory file) "")) | |
84 | (basename (file-name-nondirectory file))) | |
85 | (catch 'found | |
86 | (mapcar | |
87 | (function (lambda (s) | |
88 | (let ((trial (format (car s) dirname basename))) | |
89 | (if (and (file-exists-p trial) | |
90 | ;; Make sure the file we found with name | |
91 | ;; TRIAL is not the source file itself. | |
92 | ;; That can happen with RCS-style names | |
93 | ;; if the file name is truncated | |
94 | ;; (e.g. to 14 chars). See if either | |
95 | ;; directory or attributes differ. | |
96 | (or (not (string= dirname | |
97 | (file-name-directory trial))) | |
98 | (not (equal | |
99 | (file-attributes file) | |
100 | (file-attributes trial))))) | |
101 | (throw 'found (cons trial (cdr s))))))) | |
102 | vc-master-templates) | |
103 | nil))))) | |
594722a8 ER |
104 | |
105 | (defun vc-backend-deduce (file) | |
106 | "Return the version-control type of a file, nil if it is not registered" | |
107 | (and file | |
108 | (or (vc-file-getprop file 'vc-backend) | |
109 | (vc-file-setprop file 'vc-backend (cdr (vc-registered file)))))) | |
110 | ||
111 | (defun vc-toggle-read-only () | |
c43e436c RS |
112 | "Change read-only status of current buffer, perhaps via version control. |
113 | If the buffer is visiting a file registered with version control, | |
114 | then check the file in or out. Otherwise, just change the read-only flag | |
115 | of the buffer." | |
594722a8 ER |
116 | (interactive) |
117 | (if (vc-backend-deduce (buffer-file-name)) | |
118 | (vc-next-action nil) | |
119 | (toggle-read-only))) | |
c43e436c | 120 | (define-key global-map "\C-x\C-q" 'vc-toggle-read-only) |
594722a8 ER |
121 | |
122 | (defun vc-mode-line (file &optional label) | |
7bc2b98b | 123 | "Set `vc-mode' to display type of version control for FILE. |
594722a8 ER |
124 | The value is set in the current buffer, which should be the buffer |
125 | visiting FILE." | |
18c8a18e | 126 | (interactive (list buffer-file-name nil)) |
594722a8 ER |
127 | (let ((vc-type (vc-backend-deduce file))) |
128 | (if vc-type | |
129 | (progn | |
7bc2b98b | 130 | (setq vc-mode |
594722a8 ER |
131 | (concat " " (or label (symbol-name vc-type)))))) |
132 | ;; force update of mode line | |
133 | (set-buffer-modified-p (buffer-modified-p)) | |
134 | vc-type)) | |
135 | ||
136 | ;;; install a call to the above as a find-file hook | |
137 | (defun vc-find-file-hook () | |
18c8a18e PE |
138 | ;; Recompute whether file is version controlled, |
139 | ;; if user has killed the buffer and revisited. | |
140 | (vc-file-setprop buffer-file-name 'vc-backend nil) | |
594722a8 ER |
141 | (if (and (vc-mode-line buffer-file-name) (not vc-make-backup-files)) |
142 | (progn | |
143 | (make-local-variable 'make-backup-files) | |
144 | (setq make-backup-files nil)))) | |
145 | ||
146 | (or (memq 'vc-find-file-hook find-file-hooks) | |
147 | (setq find-file-hooks | |
148 | (cons 'vc-find-file-hook find-file-hooks))) | |
149 | ||
150 | ;;; more hooks, this time for file-not-found | |
151 | (defun vc-file-not-found-hook () | |
152 | "When file is not found, try to check it out from RCS or SCCS. | |
153 | Returns t if checkout was successful, nil otherwise." | |
154 | (if (vc-backend-deduce buffer-file-name) | |
155 | (progn | |
156 | (require 'vc) | |
157 | (not (vc-error-occurred (vc-checkout buffer-file-name)))))) | |
158 | ||
159 | (or (memq 'vc-file-not-found-hook find-file-not-found-hooks) | |
160 | (setq find-file-not-found-hooks | |
161 | (cons 'vc-file-not-found-hook find-file-not-found-hooks))) | |
162 | ||
163 | ;;; Now arrange for bindings and autoloading of the main package. | |
7bc2b98b ER |
164 | ;;; Bindings for this have to go in the global map, as we'll often |
165 | ;;; want to call them from random buffers. | |
594722a8 ER |
166 | |
167 | (setq vc-prefix-map (lookup-key global-map "\C-xv")) | |
168 | (if (not (keymapp vc-prefix-map)) | |
169 | (progn | |
170 | (setq vc-prefix-map (make-sparse-keymap)) | |
171 | (define-key global-map "\C-xv" vc-prefix-map) | |
172 | (define-key vc-prefix-map "a" 'vc-update-change-log) | |
173 | (define-key vc-prefix-map "c" 'vc-cancel-version) | |
18c8a18e | 174 | (define-key vc-prefix-map "d" 'vc-directory) |
594722a8 ER |
175 | (define-key vc-prefix-map "h" 'vc-insert-headers) |
176 | (define-key vc-prefix-map "i" 'vc-register) | |
177 | (define-key vc-prefix-map "l" 'vc-print-log) | |
178 | (define-key vc-prefix-map "r" 'vc-retrieve-snapshot) | |
179 | (define-key vc-prefix-map "s" 'vc-create-snapshot) | |
180 | (define-key vc-prefix-map "u" 'vc-revert-buffer) | |
181 | (define-key vc-prefix-map "v" 'vc-next-action) | |
18c8a18e | 182 | (define-key vc-prefix-map "=" 'vc-diff) |
594722a8 ER |
183 | )) |
184 | ||
594722a8 ER |
185 | (provide 'vc-hooks) |
186 | ||
187 | ;;; vc-hooks.el ends here |