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