Mercurial > emacs
annotate lisp/vc-hooks.el @ 1375:577493baf266
*** empty log message ***
author | Jim Blandy <jimb@redhat.com> |
---|---|
date | Sat, 10 Oct 1992 01:37:56 +0000 |
parents | 981b00f8fe77 |
children | b5a0e08b0dbe |
rev | line source |
---|---|
904 | 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 | |
1224
981b00f8fe77
(vc-toggle-read-only): Doc fix.
Roland McGrath <roland@gnu.org>
parents:
926
diff
changeset
|
8 ;; $Id: vc-hooks.el,v 1.2 1992/08/04 07:21:29 jimb Exp roland $ |
904 | 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 () | |
1224
981b00f8fe77
(vc-toggle-read-only): Doc fix.
Roland McGrath <roland@gnu.org>
parents:
926
diff
changeset
|
99 "If the file in the current buffer is under version control, perform the |
904 | 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." | |
1224
981b00f8fe77
(vc-toggle-read-only): Doc fix.
Roland McGrath <roland@gnu.org>
parents:
926
diff
changeset
|
111 (interactive (list buffer-file-name nil)) |
904 | 112 (let ((vc-type (vc-backend-deduce file))) |
113 (if vc-type | |
114 (progn | |
115 (if (null (current-local-map)) | |
116 (use-local-map (make-sparse-keymap))) | |
117 (define-key (current-local-map) "\C-x\C-q" 'vc-toggle-read-only) | |
118 (setq vc-mode-string | |
119 (concat " " (or label (symbol-name vc-type)))))) | |
120 ;; force update of mode line | |
121 (set-buffer-modified-p (buffer-modified-p)) | |
122 vc-type)) | |
123 | |
124 ;;; install a call to the above as a find-file hook | |
125 (defun vc-find-file-hook () | |
126 (if (and (vc-mode-line buffer-file-name) (not vc-make-backup-files)) | |
127 (progn | |
128 (make-local-variable 'make-backup-files) | |
129 (setq make-backup-files nil)))) | |
130 | |
131 (or (memq 'vc-find-file-hook find-file-hooks) | |
132 (setq find-file-hooks | |
133 (cons 'vc-find-file-hook find-file-hooks))) | |
134 | |
135 ;;; more hooks, this time for file-not-found | |
136 (defun vc-file-not-found-hook () | |
137 "When file is not found, try to check it out from RCS or SCCS. | |
138 Returns t if checkout was successful, nil otherwise." | |
139 (if (vc-backend-deduce buffer-file-name) | |
140 (progn | |
141 (require 'vc) | |
142 (not (vc-error-occurred (vc-checkout buffer-file-name)))))) | |
143 | |
144 (or (memq 'vc-file-not-found-hook find-file-not-found-hooks) | |
145 (setq find-file-not-found-hooks | |
146 (cons 'vc-file-not-found-hook find-file-not-found-hooks))) | |
147 | |
148 ;;; Now arrange for bindings and autoloading of the main package. | |
149 ;;; Bindings for this have to go in the global map, as it may have | |
150 ;;; to coexist with a lot of different major modes. | |
151 | |
152 (setq vc-prefix-map (lookup-key global-map "\C-xv")) | |
153 (if (not (keymapp vc-prefix-map)) | |
154 (progn | |
155 (setq vc-prefix-map (make-sparse-keymap)) | |
156 (define-key global-map "\C-xv" vc-prefix-map) | |
157 (define-key vc-prefix-map "a" 'vc-update-change-log) | |
158 (define-key vc-prefix-map "c" 'vc-cancel-version) | |
159 (define-key vc-prefix-map "d" 'vc-diff) | |
160 (define-key vc-prefix-map "h" 'vc-insert-headers) | |
161 (define-key vc-prefix-map "i" 'vc-register) | |
162 (define-key vc-prefix-map "l" 'vc-print-log) | |
163 (define-key vc-prefix-map "r" 'vc-retrieve-snapshot) | |
164 (define-key vc-prefix-map "s" 'vc-create-snapshot) | |
165 (define-key vc-prefix-map "u" 'vc-revert-buffer) | |
166 (define-key vc-prefix-map "v" 'vc-next-action) | |
167 (define-key vc-prefix-map "=" 'vc-directory) | |
168 )) | |
169 | |
170 (provide 'vc-hooks) | |
171 | |
172 ;;; vc-hooks.el ends here |