|
0
|
1 ;;; vc.el --- drive a version-control system from within Emacs
|
|
|
2
|
|
151
|
3 ;; Copyright (C) 1992, 93, 94, 95, 96 Free Software Foundation, Inc.
|
|
0
|
4
|
|
151
|
5 ;; Author: Eric S. Raymond <esr@snark.thyrsus.com>
|
|
|
6 ;; Maintainer: Andre Spiegel <spiegel@inf.fu-berlin.de>
|
|
177
|
7 ;; Maintainer: (ClearCase) Rod Whitby <rwhitby@geocities.com>
|
|
151
|
8 ;; XEmacs conversion: Steve Baur <steve@altair.xemacs.org>
|
|
0
|
9
|
|
151
|
10 ;; This file is part of GNU Emacs.
|
|
0
|
11
|
|
151
|
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
|
|
0
|
14 ;; the Free Software Foundation; either version 2, or (at your option)
|
|
|
15 ;; any later version.
|
|
|
16
|
|
151
|
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.
|
|
0
|
21
|
|
|
22 ;; You should have received a copy of the GNU General Public License
|
|
151
|
23 ;; along with GNU Emacs; see the file COPYING. If not, write to the
|
|
16
|
24 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
|
|
|
25 ;; Boston, MA 02111-1307, USA.
|
|
0
|
26
|
|
|
27 ;;; Commentary:
|
|
|
28
|
|
|
29 ;; This mode is fully documented in the Emacs user's manual.
|
|
|
30 ;;
|
|
|
31 ;; This was designed and implemented by Eric Raymond <esr@snark.thyrsus.com>.
|
|
|
32 ;; Paul Eggert <eggert@twinsun.com>, Sebastian Kremer <sk@thp.uni-koeln.de>,
|
|
|
33 ;; and Richard Stallman contributed valuable criticism, support, and testing.
|
|
|
34 ;; CVS support was added by Per Cederqvist <ceder@lysator.liu.se>
|
|
151
|
35 ;; in Jan-Feb 1994. Further enhancements came from ttn.netcom.com and
|
|
|
36 ;; Andre Spiegel <spiegel@inf.fu-berlin.de>.
|
|
0
|
37 ;;
|
|
|
38 ;; Supported version-control systems presently include SCCS, RCS, and CVS.
|
|
151
|
39 ;;
|
|
|
40 ;; Some features will not work with old RCS versions. Where
|
|
|
41 ;; appropriate, VC finds out which version you have, and allows or
|
|
|
42 ;; disallows those features (stealing locks, for example, works only
|
|
|
43 ;; from 5.6.2 onwards).
|
|
0
|
44 ;; Even initial checkins will fail if your RCS version is so old that ci
|
|
|
45 ;; doesn't understand -t-; this has been known to happen to people running
|
|
|
46 ;; NExTSTEP 3.0.
|
|
|
47 ;;
|
|
151
|
48 ;; You can support the RCS -x option by adding pairs to the
|
|
|
49 ;; vc-master-templates list.
|
|
0
|
50 ;;
|
|
|
51 ;; Proper function of the SCCS diff commands requires the shellscript vcdiff
|
|
|
52 ;; to be installed somewhere on Emacs's path for executables.
|
|
|
53 ;;
|
|
|
54 ;; If your site uses the ChangeLog convention supported by Emacs, the
|
|
|
55 ;; function vc-comment-to-change-log should prove a useful checkin hook.
|
|
|
56 ;;
|
|
|
57 ;; This code depends on call-process passing back the subprocess exit
|
|
|
58 ;; status. Thus, you need Emacs 18.58 or later to run it. For the
|
|
|
59 ;; vc-directory command to work properly as documented, you need 19.
|
|
|
60 ;; You also need Emacs 19's ring.el.
|
|
|
61 ;;
|
|
|
62 ;; The vc code maintains some internal state in order to reduce expensive
|
|
|
63 ;; version-control operations to a minimum. Some names are only computed
|
|
|
64 ;; once. If you perform version control operations with RCS/SCCS/CVS while
|
|
|
65 ;; vc's back is turned, or move/rename master files while vc is running,
|
|
|
66 ;; vc may get seriously confused. Don't do these things!
|
|
|
67 ;;
|
|
|
68 ;; Developer's notes on some concurrency issues are included at the end of
|
|
|
69 ;; the file.
|
|
177
|
70 ;;
|
|
|
71 ;; Rudimentary ClearCase support by Rod Whitby <rwhitby@geocities.com>.
|
|
|
72 ;; I (Rod Whitby) intend to maintain the rudimentary functionality that is
|
|
|
73 ;; currently in this file. At some time in the future (don't hold your
|
|
|
74 ;; breath), I intend to merge the functionality of the cc-vc package
|
|
|
75 ;; (separately available from /rtfm.mit.edu:/pub/cc-vc/) into this file.
|
|
|
76 ;; I am not the maintainer of cc-vc, nor am I the maintainer of the
|
|
|
77 ;; non-ClearCase parts of this file.
|
|
0
|
78 ;;; Code:
|
|
|
79
|
|
|
80 (require 'vc-hooks)
|
|
|
81 (require 'ring)
|
|
151
|
82 (eval-when-compile (require 'dired)) ; for dired-map-over-marks macro
|
|
0
|
83
|
|
|
84 (if (not (assoc 'vc-parent-buffer minor-mode-alist))
|
|
|
85 (setq minor-mode-alist
|
|
|
86 (cons '(vc-parent-buffer vc-parent-buffer-name)
|
|
|
87 minor-mode-alist)))
|
|
|
88
|
|
151
|
89 ;; To implement support for a new version-control system, add another
|
|
|
90 ;; branch to the vc-backend-dispatch macro and fill it in in each
|
|
|
91 ;; call. The variable vc-master-templates in vc-hooks.el will also
|
|
|
92 ;; have to change.
|
|
|
93
|
|
|
94 (defmacro vc-backend-dispatch (f s r c)
|
|
|
95 "Execute FORM1, FORM2 or FORM3 for SCCS, RCS or CVS respectively.
|
|
|
96 If FORM3 is `RCS', use FORM2 for CVS as well as RCS.
|
|
|
97 \(CVS shares some code with RCS)."
|
|
|
98 (list 'let (list (list 'type (list 'vc-backend f)))
|
|
|
99 (list 'cond
|
|
|
100 (list (list 'eq 'type (quote 'SCCS)) s) ;; SCCS
|
|
|
101 (list (list 'eq 'type (quote 'RCS)) r) ;; RCS
|
|
|
102 (list (list 'eq 'type (quote 'CVS)) ;; CVS
|
|
|
103 (if (eq c 'RCS) r c))
|
|
|
104 )))
|
|
|
105
|
|
0
|
106 ;; General customization
|
|
|
107
|
|
|
108 (defvar vc-suppress-confirm nil
|
|
|
109 "*If non-nil, treat user as expert; suppress yes-no prompts on some things.")
|
|
|
110 (defvar vc-initial-comment nil
|
|
151
|
111 "*If non-nil, prompt for initial comment when a file is registered.")
|
|
0
|
112 (defvar vc-command-messages nil
|
|
151
|
113 "*If non-nil, display run messages from back-end commands.")
|
|
|
114 (defvar vc-register-switches nil
|
|
|
115 "*A string or list of strings specifying extra switches passed
|
|
|
116 to the register program by \\[vc-register].")
|
|
0
|
117 (defvar vc-checkin-switches nil
|
|
151
|
118 "*A string or list of strings specifying extra switches passed
|
|
|
119 to the checkin program by \\[vc-checkin].")
|
|
0
|
120 (defvar vc-checkout-switches nil
|
|
151
|
121 "*A string or list of strings specifying extra switches passed
|
|
|
122 to the checkout program by \\[vc-checkout].")
|
|
|
123 (defvar vc-directory-exclusion-list '("SCCS" "RCS" "CVS")
|
|
|
124 "*A list of directory names ignored by functions that recursively
|
|
|
125 walk file trees.")
|
|
187
|
126 (defvar vc-default-init-version nil
|
|
|
127 "*A string giving the default version number for the function `vc-register'.
|
|
|
128 If `nil' (default), the choice of initial version is left to the
|
|
|
129 version control program. Can be overridden by giving a prefix
|
|
|
130 argument to `vc-register'.")
|
|
0
|
131
|
|
|
132 (defconst vc-maximum-comment-ring-size 32
|
|
|
133 "Maximum number of saved comments in the comment ring.")
|
|
|
134
|
|
151
|
135 ;;; This is duplicated in diff.el.
|
|
|
136 ;;; XEmacs: remove
|
|
|
137 ;;(defvar diff-switches "-c"
|
|
|
138 ;; "*A string or list of strings specifying switches to be be passed to diff.")
|
|
|
139
|
|
|
140 ;;;###autoload
|
|
|
141 (defvar vc-before-checkin-hook nil
|
|
|
142 "*Normal hook (list of functions) run before a file gets checked in.
|
|
|
143 See `run-hooks'.")
|
|
0
|
144
|
|
|
145 ;;;###autoload
|
|
|
146 (defvar vc-checkin-hook nil
|
|
151
|
147 "*Normal hook (List of functions) run after a checkin is done.
|
|
|
148 See `run-hooks'.")
|
|
0
|
149
|
|
|
150 ;; Header-insertion hair
|
|
|
151
|
|
|
152 (defvar vc-header-alist
|
|
|
153 '((SCCS "\%W\%") (RCS "\$Id\$") (CVS "\$Id\$"))
|
|
151
|
154 "*Header keywords to be inserted by `vc-insert-headers'.
|
|
|
155 Must be a list of two-element lists, the first element of each must
|
|
|
156 be `RCS', `CVS', or `SCCS'. The second element is the string to
|
|
|
157 be inserted for this particular backend.")
|
|
0
|
158 (defvar vc-static-header-alist
|
|
|
159 '(("\\.c$" .
|
|
|
160 "\n#ifndef lint\nstatic char vcid[] = \"\%s\";\n#endif /* lint */\n"))
|
|
|
161 "*Associate static header string templates with file types. A \%s in the
|
|
|
162 template is replaced with the first string associated with the file's
|
|
|
163 version-control type in `vc-header-alist'.")
|
|
|
164
|
|
|
165 (defvar vc-comment-alist
|
|
|
166 '((nroff-mode ".\\\"" ""))
|
|
|
167 "*Special comment delimiters to be used in generating vc headers only.
|
|
|
168 Add an entry in this list if you need to override the normal comment-start
|
|
|
169 and comment-end variables. This will only be necessary if the mode language
|
|
|
170 is sensitive to blank lines.")
|
|
|
171
|
|
|
172 ;; Default is to be extra careful for super-user.
|
|
151
|
173 (defvar vc-checkout-carefully (= (user-uid) 0)
|
|
0
|
174 "*Non-nil means be extra-careful in checkout.
|
|
|
175 Verify that the file really is not locked
|
|
|
176 and that its contents match what the master file says.")
|
|
|
177
|
|
151
|
178 (defvar vc-rcs-release nil
|
|
|
179 "*The release number of your RCS installation, as a string.
|
|
|
180 If nil, VC itself computes this value when it is first needed.")
|
|
|
181
|
|
|
182 (defvar vc-sccs-release nil
|
|
|
183 "*The release number of your SCCS installation, as a string.
|
|
|
184 If nil, VC itself computes this value when it is first needed.")
|
|
|
185
|
|
|
186 (defvar vc-cvs-release nil
|
|
|
187 "*The release number of your CVS installation, as a string.
|
|
|
188 If nil, VC itself computes this value when it is first needed.")
|
|
|
189
|
|
0
|
190 ;; Variables the user doesn't need to know about.
|
|
|
191 (defvar vc-log-entry-mode nil)
|
|
|
192 (defvar vc-log-operation nil)
|
|
|
193 (defvar vc-log-after-operation-hook nil)
|
|
|
194 (defvar vc-checkout-writable-buffer-hook 'vc-checkout-writable-buffer)
|
|
|
195 ;; In a log entry buffer, this is a local variable
|
|
|
196 ;; that points to the buffer for which it was made
|
|
|
197 ;; (either a file, or a VC dired buffer).
|
|
|
198 (defvar vc-parent-buffer nil)
|
|
|
199 (defvar vc-parent-buffer-name nil)
|
|
|
200
|
|
|
201 (defvar vc-log-file)
|
|
|
202 (defvar vc-log-version)
|
|
|
203
|
|
|
204 (defconst vc-name-assoc-file "VC-names")
|
|
|
205
|
|
|
206 (defvar vc-dired-mode nil)
|
|
|
207 (make-variable-buffer-local 'vc-dired-mode)
|
|
|
208
|
|
151
|
209 (defvar vc-comment-ring (make-ring vc-maximum-comment-ring-size))
|
|
0
|
210 (defvar vc-comment-ring-index nil)
|
|
|
211 (defvar vc-last-comment-match nil)
|
|
|
212
|
|
151
|
213 ;; Back-portability to Emacs 18
|
|
|
214
|
|
|
215 (defun file-executable-p-18 (f)
|
|
|
216 (let ((modes (file-modes f)))
|
|
|
217 (and modes (not (zerop (logand 292))))))
|
|
|
218
|
|
|
219 (defun file-regular-p-18 (f)
|
|
|
220 (let ((attributes (file-attributes f)))
|
|
|
221 (and attributes (not (car attributes)))))
|
|
|
222
|
|
|
223 ; Conditionally rebind some things for Emacs 18 compatibility
|
|
|
224 (if (not (boundp 'minor-mode-map-alist))
|
|
|
225 (progn
|
|
|
226 (setq compilation-old-error-list nil)
|
|
|
227 (fset 'file-executable-p 'file-executable-p-18)
|
|
|
228 (fset 'shrink-window-if-larger-than-buffer 'beginning-of-buffer)
|
|
|
229 ))
|
|
|
230
|
|
|
231 (if (not (fboundp 'file-regular-p))
|
|
|
232 (fset 'file-regular-p 'file-regular-p-18))
|
|
|
233
|
|
|
234 ;;; Find and compare backend releases
|
|
|
235
|
|
|
236 (defun vc-backend-release (backend)
|
|
|
237 ;; Returns which backend release is installed on this system.
|
|
|
238 (cond
|
|
|
239 ((eq backend 'RCS)
|
|
|
240 (or vc-rcs-release
|
|
|
241 (and (zerop (vc-do-command nil nil "rcs" nil nil "-V"))
|
|
|
242 (save-excursion
|
|
|
243 (set-buffer (get-buffer "*vc*"))
|
|
|
244 (setq vc-rcs-release
|
|
|
245 (car (vc-parse-buffer
|
|
|
246 '(("^RCS version \\([0-9.]+ *.*\\)" 1)))))))
|
|
|
247 (setq vc-rcs-release 'unknown)))
|
|
|
248 ((eq backend 'CVS)
|
|
|
249 (or vc-cvs-release
|
|
|
250 (and (zerop (vc-do-command nil 1 "cvs" nil nil "-v"))
|
|
|
251 (save-excursion
|
|
|
252 (set-buffer (get-buffer "*vc*"))
|
|
|
253 (setq vc-cvs-release
|
|
|
254 (car (vc-parse-buffer
|
|
|
255 '(("^Concurrent Versions System (CVS) \\([0-9.]+\\)"
|
|
|
256 1)))))))
|
|
|
257 (setq vc-cvs-release 'unknown)))
|
|
|
258 ((eq backend 'SCCS)
|
|
|
259 vc-sccs-release)))
|
|
0
|
260
|
|
151
|
261 (defun vc-release-greater-or-equal (r1 r2)
|
|
|
262 ;; Compare release numbers, represented as strings.
|
|
|
263 ;; Release components are assumed cardinal numbers, not decimal
|
|
|
264 ;; fractions (5.10 is a higher release than 5.9). Omitted fields
|
|
|
265 ;; are considered lower (5.6.7 is earlier than 5.6.7.1).
|
|
|
266 ;; Comparison runs till the end of the string is found, or a
|
|
|
267 ;; non-numeric component shows up (5.6.7 is earlier than "5.6.7 beta",
|
|
|
268 ;; which is probably not what you want in some cases).
|
|
|
269 ;; This code is suitable for existing RCS release numbers.
|
|
|
270 ;; CVS releases are handled reasonably, too (1.3 < 1.4* < 1.5).
|
|
|
271 (let (v1 v2 i1 i2)
|
|
|
272 (catch 'done
|
|
|
273 (or (and (string-match "^\\.?\\([0-9]+\\)" r1)
|
|
|
274 (setq i1 (match-end 0))
|
|
|
275 (setq v1 (string-to-number (match-string 1 r1)))
|
|
|
276 (or (and (string-match "^\\.?\\([0-9]+\\)" r2)
|
|
|
277 (setq i2 (match-end 0))
|
|
|
278 (setq v2 (string-to-number (match-string 1 r2)))
|
|
|
279 (if (> v1 v2) (throw 'done t)
|
|
|
280 (if (< v1 v2) (throw 'done nil)
|
|
|
281 (throw 'done
|
|
|
282 (vc-release-greater-or-equal
|
|
|
283 (substring r1 i1)
|
|
|
284 (substring r2 i2)))))))
|
|
|
285 (throw 'done t)))
|
|
|
286 (or (and (string-match "^\\.?\\([0-9]+\\)" r2)
|
|
|
287 (throw 'done nil))
|
|
|
288 (throw 'done t)))))
|
|
|
289
|
|
|
290 (defun vc-backend-release-p (backend release)
|
|
|
291 ;; Return t if we have RELEASE of BACKEND or better
|
|
|
292 (let (i r (ri 0) (ii 0) is rs (installation (vc-backend-release backend)))
|
|
|
293 (if (not (eq installation 'unknown))
|
|
|
294 (cond
|
|
|
295 ((or (eq backend 'RCS) (eq backend 'CVS))
|
|
|
296 (vc-release-greater-or-equal installation release))))))
|
|
|
297
|
|
|
298 ;;; functions that operate on RCS revision numbers
|
|
|
299
|
|
|
300 (defun vc-trunk-p (rev)
|
|
|
301 ;; return t if REV is a revision on the trunk
|
|
|
302 (not (eq nil (string-match "\\`[0-9]+\\.[0-9]+\\'" rev))))
|
|
|
303
|
|
|
304 (defun vc-branch-part (rev)
|
|
|
305 ;; return the branch part of a revision number REV
|
|
|
306 (substring rev 0 (string-match "\\.[0-9]+\\'" rev)))
|
|
|
307
|
|
|
308 ;; File property caching
|
|
0
|
309
|
|
|
310 (defun vc-clear-context ()
|
|
|
311 "Clear all cached file properties and the comment ring."
|
|
|
312 (interactive)
|
|
|
313 (fillarray vc-file-prop-obarray nil)
|
|
|
314 ;; Note: there is potential for minor lossage here if there is an open
|
|
|
315 ;; log buffer with a nonzero local value of vc-comment-ring-index.
|
|
151
|
316 (setq vc-comment-ring (make-ring vc-maximum-comment-ring-size)))
|
|
|
317
|
|
|
318 (defun vc-file-clear-masterprops (file)
|
|
|
319 ;; clear all properties of FILE that were retrieved
|
|
|
320 ;; from the master file
|
|
|
321 (vc-file-setprop file 'vc-latest-version nil)
|
|
|
322 (vc-file-setprop file 'vc-your-latest-version nil)
|
|
|
323 (vc-backend-dispatch file
|
|
|
324 (progn ;; SCCS
|
|
|
325 (vc-file-setprop file 'vc-master-locks nil))
|
|
|
326 (progn ;; RCS
|
|
|
327 (vc-file-setprop file 'vc-default-branch nil)
|
|
|
328 (vc-file-setprop file 'vc-head-version nil)
|
|
|
329 (vc-file-setprop file 'vc-master-workfile-version nil)
|
|
|
330 (vc-file-setprop file 'vc-master-locks nil))
|
|
|
331 (progn
|
|
|
332 (vc-file-setprop file 'vc-cvs-status nil))))
|
|
|
333
|
|
|
334 (defun vc-head-version (file)
|
|
|
335 ;; Return the RCS head version of FILE
|
|
|
336 (cond ((vc-file-getprop file 'vc-head-version))
|
|
|
337 (t (vc-fetch-master-properties file)
|
|
|
338 (vc-file-getprop file 'vc-head-version))))
|
|
0
|
339
|
|
|
340 ;; Random helper functions
|
|
|
341
|
|
151
|
342 (defun vc-latest-on-branch-p (file)
|
|
|
343 ;; return t iff the current workfile version of FILE is
|
|
|
344 ;; the latest on its branch.
|
|
|
345 (vc-backend-dispatch file
|
|
|
346 ;; SCCS
|
|
|
347 (string= (vc-workfile-version file) (vc-latest-version file))
|
|
|
348 ;; RCS
|
|
|
349 (let ((workfile-version (vc-workfile-version file)) tip-version)
|
|
|
350 (if (vc-trunk-p workfile-version)
|
|
|
351 (progn
|
|
|
352 ;; Re-fetch the head version number. This is to make
|
|
|
353 ;; sure that no-one has checked in a new version behind
|
|
|
354 ;; our back.
|
|
|
355 (vc-fetch-master-properties file)
|
|
|
356 (string= (vc-file-getprop file 'vc-head-version)
|
|
|
357 workfile-version))
|
|
|
358 ;; If we are not on the trunk, we need to examine the
|
|
|
359 ;; whole current branch. (vc-master-workfile-version
|
|
|
360 ;; is not what we need.)
|
|
|
361 (save-excursion
|
|
|
362 (set-buffer (get-buffer-create "*vc-info*"))
|
|
|
363 (vc-insert-file (vc-name file) "^desc")
|
|
|
364 (setq tip-version (car (vc-parse-buffer (list (list
|
|
|
365 (concat "^\\(" (regexp-quote (vc-branch-part workfile-version))
|
|
|
366 "\\.[0-9]+\\)\ndate[ \t]+\\([0-9.]+\\);") 1 2)))))
|
|
|
367 (if (get-buffer "*vc-info*")
|
|
|
368 (kill-buffer (get-buffer "*vc-info*")))
|
|
|
369 (string= tip-version workfile-version))))
|
|
|
370 ;; CVS
|
|
|
371 t))
|
|
|
372
|
|
0
|
373 (defun vc-registration-error (file)
|
|
|
374 (if file
|
|
|
375 (error "File %s is not under version control" file)
|
|
|
376 (error "Buffer %s is not associated with a file" (buffer-name))))
|
|
|
377
|
|
|
378 (defvar vc-binary-assoc nil)
|
|
|
379
|
|
151
|
380 ;; XEmacs: Function referred to in vc-hooks.el
|
|
|
381 ;;;###autoload
|
|
0
|
382 (defun vc-find-binary (name)
|
|
|
383 "Look for a command anywhere on the subprocess-command search path."
|
|
|
384 (or (cdr (assoc name vc-binary-assoc))
|
|
151
|
385 (catch 'found
|
|
|
386 (mapcar
|
|
|
387 (function
|
|
|
388 (lambda (s)
|
|
|
389 (if s
|
|
|
390 (let ((full (concat s "/" name)))
|
|
|
391 (if (file-executable-p full)
|
|
|
392 (progn
|
|
|
393 (setq vc-binary-assoc
|
|
|
394 (cons (cons name full) vc-binary-assoc))
|
|
|
395 (throw 'found full)))))))
|
|
|
396 exec-path)
|
|
|
397 nil)))
|
|
0
|
398
|
|
151
|
399 (defun vc-do-command (buffer okstatus command file last &rest flags)
|
|
0
|
400 "Execute a version-control command, notifying user and checking for errors.
|
|
151
|
401 Output from COMMAND goes to BUFFER, or *vc* if BUFFER is nil.
|
|
0
|
402 The command is successful if its exit status does not exceed OKSTATUS.
|
|
151
|
403 (If OKSTATUS is nil, that means to ignore errors.)
|
|
|
404 The last argument of the command is the master name of FILE if LAST is
|
|
|
405 `MASTER', or the workfile of FILE if LAST is `WORKFILE'; this is appended
|
|
|
406 to an optional list of FLAGS."
|
|
|
407 (and file (setq file (expand-file-name file)))
|
|
|
408 (if (not buffer) (setq buffer "*vc*"))
|
|
|
409 (if vc-command-messages
|
|
|
410 (message "Running %s on %s..." command file))
|
|
|
411 (let ((obuf (current-buffer)) (camefrom (current-buffer))
|
|
0
|
412 (squeezed nil)
|
|
|
413 (vc-file (and file (vc-name file)))
|
|
151
|
414 (olddir default-directory)
|
|
0
|
415 status)
|
|
151
|
416 (set-buffer (get-buffer-create buffer))
|
|
0
|
417 (set (make-local-variable 'vc-parent-buffer) camefrom)
|
|
|
418 (set (make-local-variable 'vc-parent-buffer-name)
|
|
|
419 (concat " from " (buffer-name camefrom)))
|
|
151
|
420 (setq default-directory olddir)
|
|
0
|
421
|
|
|
422 (erase-buffer)
|
|
|
423
|
|
|
424 (mapcar
|
|
|
425 (function (lambda (s) (and s (setq squeezed (append squeezed (list s))))))
|
|
|
426 flags)
|
|
|
427 (if (and vc-file (eq last 'MASTER))
|
|
|
428 (setq squeezed (append squeezed (list vc-file))))
|
|
|
429 (if (eq last 'WORKFILE)
|
|
151
|
430 (progn
|
|
|
431 (let* ((pwd (expand-file-name default-directory))
|
|
|
432 (preflen (length pwd)))
|
|
|
433 (if (string= (substring file 0 preflen) pwd)
|
|
|
434 (setq file (substring file preflen))))
|
|
|
435 (setq squeezed (append squeezed (list file)))))
|
|
|
436 (let ((exec-path (append vc-path exec-path))
|
|
0
|
437 ;; Add vc-path to PATH for the execution of this command.
|
|
151
|
438 (process-environment
|
|
|
439 (cons (concat "PATH=" (getenv "PATH")
|
|
|
440 path-separator
|
|
|
441 (mapconcat 'identity vc-path path-separator))
|
|
|
442 process-environment))
|
|
|
443 (w32-quote-process-args t))
|
|
0
|
444 (setq status (apply 'call-process command nil t nil squeezed)))
|
|
|
445 (goto-char (point-max))
|
|
151
|
446 (set-buffer-modified-p nil)
|
|
0
|
447 (forward-line -1)
|
|
151
|
448 (if (or (not (integerp status)) (and okstatus (< okstatus status)))
|
|
0
|
449 (progn
|
|
151
|
450 (pop-to-buffer buffer)
|
|
0
|
451 (goto-char (point-min))
|
|
|
452 (shrink-window-if-larger-than-buffer)
|
|
|
453 (error "Running %s...FAILED (%s)" command
|
|
|
454 (if (integerp status)
|
|
|
455 (format "status %d" status)
|
|
|
456 status))
|
|
|
457 )
|
|
|
458 (if vc-command-messages
|
|
|
459 (message "Running %s...OK" command))
|
|
|
460 )
|
|
151
|
461 (set-buffer obuf)
|
|
0
|
462 status)
|
|
|
463 )
|
|
|
464
|
|
|
465 ;;; Save a bit of the text around POSN in the current buffer, to help
|
|
|
466 ;;; us find the corresponding position again later. This works even
|
|
|
467 ;;; if all markers are destroyed or corrupted.
|
|
151
|
468 ;;; A lot of this was shamelessly lifted from Sebastian Kremer's rcs.el mode.
|
|
0
|
469 (defun vc-position-context (posn)
|
|
|
470 (list posn
|
|
|
471 (buffer-size)
|
|
|
472 (buffer-substring posn
|
|
|
473 (min (point-max) (+ posn 100)))))
|
|
|
474
|
|
|
475 ;;; Return the position of CONTEXT in the current buffer, or nil if we
|
|
|
476 ;;; couldn't find it.
|
|
|
477 (defun vc-find-position-by-context (context)
|
|
|
478 (let ((context-string (nth 2 context)))
|
|
|
479 (if (equal "" context-string)
|
|
|
480 (point-max)
|
|
|
481 (save-excursion
|
|
|
482 (let ((diff (- (nth 1 context) (buffer-size))))
|
|
|
483 (if (< diff 0) (setq diff (- diff)))
|
|
|
484 (goto-char (nth 0 context))
|
|
|
485 (if (or (search-forward context-string nil t)
|
|
|
486 ;; Can't use search-backward since the match may continue
|
|
|
487 ;; after point.
|
|
|
488 (progn (goto-char (- (point) diff (length context-string)))
|
|
|
489 ;; goto-char doesn't signal an error at
|
|
|
490 ;; beginning of buffer like backward-char would
|
|
|
491 (search-forward context-string nil t)))
|
|
|
492 ;; to beginning of OSTRING
|
|
|
493 (- (point) (length context-string))))))))
|
|
|
494
|
|
151
|
495 (defun vc-buffer-context ()
|
|
|
496 ;; Return a list '(point-context mark-context reparse); from which
|
|
|
497 ;; vc-restore-buffer-context can later restore the context.
|
|
0
|
498 (let ((point-context (vc-position-context (point)))
|
|
|
499 ;; Use mark-marker to avoid confusion in transient-mark-mode.
|
|
151
|
500 (mark-context (if (eq (marker-buffer (mark-marker #+xemacs t))
|
|
|
501 (current-buffer))
|
|
|
502 (vc-position-context (mark-marker #+xemacs t))))
|
|
|
503 ;; Make the right thing happen in transient-mark-mode.
|
|
|
504 (mark-active nil)
|
|
0
|
505 ;; We may want to reparse the compilation buffer after revert
|
|
|
506 (reparse (and (boundp 'compilation-error-list) ;compile loaded
|
|
151
|
507 (let ((curbuf (current-buffer)))
|
|
|
508 ;; Construct a list; each elt is nil or a buffer
|
|
|
509 ;; iff that buffer is a compilation output buffer
|
|
|
510 ;; that contains markers into the current buffer.
|
|
|
511 (save-excursion
|
|
|
512 (mapcar (function
|
|
|
513 (lambda (buffer)
|
|
|
514 (set-buffer buffer)
|
|
|
515 (let ((errors (or
|
|
|
516 compilation-old-error-list
|
|
|
517 compilation-error-list))
|
|
|
518 (buffer-error-marked-p nil))
|
|
|
519 (while (and (consp errors)
|
|
|
520 (not buffer-error-marked-p))
|
|
|
521 (and (markerp (cdr (car errors)))
|
|
|
522 (eq buffer
|
|
|
523 (marker-buffer
|
|
|
524 (cdr (car errors))))
|
|
|
525 (setq buffer-error-marked-p t))
|
|
|
526 (setq errors (cdr errors)))
|
|
|
527 (if buffer-error-marked-p buffer))))
|
|
|
528 (buffer-list)))))))
|
|
|
529 (list point-context mark-context reparse)))
|
|
0
|
530
|
|
151
|
531 (defun vc-restore-buffer-context (context)
|
|
|
532 ;; Restore point/mark, and reparse any affected compilation buffers.
|
|
|
533 ;; CONTEXT is that which vc-buffer-context returns.
|
|
|
534 (let ((point-context (nth 0 context))
|
|
|
535 (mark-context (nth 1 context))
|
|
|
536 (reparse (nth 2 context)))
|
|
0
|
537 ;; Reparse affected compilation buffers.
|
|
|
538 (while reparse
|
|
|
539 (if (car reparse)
|
|
|
540 (save-excursion
|
|
|
541 (set-buffer (car reparse))
|
|
|
542 (let ((compilation-last-buffer (current-buffer)) ;select buffer
|
|
|
543 ;; Record the position in the compilation buffer of
|
|
|
544 ;; the last error next-error went to.
|
|
|
545 (error-pos (marker-position
|
|
|
546 (car (car-safe compilation-error-list)))))
|
|
|
547 ;; Reparse the error messages as far as they were parsed before.
|
|
|
548 (compile-reinitialize-errors '(4) compilation-parsing-end)
|
|
|
549 ;; Move the pointer up to find the error we were at before
|
|
|
550 ;; reparsing. Now next-error should properly go to the next one.
|
|
|
551 (while (and compilation-error-list
|
|
|
552 (/= error-pos (car (car compilation-error-list))))
|
|
|
553 (setq compilation-error-list (cdr compilation-error-list))))))
|
|
|
554 (setq reparse (cdr reparse)))
|
|
|
555
|
|
|
556 ;; Restore point and mark
|
|
|
557 (let ((new-point (vc-find-position-by-context point-context)))
|
|
|
558 (if new-point (goto-char new-point)))
|
|
|
559 (if mark-context
|
|
|
560 (let ((new-mark (vc-find-position-by-context mark-context)))
|
|
|
561 (if new-mark (set-mark new-mark))))))
|
|
|
562
|
|
151
|
563 (defun vc-revert-buffer1 (&optional arg no-confirm)
|
|
|
564 ;; Revert buffer, try to keep point and mark where user expects them in spite
|
|
|
565 ;; of changes because of expanded version-control key words.
|
|
|
566 ;; This is quite important since otherwise typeahead won't work as expected.
|
|
|
567 (interactive "P")
|
|
|
568 (widen)
|
|
|
569 (let ((context (vc-buffer-context)))
|
|
|
570 ;; t means don't call normal-mode; that's to preserve various minor modes.
|
|
|
571 (revert-buffer arg no-confirm t)
|
|
|
572 (vc-restore-buffer-context context)))
|
|
|
573
|
|
0
|
574
|
|
|
575 (defun vc-buffer-sync (&optional not-urgent)
|
|
|
576 ;; Make sure the current buffer and its working file are in sync
|
|
|
577 ;; NOT-URGENT means it is ok to continue if the user says not to save.
|
|
|
578 (if (buffer-modified-p)
|
|
|
579 (if (or vc-suppress-confirm
|
|
|
580 (y-or-n-p (format "Buffer %s modified; save it? " (buffer-name))))
|
|
|
581 (save-buffer)
|
|
|
582 (if not-urgent
|
|
|
583 nil
|
|
|
584 (error "Aborted")))))
|
|
|
585
|
|
|
586
|
|
|
587 (defun vc-workfile-unchanged-p (file &optional want-differences-if-changed)
|
|
|
588 ;; Has the given workfile changed since last checkout?
|
|
151
|
589 (let ((checkout-time (vc-file-getprop file 'vc-checkout-time))
|
|
|
590 (lastmod (nth 5 (file-attributes file))))
|
|
|
591 (or (equal checkout-time lastmod)
|
|
|
592 (and (or (not checkout-time) want-differences-if-changed)
|
|
|
593 (let ((unchanged (zerop (vc-backend-diff file nil nil
|
|
|
594 (not want-differences-if-changed)))))
|
|
|
595 ;; 0 stands for an unknown time; it can't match any mod time.
|
|
|
596 (vc-file-setprop file 'vc-checkout-time (if unchanged lastmod 0))
|
|
|
597 unchanged)))))
|
|
0
|
598
|
|
|
599 (defun vc-next-action-on-file (file verbose &optional comment)
|
|
|
600 ;;; If comment is specified, it will be used as an admin or checkin comment.
|
|
|
601 (let ((vc-file (vc-name file))
|
|
151
|
602 (vc-type (vc-backend file))
|
|
|
603 owner version buffer)
|
|
0
|
604 (cond
|
|
|
605
|
|
|
606 ;; if there is no master file corresponding, create one
|
|
|
607 ((not vc-file)
|
|
151
|
608 (vc-register verbose comment)
|
|
|
609 (if vc-initial-comment
|
|
|
610 (setq vc-log-after-operation-hook
|
|
|
611 'vc-checkout-writable-buffer-hook)
|
|
0
|
612 (vc-checkout-writable-buffer file)))
|
|
|
613
|
|
151
|
614 ;; CVS: changes to the master file need to be
|
|
|
615 ;; merged back into the working file
|
|
0
|
616 ((and (eq vc-type 'CVS)
|
|
151
|
617 (or (eq (vc-cvs-status file) 'needs-checkout)
|
|
|
618 (eq (vc-cvs-status file) 'needs-merge)))
|
|
|
619 (if (or vc-dired-mode
|
|
|
620 (yes-or-no-p
|
|
|
621 (format "%s is not up-to-date. Merge in changes now? "
|
|
|
622 (buffer-name))))
|
|
0
|
623 (progn
|
|
151
|
624 (if vc-dired-mode
|
|
|
625 (and (setq buffer (get-file-buffer file))
|
|
|
626 (buffer-modified-p buffer)
|
|
|
627 (switch-to-buffer-other-window buffer)
|
|
|
628 (vc-buffer-sync t))
|
|
|
629 (setq buffer (current-buffer))
|
|
|
630 (vc-buffer-sync t))
|
|
|
631 (if (and buffer (buffer-modified-p buffer)
|
|
0
|
632 (not (yes-or-no-p
|
|
|
633 (format
|
|
|
634 "Buffer %s modified; merge file on disc anyhow? "
|
|
151
|
635 (buffer-name buffer)))))
|
|
0
|
636 (error "Merge aborted"))
|
|
|
637 (if (not (zerop (vc-backend-merge-news file)))
|
|
|
638 ;; Overlaps detected - what now? Should use some
|
|
|
639 ;; fancy RCS conflict resolving package, or maybe
|
|
|
640 ;; emerge, but for now, simply warn the user with a
|
|
|
641 ;; message.
|
|
|
642 (message "Conflicts detected!"))
|
|
151
|
643 (and buffer
|
|
|
644 (vc-resynch-buffer file t (not (buffer-modified-p buffer)))))
|
|
0
|
645 (error "%s needs update" (buffer-name))))
|
|
|
646
|
|
151
|
647 ;; If there is no lock on the file, assert one and get it.
|
|
|
648 ;; (With implicit checkout, make sure not to lose unsaved changes.)
|
|
|
649 ((progn (and (eq (vc-checkout-model file) 'implicit)
|
|
|
650 (buffer-modified-p buffer)
|
|
|
651 (vc-buffer-sync))
|
|
|
652 (not (setq owner (vc-locking-user file))))
|
|
|
653 (if (and vc-checkout-carefully
|
|
|
654 (not (vc-workfile-unchanged-p file t)))
|
|
|
655 (if (save-window-excursion
|
|
|
656 (pop-to-buffer "*vc-diff*")
|
|
|
657 (goto-char (point-min))
|
|
|
658 (insert-string (format "Changes to %s since last lock:\n\n"
|
|
|
659 file))
|
|
|
660 (not (beep))
|
|
|
661 (yes-or-no-p
|
|
|
662 (concat "File has unlocked changes, "
|
|
|
663 "claim lock retaining changes? ")))
|
|
|
664 (progn (vc-backend-steal file)
|
|
|
665 (vc-mode-line file))
|
|
|
666 (if (not (yes-or-no-p "Revert to checked-in version, instead? "))
|
|
|
667 (error "Checkout aborted")
|
|
|
668 (vc-revert-buffer1 t t)
|
|
|
669 (vc-checkout-writable-buffer file))
|
|
|
670 )
|
|
|
671 (if verbose
|
|
|
672 (if (not (eq vc-type 'SCCS))
|
|
|
673 (vc-checkout file nil
|
|
|
674 (read-string "Branch or version to move to: "))
|
|
|
675 (error "Sorry, this is not implemented for SCCS"))
|
|
|
676 (if (vc-latest-on-branch-p file)
|
|
|
677 (vc-checkout-writable-buffer file)
|
|
|
678 (if (yes-or-no-p
|
|
|
679 "This is not the latest version. Really lock it? ")
|
|
|
680 (vc-checkout-writable-buffer file)
|
|
|
681 (if (yes-or-no-p "Lock the latest version instead? ")
|
|
|
682 (vc-checkout-writable-buffer file
|
|
|
683 (if (vc-trunk-p (vc-workfile-version file))
|
|
|
684 "" ;; this means check out latest on trunk
|
|
|
685 (vc-branch-part (vc-workfile-version file)))))))
|
|
|
686 )))
|
|
0
|
687
|
|
151
|
688 ;; a checked-out version exists, but the user may not own the lock
|
|
|
689 ((and (not (eq vc-type 'CVS))
|
|
|
690 (not (string-equal owner (vc-user-login-name))))
|
|
|
691 (if comment
|
|
|
692 (error "Sorry, you can't steal the lock on %s this way" file))
|
|
|
693 (and (eq vc-type 'RCS)
|
|
|
694 (not (vc-backend-release-p 'RCS "5.6.2"))
|
|
|
695 (error "File is locked by %s" owner))
|
|
|
696 (vc-steal-lock
|
|
|
697 file
|
|
|
698 (if verbose (read-string "Version to steal: ")
|
|
|
699 (vc-workfile-version file))
|
|
|
700 owner))
|
|
|
701
|
|
|
702 ;; OK, user owns the lock on the file
|
|
|
703 (t
|
|
|
704 (if vc-dired-mode
|
|
|
705 (find-file-other-window file)
|
|
|
706 (find-file file))
|
|
0
|
707
|
|
151
|
708 ;; give luser a chance to save before checking in.
|
|
|
709 (vc-buffer-sync)
|
|
0
|
710
|
|
151
|
711 ;; Revert if file is unchanged and buffer is too.
|
|
|
712 ;; If buffer is modified, that means the user just said no
|
|
|
713 ;; to saving it; in that case, don't revert,
|
|
|
714 ;; because the user might intend to save
|
|
|
715 ;; after finishing the log entry.
|
|
|
716 (if (and (vc-workfile-unchanged-p file)
|
|
|
717 (not (buffer-modified-p)))
|
|
|
718 ;; DO NOT revert the file without asking the user!
|
|
|
719 (cond
|
|
|
720 ((yes-or-no-p "Revert to master version? ")
|
|
|
721 (vc-backend-revert file)
|
|
|
722 (vc-resynch-window file t t)))
|
|
0
|
723
|
|
151
|
724 ;; user may want to set nonstandard parameters
|
|
|
725 (if verbose
|
|
|
726 (setq version (read-string "New version level: ")))
|
|
|
727
|
|
|
728 ;; OK, let's do the checkin
|
|
|
729 (vc-checkin file version comment)
|
|
|
730 )))))
|
|
0
|
731
|
|
|
732 (defun vc-next-action-dired (file rev comment)
|
|
151
|
733 ;; Do a vc-next-action-on-file on all the marked files, possibly
|
|
|
734 ;; passing on the log comment we've just entered.
|
|
|
735 (let ((configuration (current-window-configuration))
|
|
|
736 (dired-buffer (current-buffer))
|
|
|
737 (dired-dir default-directory))
|
|
|
738 (dired-map-over-marks
|
|
|
739 (let ((file (dired-get-filename)) p
|
|
|
740 (default-directory default-directory))
|
|
0
|
741 (message "Processing %s..." file)
|
|
151
|
742 ;; Adjust the default directory so that checkouts
|
|
|
743 ;; go to the right place.
|
|
|
744 (setq default-directory (file-name-directory file))
|
|
0
|
745 (vc-next-action-on-file file nil comment)
|
|
151
|
746 (set-buffer dired-buffer)
|
|
|
747 (setq default-directory dired-dir)
|
|
|
748 (vc-dired-update-line file)
|
|
|
749 (set-window-configuration configuration)
|
|
|
750 (message "Processing %s...done" file))
|
|
|
751 nil t)))
|
|
0
|
752
|
|
|
753 ;; Here's the major entry point.
|
|
|
754
|
|
|
755 ;;;###autoload
|
|
|
756 (defun vc-next-action (verbose)
|
|
|
757 "Do the next logical checkin or checkout operation on the current file.
|
|
151
|
758 If you call this from within a VC dired buffer with no files marked,
|
|
|
759 it will operate on the file in the current line.
|
|
|
760 If you call this from within a VC dired buffer, and one or more
|
|
|
761 files are marked, it will accept a log message and then operate on
|
|
|
762 each one. The log message will be used as a comment for any register
|
|
|
763 or checkin operations, but ignored when doing checkouts. Attempted
|
|
|
764 lock steals will raise an error.
|
|
|
765 A prefix argument lets you specify the version number to use.
|
|
0
|
766
|
|
|
767 For RCS and SCCS files:
|
|
|
768 If the file is not already registered, this registers it for version
|
|
|
769 control and then retrieves a writable, locked copy for editing.
|
|
|
770 If the file is registered and not locked by anyone, this checks out
|
|
|
771 a writable and locked file ready for editing.
|
|
|
772 If the file is checked out and locked by the calling user, this
|
|
|
773 first checks to see if the file has changed since checkout. If not,
|
|
|
774 it performs a revert.
|
|
|
775 If the file has been changed, this pops up a buffer for entry
|
|
|
776 of a log message; when the message has been entered, it checks in the
|
|
|
777 resulting changes along with the log message as change commentary. If
|
|
|
778 the variable `vc-keep-workfiles' is non-nil (which is its default), a
|
|
|
779 read-only copy of the changed file is left in place afterwards.
|
|
|
780 If the file is registered and locked by someone else, you are given
|
|
|
781 the option to steal the lock.
|
|
|
782
|
|
|
783 For CVS files:
|
|
|
784 If the file is not already registered, this registers it for version
|
|
|
785 control. This does a \"cvs add\", but no \"cvs commit\".
|
|
|
786 If the file is added but not committed, it is committed.
|
|
|
787 If your working file is changed, but the repository file is
|
|
|
788 unchanged, this pops up a buffer for entry of a log message; when the
|
|
|
789 message has been entered, it checks in the resulting changes along
|
|
|
790 with the logmessage as change commentary. A writable file is retained.
|
|
|
791 If the repository file is changed, you are asked if you want to
|
|
151
|
792 merge in the changes into your working copy."
|
|
0
|
793
|
|
|
794 (interactive "P")
|
|
|
795 (catch 'nogo
|
|
|
796 (if vc-dired-mode
|
|
|
797 (let ((files (dired-get-marked-files)))
|
|
151
|
798 (if (string= ""
|
|
|
799 (mapconcat
|
|
|
800 (function (lambda (f)
|
|
|
801 (if (eq (vc-backend f) 'CVS)
|
|
|
802 (if (or (eq (vc-cvs-status f) 'locally-modified)
|
|
|
803 (eq (vc-cvs-status f) 'locally-added))
|
|
|
804 "@" "")
|
|
|
805 (if (vc-locking-user f) "@" ""))))
|
|
|
806 files ""))
|
|
|
807 (vc-next-action-dired nil nil "dummy")
|
|
|
808 (vc-start-entry nil nil nil
|
|
|
809 "Enter a change comment for the marked files."
|
|
|
810 'vc-next-action-dired))
|
|
|
811 (throw 'nogo nil)))
|
|
0
|
812 (while vc-parent-buffer
|
|
|
813 (pop-to-buffer vc-parent-buffer))
|
|
|
814 (if buffer-file-name
|
|
|
815 (vc-next-action-on-file buffer-file-name verbose)
|
|
|
816 (vc-registration-error nil))))
|
|
|
817
|
|
|
818 ;;; These functions help the vc-next-action entry point
|
|
|
819
|
|
151
|
820 (defun vc-checkout-writable-buffer (&optional file rev)
|
|
0
|
821 "Retrieve a writable copy of the latest version of the current buffer's file."
|
|
151
|
822 (vc-checkout (or file (buffer-file-name)) t rev)
|
|
0
|
823 )
|
|
|
824
|
|
|
825 ;;;###autoload
|
|
|
826 (defun vc-register (&optional override comment)
|
|
187
|
827 "Register the current file into your version-control system.
|
|
|
828 The default initial version number, taken to be `vc-default-init-version',
|
|
|
829 can be overridden by giving a prefix arg."
|
|
0
|
830 (interactive "P")
|
|
151
|
831 (or buffer-file-name
|
|
|
832 (error "No visited file"))
|
|
0
|
833 (let ((master (vc-name buffer-file-name)))
|
|
|
834 (and master (file-exists-p master)
|
|
|
835 (error "This file is already registered"))
|
|
|
836 (and master
|
|
|
837 (not (y-or-n-p "Previous master file has vanished. Make a new one? "))
|
|
|
838 (error "This file is already registered")))
|
|
|
839 ;; Watch out for new buffers of size 0: the corresponding file
|
|
|
840 ;; does not exist yet, even though buffer-modified-p is nil.
|
|
|
841 (if (and (not (buffer-modified-p))
|
|
|
842 (zerop (buffer-size))
|
|
|
843 (not (file-exists-p buffer-file-name)))
|
|
|
844 (set-buffer-modified-p t))
|
|
|
845 (vc-buffer-sync)
|
|
151
|
846 (cond ((not vc-make-backup-files)
|
|
|
847 ;; inhibit backup for this buffer
|
|
|
848 (make-local-variable 'backup-inhibited)
|
|
|
849 (setq backup-inhibited t)))
|
|
0
|
850 (vc-admin
|
|
|
851 buffer-file-name
|
|
187
|
852 (or (and override
|
|
|
853 (read-string
|
|
|
854 (format "Initial version level for %s: "
|
|
|
855 buffer-file-name)))
|
|
|
856 vc-default-init-version)
|
|
|
857 comment))
|
|
0
|
858
|
|
|
859 (defun vc-resynch-window (file &optional keep noquery)
|
|
|
860 ;; If the given file is in the current buffer,
|
|
151
|
861 ;; either revert on it so we see expanded keywords,
|
|
0
|
862 ;; or unvisit it (depending on vc-keep-workfiles)
|
|
|
863 ;; NOQUERY if non-nil inhibits confirmation for reverting.
|
|
|
864 ;; NOQUERY should be t *only* if it is known the only difference
|
|
|
865 ;; between the buffer and the file is due to RCS rather than user editing!
|
|
|
866 (and (string= buffer-file-name file)
|
|
|
867 (if keep
|
|
|
868 (progn
|
|
151
|
869 ;; temporarily remove vc-find-file-hook, so that
|
|
|
870 ;; we don't lose the properties
|
|
|
871 (remove-hook 'find-file-hooks 'vc-find-file-hook)
|
|
0
|
872 (vc-revert-buffer1 t noquery)
|
|
151
|
873 (add-hook 'find-file-hooks 'vc-find-file-hook)
|
|
0
|
874 (vc-mode-line buffer-file-name))
|
|
151
|
875 (kill-buffer (current-buffer)))))
|
|
0
|
876
|
|
151
|
877 (defun vc-resynch-buffer (file &optional keep noquery)
|
|
|
878 ;; if FILE is currently visited, resynch its buffer
|
|
|
879 (let ((buffer (get-file-buffer file)))
|
|
|
880 (if buffer
|
|
|
881 (save-excursion
|
|
|
882 (set-buffer buffer)
|
|
|
883 (vc-resynch-window file keep noquery)))))
|
|
|
884
|
|
|
885 (defun vc-start-entry (file rev comment msg action &optional after-hook)
|
|
0
|
886 ;; Accept a comment for an operation on FILE revision REV. If COMMENT
|
|
|
887 ;; is nil, pop up a VC-log buffer, emit MSG, and set the
|
|
|
888 ;; action on close to ACTION; otherwise, do action immediately.
|
|
|
889 ;; Remember the file's buffer in vc-parent-buffer (current one if no file).
|
|
|
890 ;; AFTER-HOOK specifies the local value for vc-log-operation-hook.
|
|
|
891 (let ((parent (if file (find-file-noselect file) (current-buffer))))
|
|
151
|
892 (if vc-before-checkin-hook
|
|
|
893 (if file
|
|
|
894 (save-excursion
|
|
|
895 (set-buffer parent)
|
|
|
896 (run-hooks 'vc-before-checkin-hook))
|
|
|
897 (run-hooks 'vc-before-checkin-hook)))
|
|
0
|
898 (if comment
|
|
|
899 (set-buffer (get-buffer-create "*VC-log*"))
|
|
|
900 (pop-to-buffer (get-buffer-create "*VC-log*")))
|
|
|
901 (set (make-local-variable 'vc-parent-buffer) parent)
|
|
|
902 (set (make-local-variable 'vc-parent-buffer-name)
|
|
|
903 (concat " from " (buffer-name vc-parent-buffer)))
|
|
151
|
904 (if file (vc-mode-line file))
|
|
|
905 (vc-log-mode file)
|
|
0
|
906 (make-local-variable 'vc-log-after-operation-hook)
|
|
|
907 (if after-hook
|
|
|
908 (setq vc-log-after-operation-hook after-hook))
|
|
|
909 (setq vc-log-operation action)
|
|
|
910 (setq vc-log-version rev)
|
|
|
911 (if comment
|
|
|
912 (progn
|
|
|
913 (erase-buffer)
|
|
|
914 (if (eq comment t)
|
|
|
915 (vc-finish-logentry t)
|
|
|
916 (insert comment)
|
|
|
917 (vc-finish-logentry nil)))
|
|
|
918 (message "%s Type C-c C-c when done." msg))))
|
|
|
919
|
|
|
920 (defun vc-admin (file rev &optional comment)
|
|
|
921 "Check a file into your version-control system.
|
|
|
922 FILE is the unmodified name of the file. REV should be the base version
|
|
|
923 level to check it in under. COMMENT, if specified, is the checkin comment."
|
|
|
924 (vc-start-entry file rev
|
|
|
925 (or comment (not vc-initial-comment))
|
|
|
926 "Enter initial comment." 'vc-backend-admin
|
|
151
|
927 nil))
|
|
0
|
928
|
|
151
|
929 ;; XEmacs: Function referred to in vc-hooks.el.
|
|
|
930 ;;;###autoload
|
|
|
931 (defun vc-checkout (file &optional writable rev)
|
|
0
|
932 "Retrieve a copy of the latest version of the given file."
|
|
|
933 ;; If ftp is on this system and the name matches the ange-ftp format
|
|
|
934 ;; for a remote file, the user is trying something that won't work.
|
|
151
|
935 (if (and (string-match "^/[^/:]+:" file) (vc-find-binary "ftp"))
|
|
|
936 (error "Sorry, you can't check out files over FTP"))
|
|
|
937 (vc-backend-checkout file writable rev)
|
|
|
938 (vc-resynch-buffer file t t))
|
|
0
|
939
|
|
|
940 (defun vc-steal-lock (file rev &optional owner)
|
|
|
941 "Steal the lock on the current workfile."
|
|
|
942 (let (file-description)
|
|
|
943 (if (not owner)
|
|
|
944 (setq owner (vc-locking-user file)))
|
|
|
945 (if rev
|
|
|
946 (setq file-description (format "%s:%s" file rev))
|
|
|
947 (setq file-description file))
|
|
|
948 (if (not (y-or-n-p (format "Take the lock on %s from %s? "
|
|
|
949 file-description owner)))
|
|
|
950 (error "Steal cancelled"))
|
|
|
951 (pop-to-buffer (get-buffer-create "*VC-mail*"))
|
|
|
952 (setq default-directory (expand-file-name "~/"))
|
|
|
953 (auto-save-mode auto-save-default)
|
|
|
954 (mail-mode)
|
|
|
955 (erase-buffer)
|
|
|
956 (mail-setup owner (format "Stolen lock on %s" file-description) nil nil nil
|
|
|
957 (list (list 'vc-finish-steal file rev)))
|
|
|
958 (goto-char (point-max))
|
|
|
959 (insert
|
|
|
960 (format "I stole the lock on %s, " file-description)
|
|
|
961 (current-time-string)
|
|
|
962 ".\n")
|
|
|
963 (message "Please explain why you stole the lock. Type C-c C-c when done.")))
|
|
|
964
|
|
|
965 ;; This is called when the notification has been sent.
|
|
|
966 (defun vc-finish-steal (file version)
|
|
|
967 (vc-backend-steal file version)
|
|
|
968 (if (get-file-buffer file)
|
|
|
969 (save-excursion
|
|
|
970 (set-buffer (get-file-buffer file))
|
|
|
971 (vc-resynch-window file t t))))
|
|
|
972
|
|
|
973 (defun vc-checkin (file &optional rev comment)
|
|
|
974 "Check in the file specified by FILE.
|
|
|
975 The optional argument REV may be a string specifying the new version level
|
|
|
976 \(if nil increment the current level). The file is either retained with write
|
|
|
977 permissions zeroed, or deleted (according to the value of `vc-keep-workfiles').
|
|
|
978 If the back-end is CVS, a writable workfile is always kept.
|
|
|
979 COMMENT is a comment string; if omitted, a buffer is
|
|
|
980 popped up to accept a comment."
|
|
|
981 (vc-start-entry file rev comment
|
|
|
982 "Enter a change comment." 'vc-backend-checkin
|
|
151
|
983 'vc-checkin-hook))
|
|
0
|
984
|
|
|
985 ;;; Here is a checkin hook that may prove useful to sites using the
|
|
|
986 ;;; ChangeLog facility supported by Emacs.
|
|
|
987 (defun vc-comment-to-change-log (&optional whoami file-name)
|
|
|
988 "Enter last VC comment into change log file for current buffer's file.
|
|
|
989 Optional arg (interactive prefix) non-nil means prompt for user name and site.
|
|
|
990 Second arg is file name of change log. \
|
|
|
991 If nil, uses `change-log-default-name'."
|
|
|
992 (interactive (if current-prefix-arg
|
|
|
993 (list current-prefix-arg
|
|
|
994 (prompt-for-change-log-name))))
|
|
|
995 ;; Make sure the defvar for add-log-current-defun-function has been executed
|
|
|
996 ;; before binding it.
|
|
|
997 (require 'add-log)
|
|
151
|
998 (let (;; Extract the comment first so we get any error before doing anything.
|
|
0
|
999 (comment (ring-ref vc-comment-ring 0))
|
|
|
1000 ;; Don't let add-change-log-entry insert a defun name.
|
|
|
1001 (add-log-current-defun-function 'ignore)
|
|
|
1002 end)
|
|
|
1003 ;; Call add-log to do half the work.
|
|
|
1004 (add-change-log-entry whoami file-name t t)
|
|
|
1005 ;; Insert the VC comment, leaving point before it.
|
|
|
1006 (setq end (save-excursion (insert comment) (point-marker)))
|
|
|
1007 (if (looking-at "\\s *\\s(")
|
|
|
1008 ;; It starts with an open-paren, as in "(foo): Frobbed."
|
|
|
1009 ;; So remove the ": " add-log inserted.
|
|
|
1010 (delete-char -2))
|
|
|
1011 ;; Canonicalize the white space between the file name and comment.
|
|
|
1012 (just-one-space)
|
|
|
1013 ;; Indent rest of the text the same way add-log indented the first line.
|
|
|
1014 (let ((indentation (current-indentation)))
|
|
|
1015 (save-excursion
|
|
|
1016 (while (< (point) end)
|
|
|
1017 (forward-line 1)
|
|
|
1018 (indent-to indentation))
|
|
|
1019 (setq end (point))))
|
|
|
1020 ;; Fill the inserted text, preserving open-parens at bol.
|
|
151
|
1021 (let ((paragraph-separate (concat paragraph-separate "\\|\\s *\\s("))
|
|
|
1022 (paragraph-start (concat paragraph-start "\\|\\s *\\s(")))
|
|
0
|
1023 (beginning-of-line)
|
|
|
1024 (fill-region (point) end))
|
|
|
1025 ;; Canonicalize the white space at the end of the entry so it is
|
|
|
1026 ;; separated from the next entry by a single blank line.
|
|
|
1027 (skip-syntax-forward " " end)
|
|
|
1028 (delete-char (- (skip-syntax-backward " ")))
|
|
|
1029 (or (eobp) (looking-at "\n\n")
|
|
|
1030 (insert "\n"))))
|
|
|
1031
|
|
|
1032
|
|
|
1033 (defun vc-finish-logentry (&optional nocomment)
|
|
|
1034 "Complete the operation implied by the current log entry."
|
|
|
1035 (interactive)
|
|
|
1036 ;; Check and record the comment, if any.
|
|
|
1037 (if (not nocomment)
|
|
|
1038 (progn
|
|
|
1039 (goto-char (point-max))
|
|
|
1040 (if (not (bolp))
|
|
|
1041 (newline))
|
|
|
1042 ;; Comment too long?
|
|
|
1043 (vc-backend-logentry-check vc-log-file)
|
|
|
1044 ;; Record the comment in the comment ring
|
|
|
1045 (ring-insert vc-comment-ring (buffer-string))
|
|
|
1046 ))
|
|
|
1047 ;; Sync parent buffer in case the user modified it while editing the comment.
|
|
|
1048 ;; But not if it is a vc-dired buffer.
|
|
|
1049 (save-excursion
|
|
|
1050 (set-buffer vc-parent-buffer)
|
|
|
1051 (or vc-dired-mode
|
|
|
1052 (vc-buffer-sync)))
|
|
151
|
1053 (if (not vc-log-operation) (error "No log operation is pending"))
|
|
|
1054 ;; save the parameters held in buffer-local variables
|
|
|
1055 (let ((log-operation vc-log-operation)
|
|
|
1056 (log-file vc-log-file)
|
|
|
1057 (log-version vc-log-version)
|
|
|
1058 (log-entry (buffer-string))
|
|
|
1059 (after-hook vc-log-after-operation-hook))
|
|
0
|
1060 ;; Return to "parent" buffer of this checkin and remove checkin window
|
|
|
1061 (pop-to-buffer vc-parent-buffer)
|
|
|
1062 (let ((logbuf (get-buffer "*VC-log*")))
|
|
|
1063 (delete-windows-on logbuf)
|
|
|
1064 (kill-buffer logbuf))
|
|
151
|
1065 ;; OK, do it to it
|
|
|
1066 (save-excursion
|
|
|
1067 (funcall log-operation
|
|
|
1068 log-file
|
|
|
1069 log-version
|
|
|
1070 log-entry))
|
|
0
|
1071 ;; Now make sure we see the expanded headers
|
|
|
1072 (if buffer-file-name
|
|
|
1073 (vc-resynch-window buffer-file-name vc-keep-workfiles t))
|
|
151
|
1074 (run-hooks after-hook 'vc-finish-logentry-hook)))
|
|
0
|
1075
|
|
|
1076 ;; Code for access to the comment ring
|
|
|
1077
|
|
|
1078 (defun vc-previous-comment (arg)
|
|
|
1079 "Cycle backwards through comment history."
|
|
|
1080 (interactive "*p")
|
|
|
1081 (let ((len (ring-length vc-comment-ring)))
|
|
151
|
1082 (cond ((<= len 0)
|
|
0
|
1083 (message "Empty comment ring")
|
|
|
1084 (ding))
|
|
|
1085 (t
|
|
|
1086 (erase-buffer)
|
|
|
1087 ;; Initialize the index on the first use of this command
|
|
|
1088 ;; so that the first M-p gets index 0, and the first M-n gets
|
|
|
1089 ;; index -1.
|
|
|
1090 (if (null vc-comment-ring-index)
|
|
|
1091 (setq vc-comment-ring-index
|
|
|
1092 (if (> arg 0) -1
|
|
151
|
1093 (if (< arg 0) 1 0))))
|
|
0
|
1094 (setq vc-comment-ring-index
|
|
|
1095 (mod (+ vc-comment-ring-index arg) len))
|
|
|
1096 (message "%d" (1+ vc-comment-ring-index))
|
|
|
1097 (insert (ring-ref vc-comment-ring vc-comment-ring-index))))))
|
|
|
1098
|
|
|
1099 (defun vc-next-comment (arg)
|
|
|
1100 "Cycle forwards through comment history."
|
|
|
1101 (interactive "*p")
|
|
|
1102 (vc-previous-comment (- arg)))
|
|
|
1103
|
|
|
1104 (defun vc-comment-search-reverse (str)
|
|
|
1105 "Searches backwards through comment history for substring match."
|
|
|
1106 (interactive "sComment substring: ")
|
|
|
1107 (if (string= str "")
|
|
|
1108 (setq str vc-last-comment-match)
|
|
|
1109 (setq vc-last-comment-match str))
|
|
|
1110 (if (null vc-comment-ring-index)
|
|
|
1111 (setq vc-comment-ring-index -1))
|
|
|
1112 (let ((str (regexp-quote str))
|
|
151
|
1113 (len (ring-length vc-comment-ring))
|
|
0
|
1114 (n (1+ vc-comment-ring-index)))
|
|
|
1115 (while (and (< n len) (not (string-match str (ring-ref vc-comment-ring n))))
|
|
|
1116 (setq n (+ n 1)))
|
|
|
1117 (cond ((< n len)
|
|
|
1118 (vc-previous-comment (- n vc-comment-ring-index)))
|
|
|
1119 (t (error "Not found")))))
|
|
|
1120
|
|
|
1121 (defun vc-comment-search-forward (str)
|
|
|
1122 "Searches forwards through comment history for substring match."
|
|
|
1123 (interactive "sComment substring: ")
|
|
|
1124 (if (string= str "")
|
|
|
1125 (setq str vc-last-comment-match)
|
|
|
1126 (setq vc-last-comment-match str))
|
|
|
1127 (if (null vc-comment-ring-index)
|
|
|
1128 (setq vc-comment-ring-index 0))
|
|
|
1129 (let ((str (regexp-quote str))
|
|
151
|
1130 (len (ring-length vc-comment-ring))
|
|
0
|
1131 (n vc-comment-ring-index))
|
|
|
1132 (while (and (>= n 0) (not (string-match str (ring-ref vc-comment-ring n))))
|
|
|
1133 (setq n (- n 1)))
|
|
|
1134 (cond ((>= n 0)
|
|
|
1135 (vc-next-comment (- n vc-comment-ring-index)))
|
|
|
1136 (t (error "Not found")))))
|
|
|
1137
|
|
|
1138 ;; Additional entry points for examining version histories
|
|
|
1139
|
|
|
1140 ;;;###autoload
|
|
|
1141 (defun vc-diff (historic &optional not-urgent)
|
|
|
1142 "Display diffs between file versions.
|
|
|
1143 Normally this compares the current file and buffer with the most recent
|
|
|
1144 checked in version of that file. This uses no arguments.
|
|
|
1145 With a prefix argument, it reads the file name to use
|
|
|
1146 and two version designators specifying which versions to compare."
|
|
151
|
1147 (interactive (list current-prefix-arg t))
|
|
0
|
1148 (if vc-dired-mode
|
|
|
1149 (set-buffer (find-file-noselect (dired-get-filename))))
|
|
|
1150 (while vc-parent-buffer
|
|
151
|
1151 (pop-to-buffer vc-parent-buffer))
|
|
0
|
1152 (if historic
|
|
|
1153 (call-interactively 'vc-version-diff)
|
|
|
1154 (if (or (null buffer-file-name) (null (vc-name buffer-file-name)))
|
|
|
1155 (error
|
|
|
1156 "There is no version-control master associated with this buffer"))
|
|
|
1157 (let ((file buffer-file-name)
|
|
|
1158 unchanged)
|
|
|
1159 (or (and file (vc-name file))
|
|
|
1160 (vc-registration-error file))
|
|
|
1161 (vc-buffer-sync not-urgent)
|
|
|
1162 (setq unchanged (vc-workfile-unchanged-p buffer-file-name))
|
|
|
1163 (if unchanged
|
|
151
|
1164 (message "No changes to %s since latest version" file)
|
|
0
|
1165 (vc-backend-diff file)
|
|
|
1166 ;; Ideally, we'd like at this point to parse the diff so that
|
|
|
1167 ;; the buffer effectively goes into compilation mode and we
|
|
|
1168 ;; can visit the old and new change locations via next-error.
|
|
|
1169 ;; Unfortunately, this is just too painful to do. The basic
|
|
|
1170 ;; problem is that the `old' file doesn't exist to be
|
|
|
1171 ;; visited. This plays hell with numerous assumptions in
|
|
|
1172 ;; the diff.el and compile.el machinery.
|
|
151
|
1173 (set-buffer "*vc-diff*")
|
|
0
|
1174 (setq default-directory (file-name-directory file))
|
|
|
1175 (if (= 0 (buffer-size))
|
|
|
1176 (progn
|
|
|
1177 (setq unchanged t)
|
|
151
|
1178 (message "No changes to %s since latest version" file))
|
|
|
1179 (pop-to-buffer "*vc-diff*")
|
|
0
|
1180 (goto-char (point-min))
|
|
|
1181 (shrink-window-if-larger-than-buffer)))
|
|
|
1182 (not unchanged))))
|
|
|
1183
|
|
177
|
1184 ;;;###autoload
|
|
0
|
1185 (defun vc-version-diff (file rel1 rel2)
|
|
|
1186 "For FILE, report diffs between two stored versions REL1 and REL2 of it.
|
|
|
1187 If FILE is a directory, generate diffs between versions for all registered
|
|
|
1188 files in or below it."
|
|
151
|
1189 (interactive "FFile or directory to diff: \nsOlder version: \nsNewer version: ")
|
|
0
|
1190 (if (string-equal rel1 "") (setq rel1 nil))
|
|
|
1191 (if (string-equal rel2 "") (setq rel2 nil))
|
|
|
1192 (if (file-directory-p file)
|
|
|
1193 (let ((camefrom (current-buffer)))
|
|
|
1194 (set-buffer (get-buffer-create "*vc-status*"))
|
|
|
1195 (set (make-local-variable 'vc-parent-buffer) camefrom)
|
|
|
1196 (set (make-local-variable 'vc-parent-buffer-name)
|
|
|
1197 (concat " from " (buffer-name camefrom)))
|
|
|
1198 (erase-buffer)
|
|
|
1199 (insert "Diffs between "
|
|
|
1200 (or rel1 "last version checked in")
|
|
|
1201 " and "
|
|
|
1202 (or rel2 "current workfile(s)")
|
|
|
1203 ":\n\n")
|
|
151
|
1204 (set-buffer (get-buffer-create "*vc-diff*"))
|
|
0
|
1205 (cd file)
|
|
|
1206 (vc-file-tree-walk
|
|
151
|
1207 default-directory
|
|
0
|
1208 (function (lambda (f)
|
|
|
1209 (message "Looking at %s" f)
|
|
|
1210 (and
|
|
|
1211 (not (file-directory-p f))
|
|
|
1212 (vc-registered f)
|
|
|
1213 (vc-backend-diff f rel1 rel2)
|
|
|
1214 (append-to-buffer "*vc-status*" (point-min) (point-max)))
|
|
|
1215 )))
|
|
|
1216 (pop-to-buffer "*vc-status*")
|
|
|
1217 (insert "\nEnd of diffs.\n")
|
|
|
1218 (goto-char (point-min))
|
|
|
1219 (set-buffer-modified-p nil)
|
|
|
1220 )
|
|
|
1221 (if (zerop (vc-backend-diff file rel1 rel2))
|
|
|
1222 (message "No changes to %s between %s and %s." file rel1 rel2)
|
|
151
|
1223 (pop-to-buffer "*vc-diff*"))))
|
|
0
|
1224
|
|
|
1225 ;;;###autoload
|
|
|
1226 (defun vc-version-other-window (rev)
|
|
|
1227 "Visit version REV of the current buffer in another window.
|
|
|
1228 If the current buffer is named `F', the version is named `F.~REV~'.
|
|
|
1229 If `F.~REV~' already exists, it is used instead of being re-created."
|
|
|
1230 (interactive "sVersion to visit (default is latest version): ")
|
|
|
1231 (if vc-dired-mode
|
|
|
1232 (set-buffer (find-file-noselect (dired-get-filename))))
|
|
|
1233 (while vc-parent-buffer
|
|
151
|
1234 (pop-to-buffer vc-parent-buffer))
|
|
0
|
1235 (if (and buffer-file-name (vc-name buffer-file-name))
|
|
|
1236 (let* ((version (if (string-equal rev "")
|
|
|
1237 (vc-latest-version buffer-file-name)
|
|
|
1238 rev))
|
|
|
1239 (filename (concat buffer-file-name ".~" version "~")))
|
|
151
|
1240 (or (file-exists-p filename)
|
|
|
1241 (vc-backend-checkout buffer-file-name nil version filename))
|
|
|
1242 (find-file-other-window filename))
|
|
0
|
1243 (vc-registration-error buffer-file-name)))
|
|
|
1244
|
|
|
1245 ;; Header-insertion code
|
|
|
1246
|
|
|
1247 ;;;###autoload
|
|
|
1248 (defun vc-insert-headers ()
|
|
|
1249 "Insert headers in a file for use with your version-control system.
|
|
|
1250 Headers desired are inserted at the start of the buffer, and are pulled from
|
|
|
1251 the variable `vc-header-alist'."
|
|
|
1252 (interactive)
|
|
|
1253 (if vc-dired-mode
|
|
|
1254 (find-file-other-window (dired-get-filename)))
|
|
|
1255 (while vc-parent-buffer
|
|
151
|
1256 (pop-to-buffer vc-parent-buffer))
|
|
0
|
1257 (save-excursion
|
|
|
1258 (save-restriction
|
|
|
1259 (widen)
|
|
|
1260 (if (or (not (vc-check-headers))
|
|
|
1261 (y-or-n-p "Version headers already exist. Insert another set? "))
|
|
|
1262 (progn
|
|
|
1263 (let* ((delims (cdr (assq major-mode vc-comment-alist)))
|
|
|
1264 (comment-start-vc (or (car delims) comment-start "#"))
|
|
|
1265 (comment-end-vc (or (car (cdr delims)) comment-end ""))
|
|
151
|
1266 (hdstrings (cdr (assoc (vc-backend (buffer-file-name)) vc-header-alist))))
|
|
|
1267 (mapcar (function (lambda (s)
|
|
|
1268 (insert comment-start-vc "\t" s "\t"
|
|
|
1269 comment-end-vc "\n")))
|
|
0
|
1270 hdstrings)
|
|
|
1271 (if vc-static-header-alist
|
|
151
|
1272 (mapcar (function (lambda (f)
|
|
|
1273 (if (string-match (car f) buffer-file-name)
|
|
|
1274 (insert (format (cdr f) (car hdstrings))))))
|
|
0
|
1275 vc-static-header-alist))
|
|
|
1276 )
|
|
|
1277 )))))
|
|
|
1278
|
|
151
|
1279 (defun vc-clear-headers ()
|
|
|
1280 ;; Clear all version headers in the current buffer, i.e. reset them
|
|
|
1281 ;; to the nonexpanded form. Only implemented for RCS, yet.
|
|
|
1282 ;; Don't lose point and mark during this.
|
|
|
1283 (let ((context (vc-buffer-context)))
|
|
|
1284 (goto-char (point-min))
|
|
|
1285 (while (re-search-forward "\\$\\([A-Za-z]+\\): [^\\$]+\\$" nil t)
|
|
|
1286 (replace-match "$\\1$"))
|
|
|
1287 (vc-restore-buffer-context context)))
|
|
|
1288
|
|
|
1289 ;; The VC directory major mode. Coopt Dired for this.
|
|
0
|
1290 ;; All VC commands get mapped into logical equivalents.
|
|
|
1291
|
|
151
|
1292 (define-derived-mode vc-dired-mode dired-mode "Dired under VC"
|
|
|
1293 "The major mode used in VC directory buffers. It is derived from Dired.
|
|
0
|
1294 All Dired commands operate normally. Users currently locking listed files
|
|
|
1295 are listed in place of the file's owner and group.
|
|
|
1296 Keystrokes bound to VC commands will execute as though they had been called
|
|
|
1297 on a buffer attached to the file named in the current Dired buffer line."
|
|
151
|
1298 (setq vc-dired-mode t))
|
|
|
1299
|
|
|
1300 (define-key vc-dired-mode-map "\C-xv" vc-prefix-map)
|
|
|
1301 (define-key vc-dired-mode-map "g" 'vc-dired-update)
|
|
|
1302 (define-key vc-dired-mode-map "=" 'vc-diff)
|
|
|
1303
|
|
|
1304 (defun vc-dired-state-info (file)
|
|
|
1305 ;; Return the string that indicates the version control status
|
|
|
1306 ;; on a VC dired line.
|
|
|
1307 (let ((cvs-state (and (eq (vc-backend file) 'CVS)
|
|
|
1308 (vc-cvs-status file))))
|
|
|
1309 (if cvs-state
|
|
|
1310 (cond ((eq cvs-state 'up-to-date) nil)
|
|
|
1311 ((eq cvs-state 'needs-checkout) "patch")
|
|
|
1312 ((eq cvs-state 'locally-modified) "modified")
|
|
|
1313 ((eq cvs-state 'needs-merge) "merge")
|
|
|
1314 ((eq cvs-state 'unresolved-conflict) "conflict")
|
|
|
1315 ((eq cvs-state 'locally-added) "added"))
|
|
|
1316 (vc-locking-user file))))
|
|
0
|
1317
|
|
|
1318 (defun vc-dired-reformat-line (x)
|
|
|
1319 ;; Hack a directory-listing line, plugging in locking-user info in
|
|
|
1320 ;; place of the user and group info. Should have the beneficial
|
|
|
1321 ;; side-effect of shortening the listing line. Each call starts with
|
|
|
1322 ;; point immediately following the dired mark area on the line to be
|
|
|
1323 ;; hacked.
|
|
|
1324 ;;
|
|
|
1325 ;; Simplest possible one:
|
|
|
1326 ;; (insert (concat x "\t")))
|
|
|
1327 ;;
|
|
|
1328 ;; This code, like dired, assumes UNIX -l format.
|
|
151
|
1329 (let ((pos (point)) limit perm owner date-and-file)
|
|
|
1330 (end-of-line)
|
|
|
1331 (setq limit (point))
|
|
|
1332 (goto-char pos)
|
|
|
1333 (cond
|
|
|
1334 ((or
|
|
|
1335 (re-search-forward ;; owner and group
|
|
|
1336 "\\([drwxlts-]+ \\) *[0-9]+ \\([^ ]+\\) +[^ ]+ +[0-9]+\\( [^ 0-9]+ [0-9 ][0-9] .*\\)"
|
|
|
1337 limit t)
|
|
|
1338 (re-search-forward ;; only owner displayed
|
|
|
1339 "\\([drwxlts-]+ \\) *[0-9]+ \\([^ ]+\\) +[0-9]+\\( [^ 0-9]+ [0-9 ][0-9] .*\\)"
|
|
|
1340 limit t))
|
|
|
1341 (setq perm (match-string 1)
|
|
|
1342 owner (match-string 2)
|
|
|
1343 date-and-file (match-string 3)))
|
|
|
1344 ((re-search-forward ;; OS/2 -l format, no links, owner, group
|
|
|
1345 "\\([drwxlts-]+ \\) *[0-9]+\\( [^ 0-9]+ [0-9 ][0-9] .*\\)"
|
|
|
1346 limit t)
|
|
|
1347 (setq perm (match-string 1)
|
|
|
1348 date-and-file (match-string 2))))
|
|
|
1349 (if x (setq x (concat "(" x ")")))
|
|
|
1350 (let ((rep (substring (concat x " ") 0 10)))
|
|
|
1351 (replace-match (concat perm rep date-and-file)))))
|
|
|
1352
|
|
|
1353 (defun vc-dired-update-line (file)
|
|
|
1354 ;; Update the vc-dired listing line of file -- it is assumed
|
|
|
1355 ;; that point is already on this line. Don't use dired-do-redisplay
|
|
|
1356 ;; for this, because it cannot handle the way vc-dired deals with
|
|
|
1357 ;; subdirectories.
|
|
|
1358 (beginning-of-line)
|
|
|
1359 (forward-char 2)
|
|
|
1360 (let ((start (point)))
|
|
|
1361 (forward-line 1)
|
|
|
1362 (beginning-of-line)
|
|
|
1363 (delete-region start (point))
|
|
|
1364 (insert-directory file dired-listing-switches)
|
|
|
1365 (forward-line -1)
|
|
|
1366 (end-of-line)
|
|
|
1367 (delete-char (- (length file)))
|
|
|
1368 (insert (substring file (length (expand-file-name default-directory))))
|
|
|
1369 (goto-char start))
|
|
|
1370 (vc-dired-reformat-line (vc-dired-state-info file)))
|
|
0
|
1371
|
|
151
|
1372 (defun vc-dired-update (verbose)
|
|
|
1373 (interactive "P")
|
|
|
1374 (vc-directory default-directory verbose))
|
|
|
1375
|
|
|
1376 ;;; Note in Emacs 18 the following defun gets overridden
|
|
|
1377 ;;; with the symbol 'vc-directory-18. See below.
|
|
0
|
1378 ;;;###autoload
|
|
151
|
1379 (defun vc-directory (dirname verbose)
|
|
|
1380 "Show version-control status of the current directory and subdirectories.
|
|
|
1381 Normally it creates a Dired buffer that lists only the locked files
|
|
|
1382 in all these directories. With a prefix argument, it lists all files."
|
|
|
1383 (interactive "DDired under VC (directory): \nP")
|
|
|
1384 (require 'dired)
|
|
|
1385 (setq dirname (expand-file-name dirname))
|
|
|
1386 ;; force a trailing slash
|
|
|
1387 (if (not (eq (elt dirname (1- (length dirname))) ?/))
|
|
|
1388 (setq dirname (concat dirname "/")))
|
|
|
1389 (let (nonempty
|
|
|
1390 (dl (if (featurep 'xemacs)
|
|
153
|
1391 (+ 1 (length (directory-file-name (expand-file-name dirname))))
|
|
151
|
1392 (length dirname)))
|
|
|
1393 (filelist nil) (statelist nil)
|
|
|
1394 (old-dir default-directory)
|
|
|
1395 dired-buf
|
|
|
1396 dired-buf-mod-count)
|
|
|
1397 (vc-file-tree-walk
|
|
|
1398 dirname
|
|
|
1399 (function
|
|
|
1400 (lambda (f)
|
|
|
1401 (if (vc-registered f)
|
|
|
1402 (let ((state (vc-dired-state-info f)))
|
|
|
1403 (and (or verbose state)
|
|
|
1404 (setq filelist (cons (substring f dl) filelist))
|
|
|
1405 (setq statelist (cons state statelist))))))))
|
|
|
1406 (save-window-excursion
|
|
|
1407 (save-excursion
|
|
|
1408 ;; This uses a semi-documented feature of dired; giving a switch
|
|
|
1409 ;; argument forces the buffer to refresh each time.
|
|
|
1410 (setq dired-buf
|
|
|
1411 (dired-internal-noselect
|
|
|
1412 (cons dirname (nreverse filelist))
|
|
|
1413 dired-listing-switches 'vc-dired-mode))
|
|
|
1414 (setq nonempty (not (eq 0 (length filelist))))))
|
|
|
1415 (switch-to-buffer dired-buf)
|
|
|
1416 ;; Make a few modifications to the header
|
|
|
1417 (setq buffer-read-only nil)
|
|
|
1418 (goto-char (point-min))
|
|
|
1419 (forward-line 1) ;; Skip header line
|
|
|
1420 (let ((start (point))) ;; Erase (but don't remove) the
|
|
|
1421 (end-of-line) ;; "wildcard" line.
|
|
|
1422 (delete-region start (point)))
|
|
|
1423 (beginning-of-line)
|
|
0
|
1424 (if nonempty
|
|
|
1425 (progn
|
|
151
|
1426 ;; Plug the version information into the individual lines
|
|
0
|
1427 (mapcar
|
|
|
1428 (function
|
|
|
1429 (lambda (x)
|
|
151
|
1430 (forward-char 2) ;; skip dired's mark area
|
|
|
1431 (vc-dired-reformat-line x)
|
|
|
1432 (forward-line 1))) ;; go to next line
|
|
|
1433 (nreverse statelist))
|
|
|
1434 (if (featurep 'xemacs)
|
|
|
1435 (dired-insert-set-properties (point-min) (point-max)))
|
|
0
|
1436 (setq buffer-read-only t)
|
|
|
1437 (goto-char (point-min))
|
|
151
|
1438 (dired-next-line 2)
|
|
0
|
1439 )
|
|
151
|
1440 (dired-next-line 1)
|
|
|
1441 (insert " ")
|
|
|
1442 (setq buffer-read-only t)
|
|
0
|
1443 (message "No files are currently %s under %s"
|
|
151
|
1444 (if verbose "registered" "locked") dirname))
|
|
0
|
1445 ))
|
|
|
1446
|
|
151
|
1447 ;; Emacs 18 version
|
|
|
1448 (defun vc-directory-18 (verbose)
|
|
|
1449 "Show version-control status of all files under the current directory."
|
|
|
1450 (interactive "P")
|
|
|
1451 (let (nonempty (dir default-directory))
|
|
|
1452 (save-excursion
|
|
|
1453 (set-buffer (get-buffer-create "*vc-status*"))
|
|
|
1454 (erase-buffer)
|
|
|
1455 (cd dir)
|
|
|
1456 (vc-file-tree-walk
|
|
|
1457 default-directory
|
|
|
1458 (function (lambda (f)
|
|
|
1459 (if (vc-registered f)
|
|
|
1460 (let ((user (vc-locking-user f)))
|
|
|
1461 (if (or user verbose)
|
|
|
1462 (insert (format
|
|
|
1463 "%s %s\n"
|
|
|
1464 (concat user) f))))))))
|
|
|
1465 (setq nonempty (not (zerop (buffer-size)))))
|
|
|
1466
|
|
|
1467 (if nonempty
|
|
|
1468 (progn
|
|
|
1469 (pop-to-buffer "*vc-status*" t)
|
|
|
1470 (goto-char (point-min))
|
|
|
1471 (shrink-window-if-larger-than-buffer)))
|
|
|
1472 (message "No files are currently %s under %s"
|
|
|
1473 (if verbose "registered" "locked") default-directory))
|
|
|
1474 )
|
|
|
1475
|
|
|
1476 (or (boundp 'minor-mode-map-alist)
|
|
|
1477 (fset 'vc-directory 'vc-directory-18))
|
|
0
|
1478
|
|
|
1479 ;; Named-configuration support for SCCS
|
|
|
1480
|
|
|
1481 (defun vc-add-triple (name file rev)
|
|
|
1482 (save-excursion
|
|
151
|
1483 (find-file (expand-file-name
|
|
|
1484 vc-name-assoc-file
|
|
|
1485 (file-name-as-directory
|
|
|
1486 (expand-file-name (vc-backend-subdirectory-name file)
|
|
|
1487 (file-name-directory file)))))
|
|
0
|
1488 (goto-char (point-max))
|
|
|
1489 (insert name "\t:\t" file "\t" rev "\n")
|
|
|
1490 (basic-save-buffer)
|
|
|
1491 (kill-buffer (current-buffer))
|
|
|
1492 ))
|
|
|
1493
|
|
|
1494 (defun vc-record-rename (file newname)
|
|
|
1495 (save-excursion
|
|
151
|
1496 (find-file
|
|
|
1497 (expand-file-name
|
|
|
1498 vc-name-assoc-file
|
|
|
1499 (file-name-as-directory
|
|
|
1500 (expand-file-name (vc-backend-subdirectory-name file)
|
|
|
1501 (file-name-directory file)))))
|
|
0
|
1502 (goto-char (point-min))
|
|
|
1503 ;; (replace-regexp (concat ":" (regexp-quote file) "$") (concat ":" newname))
|
|
|
1504 (while (re-search-forward (concat ":" (regexp-quote file) "$") nil t)
|
|
|
1505 (replace-match (concat ":" newname) nil nil))
|
|
|
1506 (basic-save-buffer)
|
|
|
1507 (kill-buffer (current-buffer))
|
|
|
1508 ))
|
|
|
1509
|
|
|
1510 (defun vc-lookup-triple (file name)
|
|
|
1511 ;; Return the numeric version corresponding to a named snapshot of file
|
|
|
1512 ;; If name is nil or a version number string it's just passed through
|
|
|
1513 (cond ((null name) name)
|
|
|
1514 ((let ((firstchar (aref name 0)))
|
|
|
1515 (and (>= firstchar ?0) (<= firstchar ?9)))
|
|
|
1516 name)
|
|
|
1517 (t
|
|
151
|
1518 (save-excursion
|
|
|
1519 (set-buffer (get-buffer-create "*vc-info*"))
|
|
|
1520 (vc-insert-file
|
|
|
1521 (expand-file-name
|
|
|
1522 vc-name-assoc-file
|
|
|
1523 (file-name-as-directory
|
|
|
1524 (expand-file-name (vc-backend-subdirectory-name file)
|
|
|
1525 (file-name-directory file)))))
|
|
|
1526 (prog1
|
|
|
1527 (car (vc-parse-buffer
|
|
|
1528 (list (list (concat name "\t:\t" file "\t\\(.+\\)") 1))))
|
|
|
1529 (kill-buffer "*vc-info*"))))
|
|
|
1530 ))
|
|
0
|
1531
|
|
|
1532 ;; Named-configuration entry points
|
|
|
1533
|
|
151
|
1534 (defun vc-snapshot-precondition ()
|
|
|
1535 ;; Scan the tree below the current directory.
|
|
|
1536 ;; If any files are locked, return the name of the first such file.
|
|
|
1537 ;; (This means, neither snapshot creation nor retrieval is allowed.)
|
|
|
1538 ;; If one or more of the files are currently visited, return `visited'.
|
|
|
1539 ;; Otherwise, return nil.
|
|
|
1540 (let ((status nil))
|
|
|
1541 (catch 'vc-locked-example
|
|
|
1542 (vc-file-tree-walk
|
|
|
1543 default-directory
|
|
|
1544 (function (lambda (f)
|
|
|
1545 (and (vc-registered f)
|
|
|
1546 (if (vc-locking-user f) (throw 'vc-locked-example f)
|
|
|
1547 (if (get-file-buffer f) (setq status 'visited)))))))
|
|
|
1548 status)))
|
|
0
|
1549
|
|
|
1550 ;;;###autoload
|
|
|
1551 (defun vc-create-snapshot (name)
|
|
|
1552 "Make a snapshot called NAME.
|
|
|
1553 The snapshot is made from all registered files at or below the current
|
|
|
1554 directory. For each file, the version level of its latest
|
|
|
1555 version becomes part of the named configuration."
|
|
|
1556 (interactive "sNew snapshot name: ")
|
|
151
|
1557 (let ((result (vc-snapshot-precondition)))
|
|
|
1558 (if (stringp result)
|
|
|
1559 (error "File %s is locked" result)
|
|
0
|
1560 (vc-file-tree-walk
|
|
151
|
1561 default-directory
|
|
0
|
1562 (function (lambda (f) (and
|
|
|
1563 (vc-name f)
|
|
|
1564 (vc-backend-assign-name f name)))))
|
|
|
1565 )))
|
|
|
1566
|
|
|
1567 ;;;###autoload
|
|
|
1568 (defun vc-retrieve-snapshot (name)
|
|
|
1569 "Retrieve the snapshot called NAME.
|
|
|
1570 This function fails if any files are locked at or below the current directory
|
|
|
1571 Otherwise, all registered files are checked out (unlocked) at their version
|
|
|
1572 levels in the snapshot."
|
|
|
1573 (interactive "sSnapshot name to retrieve: ")
|
|
151
|
1574 (let ((result (vc-snapshot-precondition))
|
|
|
1575 (update nil))
|
|
|
1576 (if (stringp result)
|
|
|
1577 (error "File %s is locked" result)
|
|
|
1578 (if (eq result 'visited)
|
|
|
1579 (setq update (yes-or-no-p "Update the affected buffers? ")))
|
|
0
|
1580 (vc-file-tree-walk
|
|
151
|
1581 default-directory
|
|
0
|
1582 (function (lambda (f) (and
|
|
|
1583 (vc-name f)
|
|
|
1584 (vc-error-occurred
|
|
151
|
1585 (vc-backend-checkout f nil name)
|
|
|
1586 (if update (vc-resynch-buffer f t t)))))))
|
|
0
|
1587 )))
|
|
|
1588
|
|
|
1589 ;; Miscellaneous other entry points
|
|
|
1590
|
|
|
1591 ;;;###autoload
|
|
|
1592 (defun vc-print-log ()
|
|
|
1593 "List the change log of the current buffer in a window."
|
|
|
1594 (interactive)
|
|
|
1595 (if vc-dired-mode
|
|
|
1596 (set-buffer (find-file-noselect (dired-get-filename))))
|
|
|
1597 (while vc-parent-buffer
|
|
151
|
1598 (pop-to-buffer vc-parent-buffer))
|
|
0
|
1599 (if (and buffer-file-name (vc-name buffer-file-name))
|
|
|
1600 (let ((file buffer-file-name))
|
|
151
|
1601 (vc-backend-print-log file)
|
|
0
|
1602 (pop-to-buffer (get-buffer-create "*vc*"))
|
|
|
1603 (setq default-directory (file-name-directory file))
|
|
151
|
1604 (goto-char (point-max)) (forward-line -1)
|
|
0
|
1605 (while (looking-at "=*\n")
|
|
|
1606 (delete-char (- (match-end 0) (match-beginning 0)))
|
|
|
1607 (forward-line -1))
|
|
|
1608 (goto-char (point-min))
|
|
|
1609 (if (looking-at "[\b\t\n\v\f\r ]+")
|
|
|
1610 (delete-char (- (match-end 0) (match-beginning 0))))
|
|
151
|
1611 (shrink-window-if-larger-than-buffer)
|
|
|
1612 ;; move point to the log entry for the current version
|
|
|
1613 (and (not (eq (vc-backend file) 'SCCS))
|
|
|
1614 (re-search-forward
|
|
|
1615 ;; also match some context, for safety
|
|
|
1616 (concat "----\nrevision " (vc-workfile-version file)
|
|
|
1617 "\\(\tlocked by:.*\n\\|\n\\)date: ") nil t)
|
|
|
1618 ;; set the display window so that
|
|
|
1619 ;; the whole log entry is displayed
|
|
|
1620 (let (start end lines)
|
|
|
1621 (beginning-of-line) (forward-line -1) (setq start (point))
|
|
|
1622 (if (not (re-search-forward "^----*\nrevision" nil t))
|
|
|
1623 (setq end (point-max))
|
|
|
1624 (beginning-of-line) (forward-line -1) (setq end (point)))
|
|
|
1625 (setq lines (count-lines start end))
|
|
|
1626 (cond
|
|
|
1627 ;; if the global information and this log entry fit
|
|
|
1628 ;; into the window, display from the beginning
|
|
|
1629 ((< (count-lines (point-min) end) (window-height))
|
|
|
1630 (goto-char (point-min))
|
|
|
1631 (recenter 0)
|
|
|
1632 (goto-char start))
|
|
|
1633 ;; if the whole entry fits into the window,
|
|
|
1634 ;; display it centered
|
|
|
1635 ((< (1+ lines) (window-height))
|
|
|
1636 (goto-char start)
|
|
|
1637 (recenter (1- (- (/ (window-height) 2) (/ lines 2)))))
|
|
|
1638 ;; otherwise (the entry is too large for the window),
|
|
|
1639 ;; display from the start
|
|
|
1640 (t
|
|
|
1641 (goto-char start)
|
|
|
1642 (recenter 0)))))
|
|
0
|
1643 )
|
|
151
|
1644 (vc-registration-error buffer-file-name)
|
|
|
1645 )
|
|
|
1646 )
|
|
0
|
1647
|
|
|
1648 ;;;###autoload
|
|
|
1649 (defun vc-revert-buffer ()
|
|
|
1650 "Revert the current buffer's file back to the latest checked-in version.
|
|
|
1651 This asks for confirmation if the buffer contents are not identical
|
|
|
1652 to that version.
|
|
|
1653 If the back-end is CVS, this will give you the most recent revision of
|
|
|
1654 the file on the branch you are editing."
|
|
|
1655 (interactive)
|
|
|
1656 (if vc-dired-mode
|
|
|
1657 (find-file-other-window (dired-get-filename)))
|
|
|
1658 (while vc-parent-buffer
|
|
151
|
1659 (pop-to-buffer vc-parent-buffer))
|
|
0
|
1660 (let ((file buffer-file-name)
|
|
151
|
1661 ;; This operation should always ask for confirmation.
|
|
|
1662 (vc-suppress-confirm nil)
|
|
0
|
1663 (obuf (current-buffer)) (changed (vc-diff nil t)))
|
|
151
|
1664 (if (and changed (not (yes-or-no-p "Discard changes? ")))
|
|
0
|
1665 (progn
|
|
151
|
1666 (if (and (window-dedicated-p (selected-window))
|
|
|
1667 (one-window-p t 'selected-frame))
|
|
|
1668 (make-frame-invisible (selected-frame))
|
|
|
1669 (delete-window))
|
|
0
|
1670 (error "Revert cancelled"))
|
|
|
1671 (set-buffer obuf))
|
|
|
1672 (if changed
|
|
151
|
1673 (if (and (window-dedicated-p (selected-window))
|
|
|
1674 (one-window-p t 'selected-frame))
|
|
|
1675 (make-frame-invisible (selected-frame))
|
|
|
1676 (delete-window)))
|
|
0
|
1677 (vc-backend-revert file)
|
|
|
1678 (vc-resynch-window file t t)
|
|
151
|
1679 )
|
|
|
1680 )
|
|
0
|
1681
|
|
|
1682 ;;;###autoload
|
|
|
1683 (defun vc-cancel-version (norevert)
|
|
|
1684 "Get rid of most recently checked in version of this file.
|
|
|
1685 A prefix argument means do not revert the buffer afterwards."
|
|
|
1686 (interactive "P")
|
|
|
1687 (if vc-dired-mode
|
|
|
1688 (find-file-other-window (dired-get-filename)))
|
|
|
1689 (while vc-parent-buffer
|
|
|
1690 (pop-to-buffer vc-parent-buffer))
|
|
151
|
1691 (cond
|
|
|
1692 ((not (vc-registered (buffer-file-name)))
|
|
|
1693 (vc-registration-error (buffer-file-name)))
|
|
|
1694 ((eq (vc-backend (buffer-file-name)) 'CVS)
|
|
|
1695 (error "Unchecking files under CVS is dangerous and not supported in VC"))
|
|
|
1696 ((vc-locking-user (buffer-file-name))
|
|
|
1697 (error "This version is locked; use vc-revert-buffer to discard changes"))
|
|
|
1698 ((not (vc-latest-on-branch-p (buffer-file-name)))
|
|
|
1699 (error "This is not the latest version--VC cannot cancel it")))
|
|
|
1700 (let* ((target (vc-workfile-version (buffer-file-name)))
|
|
|
1701 (recent (if (vc-trunk-p target) "" (vc-branch-part target)))
|
|
|
1702 (config (current-window-configuration)) done)
|
|
|
1703 (if (null (yes-or-no-p (format "Remove version %s from master? " target)))
|
|
0
|
1704 nil
|
|
151
|
1705 (setq norevert (or norevert (not
|
|
|
1706 (yes-or-no-p "Revert buffer to most recent remaining version? "))))
|
|
0
|
1707 (vc-backend-uncheck (buffer-file-name) target)
|
|
151
|
1708 ;; Check out the most recent remaining version. If it fails, because
|
|
|
1709 ;; the whole branch got deleted, do a double-take and check out the
|
|
|
1710 ;; version where the branch started.
|
|
|
1711 (while (not done)
|
|
|
1712 (condition-case err
|
|
|
1713 (progn
|
|
|
1714 (if norevert
|
|
|
1715 ;; Check out locked, but only to disc, and keep
|
|
|
1716 ;; modifications in the buffer.
|
|
|
1717 (vc-backend-checkout (buffer-file-name) t recent)
|
|
|
1718 ;; Check out unlocked, and revert buffer.
|
|
|
1719 (vc-checkout (buffer-file-name) nil recent))
|
|
|
1720 (setq done t))
|
|
|
1721 ;; If the checkout fails, vc-do-command signals an error.
|
|
|
1722 ;; We catch this error, check the reason, correct the
|
|
|
1723 ;; version number, and try a second time.
|
|
|
1724 (error (set-buffer "*vc*")
|
|
|
1725 (goto-char (point-min))
|
|
|
1726 (if (search-forward "no side branches present for" nil t)
|
|
|
1727 (progn (setq recent (vc-branch-part recent))
|
|
|
1728 ;; vc-do-command popped up a window with
|
|
|
1729 ;; the error message. Get rid of it, by
|
|
|
1730 ;; restoring the old window configuration.
|
|
|
1731 (set-window-configuration config))
|
|
|
1732 ;; No, it was some other error: re-signal it.
|
|
|
1733 (signal (car err) (cdr err))))))
|
|
|
1734 ;; If norevert, clear version headers and mark the buffer modified.
|
|
|
1735 (if norevert
|
|
|
1736 (progn
|
|
|
1737 (set-visited-file-name (buffer-file-name))
|
|
|
1738 (if (not vc-make-backup-files)
|
|
|
1739 ;; inhibit backup for this buffer
|
|
|
1740 (progn (make-local-variable 'backup-inhibited)
|
|
|
1741 (setq backup-inhibited t)))
|
|
|
1742 (if (eq (vc-backend (buffer-file-name)) 'RCS)
|
|
|
1743 (progn (setq buffer-read-only nil)
|
|
|
1744 (vc-clear-headers)))
|
|
|
1745 (vc-mode-line (buffer-file-name))))
|
|
|
1746 (message "Version %s has been removed from the master" target)
|
|
|
1747 )))
|
|
0
|
1748
|
|
|
1749 ;;;###autoload
|
|
|
1750 (defun vc-rename-file (old new)
|
|
|
1751 "Rename file OLD to NEW, and rename its master file likewise."
|
|
|
1752 (interactive "fVC rename file: \nFRename to: ")
|
|
|
1753 ;; There are several ways of renaming files under CVS 1.3, but they all
|
|
|
1754 ;; have serious disadvantages. See the FAQ (available from think.com in
|
|
|
1755 ;; pub/cvs/). I'd rather send the user an error, than do something he might
|
|
|
1756 ;; consider to be wrong. When the famous, long-awaited rename database is
|
|
|
1757 ;; implemented things might change for the better. This is unlikely to occur
|
|
|
1758 ;; until CVS 2.0 is released. --ceder 1994-01-23 21:27:51
|
|
151
|
1759 (if (eq (vc-backend old) 'CVS)
|
|
|
1760 (error "Renaming files under CVS is dangerous and not supported in VC"))
|
|
0
|
1761 (let ((oldbuf (get-file-buffer old)))
|
|
|
1762 (if (and oldbuf (buffer-modified-p oldbuf))
|
|
|
1763 (error "Please save files before moving them"))
|
|
|
1764 (if (get-file-buffer new)
|
|
|
1765 (error "Already editing new file name"))
|
|
|
1766 (if (file-exists-p new)
|
|
|
1767 (error "New file already exists"))
|
|
|
1768 (let ((oldmaster (vc-name old)))
|
|
|
1769 (if oldmaster
|
|
|
1770 (progn
|
|
151
|
1771 (if (vc-locking-user old)
|
|
0
|
1772 (error "Please check in files before moving them"))
|
|
|
1773 (if (or (file-symlink-p oldmaster)
|
|
|
1774 ;; This had FILE, I changed it to OLD. -- rms.
|
|
|
1775 (file-symlink-p (vc-backend-subdirectory-name old)))
|
|
151
|
1776 (error "This is not a safe thing to do in the presence of symbolic links"))
|
|
0
|
1777 (rename-file
|
|
151
|
1778 oldmaster
|
|
|
1779 (let ((backend (vc-backend old))
|
|
0
|
1780 (newdir (or (file-name-directory new) ""))
|
|
|
1781 (newbase (file-name-nondirectory new)))
|
|
|
1782 (catch 'found
|
|
|
1783 (mapcar
|
|
151
|
1784 (function
|
|
0
|
1785 (lambda (s)
|
|
|
1786 (if (eq backend (cdr s))
|
|
|
1787 (let* ((newmaster (format (car s) newdir newbase))
|
|
|
1788 (newmasterdir (file-name-directory newmaster)))
|
|
|
1789 (if (or (not newmasterdir)
|
|
|
1790 (file-directory-p newmasterdir))
|
|
|
1791 (throw 'found newmaster))))))
|
|
|
1792 vc-master-templates)
|
|
|
1793 (error "New file lacks a version control directory"))))))
|
|
|
1794 (if (or (not oldmaster) (file-exists-p old))
|
|
|
1795 (rename-file old new)))
|
|
151
|
1796 ; ?? Renaming a file might change its contents due to keyword expansion.
|
|
|
1797 ; We should really check out a new copy if the old copy was precisely equal
|
|
|
1798 ; to some checked in version. However, testing for this is tricky....
|
|
0
|
1799 (if oldbuf
|
|
151
|
1800 (save-excursion
|
|
0
|
1801 (set-buffer oldbuf)
|
|
151
|
1802 (let ((buffer-read-only buffer-read-only))
|
|
|
1803 (set-visited-file-name new))
|
|
|
1804 (vc-backend new)
|
|
|
1805 (vc-mode-line new)
|
|
0
|
1806 (set-buffer-modified-p nil))))
|
|
|
1807 ;; This had FILE, I changed it to OLD. -- rms.
|
|
|
1808 (vc-backend-dispatch old
|
|
151
|
1809 (vc-record-rename old new) ;SCCS
|
|
|
1810 nil ;RCS
|
|
|
1811 nil ;CVS
|
|
|
1812 )
|
|
0
|
1813 )
|
|
|
1814
|
|
|
1815 ;;;###autoload
|
|
151
|
1816 (defun vc-update-change-log (&rest args)
|
|
|
1817 "Find change log file and add entries from recent RCS/CVS logs.
|
|
|
1818 Normally, find log entries for all registered files in the default
|
|
|
1819 directory using `rcs2log', which finds CVS logs preferentially.
|
|
|
1820 The mark is left at the end of the text prepended to the change log.
|
|
|
1821
|
|
|
1822 With prefix arg of C-u, only find log entries for the current buffer's file.
|
|
74
|
1823
|
|
151
|
1824 With any numeric prefix arg, find log entries for all currently visited
|
|
|
1825 files that are under version control. This puts all the entries in the
|
|
|
1826 log for the default directory, which may not be appropriate.
|
|
|
1827
|
|
|
1828 From a program, any arguments are assumed to be filenames and are
|
|
|
1829 passed to the `rcs2log' script after massaging to be relative to the
|
|
|
1830 default directory."
|
|
0
|
1831 (interactive
|
|
|
1832 (cond ((consp current-prefix-arg) ;C-u
|
|
|
1833 (list buffer-file-name))
|
|
151
|
1834 (current-prefix-arg ;Numeric argument.
|
|
0
|
1835 (let ((files nil)
|
|
|
1836 (buffers (buffer-list))
|
|
|
1837 file)
|
|
|
1838 (while buffers
|
|
|
1839 (setq file (buffer-file-name (car buffers)))
|
|
151
|
1840 (and file (vc-backend file)
|
|
|
1841 (setq files (cons file files)))
|
|
0
|
1842 (setq buffers (cdr buffers)))
|
|
|
1843 files))
|
|
|
1844 (t
|
|
151
|
1845 ;; `rcs2log' will find the relevant RCS or CVS files
|
|
|
1846 ;; relative to the curent directory if none supplied.
|
|
|
1847 nil)))
|
|
171
|
1848 (require 'add-log) ; XEmacs change
|
|
151
|
1849 (let ((odefault default-directory)
|
|
|
1850 (full-name (or add-log-full-name
|
|
|
1851 (user-full-name)
|
|
|
1852 (user-login-name)
|
|
|
1853 (format "uid%d" (number-to-string (user-uid)))))
|
|
|
1854 (mailing-address (or add-log-mailing-address
|
|
|
1855 user-mail-address)))
|
|
0
|
1856 (find-file-other-window (find-change-log))
|
|
|
1857 (barf-if-buffer-read-only)
|
|
|
1858 (vc-buffer-sync)
|
|
|
1859 (undo-boundary)
|
|
|
1860 (goto-char (point-min))
|
|
|
1861 (push-mark)
|
|
|
1862 (message "Computing change log entries...")
|
|
|
1863 (message "Computing change log entries... %s"
|
|
151
|
1864 (if (eq 0 (apply 'call-process "rcs2log" nil '(t nil) nil
|
|
|
1865 "-u"
|
|
|
1866 (concat (vc-user-login-name)
|
|
|
1867 "\t"
|
|
|
1868 full-name
|
|
|
1869 "\t"
|
|
|
1870 mailing-address)
|
|
|
1871 (mapcar (function
|
|
|
1872 (lambda (f)
|
|
|
1873 (file-relative-name
|
|
|
1874 (if (file-name-absolute-p f)
|
|
|
1875 f
|
|
|
1876 (concat odefault f)))))
|
|
|
1877 args)))
|
|
0
|
1878 "done" "failed"))))
|
|
|
1879
|
|
151
|
1880 ;; Collect back-end-dependent stuff here
|
|
0
|
1881
|
|
|
1882 (defun vc-backend-admin (file &optional rev comment)
|
|
|
1883 ;; Register a file into the version-control system
|
|
|
1884 ;; Automatically retrieves a read-only version of the file with
|
|
|
1885 ;; keywords expanded if vc-keep-workfiles is non-nil, otherwise
|
|
|
1886 ;; it deletes the workfile.
|
|
|
1887 (vc-file-clearprops file)
|
|
|
1888 (or vc-default-back-end
|
|
|
1889 (setq vc-default-back-end (if (vc-find-binary "rcs") 'RCS 'SCCS)))
|
|
|
1890 (message "Registering %s..." file)
|
|
151
|
1891 (let ((switches
|
|
|
1892 (if (stringp vc-register-switches)
|
|
|
1893 (list vc-register-switches)
|
|
|
1894 vc-register-switches))
|
|
|
1895 (backend
|
|
|
1896 (cond
|
|
0
|
1897 ((file-exists-p (vc-backend-subdirectory-name)) vc-default-back-end)
|
|
|
1898 ((file-exists-p "RCS") 'RCS)
|
|
|
1899 ((file-exists-p "SCCS") 'SCCS)
|
|
151
|
1900 ((file-exists-p "CVS") 'CVS)
|
|
0
|
1901 (t vc-default-back-end))))
|
|
|
1902 (cond ((eq backend 'SCCS)
|
|
151
|
1903 (apply 'vc-do-command nil 0 "admin" file 'MASTER ;; SCCS
|
|
|
1904 (and rev (concat "-r" rev))
|
|
|
1905 "-fb"
|
|
|
1906 (concat "-i" file)
|
|
|
1907 (and comment (concat "-y" comment))
|
|
|
1908 (format
|
|
|
1909 (car (rassq 'SCCS vc-master-templates))
|
|
|
1910 (or (file-name-directory file) "")
|
|
|
1911 (file-name-nondirectory file))
|
|
|
1912 switches)
|
|
0
|
1913 (delete-file file)
|
|
|
1914 (if vc-keep-workfiles
|
|
151
|
1915 (vc-do-command nil 0 "get" file 'MASTER)))
|
|
0
|
1916 ((eq backend 'RCS)
|
|
151
|
1917 (apply 'vc-do-command nil 0 "ci" file 'WORKFILE ;; RCS
|
|
|
1918 ;; if available, use the secure registering option
|
|
|
1919 (and (vc-backend-release-p 'RCS "5.6.4") "-i")
|
|
|
1920 (concat (if vc-keep-workfiles "-u" "-r") rev)
|
|
|
1921 (and comment (concat "-t-" comment))
|
|
|
1922 switches))
|
|
|
1923 ((eq backend 'CVS)
|
|
|
1924 (apply 'vc-do-command nil 0 "cvs" file 'WORKFILE ;; CVS
|
|
|
1925 "add"
|
|
|
1926 (and comment (string-match "[^\t\n ]" comment)
|
|
|
1927 (concat "-m" comment))
|
|
|
1928 switches)
|
|
0
|
1929 )))
|
|
|
1930 (message "Registering %s...done" file)
|
|
|
1931 )
|
|
|
1932
|
|
|
1933 (defun vc-backend-checkout (file &optional writable rev workfile)
|
|
|
1934 ;; Retrieve a copy of a saved version into a workfile
|
|
151
|
1935 (let ((filename (or workfile file))
|
|
|
1936 (file-buffer (get-file-buffer file))
|
|
|
1937 switches)
|
|
0
|
1938 (message "Checking out %s..." filename)
|
|
|
1939 (save-excursion
|
|
151
|
1940 ;; Change buffers to get local value of vc-checkout-switches.
|
|
|
1941 (if file-buffer (set-buffer file-buffer))
|
|
|
1942 (setq switches (if (stringp vc-checkout-switches)
|
|
|
1943 (list vc-checkout-switches)
|
|
|
1944 vc-checkout-switches))
|
|
|
1945 ;; Save this buffer's default-directory
|
|
|
1946 ;; and use save-excursion to make sure it is restored
|
|
|
1947 ;; in the same buffer it was saved in.
|
|
|
1948 (let ((default-directory default-directory))
|
|
|
1949 (save-excursion
|
|
|
1950 ;; Adjust the default-directory so that the check-out creates
|
|
|
1951 ;; the file in the right place.
|
|
|
1952 (setq default-directory (file-name-directory filename))
|
|
|
1953 (vc-backend-dispatch file
|
|
|
1954 (progn ;; SCCS
|
|
|
1955 (and rev (string= rev "") (setq rev nil))
|
|
|
1956 (if workfile
|
|
|
1957 ;; Some SCCS implementations allow checking out directly to a
|
|
|
1958 ;; file using the -G option, but then some don't so use the
|
|
|
1959 ;; least common denominator approach and use the -p option
|
|
|
1960 ;; ala RCS.
|
|
|
1961 (let ((vc-modes (logior (file-modes (vc-name file))
|
|
|
1962 (if writable 128 0)))
|
|
|
1963 (failed t))
|
|
|
1964 (unwind-protect
|
|
|
1965 (progn
|
|
|
1966 (apply 'vc-do-command
|
|
|
1967 nil 0 "/bin/sh" file 'MASTER "-c"
|
|
|
1968 ;; Some shells make the "" dummy argument into $0
|
|
|
1969 ;; while others use the shell's name as $0 and
|
|
|
1970 ;; use the "" as $1. The if-statement
|
|
|
1971 ;; converts the latter case to the former.
|
|
|
1972 (format "if [ x\"$1\" = x ]; then shift; fi; \
|
|
|
1973 umask %o; exec >\"$1\" || exit; \
|
|
|
1974 shift; umask %o; exec get \"$@\""
|
|
|
1975 (logand 511 (lognot vc-modes))
|
|
|
1976 (logand 511 (lognot (default-file-modes))))
|
|
|
1977 "" ; dummy argument for shell's $0
|
|
|
1978 filename
|
|
|
1979 (if writable "-e")
|
|
|
1980 "-p"
|
|
|
1981 (and rev
|
|
|
1982 (concat "-r" (vc-lookup-triple file rev)))
|
|
|
1983 switches)
|
|
|
1984 (setq failed nil))
|
|
|
1985 (and failed (file-exists-p filename)
|
|
|
1986 (delete-file filename))))
|
|
|
1987 (apply 'vc-do-command nil 0 "get" file 'MASTER ;; SCCS
|
|
|
1988 (if writable "-e")
|
|
|
1989 (and rev (concat "-r" (vc-lookup-triple file rev)))
|
|
|
1990 switches)
|
|
|
1991 (vc-file-setprop file 'vc-workfile-version nil)))
|
|
|
1992 (if workfile ;; RCS
|
|
|
1993 ;; RCS doesn't let us check out into arbitrary file names directly.
|
|
|
1994 ;; Use `co -p' and make stdout point to the correct file.
|
|
|
1995 (let ((vc-modes (logior (file-modes (vc-name file))
|
|
|
1996 (if writable 128 0)))
|
|
|
1997 (failed t))
|
|
|
1998 (unwind-protect
|
|
|
1999 (progn
|
|
|
2000 (apply 'vc-do-command
|
|
|
2001 nil 0 "/bin/sh" file 'MASTER "-c"
|
|
|
2002 ;; See the SCCS case, above, regarding the
|
|
|
2003 ;; if-statement.
|
|
|
2004 (format "if [ x\"$1\" = x ]; then shift; fi; \
|
|
|
2005 umask %o; exec >\"$1\" || exit; \
|
|
|
2006 shift; umask %o; exec co \"$@\""
|
|
|
2007 (logand 511 (lognot vc-modes))
|
|
|
2008 (logand 511 (lognot (default-file-modes))))
|
|
|
2009 "" ; dummy argument for shell's $0
|
|
|
2010 filename
|
|
|
2011 (if writable "-l")
|
|
|
2012 (concat "-p" rev)
|
|
|
2013 switches)
|
|
|
2014 (setq failed nil))
|
|
|
2015 (and failed (file-exists-p filename) (delete-file filename))))
|
|
|
2016 (let (new-version)
|
|
|
2017 ;; if we should go to the head of the trunk,
|
|
|
2018 ;; clear the default branch first
|
|
|
2019 (and rev (string= rev "")
|
|
|
2020 (vc-do-command nil 0 "rcs" file 'MASTER "-b"))
|
|
|
2021 ;; now do the checkout
|
|
|
2022 (apply 'vc-do-command
|
|
|
2023 nil 0 "co" file 'MASTER
|
|
|
2024 ;; If locking is not strict, force to overwrite
|
|
|
2025 ;; the writable workfile.
|
|
|
2026 (if (eq (vc-checkout-model file) 'implicit) "-f")
|
|
|
2027 (if writable "-l")
|
|
|
2028 (if rev (concat "-r" rev)
|
|
|
2029 ;; if no explicit revision was specified,
|
|
|
2030 ;; check out that of the working file
|
|
|
2031 (let ((workrev (vc-workfile-version file)))
|
|
|
2032 (if workrev (concat "-r" workrev)
|
|
|
2033 nil)))
|
|
|
2034 switches)
|
|
|
2035 ;; determine the new workfile version
|
|
|
2036 (save-excursion
|
|
|
2037 (set-buffer "*vc*")
|
|
|
2038 (goto-char (point-min))
|
|
|
2039 (setq new-version
|
|
|
2040 (if (re-search-forward "^revision \\([0-9.]+\\).*\n" nil t)
|
|
|
2041 (buffer-substring (match-beginning 1) (match-end 1)))))
|
|
|
2042 (vc-file-setprop file 'vc-workfile-version new-version)
|
|
|
2043 ;; if necessary, adjust the default branch
|
|
|
2044 (and rev (not (string= rev ""))
|
|
|
2045 (vc-do-command nil 0 "rcs" file 'MASTER
|
|
|
2046 (concat "-b" (if (vc-latest-on-branch-p file)
|
|
|
2047 (if (vc-trunk-p new-version) nil
|
|
|
2048 (vc-branch-part new-version))
|
|
|
2049 new-version))))))
|
|
|
2050 (if workfile ;; CVS
|
|
|
2051 ;; CVS is much like RCS
|
|
|
2052 (let ((failed t))
|
|
|
2053 (unwind-protect
|
|
|
2054 (progn
|
|
|
2055 (apply 'vc-do-command
|
|
|
2056 nil 0 "/bin/sh" file 'WORKFILE "-c"
|
|
|
2057 "exec >\"$1\" || exit; shift; exec cvs update \"$@\""
|
|
|
2058 "" ; dummy argument for shell's $0
|
|
|
2059 workfile
|
|
|
2060 (concat "-r" rev)
|
|
|
2061 "-p"
|
|
|
2062 switches)
|
|
|
2063 (setq failed nil))
|
|
|
2064 (and failed (file-exists-p filename) (delete-file filename))))
|
|
|
2065 ;; default for verbose checkout: clear the sticky tag
|
|
|
2066 ;; so that the actual update will get the head of the trunk
|
|
|
2067 (and rev (string= rev "")
|
|
|
2068 (vc-do-command nil 0 "cvs" file 'WORKFILE "update" "-A"))
|
|
|
2069 ;; If a revision was specified, check that out.
|
|
|
2070 (if rev
|
|
|
2071 (apply 'vc-do-command nil 0 "cvs" file 'WORKFILE
|
|
|
2072 (and writable (eq (vc-checkout-model file) 'manual) "-w")
|
|
|
2073 "update"
|
|
|
2074 (and rev (not (string= rev ""))
|
|
|
2075 (concat "-r" rev))
|
|
|
2076 switches)
|
|
|
2077 ;; If no revision was specified, simply make the file writable.
|
|
|
2078 (and writable
|
|
|
2079 (or (eq (vc-checkout-model file) 'manual)
|
|
|
2080 (zerop (logand 128 (file-modes file))))
|
|
|
2081 (set-file-modes file (logior 128 (file-modes file)))))
|
|
|
2082 (if rev (vc-file-setprop file 'vc-workfile-version nil))))
|
|
|
2083 (cond
|
|
|
2084 ((not workfile)
|
|
|
2085 (vc-file-clear-masterprops file)
|
|
|
2086 (if writable
|
|
|
2087 (vc-file-setprop file 'vc-locking-user (vc-user-login-name)))
|
|
|
2088 (vc-file-setprop file
|
|
|
2089 'vc-checkout-time (nth 5 (file-attributes file)))))
|
|
|
2090 (message "Checking out %s...done" filename))))))
|
|
0
|
2091
|
|
|
2092 (defun vc-backend-logentry-check (file)
|
|
|
2093 (vc-backend-dispatch file
|
|
151
|
2094 (if (>= (buffer-size) 512) ;; SCCS
|
|
|
2095 (progn
|
|
|
2096 (goto-char 512)
|
|
|
2097 (error
|
|
|
2098 "Log must be less than 512 characters; point is now at pos 512")))
|
|
|
2099 nil ;; RCS
|
|
|
2100 nil) ;; CVS
|
|
0
|
2101 )
|
|
|
2102
|
|
|
2103 (defun vc-backend-checkin (file rev comment)
|
|
|
2104 ;; Register changes to FILE as level REV with explanatory COMMENT.
|
|
|
2105 ;; Automatically retrieves a read-only version of the file with
|
|
|
2106 ;; keywords expanded if vc-keep-workfiles is non-nil, otherwise
|
|
|
2107 ;; it deletes the workfile.
|
|
151
|
2108 ;; Adaptation for RCS branch support: if this is an explicit checkin,
|
|
|
2109 ;; or if the checkin creates a new branch, set the master file branch
|
|
|
2110 ;; accordingly.
|
|
0
|
2111 (message "Checking in %s..." file)
|
|
151
|
2112 ;; "This log message intentionally left almost blank".
|
|
|
2113 ;; RCS 5.7 gripes about white-space-only comments too.
|
|
|
2114 (or (and comment (string-match "[^\t\n ]" comment))
|
|
|
2115 (setq comment "*** empty log message ***"))
|
|
0
|
2116 (save-excursion
|
|
|
2117 ;; Change buffers to get local value of vc-checkin-switches.
|
|
|
2118 (set-buffer (or (get-file-buffer file) (current-buffer)))
|
|
151
|
2119 (let ((switches
|
|
|
2120 (if (stringp vc-checkin-switches)
|
|
|
2121 (list vc-checkin-switches)
|
|
|
2122 vc-checkin-switches)))
|
|
|
2123 ;; Clear the master-properties. Do that here, not at the
|
|
|
2124 ;; end, because if the check-in fails we want them to get
|
|
|
2125 ;; re-computed before the next try.
|
|
|
2126 (vc-file-clear-masterprops file)
|
|
|
2127 (vc-backend-dispatch file
|
|
|
2128 ;; SCCS
|
|
|
2129 (progn
|
|
|
2130 (apply 'vc-do-command nil 0 "delta" file 'MASTER
|
|
|
2131 (if rev (concat "-r" rev))
|
|
|
2132 (concat "-y" comment)
|
|
|
2133 switches)
|
|
|
2134 (vc-file-setprop file 'vc-locking-user 'none)
|
|
|
2135 (vc-file-setprop file 'vc-workfile-version nil)
|
|
|
2136 (if vc-keep-workfiles
|
|
|
2137 (vc-do-command nil 0 "get" file 'MASTER))
|
|
|
2138 )
|
|
|
2139 ;; RCS
|
|
|
2140 (let ((old-version (vc-workfile-version file)) new-version)
|
|
|
2141 (apply 'vc-do-command nil 0 "ci" file 'MASTER
|
|
|
2142 ;; if available, use the secure check-in option
|
|
|
2143 (and (vc-backend-release-p 'RCS "5.6.4") "-j")
|
|
|
2144 (concat (if vc-keep-workfiles "-u" "-r") rev)
|
|
|
2145 (concat "-m" comment)
|
|
|
2146 switches)
|
|
|
2147 (vc-file-setprop file 'vc-locking-user 'none)
|
|
|
2148 (vc-file-setprop file 'vc-workfile-version nil)
|
|
|
2149
|
|
|
2150 ;; determine the new workfile version
|
|
|
2151 (set-buffer "*vc*")
|
|
|
2152 (goto-char (point-min))
|
|
|
2153 (if (or (re-search-forward
|
|
|
2154 "new revision: \\([0-9.]+\\);" nil t)
|
|
|
2155 (re-search-forward
|
|
|
2156 "reverting to previous revision \\([0-9.]+\\)" nil t))
|
|
|
2157 (progn (setq new-version (buffer-substring (match-beginning 1)
|
|
|
2158 (match-end 1)))
|
|
|
2159 (vc-file-setprop file 'vc-workfile-version new-version)))
|
|
|
2160
|
|
|
2161 ;; if we got to a different branch, adjust the default
|
|
|
2162 ;; branch accordingly
|
|
|
2163 (cond
|
|
|
2164 ((and old-version new-version
|
|
|
2165 (not (string= (vc-branch-part old-version)
|
|
|
2166 (vc-branch-part new-version))))
|
|
|
2167 (vc-do-command nil 0 "rcs" file 'MASTER
|
|
|
2168 (if (vc-trunk-p new-version) "-b"
|
|
|
2169 (concat "-b" (vc-branch-part new-version))))
|
|
|
2170 ;; If this is an old RCS release, we might have
|
|
|
2171 ;; to remove a remaining lock.
|
|
|
2172 (if (not (vc-backend-release-p 'RCS "5.6.2"))
|
|
|
2173 ;; exit status of 1 is also accepted.
|
|
|
2174 ;; It means that the lock was removed before.
|
|
|
2175 (vc-do-command nil 1 "rcs" file 'MASTER
|
|
|
2176 (concat "-u" old-version))))))
|
|
|
2177 ;; CVS
|
|
|
2178 (progn
|
|
|
2179 ;; explicit check-in to the trunk requires a
|
|
|
2180 ;; double check-in (first unexplicit) (CVS-1.3)
|
|
|
2181 (condition-case nil
|
|
|
2182 (progn
|
|
|
2183 (if (and rev (vc-trunk-p rev))
|
|
|
2184 (apply 'vc-do-command nil 0 "cvs" file 'WORKFILE
|
|
|
2185 "ci" "-m" "intermediate"
|
|
|
2186 switches))
|
|
|
2187 (apply 'vc-do-command nil 0 "cvs" file 'WORKFILE
|
|
|
2188 "ci" (if rev (concat "-r" rev))
|
|
|
2189 (concat "-m" comment)
|
|
|
2190 switches))
|
|
|
2191 (error (if (eq (vc-cvs-status file) 'needs-merge)
|
|
|
2192 ;; The CVS output will be on top of this message.
|
|
|
2193 (error "Type C-x 0 C-x C-q to merge in changes")
|
|
|
2194 (error "Check-in failed"))))
|
|
|
2195 ;; determine and store the new workfile version
|
|
|
2196 (set-buffer "*vc*")
|
|
|
2197 (goto-char (point-min))
|
|
|
2198 (if (re-search-forward
|
|
|
2199 "^\\(new\\|initial\\) revision: \\([0-9.]+\\)" nil t)
|
|
|
2200 (vc-file-setprop file 'vc-workfile-version
|
|
|
2201 (buffer-substring (match-beginning 2)
|
|
|
2202 (match-end 2)))
|
|
|
2203 (vc-file-setprop file 'vc-workfile-version nil))
|
|
|
2204 ;; if this was an explicit check-in, remove the sticky tag
|
|
|
2205 (if rev
|
|
|
2206 (vc-do-command nil 0 "cvs" file 'WORKFILE "update" "-A"))
|
|
|
2207 (vc-file-setprop file 'vc-locking-user 'none)
|
|
|
2208 (vc-file-setprop file 'vc-checkout-time
|
|
|
2209 (nth 5 (file-attributes file)))))))
|
|
|
2210 (message "Checking in %s...done" file))
|
|
0
|
2211
|
|
|
2212 (defun vc-backend-revert (file)
|
|
|
2213 ;; Revert file to latest checked-in version.
|
|
151
|
2214 ;; (for RCS, to workfile version)
|
|
0
|
2215 (message "Reverting %s..." file)
|
|
151
|
2216 (vc-file-clear-masterprops file)
|
|
0
|
2217 (vc-backend-dispatch
|
|
151
|
2218 file
|
|
|
2219 ;; SCCS
|
|
|
2220 (progn
|
|
|
2221 (vc-do-command nil 0 "unget" file 'MASTER nil)
|
|
|
2222 (vc-do-command nil 0 "get" file 'MASTER nil))
|
|
|
2223 ;; RCS
|
|
|
2224 (vc-do-command nil 0 "co" file 'MASTER
|
|
|
2225 "-f" (concat "-u" (vc-workfile-version file)))
|
|
|
2226 ;; CVS
|
|
|
2227 (progn
|
|
|
2228 (delete-file file)
|
|
|
2229 (vc-do-command nil 0 "cvs" file 'WORKFILE "update")))
|
|
|
2230 (vc-file-setprop file 'vc-locking-user 'none)
|
|
|
2231 (vc-file-setprop file 'vc-checkout-time (nth 5 (file-attributes file)))
|
|
0
|
2232 (message "Reverting %s...done" file)
|
|
|
2233 )
|
|
|
2234
|
|
|
2235 (defun vc-backend-steal (file &optional rev)
|
|
|
2236 ;; Steal the lock on the current workfile. Needs RCS 5.6.2 or later for -M.
|
|
|
2237 (message "Stealing lock on %s..." file)
|
|
|
2238 (vc-backend-dispatch file
|
|
151
|
2239 (progn ;SCCS
|
|
|
2240 (vc-do-command nil 0 "unget" file 'MASTER "-n" (if rev (concat "-r" rev)))
|
|
|
2241 (vc-do-command nil 0 "get" file 'MASTER "-g" (if rev (concat "-r" rev)))
|
|
|
2242 )
|
|
|
2243 (vc-do-command nil 0 "rcs" file 'MASTER ;RCS
|
|
|
2244 "-M" (concat "-u" rev) (concat "-l" rev))
|
|
|
2245 (error "You cannot steal a CVS lock; there are no CVS locks to steal") ;CVS
|
|
|
2246 )
|
|
|
2247 (vc-file-setprop file 'vc-locking-user (vc-user-login-name))
|
|
0
|
2248 (message "Stealing lock on %s...done" file)
|
|
|
2249 )
|
|
|
2250
|
|
|
2251 (defun vc-backend-uncheck (file target)
|
|
151
|
2252 ;; Undo the latest checkin.
|
|
0
|
2253 (message "Removing last change from %s..." file)
|
|
|
2254 (vc-backend-dispatch file
|
|
151
|
2255 (vc-do-command nil 0 "rmdel" file 'MASTER (concat "-r" target))
|
|
|
2256 (vc-do-command nil 0 "rcs" file 'MASTER (concat "-o" target))
|
|
|
2257 nil ;; this is never reached under CVS
|
|
|
2258 )
|
|
0
|
2259 (message "Removing last change from %s...done" file)
|
|
|
2260 )
|
|
|
2261
|
|
|
2262 (defun vc-backend-print-log (file)
|
|
151
|
2263 ;; Get change log associated with FILE.
|
|
0
|
2264 (vc-backend-dispatch
|
|
151
|
2265 file
|
|
|
2266 (vc-do-command nil 0 "prs" file 'MASTER)
|
|
|
2267 (vc-do-command nil 0 "rlog" file 'MASTER)
|
|
|
2268 (vc-do-command nil 0 "cvs" file 'WORKFILE "log")))
|
|
0
|
2269
|
|
|
2270 (defun vc-backend-assign-name (file name)
|
|
|
2271 ;; Assign to a FILE's latest version a given NAME.
|
|
|
2272 (vc-backend-dispatch file
|
|
151
|
2273 (vc-add-triple name file (vc-latest-version file)) ;; SCCS
|
|
|
2274 (vc-do-command nil 0 "rcs" file 'MASTER (concat "-n" name ":")) ;; RCS
|
|
|
2275 (vc-do-command nil 0 "cvs" file 'WORKFILE "tag" name) ;; CVS
|
|
|
2276 )
|
|
0
|
2277 )
|
|
|
2278
|
|
|
2279 (defun vc-backend-diff (file &optional oldvers newvers cmp)
|
|
|
2280 ;; Get a difference report between two versions of FILE.
|
|
|
2281 ;; Get only a brief comparison report if CMP, a difference report otherwise.
|
|
151
|
2282 (let ((backend (vc-backend file)) options status
|
|
|
2283 (diff-switches-list (if (listp diff-switches)
|
|
|
2284 diff-switches
|
|
|
2285 (list diff-switches))))
|
|
0
|
2286 (cond
|
|
|
2287 ((eq backend 'SCCS)
|
|
|
2288 (setq oldvers (vc-lookup-triple file oldvers))
|
|
151
|
2289 (setq newvers (vc-lookup-triple file newvers))
|
|
|
2290 (setq options (append (list (and cmp "--brief") "-q"
|
|
|
2291 (and oldvers (concat "-r" oldvers))
|
|
|
2292 (and newvers (concat "-r" newvers)))
|
|
|
2293 (and (not cmp) diff-switches-list)))
|
|
|
2294 (apply 'vc-do-command "*vc-diff*" 1 "vcdiff" file 'MASTER options))
|
|
|
2295 ((eq backend 'RCS)
|
|
|
2296 (if (not oldvers) (setq oldvers (vc-workfile-version file)))
|
|
|
2297 ;; If we know that --brief is not supported, don't try it.
|
|
|
2298 (setq cmp (and cmp (not (eq vc-rcsdiff-knows-brief 'no))))
|
|
|
2299 (setq options (append (list (and cmp "--brief") "-q"
|
|
|
2300 (concat "-r" oldvers)
|
|
|
2301 (and newvers (concat "-r" newvers)))
|
|
|
2302 (and (not cmp) diff-switches-list)))
|
|
|
2303 (setq status (apply 'vc-do-command "*vc-diff*" 2
|
|
|
2304 "rcsdiff" file 'WORKFILE options))
|
|
|
2305 ;; If --brief didn't work, do a double-take and remember it
|
|
|
2306 ;; for the future.
|
|
|
2307 (if (eq status 2)
|
|
|
2308 (prog1
|
|
|
2309 (apply 'vc-do-command "*vc-diff*" 1 "rcsdiff" file 'WORKFILE
|
|
|
2310 (if cmp (cdr options) options))
|
|
|
2311 (if cmp (setq vc-rcsdiff-knows-brief 'no)))
|
|
|
2312 ;; If --brief DID work, remember that, too.
|
|
|
2313 (and cmp (not vc-rcsdiff-knows-brief)
|
|
|
2314 (setq vc-rcsdiff-knows-brief 'yes))
|
|
|
2315 status))
|
|
0
|
2316 ;; CVS is different.
|
|
|
2317 ((eq backend 'CVS)
|
|
151
|
2318 (if (string= (vc-workfile-version file) "0")
|
|
0
|
2319 ;; This file is added but not yet committed; there is no master file.
|
|
|
2320 (if (or oldvers newvers)
|
|
151
|
2321 (error "No revisions of %s exist" file)
|
|
|
2322 (if cmp 1 ;; file is added but not committed,
|
|
|
2323 ;; we regard this as "changed".
|
|
|
2324 ;; diff it against /dev/null.
|
|
|
2325 (apply 'vc-do-command
|
|
|
2326 "*vc-diff*" 1 "diff" file 'WORKFILE
|
|
|
2327 (append (if (listp diff-switches)
|
|
|
2328 diff-switches
|
|
|
2329 (list diff-switches)) '("/dev/null")))))
|
|
|
2330 ;; cmp is not yet implemented -- we always do a full diff.
|
|
0
|
2331 (apply 'vc-do-command
|
|
151
|
2332 "*vc-diff*" 1 "cvs" file 'WORKFILE "diff"
|
|
0
|
2333 (and oldvers (concat "-r" oldvers))
|
|
|
2334 (and newvers (concat "-r" newvers))
|
|
|
2335 (if (listp diff-switches)
|
|
151
|
2336 diff-switches
|
|
|
2337 (list diff-switches)))))
|
|
0
|
2338 (t
|
|
|
2339 (vc-registration-error file)))))
|
|
|
2340
|
|
|
2341 (defun vc-backend-merge-news (file)
|
|
|
2342 ;; Merge in any new changes made to FILE.
|
|
151
|
2343 (message "Merging changes into %s..." file)
|
|
|
2344 (prog1
|
|
|
2345 (vc-backend-dispatch
|
|
|
2346 file
|
|
|
2347 (error "vc-backend-merge-news not meaningful for SCCS files") ;SCCS
|
|
|
2348 (error "vc-backend-merge-news not meaningful for RCS files") ;RCS
|
|
|
2349 (save-excursion ; CVS
|
|
|
2350 (vc-file-clear-masterprops file)
|
|
|
2351 (vc-file-setprop file 'vc-workfile-version nil)
|
|
|
2352 (vc-file-setprop file 'vc-locking-user nil)
|
|
|
2353 (vc-do-command nil 0 "cvs" file 'WORKFILE "update")
|
|
|
2354 ;; CVS doesn't return an error code if conflicts are detected.
|
|
|
2355 ;; Since we want to warn the user about it (and possibly start
|
|
|
2356 ;; emerge later), scan the output and see if this occurred.
|
|
|
2357 (set-buffer (get-buffer "*vc*"))
|
|
|
2358 (goto-char (point-min))
|
|
|
2359 (if (re-search-forward "^cvs update: conflicts found in .*" nil t)
|
|
|
2360 1 ;; error code for caller
|
|
|
2361 0 ;; no conflict detected
|
|
|
2362 )))
|
|
|
2363 (message "Merging changes into %s...done" file)))
|
|
0
|
2364
|
|
|
2365 (defun vc-check-headers ()
|
|
|
2366 "Check if the current file has any headers in it."
|
|
|
2367 (interactive)
|
|
|
2368 (save-excursion
|
|
|
2369 (goto-char (point-min))
|
|
|
2370 (vc-backend-dispatch buffer-file-name
|
|
151
|
2371 (re-search-forward "%[MIRLBSDHTEGUYFPQCZWA]%" nil t) ;; SCCS
|
|
|
2372 (re-search-forward "\\$[A-Za-z\300-\326\330-\366\370-\377]+\\(: [\t -#%-\176\240-\377]*\\)?\\$" nil t) ;; RCS
|
|
|
2373 'RCS ;; CVS works like RCS in this regard.
|
|
|
2374 )
|
|
0
|
2375 ))
|
|
|
2376
|
|
|
2377 ;; Back-end-dependent stuff ends here.
|
|
|
2378
|
|
|
2379 ;; Set up key bindings for use while editing log messages
|
|
|
2380
|
|
151
|
2381 (defun vc-log-mode (&optional file)
|
|
0
|
2382 "Minor mode for driving version-control tools.
|
|
|
2383 These bindings are added to the global keymap when you enter this mode:
|
|
151
|
2384 \\[vc-next-action] perform next logical version-control operation on current file
|
|
|
2385 \\[vc-register] register current file
|
|
|
2386 \\[vc-toggle-read-only] like next-action, but won't register files
|
|
|
2387 \\[vc-insert-headers] insert version-control headers in current file
|
|
|
2388 \\[vc-print-log] display change history of current file
|
|
|
2389 \\[vc-revert-buffer] revert buffer to latest version
|
|
|
2390 \\[vc-cancel-version] undo latest checkin
|
|
|
2391 \\[vc-diff] show diffs between file versions
|
|
|
2392 \\[vc-version-other-window] visit old version in another window
|
|
|
2393 \\[vc-directory] show all files locked by any user in or below .
|
|
|
2394 \\[vc-update-change-log] add change log entry from recent checkins
|
|
0
|
2395
|
|
|
2396 While you are entering a change log message for a version, the following
|
|
|
2397 additional bindings will be in effect.
|
|
|
2398
|
|
151
|
2399 \\[vc-finish-logentry] proceed with check in, ending log message entry
|
|
0
|
2400
|
|
|
2401 Whenever you do a checkin, your log comment is added to a ring of
|
|
|
2402 saved comments. These can be recalled as follows:
|
|
|
2403
|
|
151
|
2404 \\[vc-next-comment] replace region with next message in comment ring
|
|
|
2405 \\[vc-previous-comment] replace region with previous message in comment ring
|
|
|
2406 \\[vc-comment-search-reverse] search backward for regexp in the comment ring
|
|
|
2407 \\[vc-comment-search-forward] search backward for regexp in the comment ring
|
|
0
|
2408
|
|
|
2409 Entry to the change-log submode calls the value of text-mode-hook, then
|
|
|
2410 the value of vc-log-mode-hook.
|
|
|
2411
|
|
|
2412 Global user options:
|
|
151
|
2413 vc-initial-comment If non-nil, require user to enter a change
|
|
|
2414 comment upon first checkin of the file.
|
|
0
|
2415
|
|
151
|
2416 vc-keep-workfiles Non-nil value prevents workfiles from being
|
|
|
2417 deleted when changes are checked in
|
|
0
|
2418
|
|
151
|
2419 vc-suppress-confirm Suppresses some confirmation prompts,
|
|
|
2420 notably for reversions.
|
|
0
|
2421
|
|
151
|
2422 vc-header-alist Which keywords to insert when adding headers
|
|
|
2423 with \\[vc-insert-headers]. Defaults to
|
|
|
2424 '(\"\%\W\%\") under SCCS, '(\"\$Id\$\") under
|
|
|
2425 RCS and CVS.
|
|
0
|
2426
|
|
151
|
2427 vc-static-header-alist By default, version headers inserted in C files
|
|
|
2428 get stuffed in a static string area so that
|
|
|
2429 ident(RCS/CVS) or what(SCCS) can see them in
|
|
|
2430 the compiled object code. You can override
|
|
|
2431 this by setting this variable to nil, or change
|
|
|
2432 the header template by changing it.
|
|
0
|
2433
|
|
151
|
2434 vc-command-messages if non-nil, display run messages from the
|
|
|
2435 actual version-control utilities (this is
|
|
|
2436 intended primarily for people hacking vc
|
|
|
2437 itself).
|
|
0
|
2438 "
|
|
|
2439 (interactive)
|
|
|
2440 (set-syntax-table text-mode-syntax-table)
|
|
|
2441 (use-local-map vc-log-entry-mode)
|
|
|
2442 (setq local-abbrev-table text-mode-abbrev-table)
|
|
|
2443 (setq major-mode 'vc-log-mode)
|
|
|
2444 (setq mode-name "VC-Log")
|
|
|
2445 (make-local-variable 'vc-log-file)
|
|
151
|
2446 (setq vc-log-file file)
|
|
0
|
2447 (make-local-variable 'vc-log-version)
|
|
|
2448 (make-local-variable 'vc-comment-ring-index)
|
|
|
2449 (set-buffer-modified-p nil)
|
|
|
2450 (setq buffer-file-name nil)
|
|
|
2451 (run-hooks 'text-mode-hook 'vc-log-mode-hook)
|
|
151
|
2452 )
|
|
0
|
2453
|
|
|
2454 ;; Initialization code, to be done just once at load-time
|
|
|
2455 (if vc-log-entry-mode
|
|
|
2456 nil
|
|
|
2457 (setq vc-log-entry-mode (make-sparse-keymap))
|
|
|
2458 (define-key vc-log-entry-mode "\M-n" 'vc-next-comment)
|
|
|
2459 (define-key vc-log-entry-mode "\M-p" 'vc-previous-comment)
|
|
|
2460 (define-key vc-log-entry-mode "\M-r" 'vc-comment-search-reverse)
|
|
|
2461 (define-key vc-log-entry-mode "\M-s" 'vc-comment-search-forward)
|
|
|
2462 (define-key vc-log-entry-mode "\C-c\C-c" 'vc-finish-logentry)
|
|
|
2463 )
|
|
|
2464
|
|
|
2465 ;;; These things should probably be generally available
|
|
|
2466
|
|
151
|
2467 (defun vc-file-tree-walk (dirname func &rest args)
|
|
|
2468 "Walk recursively through DIRNAME.
|
|
0
|
2469 Invoke FUNC f ARGS on each non-directory file f underneath it."
|
|
151
|
2470 (vc-file-tree-walk-internal (expand-file-name dirname) func args)
|
|
|
2471 (message "Traversing directory %s...done" dirname))
|
|
0
|
2472
|
|
|
2473 (defun vc-file-tree-walk-internal (file func args)
|
|
|
2474 (if (not (file-directory-p file))
|
|
|
2475 (apply func file args)
|
|
151
|
2476 (message "Traversing directory %s..." (abbreviate-file-name file))
|
|
0
|
2477 (let ((dir (file-name-as-directory file)))
|
|
|
2478 (mapcar
|
|
|
2479 (function
|
|
|
2480 (lambda (f) (or
|
|
|
2481 (string-equal f ".")
|
|
|
2482 (string-equal f "..")
|
|
|
2483 (member f vc-directory-exclusion-list)
|
|
|
2484 (let ((dirf (concat dir f)))
|
|
151
|
2485 (or
|
|
|
2486 (file-symlink-p dirf) ;; Avoid possible loops
|
|
|
2487 (vc-file-tree-walk-internal dirf func args))))))
|
|
0
|
2488 (directory-files dir)))))
|
|
|
2489
|
|
|
2490 (provide 'vc)
|
|
|
2491
|
|
|
2492 ;;; DEVELOPER'S NOTES ON CONCURRENCY PROBLEMS IN THIS CODE
|
|
|
2493 ;;;
|
|
|
2494 ;;; These may be useful to anyone who has to debug or extend the package.
|
|
151
|
2495 ;;; (Note that this information corresponds to versions 5.x. Some of it
|
|
|
2496 ;;; might have been invalidated by the additions to support branching
|
|
|
2497 ;;; and RCS keyword lookup. AS, 1995/03/24)
|
|
0
|
2498 ;;;
|
|
|
2499 ;;; A fundamental problem in VC is that there are time windows between
|
|
|
2500 ;;; vc-next-action's computations of the file's version-control state and
|
|
|
2501 ;;; the actions that change it. This is a window open to lossage in a
|
|
|
2502 ;;; multi-user environment; someone else could nip in and change the state
|
|
|
2503 ;;; of the master during it.
|
|
|
2504 ;;;
|
|
|
2505 ;;; The performance problem is that rlog/prs calls are very expensive; we want
|
|
|
2506 ;;; to avoid them as much as possible.
|
|
|
2507 ;;;
|
|
|
2508 ;;; ANALYSIS:
|
|
|
2509 ;;;
|
|
|
2510 ;;; The performance problem, it turns out, simplifies in practice to the
|
|
|
2511 ;;; problem of making vc-locking-user fast. The two other functions that call
|
|
|
2512 ;;; prs/rlog will not be so commonly used that the slowdown is a problem; one
|
|
|
2513 ;;; makes snapshots, the other deletes the calling user's last change in the
|
|
|
2514 ;;; master.
|
|
|
2515 ;;;
|
|
|
2516 ;;; The race condition implies that we have to either (a) lock the master
|
|
|
2517 ;;; during the entire execution of vc-next-action, or (b) detect and
|
|
|
2518 ;;; recover from errors resulting from dispatch on an out-of-date state.
|
|
|
2519 ;;;
|
|
151
|
2520 ;;; Alternative (a) appears to be infeasible. The problem is that we can't
|
|
0
|
2521 ;;; guarantee that the lock will ever be removed. Suppose a user starts a
|
|
|
2522 ;;; checkin, the change message buffer pops up, and the user, having wandered
|
|
|
2523 ;;; off to do something else, simply forgets about it?
|
|
|
2524 ;;;
|
|
|
2525 ;;; Alternative (b), on the other hand, works well with a cheap way to speed up
|
|
|
2526 ;;; vc-locking-user. Usually, if a file is registered, we can read its locked/
|
|
|
2527 ;;; unlocked state and its current owner from its permissions.
|
|
|
2528 ;;;
|
|
|
2529 ;;; This shortcut will fail if someone has manually changed the workfile's
|
|
|
2530 ;;; permissions; also if developers are munging the workfile in several
|
|
|
2531 ;;; directories, with symlinks to a master (in this latter case, the
|
|
|
2532 ;;; permissions shortcut will fail to detect a lock asserted from another
|
|
|
2533 ;;; directory).
|
|
|
2534 ;;;
|
|
|
2535 ;;; Note that these cases correspond exactly to the errors which could happen
|
|
|
2536 ;;; because of a competing checkin/checkout race in between two instances of
|
|
|
2537 ;;; vc-next-action.
|
|
|
2538 ;;;
|
|
|
2539 ;;; For VC's purposes, a workfile/master pair may have the following states:
|
|
|
2540 ;;;
|
|
|
2541 ;;; A. Unregistered. There is a workfile, there is no master.
|
|
|
2542 ;;;
|
|
|
2543 ;;; B. Registered and not locked by anyone.
|
|
|
2544 ;;;
|
|
|
2545 ;;; C. Locked by calling user and unchanged.
|
|
|
2546 ;;;
|
|
|
2547 ;;; D. Locked by the calling user and changed.
|
|
|
2548 ;;;
|
|
|
2549 ;;; E. Locked by someone other than the calling user.
|
|
|
2550 ;;;
|
|
|
2551 ;;; This makes for 25 states and 20 error conditions. Here's the matrix:
|
|
|
2552 ;;;
|
|
|
2553 ;;; VC's idea of state
|
|
|
2554 ;;; |
|
|
|
2555 ;;; V Actual state RCS action SCCS action Effect
|
|
|
2556 ;;; A B C D E
|
|
|
2557 ;;; A . 1 2 3 4 ci -u -t- admin -fb -i<file> initial admin
|
|
|
2558 ;;; B 5 . 6 7 8 co -l get -e checkout
|
|
|
2559 ;;; C 9 10 . 11 12 co -u unget; get revert
|
|
|
2560 ;;; D 13 14 15 . 16 ci -u -m<comment> delta -y<comment>; get checkin
|
|
151
|
2561 ;;; E 17 18 19 20 . rcs -u -M -l unget -n ; get -g steal lock
|
|
0
|
2562 ;;;
|
|
|
2563 ;;; All commands take the master file name as a last argument (not shown).
|
|
|
2564 ;;;
|
|
|
2565 ;;; In the discussion below, a "self-race" is a pathological situation in
|
|
|
2566 ;;; which VC operations are being attempted simultaneously by two or more
|
|
|
2567 ;;; Emacsen running under the same username.
|
|
|
2568 ;;;
|
|
|
2569 ;;; The vc-next-action code has the following windows:
|
|
|
2570 ;;;
|
|
|
2571 ;;; Window P:
|
|
|
2572 ;;; Between the check for existence of a master file and the call to
|
|
|
2573 ;;; admin/checkin in vc-buffer-admin (apparent state A). This window may
|
|
|
2574 ;;; never close if the initial-comment feature is on.
|
|
|
2575 ;;;
|
|
|
2576 ;;; Window Q:
|
|
|
2577 ;;; Between the call to vc-workfile-unchanged-p in and the immediately
|
|
|
2578 ;;; following revert (apparent state C).
|
|
|
2579 ;;;
|
|
|
2580 ;;; Window R:
|
|
|
2581 ;;; Between the call to vc-workfile-unchanged-p in and the following
|
|
|
2582 ;;; checkin (apparent state D). This window may never close.
|
|
|
2583 ;;;
|
|
|
2584 ;;; Window S:
|
|
|
2585 ;;; Between the unlock and the immediately following checkout during a
|
|
|
2586 ;;; revert operation (apparent state C). Included in window Q.
|
|
|
2587 ;;;
|
|
|
2588 ;;; Window T:
|
|
|
2589 ;;; Between vc-locking-user and the following checkout (apparent state B).
|
|
|
2590 ;;;
|
|
|
2591 ;;; Window U:
|
|
|
2592 ;;; Between vc-locking-user and the following revert (apparent state C).
|
|
|
2593 ;;; Includes windows Q and S.
|
|
|
2594 ;;;
|
|
|
2595 ;;; Window V:
|
|
|
2596 ;;; Between vc-locking-user and the following checkin (apparent state
|
|
|
2597 ;;; D). This window may never be closed if the user fails to complete the
|
|
|
2598 ;;; checkin message. Includes window R.
|
|
|
2599 ;;;
|
|
|
2600 ;;; Window W:
|
|
|
2601 ;;; Between vc-locking-user and the following steal-lock (apparent
|
|
|
2602 ;;; state E). This window may never close if the user fails to complete
|
|
|
2603 ;;; the steal-lock message. Includes window X.
|
|
|
2604 ;;;
|
|
|
2605 ;;; Window X:
|
|
|
2606 ;;; Between the unlock and the immediately following re-lock during a
|
|
|
2607 ;;; steal-lock operation (apparent state E). This window may never cloce
|
|
|
2608 ;;; if the user fails to complete the steal-lock message.
|
|
|
2609 ;;;
|
|
|
2610 ;;; Errors:
|
|
|
2611 ;;;
|
|
|
2612 ;;; Apparent state A ---
|
|
|
2613 ;;;
|
|
|
2614 ;;; 1. File looked unregistered but is actually registered and not locked.
|
|
|
2615 ;;;
|
|
|
2616 ;;; Potential cause: someone else's admin during window P, with
|
|
|
2617 ;;; caller's admin happening before their checkout.
|
|
|
2618 ;;;
|
|
151
|
2619 ;;; RCS: Prior to version 5.6.4, ci fails with message
|
|
|
2620 ;;; "no lock set by <user>". From 5.6.4 onwards, VC uses the new
|
|
|
2621 ;;; ci -i option and the message is "<file>,v: already exists".
|
|
0
|
2622 ;;; SCCS: admin will fail with error (ad19).
|
|
|
2623 ;;;
|
|
|
2624 ;;; We can let these errors be passed up to the user.
|
|
|
2625 ;;;
|
|
|
2626 ;;; 2. File looked unregistered but is actually locked by caller, unchanged.
|
|
|
2627 ;;;
|
|
|
2628 ;;; Potential cause: self-race during window P.
|
|
|
2629 ;;;
|
|
151
|
2630 ;;; RCS: Prior to version 5.6.4, reverts the file to the last saved
|
|
|
2631 ;;; version and unlocks it. From 5.6.4 onwards, VC uses the new
|
|
|
2632 ;;; ci -i option, failing with message "<file>,v: already exists".
|
|
0
|
2633 ;;; SCCS: will fail with error (ad19).
|
|
|
2634 ;;;
|
|
|
2635 ;;; Either of these consequences is acceptable.
|
|
|
2636 ;;;
|
|
|
2637 ;;; 3. File looked unregistered but is actually locked by caller, changed.
|
|
|
2638 ;;;
|
|
|
2639 ;;; Potential cause: self-race during window P.
|
|
|
2640 ;;;
|
|
151
|
2641 ;;; RCS: Prior to version 5.6.4, VC registers the caller's workfile as
|
|
|
2642 ;;; a delta with a null change comment (the -t- switch will be
|
|
|
2643 ;;; ignored). From 5.6.4 onwards, VC uses the new ci -i option,
|
|
|
2644 ;;; failing with message "<file>,v: already exists".
|
|
0
|
2645 ;;; SCCS: will fail with error (ad19).
|
|
|
2646 ;;;
|
|
|
2647 ;;; 4. File looked unregistered but is locked by someone else.
|
|
|
2648 ;;;
|
|
|
2649 ;;; Potential cause: someone else's admin during window P, with
|
|
|
2650 ;;; caller's admin happening *after* their checkout.
|
|
|
2651 ;;;
|
|
151
|
2652 ;;; RCS: Prior to version 5.6.4, ci fails with a
|
|
|
2653 ;;; "no lock set by <user>" message. From 5.6.4 onwards,
|
|
|
2654 ;;; VC uses the new ci -i option, failing with message
|
|
|
2655 ;;; "<file>,v: already exists".
|
|
0
|
2656 ;;; SCCS: will fail with error (ad19).
|
|
|
2657 ;;;
|
|
|
2658 ;;; We can let these errors be passed up to the user.
|
|
|
2659 ;;;
|
|
|
2660 ;;; Apparent state B ---
|
|
|
2661 ;;;
|
|
|
2662 ;;; 5. File looked registered and not locked, but is actually unregistered.
|
|
|
2663 ;;;
|
|
|
2664 ;;; Potential cause: master file got nuked during window P.
|
|
|
2665 ;;;
|
|
|
2666 ;;; RCS: will fail with "RCS/<file>: No such file or directory"
|
|
|
2667 ;;; SCCS: will fail with error ut4.
|
|
|
2668 ;;;
|
|
|
2669 ;;; We can let these errors be passed up to the user.
|
|
|
2670 ;;;
|
|
|
2671 ;;; 6. File looked registered and not locked, but is actually locked by the
|
|
|
2672 ;;; calling user and unchanged.
|
|
|
2673 ;;;
|
|
|
2674 ;;; Potential cause: self-race during window T.
|
|
|
2675 ;;;
|
|
|
2676 ;;; RCS: in the same directory as the previous workfile, co -l will fail
|
|
|
2677 ;;; with "co error: writable foo exists; checkout aborted". In any other
|
|
|
2678 ;;; directory, checkout will succeed.
|
|
|
2679 ;;; SCCS: will fail with ge17.
|
|
|
2680 ;;;
|
|
|
2681 ;;; Either of these consequences is acceptable.
|
|
|
2682 ;;;
|
|
|
2683 ;;; 7. File looked registered and not locked, but is actually locked by the
|
|
|
2684 ;;; calling user and changed.
|
|
|
2685 ;;;
|
|
|
2686 ;;; As case 6.
|
|
|
2687 ;;;
|
|
|
2688 ;;; 8. File looked registered and not locked, but is actually locked by another
|
|
|
2689 ;;; user.
|
|
|
2690 ;;;
|
|
|
2691 ;;; Potential cause: someone else checks it out during window T.
|
|
|
2692 ;;;
|
|
|
2693 ;;; RCS: co error: revision 1.3 already locked by <user>
|
|
|
2694 ;;; SCCS: fails with ge4 (in directory) or ut7 (outside it).
|
|
|
2695 ;;;
|
|
|
2696 ;;; We can let these errors be passed up to the user.
|
|
|
2697 ;;;
|
|
|
2698 ;;; Apparent state C ---
|
|
|
2699 ;;;
|
|
|
2700 ;;; 9. File looks locked by calling user and unchanged, but is unregistered.
|
|
|
2701 ;;;
|
|
|
2702 ;;; As case 5.
|
|
|
2703 ;;;
|
|
|
2704 ;;; 10. File looks locked by calling user and unchanged, but is actually not
|
|
|
2705 ;;; locked.
|
|
|
2706 ;;;
|
|
|
2707 ;;; Potential cause: a self-race in window U, or by the revert's
|
|
|
2708 ;;; landing during window X of some other user's steal-lock or window S
|
|
|
2709 ;;; of another user's revert.
|
|
|
2710 ;;;
|
|
|
2711 ;;; RCS: succeeds, refreshing the file from the identical version in
|
|
|
2712 ;;; the master.
|
|
|
2713 ;;; SCCS: fails with error ut4 (p file nonexistent).
|
|
|
2714 ;;;
|
|
|
2715 ;;; Either of these consequences is acceptable.
|
|
|
2716 ;;;
|
|
|
2717 ;;; 11. File is locked by calling user. It looks unchanged, but is actually
|
|
|
2718 ;;; changed.
|
|
|
2719 ;;;
|
|
|
2720 ;;; Potential cause: the file would have to be touched by a self-race
|
|
|
2721 ;;; during window Q.
|
|
|
2722 ;;;
|
|
|
2723 ;;; The revert will succeed, removing whatever changes came with
|
|
|
2724 ;;; the touch. It is theoretically possible that work could be lost.
|
|
|
2725 ;;;
|
|
|
2726 ;;; 12. File looks like it's locked by the calling user and unchanged, but
|
|
|
2727 ;;; it's actually locked by someone else.
|
|
|
2728 ;;;
|
|
|
2729 ;;; Potential cause: a steal-lock in window V.
|
|
|
2730 ;;;
|
|
|
2731 ;;; RCS: co error: revision <rev> locked by <user>; use co -r or rcs -u
|
|
|
2732 ;;; SCCS: fails with error un2
|
|
|
2733 ;;;
|
|
|
2734 ;;; We can pass these errors up to the user.
|
|
|
2735 ;;;
|
|
|
2736 ;;; Apparent state D ---
|
|
|
2737 ;;;
|
|
|
2738 ;;; 13. File looks like it's locked by the calling user and changed, but it's
|
|
|
2739 ;;; actually unregistered.
|
|
|
2740 ;;;
|
|
|
2741 ;;; Potential cause: master file got nuked during window P.
|
|
|
2742 ;;;
|
|
151
|
2743 ;;; RCS: Prior to version 5.6.4, checks in the user's version as an
|
|
|
2744 ;;; initial delta. From 5.6.4 onwards, VC uses the new ci -j
|
|
|
2745 ;;; option, failing with message "no such file or directory".
|
|
0
|
2746 ;;; SCCS: will fail with error ut4.
|
|
|
2747 ;;;
|
|
151
|
2748 ;;; This case is kind of nasty. Under RCS prior to version 5.6.4,
|
|
|
2749 ;;; VC may fail to detect the loss of previous version information.
|
|
0
|
2750 ;;;
|
|
|
2751 ;;; 14. File looks like it's locked by the calling user and changed, but it's
|
|
|
2752 ;;; actually unlocked.
|
|
|
2753 ;;;
|
|
|
2754 ;;; Potential cause: self-race in window V, or the checkin happening
|
|
|
2755 ;;; during the window X of someone else's steal-lock or window S of
|
|
|
2756 ;;; someone else's revert.
|
|
|
2757 ;;;
|
|
|
2758 ;;; RCS: ci will fail with "no lock set by <user>".
|
|
|
2759 ;;; SCCS: delta will fail with error ut4.
|
|
|
2760 ;;;
|
|
|
2761 ;;; 15. File looks like it's locked by the calling user and changed, but it's
|
|
|
2762 ;;; actually locked by the calling user and unchanged.
|
|
|
2763 ;;;
|
|
|
2764 ;;; Potential cause: another self-race --- a whole checkin/checkout
|
|
|
2765 ;;; sequence by the calling user would have to land in window R.
|
|
|
2766 ;;;
|
|
|
2767 ;;; SCCS: checks in a redundant delta and leaves the file unlocked as usual.
|
|
|
2768 ;;; RCS: reverts to the file state as of the second user's checkin, leaving
|
|
|
2769 ;;; the file unlocked.
|
|
|
2770 ;;;
|
|
|
2771 ;;; It is theoretically possible that work could be lost under RCS.
|
|
|
2772 ;;;
|
|
|
2773 ;;; 16. File looks like it's locked by the calling user and changed, but it's
|
|
|
2774 ;;; actually locked by a different user.
|
|
|
2775 ;;;
|
|
|
2776 ;;; RCS: ci error: no lock set by <user>
|
|
|
2777 ;;; SCCS: unget will fail with error un2
|
|
|
2778 ;;;
|
|
|
2779 ;;; We can pass these errors up to the user.
|
|
|
2780 ;;;
|
|
|
2781 ;;; Apparent state E ---
|
|
|
2782 ;;;
|
|
|
2783 ;;; 17. File looks like it's locked by some other user, but it's actually
|
|
|
2784 ;;; unregistered.
|
|
|
2785 ;;;
|
|
|
2786 ;;; As case 13.
|
|
|
2787 ;;;
|
|
|
2788 ;;; 18. File looks like it's locked by some other user, but it's actually
|
|
|
2789 ;;; unlocked.
|
|
|
2790 ;;;
|
|
|
2791 ;;; Potential cause: someone released a lock during window W.
|
|
|
2792 ;;;
|
|
|
2793 ;;; RCS: The calling user will get the lock on the file.
|
|
|
2794 ;;; SCCS: unget -n will fail with cm4.
|
|
|
2795 ;;;
|
|
|
2796 ;;; Either of these consequences will be OK.
|
|
|
2797 ;;;
|
|
|
2798 ;;; 19. File looks like it's locked by some other user, but it's actually
|
|
|
2799 ;;; locked by the calling user and unchanged.
|
|
|
2800 ;;;
|
|
|
2801 ;;; Potential cause: the other user relinquishing a lock followed by
|
|
|
2802 ;;; a self-race, both in window W.
|
|
|
2803 ;;;
|
|
|
2804 ;;; Under both RCS and SCCS, both unlock and lock will succeed, making
|
|
|
2805 ;;; the sequence a no-op.
|
|
|
2806 ;;;
|
|
|
2807 ;;; 20. File looks like it's locked by some other user, but it's actually
|
|
|
2808 ;;; locked by the calling user and changed.
|
|
|
2809 ;;;
|
|
|
2810 ;;; As case 19.
|
|
|
2811 ;;;
|
|
|
2812 ;;; PROBLEM CASES:
|
|
|
2813 ;;;
|
|
|
2814 ;;; In order of decreasing severity:
|
|
|
2815 ;;;
|
|
151
|
2816 ;;; Cases 11 and 15 are the only ones that potentially lose work.
|
|
0
|
2817 ;;; They would require a self-race for this to happen.
|
|
|
2818 ;;;
|
|
|
2819 ;;; Case 13 in RCS loses information about previous deltas, retaining
|
|
|
2820 ;;; only the information in the current workfile. This can only happen
|
|
|
2821 ;;; if the master file gets nuked in window P.
|
|
|
2822 ;;;
|
|
|
2823 ;;; Case 3 in RCS and case 15 under SCCS insert a redundant delta with
|
|
|
2824 ;;; no change comment in the master. This would require a self-race in
|
|
|
2825 ;;; window P or R respectively.
|
|
|
2826 ;;;
|
|
|
2827 ;;; Cases 2, 10, 19 and 20 do extra work, but make no changes.
|
|
|
2828 ;;;
|
|
|
2829 ;;; Unfortunately, it appears to me that no recovery is possible in these
|
|
|
2830 ;;; cases. They don't yield error messages, so there's no way to tell that
|
|
|
2831 ;;; a race condition has occurred.
|
|
|
2832 ;;;
|
|
|
2833 ;;; All other cases don't change either the workfile or the master, and
|
|
|
2834 ;;; trigger command errors which the user will see.
|
|
|
2835 ;;;
|
|
|
2836 ;;; Thus, there is no explicit recovery code.
|
|
|
2837
|
|
|
2838 ;;; vc.el ends here
|
