|
2232
|
1 ;;; vc-hooks.el --- resident support for version-control
|
|
904
|
2
|
|
|
3 ;; Copyright (C) 1992 Free Software Foundation, Inc.
|
|
|
4
|
|
|
5 ;; Author: Eric S. Raymond <esr@snark.thyrsus.com>
|
|
2491
|
6 ;; Version: 5.3
|
|
904
|
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
|
|
2491
|
42 (if (not (assoc 'vc-mode minor-mode-alist))
|
|
|
43 (setq minor-mode-alist (cons '(vc-mode vc-mode)
|
|
904
|
44 minor-mode-alist)))
|
|
|
45
|
|
2491
|
46 (make-variable-buffer-local 'vc-mode)
|
|
2620
|
47 (put 'vc-mode 'permanent-local t)
|
|
904
|
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
|
2213
9ff513b5d296
vc-error-occurred: moved to vc-hooks.el in order for ^X^F of a
Eric S. Raymond <esr@snark.thyrsus.com>
diff
changeset
|
53 (defmacro vc-error-occurred (&rest body)
|
9ff513b5d296
vc-error-occurred: moved to vc-hooks.el in order for ^X^F of a
Eric S. Raymond <esr@snark.thyrsus.com>
diff
changeset
|
54 (list 'condition-case nil (cons 'progn (append body '(nil))) '(error t)))
|
9ff513b5d296
vc-error-occurred: moved to vc-hooks.el in order for ^X^F of a
Eric S. Raymond <esr@snark.thyrsus.com>
diff
changeset
|
55
|
|
904
|
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)
|
|
2218
|
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)))))
|
|
904
|
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 ()
|
|
2620
|
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."
|
|
904
|
116 (interactive)
|
|
|
117 (if (vc-backend-deduce (buffer-file-name))
|
|
|
118 (vc-next-action nil)
|
|
|
119 (toggle-read-only)))
|
|
2620
|
120 (define-key global-map "\C-x\C-q" 'vc-toggle-read-only)
|
|
904
|
121
|
|
|
122 (defun vc-mode-line (file &optional label)
|
|
2491
|
123 "Set `vc-mode' to display type of version control for FILE.
|
|
904
|
124 The value is set in the current buffer, which should be the buffer
|
|
|
125 visiting FILE."
|
|
2218
|
126 (interactive (list buffer-file-name nil))
|
|
904
|
127 (let ((vc-type (vc-backend-deduce file)))
|
|
|
128 (if vc-type
|
|
|
129 (progn
|
|
2491
|
130 (setq vc-mode
|
|
904
|
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 ()
|
|
2218
|
138 ;; Recompute whether file is version controlled,
|
|
|
139 ;; if user has killed the buffer and revisited.
|
|
3459
|
140 (if buffer-file-name
|
|
|
141 (vc-file-setprop buffer-file-name 'vc-backend nil))
|
|
904
|
142 (if (and (vc-mode-line buffer-file-name) (not vc-make-backup-files))
|
|
|
143 (progn
|
|
|
144 (make-local-variable 'make-backup-files)
|
|
|
145 (setq make-backup-files nil))))
|
|
|
146
|
|
|
147 (or (memq 'vc-find-file-hook find-file-hooks)
|
|
|
148 (setq find-file-hooks
|
|
|
149 (cons 'vc-find-file-hook find-file-hooks)))
|
|
|
150
|
|
|
151 ;;; more hooks, this time for file-not-found
|
|
|
152 (defun vc-file-not-found-hook ()
|
|
|
153 "When file is not found, try to check it out from RCS or SCCS.
|
|
|
154 Returns t if checkout was successful, nil otherwise."
|
|
|
155 (if (vc-backend-deduce buffer-file-name)
|
|
|
156 (progn
|
|
|
157 (require 'vc)
|
|
|
158 (not (vc-error-occurred (vc-checkout buffer-file-name))))))
|
|
|
159
|
|
|
160 (or (memq 'vc-file-not-found-hook find-file-not-found-hooks)
|
|
|
161 (setq find-file-not-found-hooks
|
|
|
162 (cons 'vc-file-not-found-hook find-file-not-found-hooks)))
|
|
|
163
|
|
|
164 ;;; Now arrange for bindings and autoloading of the main package.
|
|
2491
|
165 ;;; Bindings for this have to go in the global map, as we'll often
|
|
|
166 ;;; want to call them from random buffers.
|
|
904
|
167
|
|
|
168 (setq vc-prefix-map (lookup-key global-map "\C-xv"))
|
|
|
169 (if (not (keymapp vc-prefix-map))
|
|
|
170 (progn
|
|
|
171 (setq vc-prefix-map (make-sparse-keymap))
|
|
|
172 (define-key global-map "\C-xv" vc-prefix-map)
|
|
|
173 (define-key vc-prefix-map "a" 'vc-update-change-log)
|
|
|
174 (define-key vc-prefix-map "c" 'vc-cancel-version)
|
|
2218
|
175 (define-key vc-prefix-map "d" 'vc-directory)
|
|
904
|
176 (define-key vc-prefix-map "h" 'vc-insert-headers)
|
|
|
177 (define-key vc-prefix-map "i" 'vc-register)
|
|
|
178 (define-key vc-prefix-map "l" 'vc-print-log)
|
|
|
179 (define-key vc-prefix-map "r" 'vc-retrieve-snapshot)
|
|
|
180 (define-key vc-prefix-map "s" 'vc-create-snapshot)
|
|
|
181 (define-key vc-prefix-map "u" 'vc-revert-buffer)
|
|
|
182 (define-key vc-prefix-map "v" 'vc-next-action)
|
|
2218
|
183 (define-key vc-prefix-map "=" 'vc-diff)
|
|
904
|
184 ))
|
|
|
185
|
|
|
186 (provide 'vc-hooks)
|
|
|
187
|
|
|
188 ;;; vc-hooks.el ends here
|
