904
|
1 ;;; vc.el --- drive a version-control system from within Emacs
|
|
2
|
|
3 ;; Copyright (C) 1992 Free Software Foundation, Inc.
|
|
4
|
|
5 ;; Author: Eric S. Raymond <esr@snark.thyrsus.com>
|
|
6 ;; Version: 4.0
|
|
7
|
|
8 ;; $Id: vc.el,v 1.58 1992/07/31 07:17:21 esr Exp $
|
|
9
|
|
10 ;; This file is part of GNU Emacs.
|
|
11
|
|
12 ;; GNU Emacs is free software; you can redistribute it and/or modify
|
|
13 ;; it under the terms of the GNU General Public License as published by
|
|
14 ;; the Free Software Foundation; either version 2, or (at your option)
|
|
15 ;; any later version.
|
|
16
|
|
17 ;; GNU Emacs is distributed in the hope that it will be useful,
|
|
18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
20 ;; GNU General Public License for more details.
|
|
21
|
|
22 ;; You should have received a copy of the GNU General Public License
|
|
23 ;; along with GNU Emacs; see the file COPYING. If not, write to
|
|
24 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
|
|
25
|
|
26 ;;; Commentary:
|
|
27
|
|
28 ;; This was designed and implemented by Eric Raymond <esr@snark.thyrsus.com>.
|
|
29 ;; Paul Eggert <eggert@twinsun.com>, Sebastian Kremer <sk@thp.uni-koeln.de>,
|
|
30 ;; and Richard Stallman contributed valuable criticism, support, and testing.
|
|
31 ;;
|
|
32 ;; Supported version-control systems presently include SCCS and RCS;
|
|
33 ;; your RCS version should be 5.6.2 or later for proper operation of
|
|
34 ;; the lock-breaking code.
|
|
35 ;;
|
|
36 ;; The RCS code assumes strict locking. You can support the RCS -x option
|
|
37 ;; by adding pairs to the vc-master-templates list.
|
|
38 ;;
|
|
39 ;; Proper function of the SCCS diff commands requires the shellscript vcdiff
|
|
40 ;; to be installed somewhere on Emacs's path for executables.
|
|
41 ;;
|
|
42 ;; This code depends on call-process passing back the subprocess exit
|
|
43 ;; status. Thus, you need Emacs 18.58 or later to run it.
|
|
44 ;;
|
|
45 ;; The vc code maintains some internal state in order to reduce expensive
|
|
46 ;; version-control operations to a minimum. Some names are only computed
|
|
47 ;; once. If you perform version control operations with RCS/SCCS/CVS while
|
|
48 ;; vc's back is turned, or move/rename master files while vc is running,
|
|
49 ;; vc may get seriously confused. Don't do these things!
|
|
50 ;;
|
|
51 ;; Developer's notes on some concurrency issues are included at the end of
|
|
52 ;; the file.
|
|
53
|
|
54 ;;; Code:
|
|
55
|
|
56 (require 'vc-hooks)
|
|
57
|
|
58 ;; General customization
|
|
59
|
|
60 (defvar vc-default-back-end nil
|
|
61 "*Back-end actually used by this interface; may be SCCS or RCS.
|
|
62 The value is only computed when needed to avoid an expensive search.")
|
|
63 (defvar vc-diff-options '("-a" "-c1")
|
|
64 "*The command/flags list to be used in constructing diff commands.")
|
|
65 (defvar vc-suppress-confirm nil
|
|
66 "*If non-nil, reat user as expert; suppress yes-no prompts on some things.")
|
|
67 (defvar vc-keep-workfiles t
|
|
68 "*If non-nil, don't delete working files after registering changes.")
|
|
69 (defvar vc-initial-comment nil
|
|
70 "*Prompt for initial comment when a file is registered.")
|
|
71 (defvar vc-command-messages nil
|
|
72 "*Display run messages from back-end commands.")
|
|
73 (defvar vc-mistrust-permissions 'file-symlink-p
|
|
74 "*Don't assume that permissions and ownership track version-control status.")
|
|
75
|
|
76 ;; Header-insertion hair
|
|
77
|
|
78 (defvar vc-header-alist
|
|
79 '((SCCS "\%W\%") (RCS "\$Id\$"))
|
|
80 "*Header keywords to be inserted when vc-insert-header is executed.")
|
|
81 (defconst vc-static-header-alist
|
|
82 '(("\\.c$" .
|
|
83 "\n#ifndef lint\nstatic char vcid[] = \"\%s\";\n#endif /* lint */\n"))
|
|
84 "*Associate static header string templates with file types. A \%s in the
|
|
85 template is replaced with the first string associated with the file's
|
|
86 verson-control type in vc-header-strings.")
|
|
87 (defvar vc-comment-alist
|
|
88 '((nroff-mode ".\\\"" ""))
|
|
89 "*Special comment delimiters to be used in generating vc headers only.
|
|
90 Add an entry in this list if you need to override the normal comment-start
|
|
91 and comment-end variables. This will only be necessary if the mode language
|
|
92 is sensitive to blank lines.")
|
|
93
|
|
94 ;; Variables the user doesn't need to know about.
|
|
95 (defvar vc-log-entry-mode nil)
|
|
96 (defvar vc-log-operation nil)
|
|
97
|
|
98 (defconst vc-name-assoc-file "VC-names")
|
|
99
|
|
100 (defmacro vc-error-occurred (&rest body)
|
|
101 (list 'condition-case nil (cons 'progn (append body '(nil))) '(error t)))
|
|
102
|
|
103 ;; File property caching
|
|
104
|
|
105 (defun vc-file-clearprops (file)
|
|
106 ;; clear all properties of a given file
|
|
107 (setplist (intern file vc-file-prop-obarray) nil))
|
|
108
|
|
109 ;; Random helper functions
|
|
110
|
|
111 (defun vc-name (file)
|
|
112 "Return the master name of a file, nil if it is not registered"
|
|
113 (or (vc-file-getprop file 'vc-name)
|
|
114 (vc-file-setprop file 'vc-name
|
|
115 (let ((name-and-type (vc-registered file)))
|
|
116 (and name-and-type (car name-and-type))))))
|
|
117
|
|
118 (defvar vc-binary-assoc nil)
|
|
119
|
|
120 (defun vc-find-binary (name)
|
|
121 "Look for a command anywhere on the subprocess-command search path."
|
|
122 (or (cdr (assoc name vc-binary-assoc))
|
|
123 (let ((full nil))
|
|
124 (catch 'found
|
|
125 (mapcar
|
|
126 (function (lambda (s)
|
|
127 (if (and s (file-exists-p (setq full (concat s "/" name))))
|
|
128 (throw 'found nil))))
|
|
129 exec-path))
|
|
130 (if full
|
|
131 (setq vc-binary-assoc (cons (cons name full) vc-binary-assoc)))
|
|
132 full)))
|
|
133
|
|
134 (defun vc-do-command (okstatus command file &rest flags)
|
|
135 "Execute a version-control command, notifying user and checking for errors.
|
|
136 The command is successful if its exit status does not exceed OKSTATUS.
|
|
137 Output from COMMAND goes to buffer *vc*. The last argument of the command is
|
|
138 the master name of FILE; this is appended to an optional list of FLAGS."
|
|
139 (setq file (expand-file-name file))
|
|
140 (if vc-command-messages
|
|
141 (message (format "Running %s on %s..." command file)))
|
|
142 (let ((obuf (current-buffer))
|
|
143 (squeezed nil)
|
|
144 (vc-file (and file (vc-name file)))
|
|
145 status)
|
|
146 (set-buffer (get-buffer-create "*vc*"))
|
|
147 (erase-buffer)
|
|
148 (mapcar
|
|
149 (function (lambda (s) (and s (setq squeezed (append squeezed (list s))))))
|
|
150 flags)
|
|
151 (if vc-file
|
|
152 (setq squeezed (append squeezed (list vc-file))))
|
|
153 (let
|
|
154 ((default-directory (file-name-directory (or file "./"))))
|
|
155 (setq status (apply 'call-process command nil t nil squeezed))
|
|
156 )
|
|
157 (goto-char (point-max))
|
|
158 (previous-line 1)
|
|
159 (if (or (not (integerp status)) (< okstatus status))
|
|
160 (progn
|
|
161 (previous-line 1)
|
|
162 (print (cons command squeezed))
|
|
163 (next-line 1)
|
|
164 (pop-to-buffer "*vc*")
|
|
165 (vc-shrink-to-fit)
|
|
166 (goto-char (point-min))
|
|
167 (error (format "Running %s...FAILED (%s)" command
|
|
168 (if (integerp status)
|
|
169 (format "status %d" status)
|
|
170 status)))
|
|
171 )
|
|
172 (if vc-command-messages
|
|
173 (message (format "Running %s...OK" command)))
|
|
174 )
|
|
175 (set-buffer obuf)
|
|
176 status)
|
|
177 )
|
|
178
|
|
179 (defun vc-revert-buffer1 (&optional arg no-confirm)
|
|
180 ;; This code was shamelessly lifted from Sebastian Kremer's rcs.el mode.
|
|
181 ;; Revert buffer, try to keep point where user expects it in spite
|
|
182 ;; of changes because of expanded version-control key words.
|
|
183 ;; This is quite important since otherwise typeahead won't work as expected.
|
|
184 (interactive "P")
|
|
185 (widen)
|
|
186 (let* ((opoint (point))
|
|
187 (osize (buffer-size))
|
|
188 diff
|
|
189 (context 100)
|
|
190 (ostring (buffer-substring (point)
|
|
191 (min (point-max)
|
|
192 (+ (point) context))))
|
|
193 (l (length ostring)))
|
|
194 (revert-buffer arg no-confirm)
|
|
195 (setq diff (- osize (buffer-size)))
|
|
196 (if (< diff 0) (setq diff (- diff)))
|
|
197 (goto-char opoint)
|
|
198 (cond ((equal "" ostring)
|
|
199 (goto-char (point-max)))
|
|
200 ((or (search-forward ostring nil t)
|
|
201 ;; Can't use search-backward since the match may continue
|
|
202 ;; after point.
|
|
203 (progn (goto-char (- (point) diff l))
|
|
204 ;; goto-char doesn't signal an error at
|
|
205 ;; beginning of buffer like backward-char would
|
|
206 (search-forward ostring nil t)))
|
|
207 ;; to beginning of OSTRING
|
|
208 (backward-char l)))))
|
|
209
|
|
210 (defun vc-buffer-sync ()
|
|
211 ;; Make sure the current buffer and its working file are in sync
|
|
212 (if (and (buffer-modified-p)
|
|
213 (or
|
|
214 vc-suppress-confirm
|
|
215 (y-or-n-p (format "%s has been modified. Write it out? "
|
|
216 (buffer-name)))))
|
|
217 (save-buffer)))
|
|
218
|
|
219 (defun vc-workfile-unchanged-p (file)
|
|
220 ;; Has the given workfile changed since last checkout?
|
|
221 (let ((checkout-time (vc-file-getprop file 'vc-checkout-time))
|
|
222 (lastmod (nth 5 (file-attributes file))))
|
|
223 (if checkout-time
|
|
224 (equal lastmod checkout-time)
|
|
225 (if (zerop (vc-backend-diff file nil))
|
|
226 (progn
|
|
227 (vc-file-setprop file 'vc-checkout-time lastmod)
|
|
228 t)
|
|
229 (progn
|
|
230 (vc-file-setprop file 'vc-checkout-time '(0 . 0))
|
|
231 nil
|
|
232 ))
|
|
233 )))
|
|
234
|
|
235 ;; Here's the major entry point
|
|
236
|
|
237 (defun vc-next-action (verbose)
|
|
238 "Do the next logical checkin or checkout operation on the current file.
|
|
239 If the file is not already registered, this registers it for version
|
|
240 control and then retrieves a writeable, locked copy for editing.
|
|
241 If the file is registered and not locked by anyone, this checks out
|
|
242 a writeable and locked file ready for editing.
|
|
243 If the file is checked out and locked by the calling user, this
|
|
244 first checks to see if the file has changed since checkout. If not,
|
|
245 it performs a revert.
|
|
246 If the file has been changed, this pops up a buffer for creation of
|
|
247 a log message; when the message has been entered, it checks in the
|
|
248 resulting changes along with the log message as change commentary. If
|
|
249 the variable vc-keep-workfiles is non-nil (which is its default), a
|
|
250 read-only copy of the changed file is left in place afterwards.
|
|
251 If the file is registered and locked by someone else, you are given
|
|
252 the option to steal the lock."
|
|
253 (interactive "P")
|
|
254 (if buffer-file-name
|
|
255 (let
|
|
256 (do-update owner version
|
|
257 (file buffer-file-name)
|
|
258 (vc-file (vc-name buffer-file-name))
|
|
259 (err-msg nil)
|
|
260 owner)
|
|
261
|
|
262 (cond
|
|
263
|
|
264 ;; if there is no master file corresponding, create one
|
|
265 ((not vc-file)
|
|
266 (vc-register verbose)
|
|
267 (vc-next-action verbose))
|
|
268
|
|
269 ;; if there is no lock on the file, assert one and get it
|
|
270 ((not (setq owner (vc-locking-user file)))
|
|
271 (vc-checkout file t))
|
|
272
|
|
273 ;; a checked-out version exists, but the user may not own the lock
|
|
274 ((not (string-equal owner (user-login-name)))
|
|
275 (vc-steal-lock
|
|
276 file
|
|
277 (and verbose (read-string "Version to steal: "))
|
|
278 owner))
|
|
279
|
|
280 ;; OK, user owns the lock on the file
|
|
281 (t (progn
|
|
282
|
|
283 ;; give luser a chance to save before checking in.
|
|
284 (vc-buffer-sync)
|
|
285
|
|
286 ;; revert if file is unchanged
|
|
287 (if (vc-workfile-unchanged-p file)
|
|
288 (progn
|
|
289 (vc-backend-revert file)
|
|
290 (vc-resynch-window file t))
|
|
291
|
|
292 ;; user may want to set nonstandard parameters
|
|
293 (if verbose
|
|
294 (setq version (read-string "New version level: ")))
|
|
295
|
|
296 ;; OK, let's do the checkin
|
|
297 (vc-checkin file version))))))
|
|
298 (error "There is no file associated with buffer %s" (buffer-name))))
|
|
299
|
|
300 ;;; These functions help the vc-next-action entry point
|
|
301
|
|
302 (defun vc-register (&optional override)
|
|
303 "Register the current file into your version-control system."
|
|
304 (interactive "P")
|
|
305 (if (vc-name buffer-file-name)
|
|
306 (error "This file is already registered."))
|
|
307 (vc-buffer-sync)
|
|
308 (vc-admin
|
|
309 buffer-file-name
|
|
310 (and override (read-string "Initial version level: ")))
|
|
311 )
|
|
312
|
|
313 (defun vc-resynch-window (file &optional keep)
|
|
314 ;; If the given file is in the current buffer,
|
|
315 ;; either revert on it so we see expanded keyworks,
|
|
316 ;; or unvisit it (depending on vc-keep-workfiles)
|
|
317 (and (string= buffer-file-name file)
|
|
318 (if keep
|
|
319 (progn
|
|
320 (vc-revert-buffer1 nil t)
|
|
321 (vc-mode-line buffer-file-name))
|
|
322 (progn
|
|
323 (delete-window)
|
|
324 (kill-buffer (current-buffer))))))
|
|
325
|
|
326
|
|
327 (defun vc-admin (file rev)
|
|
328 "Checks a file into your version-control system.
|
|
329 FILE is the unmodified name of the file. REV should be the base version
|
|
330 level to check it in under."
|
|
331 (if vc-initial-comment
|
|
332 (progn
|
|
333 (pop-to-buffer (get-buffer-create "*VC-log*"))
|
|
334 (vc-log-mode)
|
|
335 (narrow-to-region (point-max) (point-max))
|
|
336 (vc-mode-line file (file-name-nondirectory file))
|
|
337 (setq vc-log-operation 'vc-backend-admin)
|
|
338 (setq vc-log-file file)
|
|
339 (setq vc-log-version rev)
|
|
340 (message "Enter initial comment. Type C-c C-c when done."))
|
|
341 (progn
|
|
342 (vc-backend-admin file rev)
|
|
343 (vc-resynch-window file vc-keep-workfiles))))
|
|
344
|
|
345 (defun vc-steal-lock (file rev &optional owner)
|
|
346 "Steal the lock on the current workfile."
|
|
347 (interactive)
|
|
348 (if (not owner)
|
|
349 (setq owner (vc-locking-user file)))
|
|
350 (if (not (y-or-n-p (format "Take the lock on %s:%s from %s?" file rev owner)))
|
|
351 (error "Steal cancelled."))
|
|
352 (pop-to-buffer (get-buffer-create "*VC-log*"))
|
|
353 (vc-log-mode)
|
|
354 (narrow-to-region (point-max) (point-max))
|
|
355 (insert
|
|
356 (format "To: %s\n\nI stole the lock on %s:%s, " owner file rev)
|
|
357 (current-time-string)
|
|
358 "\n")
|
|
359 (vc-mode-line file (file-name-nondirectory file))
|
|
360 (setq vc-log-operation 'vc-finish-steal)
|
|
361 (setq vc-log-file file)
|
|
362 (setq vc-log-version rev)
|
|
363 (message "Please explain why you stole the lock. Type C-c C-c when done.")
|
|
364 )
|
|
365
|
|
366 (defun vc-finish-steal (file version)
|
|
367 ;; Actually do the lock acquisition; send the former owner a notification
|
|
368 (vc-backend-steal file version)
|
|
369 (require 'sendmail) ;; (send-mail) isn't on the standard autoload list.
|
|
370 (mail-send)
|
|
371 (vc-resynch-window file t)
|
|
372 )
|
|
373
|
|
374 (defun vc-checkout (file &optional writeable)
|
|
375 "Retrieve a copy of the latest version of the given file."
|
|
376 (vc-backend-checkout file writeable)
|
|
377 (if (string-equal file buffer-file-name)
|
|
378 (vc-resynch-window file t))
|
|
379 )
|
|
380
|
|
381 (defun vc-checkin (file &optional rev comment)
|
|
382 "Check in the file specified by FILE.
|
|
383 The optional argument REV may be a string specifying the new version level
|
|
384 (if nil increment the current level). The file is either retained with write
|
|
385 permissions zeroed, or deleted (according to the value of vc-keep-workfiles).
|
|
386 COMMENT is a comment string; if omitted, a buffer is
|
|
387 popped up to accept a comment."
|
|
388 (pop-to-buffer (get-buffer-create "*VC-log*"))
|
|
389 (vc-log-mode)
|
|
390 (narrow-to-region (point-max) (point-max))
|
|
391 (vc-mode-line file (file-name-nondirectory file))
|
|
392 (setq vc-log-operation 'vc-backend-checkin)
|
|
393 (setq vc-log-file file)
|
|
394 (setq vc-log-version rev)
|
|
395 (message "Enter log message. Type C-c C-c when done.")
|
|
396 (if comment
|
|
397 (progn
|
|
398 (insert comment)
|
|
399 (vc-finish-logentry))))
|
|
400
|
|
401 (defun vc-finish-logentry ()
|
|
402 "Complete the operation implied by the current log entry."
|
|
403 (interactive)
|
|
404 (goto-char (point-max))
|
|
405 (if (not (bolp)) (newline))
|
|
406 ;; delimit current page
|
|
407 (save-excursion
|
|
408 (widen)
|
|
409 (goto-char (point-max))
|
|
410 (if (and (not (bobp)) (not (= (char-after (1- (point))) ?\f)))
|
|
411 (insert-char ?\f 1)))
|
|
412 (if (not (bobp))
|
|
413 (forward-char -1))
|
|
414 (mark-page)
|
|
415 ;; Check for errors
|
|
416 (vc-backend-logentry-check vc-log-file)
|
|
417 ;; OK, do it to it
|
|
418 (if vc-log-operation
|
|
419 (funcall vc-log-operation
|
|
420 vc-log-file
|
|
421 vc-log-version
|
|
422 (buffer-substring (region-beginning) (1- (region-end))))
|
|
423 (error "No log operation is pending."))
|
|
424 ;; Return to "parent" buffer of this checkin and remove checkin window
|
|
425 (pop-to-buffer (get-file-buffer vc-log-file))
|
|
426 (delete-window (get-buffer-window "*VC-log*"))
|
|
427 (bury-buffer "*VC-log*")
|
|
428 ;; Now make sure we see the expanded headers
|
|
429 (vc-resynch-window buffer-file-name vc-keep-workfiles)
|
|
430 )
|
|
431
|
|
432 ;; Code for access to the comment ring
|
|
433
|
|
434 (defun vc-next-comment ()
|
|
435 "Fill the log buffer with the next message in the msg ring."
|
|
436 (interactive)
|
|
437 (widen)
|
|
438 (forward-page)
|
|
439 (if (= (point) (point-max))
|
|
440 (goto-char (point-min)))
|
|
441 (mark-page)
|
|
442 (narrow-to-page))
|
|
443
|
|
444 (defun vc-previous-comment ()
|
|
445 "Fill the log buffer with the previous message in the msg ring."
|
|
446 (interactive)
|
|
447 (widen)
|
|
448 (if (= (point) (point-min))
|
|
449 (goto-char (point-max)))
|
|
450 (backward-page)
|
|
451 (mark-page)
|
|
452 (narrow-to-page))
|
|
453
|
|
454 (defun vc-comment-search-backward (regexp)
|
|
455 "Fill the log buffer with the last message in the msg ring matching REGEXP."
|
|
456 (interactive "sSearch backward for: ")
|
|
457 (widen)
|
|
458 (if (= (point) (point-min))
|
|
459 (goto-char (point-max)))
|
|
460 (re-search-backward regexp nil t)
|
|
461 (mark-page)
|
|
462 (narrow-to-page))
|
|
463
|
|
464 (defun vc-comment-search-forward (regexp)
|
|
465 "Fill the log buffer with the next message in the msg ring matching REGEXP."
|
|
466 (interactive "sSearch forward for: ")
|
|
467 (widen)
|
|
468 (if (= (point) (point-min))
|
|
469 (goto-char (point-max)))
|
|
470 (re-search-forward regexp nil t)
|
|
471 (mark-page)
|
|
472 (narrow-to-page))
|
|
473
|
|
474 ;; Additional entry points for examining version histories
|
|
475
|
|
476 (defun vc-diff (historic)
|
|
477 "Display diffs between file versions."
|
|
478 (interactive "P")
|
|
479 (if historic
|
|
480 (call-interactively 'vc-version-diff)
|
|
481 (let ((old
|
|
482 (and
|
|
483 current-prefix-arg
|
|
484 (read-string "Version to compare against: ")))
|
|
485 (file buffer-file-name)
|
|
486 unchanged)
|
|
487 (vc-buffer-sync)
|
|
488 (setq unchanged (vc-workfile-unchanged-p buffer-file-name))
|
|
489 (if unchanged
|
|
490 (message (format "No changes to %s since latest version." file))
|
|
491 (pop-to-buffer "*vc*")
|
|
492 (vc-backend-diff file nil)
|
|
493 (goto-char (point-min))
|
|
494 )
|
|
495 (not unchanged)
|
|
496 )
|
|
497 )
|
|
498 )
|
|
499
|
|
500 (defun vc-version-diff (file rel1 rel2)
|
|
501 "For FILE, report diffs between two stored versions REL1 and REL2 of it.
|
|
502 If FILE is a directory, generate diffs between versions for all registered
|
|
503 files in or below it."
|
|
504 (interactive "FFile or directory: \nsOlder version: \nsNewer version: ")
|
|
505 (if (string-equal rel1 "") (setq rel1 nil))
|
|
506 (if (string-equal rel2 "") (setq rel2 nil))
|
|
507 (if (file-directory-p file)
|
|
508 (progn
|
|
509 (set-buffer (get-buffer-create "*vc-status*"))
|
|
510 (erase-buffer)
|
|
511 (insert "Diffs between " rel1 " and " rel2 ":\n\n")
|
|
512 (set-buffer (get-buffer-create "*vc*"))
|
|
513 (vc-file-tree-walk
|
|
514 (function (lambda (f)
|
|
515 (and
|
|
516 (not (file-directory-p f))
|
|
517 (vc-name f)
|
|
518 (vc-backend-diff f rel1 rel2))
|
|
519 (append-to-buffer "*vc-status*" (point-min) (point-max))
|
|
520 ))
|
|
521 default-directory)
|
|
522 (pop-to-buffer "*vc-status*")
|
|
523 (insert "\nEnd of diffs.\n")
|
|
524 (goto-char (point-min))
|
|
525 (set-buffer-modified-p nil)
|
|
526 )
|
|
527 (progn
|
|
528 (vc-backend-diff file rel1 rel2)
|
|
529 (goto-char (point-min))
|
|
530 (if (equal (point-min) (point-max))
|
|
531 (message (format "No changes to %s between %s and %s." file rel1 rel2))
|
|
532 (pop-to-buffer "*vc*")
|
|
533 (goto-char (point-min))
|
|
534 )
|
|
535 )
|
|
536 )
|
|
537 )
|
|
538
|
|
539 ;; Header-insertion code
|
|
540
|
|
541 (defun vc-insert-headers ()
|
|
542 "Insert headers in a file for use with your version-control system.
|
|
543 Headers desired are inserted at the start of the buffer, and are pulled from
|
|
544 the variable vc-header-strings"
|
|
545 (interactive)
|
|
546 (save-excursion
|
|
547 (save-restriction
|
|
548 (widen)
|
|
549 (if (or (not (vc-check-headers))
|
|
550 (y-or-n-p "Version headers already exist. Insert another set?"))
|
|
551 (progn
|
|
552 (let* ((delims (cdr (assq major-mode vc-comment-alist)))
|
|
553 (comment-start-vc (or (car delims) comment-start "#"))
|
|
554 (comment-end-vc (or (car (cdr delims)) comment-end ""))
|
|
555 (hdstrings (cdr (assoc (vc-backend-deduce (buffer-file-name)) vc-header-alist))))
|
|
556 (mapcar (function (lambda (s)
|
|
557 (insert comment-start-vc "\t" s "\t"
|
|
558 comment-end-vc "\n")))
|
|
559 hdstrings)
|
|
560 (if vc-static-header-alist
|
|
561 (mapcar (function (lambda (f)
|
|
562 (if (string-match (car f) buffer-file-name)
|
|
563 (insert (format (cdr f) (car hdstrings))))))
|
|
564 vc-static-header-alist))
|
|
565 )
|
|
566 )))))
|
|
567
|
|
568 ;; Status-checking functions
|
|
569
|
|
570 (defun vc-directory (verbose)
|
|
571 "Show version-control status of all files under the current directory."
|
|
572 (interactive "P")
|
|
573 (let ((dir (substring default-directory 0 (1- (length default-directory))))
|
|
574 nonempty)
|
|
575 (save-excursion
|
|
576 (set-buffer (get-buffer-create "*vc-status*"))
|
|
577 (erase-buffer)
|
|
578 (vc-file-tree-walk
|
|
579 (function (lambda (f)
|
|
580 (if (vc-registered f)
|
|
581 (let ((user (vc-locking-user f)))
|
|
582 (if (or user verbose)
|
|
583 (insert (format
|
|
584 "%s %s\n"
|
|
585 (concat user) f)))))))
|
|
586 dir)
|
|
587 (setq nonempty (not (zerop (buffer-size)))))
|
|
588 (if nonempty
|
|
589 (progn
|
|
590 (pop-to-buffer "*vc-status*" t)
|
|
591 (vc-shrink-to-fit)
|
|
592 (goto-char (point-min)))
|
|
593 (message "No files are currently registered under %s" dir))
|
|
594 ))
|
|
595
|
|
596 ;; Named-configuration support for SCCS
|
|
597
|
|
598 (defun vc-add-triple (name file rev)
|
|
599 (save-excursion
|
|
600 (find-file (concat (vc-backend-subdirectory-name file) "/" vc-name-assoc-file))
|
|
601 (goto-char (point-max))
|
|
602 (insert name "\t:\t" file "\t" rev "\n")
|
|
603 (basic-save-buffer)
|
|
604 (kill-buffer (current-buffer))
|
|
605 ))
|
|
606
|
|
607 (defun vc-record-rename (file newname)
|
|
608 (save-excursion
|
|
609 (find-file (concat (vc-backend-subdirectory-name file) "/" vc-name-assoc-file))
|
|
610 (goto-char (point-min))
|
|
611 (replace-regexp (concat ":" (regexp-quote file) "$") (concat ":" newname))
|
|
612 (basic-save-buffer)
|
|
613 (kill-buffer (current-buffer))
|
|
614 ))
|
|
615
|
|
616 (defun vc-lookup-triple (file name)
|
|
617 (or
|
|
618 name
|
|
619 (let ((firstchar (aref name 0)))
|
|
620 (and (>= firstchar ?0) (<= firstchar ?9) name))
|
|
621 (car (vc-master-info
|
|
622 (concat (vc-backend-subdirectory-name file) "/" vc-name-assoc-file)
|
|
623 (list (concat name "\t:\t" file "\t\\(.+\\)"))))
|
|
624 ))
|
|
625
|
|
626 ;; Named-configuration entry points
|
|
627
|
|
628 (defun vc-quiescent-p ()
|
|
629 ;; Is the current directory ready to be snapshot?
|
|
630 (let ((dir (substring default-directory 0 (1- (length default-directory)))))
|
|
631 (catch 'quiet
|
|
632 (vc-file-tree-walk
|
|
633 (function (lambda (f)
|
|
634 (if (and (vc-registered f) (vc-locking-user f))
|
|
635 (throw 'quiet nil))))
|
|
636 dir)
|
|
637 t)))
|
|
638
|
|
639 (defun vc-create-snapshot (name)
|
|
640 "Make a snapshot called NAME.
|
|
641 The snapshot is made from all registered files at or below the current
|
|
642 directory. For each file, the version level of its latest
|
|
643 version becomes part of the named configuration."
|
|
644 (interactive "sNew snapshot name: ")
|
|
645 (if (not (vc-quiescent-p))
|
|
646 (error "Can't make a snapshot, locked files are in the way.")
|
|
647 (vc-file-tree-walk
|
|
648 (function (lambda (f) (and
|
|
649 (not (file-directory-p f))
|
|
650 (vc-name f)
|
|
651 (vc-backend-assign-name f name))))
|
|
652 default-directory)
|
|
653 ))
|
|
654
|
|
655 (defun vc-retrieve-snapshot (name)
|
|
656 "Retrieve the snapshot called NAME.
|
|
657 This function fails if any files are locked at or below the current directory
|
|
658 Otherwise, all registered files are checked out (unlocked) at their version
|
|
659 levels in the snapshot."
|
|
660 (interactive "sSnapshot name to retrieve: ")
|
|
661 (if (not (vc-quiescent-p))
|
|
662 (error "Can't retrieve a snapshot, locked files are in the way.")
|
|
663 (vc-file-tree-walk
|
|
664 (function (lambda (f) (and
|
|
665 (not (file-directory-p f))
|
|
666 (vc-name f)
|
|
667 (vc-error-occurred (vc-backend-checkout f nil name)))))
|
|
668 default-directory)
|
|
669 ))
|
|
670
|
|
671 ;; Miscellaneous other entry points
|
|
672
|
|
673 (defun vc-print-log ()
|
|
674 "List the change log of the current buffer in a window."
|
|
675 (interactive)
|
|
676 (if (and buffer-file-name (vc-name buffer-file-name))
|
|
677 (progn
|
|
678 (vc-backend-print-log buffer-file-name)
|
|
679 (pop-to-buffer (get-buffer-create "*vc*"))
|
|
680 (goto-char (point-min))
|
|
681 )
|
|
682 (error "There is no version-control master associated with this buffer")
|
|
683 )
|
|
684 )
|
|
685
|
|
686 (defun vc-revert-buffer ()
|
|
687 "Revert the current buffer's file back to the latest version."
|
|
688 (interactive)
|
|
689 (let ((file buffer-file-name)
|
|
690 (obuf (current-buffer)) (changed (vc-diff nil)))
|
|
691 (if (and changed (or vc-suppress-confirm (not (y-or-n-p "Discard changes? "))))
|
|
692 (progn
|
|
693 (delete-window)
|
|
694 (error "Revert cancelled."))
|
|
695 (set-buffer obuf))
|
|
696 (if changed
|
|
697 (delete-window))
|
|
698 (vc-backend-revert file)
|
|
699 (vc-resynch-window file t)
|
|
700 )
|
|
701 )
|
|
702
|
|
703 (defun vc-cancel-version (norevert)
|
|
704 "Undo your latest checkin."
|
|
705 (interactive "P")
|
|
706 (let ((target (vc-your-latest-version (buffer-file-name))))
|
|
707 (if (null target)
|
|
708 (error "You didn't check in the last change."))
|
|
709 (and (y-or-n-p (format "Remove version %s from master? " target))
|
|
710 (vc-backend-uncheck (buffer-file-name) target)))
|
|
711 (if norevert
|
|
712 (vc-mode-line (buffer-file-name))
|
|
713 (vc-checkout (buffer-file-name) nil))
|
|
714 )
|
|
715
|
|
716 (defun vc-rename-file (old new)
|
|
717 "Rename a file, taking its master files with it."
|
|
718 (interactive "fOld name: \nFNew name: ")
|
|
719 (let ((oldbuf (get-file-buffer old)))
|
|
720 (if (buffer-modified-p oldbuf)
|
|
721 (error "Please save files before moving them."))
|
|
722 (if (get-file-buffer new)
|
|
723 (error "Already editing new file name."))
|
|
724 (let ((oldmaster (vc-name old)))
|
|
725 (if oldmaster
|
|
726 (if (vc-locking-user old)
|
|
727 (error "Please check in files before moving them."))
|
|
728 (if (or (file-symlink-p oldmaster)
|
|
729 (file-symlink-p (vc-backend-subdirectory-name file)))
|
|
730 (error "This is not a safe thing to do in the presence of symbolic links."))
|
|
731 (rename-file oldmaster (vc-name new)))
|
|
732 (if (or (not oldmaster) (file-exists-p old))
|
|
733 (rename-file old new)))
|
|
734 ; ?? Renaming a file might change its contents due to keyword expansion.
|
|
735 ; We should really check out a new copy if the old copy was precisely equal
|
|
736 ; to some checked in version. However, testing for this is tricky....
|
|
737 (if oldbuf
|
|
738 (save-excursion
|
|
739 (set-buffer oldbuf)
|
|
740 (set-visited-file-name new)
|
|
741 (set-buffer-modified-p nil))))
|
|
742 (vc-backend-dispatch file
|
|
743 (vc-record-rename old new)
|
|
744 nil)
|
|
745 )
|
|
746
|
|
747 (defun vc-update-change-log ()
|
|
748 "Find change log file and add entries from recent RCS logs."
|
|
749 (interactive)
|
|
750 (find-file-other-window "ChangeLog")
|
|
751 (vc-buffer-sync)
|
|
752 (or (eq major-mode 'indented-text-mode)
|
|
753 (progn
|
|
754 (indented-text-mode)
|
|
755 (setq left-margin 8)
|
|
756 (setq fill-column 74)))
|
|
757 (auto-fill-mode 1)
|
|
758 (undo-boundary)
|
|
759 (goto-char (point-min))
|
|
760 (message "Computing change log entries...")
|
|
761 (shell-command-on-region (point) (point) "rcs2log" t)
|
|
762 (message "Computing change log entries... done"))
|
|
763
|
|
764 ;; Functions for querying the master and lock files.
|
|
765
|
|
766 (defun match-substring (bn)
|
|
767 (buffer-substring (match-beginning bn) (match-end bn)))
|
|
768
|
|
769 (defun vc-parse-buffer (patterns &optional file properties)
|
|
770 ;; Use PATTERNS to parse information out of the current buffer
|
|
771 ;; by matching each regular expression in the list and returning \\1.
|
|
772 ;; If a regexp has two tag brackets, assume the second is a date
|
|
773 ;; field and we want the most recent entry matching the template.
|
|
774 ;; If FILE and PROPERTIES are given, the latter must be a list of
|
|
775 ;; properties of the same length as PATTERNS; each property is assigned
|
|
776 ;; the corresponding value.
|
|
777 (mapcar (function (lambda (p)
|
|
778 (goto-char (point-min))
|
|
779 (if (string-match "\\\\(.*\\\\(" p)
|
|
780 (let ((latest-date "") (latest-val))
|
|
781 (while (re-search-forward p nil t)
|
|
782 (let ((date (match-substring 2)))
|
|
783 (if (string< latest-date date)
|
|
784 (progn
|
|
785 (setq latest-date date)
|
|
786 (setq latest-val
|
|
787 (match-substring 1))))))
|
|
788 latest-val))
|
|
789 (prog1
|
|
790 (and (re-search-forward p nil t)
|
|
791 (let ((value (match-substring 1)))
|
|
792 (if file
|
|
793 (vc-file-setprop file (car properties) value))
|
|
794 value))
|
|
795 (setq properties (cdr properties)))))
|
|
796 patterns)
|
|
797 )
|
|
798
|
|
799 (defun vc-master-info (file fields &optional rfile properties)
|
|
800 ;; Search for information in a master file.
|
|
801 (if (and file (file-exists-p file))
|
|
802 (save-excursion
|
|
803 (let ((buf))
|
|
804 (setq buf (create-file-buffer file))
|
|
805 (set-buffer buf))
|
|
806 (erase-buffer)
|
|
807 (insert-file-contents file nil)
|
|
808 (set-buffer-modified-p nil)
|
|
809 (auto-save-mode nil)
|
|
810 (prog1
|
|
811 (vc-parse-buffer fields rfile properties)
|
|
812 (kill-buffer (current-buffer)))
|
|
813 )
|
|
814 (if rfile
|
|
815 (mapcar
|
|
816 (function (lambda (p) (vc-file-setprop rfile p nil)))
|
|
817 properties))
|
|
818 )
|
|
819 )
|
|
820
|
|
821 (defun vc-log-info (command file patterns &optional properties)
|
|
822 ;; Search for information in log program output
|
|
823 (if (and file (file-exists-p file))
|
|
824 (save-excursion
|
|
825 (let ((buf))
|
|
826 (setq buf (get-buffer-create "*vc*"))
|
|
827 (set-buffer buf))
|
|
828 (apply 'vc-do-command 0 command file nil)
|
|
829 (set-buffer-modified-p nil)
|
|
830 (prog1
|
|
831 (vc-parse-buffer patterns file properties)
|
|
832 (kill-buffer (current-buffer))
|
|
833 )
|
|
834 )
|
|
835 (if file
|
|
836 (mapcar
|
|
837 (function (lambda (p) (vc-file-setprop file p nil)))
|
|
838 properties))
|
|
839 )
|
|
840 )
|
|
841
|
|
842 (defun vc-locking-user (file)
|
|
843 "Return the name of the person currently holding a lock on FILE.
|
|
844 Return nil if there is no such person."
|
|
845 (if (or (not vc-keep-workfiles)
|
|
846 (eq vc-mistrust-permissions 't)
|
|
847 (and vc-mistrust-permissions
|
|
848 (funcall vc-mistrust-permissions (vc-backend-subdirectory-name file))))
|
|
849 (vc-true-locking-user file)
|
|
850 ;; This implementation assumes that any file which is under version
|
|
851 ;; control and has -rw-r--r-- is locked by its owner. This is true
|
|
852 ;; for both RCS and SCCS, which keep unlocked files at -r--r--r--.
|
|
853 ;; We have to be careful not to exclude files with execute bits on;
|
|
854 ;; scripts can be under version control too. The advantage of this
|
|
855 ;; hack is that calls to the very expensive vc-fetch-properties
|
|
856 ;; function only have to be made if (a) the file is locked by someone
|
|
857 ;; other than the current user, or (b) some untoward manipulation
|
|
858 ;; behind vc's back has twiddled the `group' or `other' write bits.
|
|
859 (let ((attributes (file-attributes file)))
|
|
860 (cond ((string-match ".r-.r-.r-." (nth 8 attributes))
|
|
861 nil)
|
|
862 ((and (= (nth 2 attributes) (user-uid))
|
|
863 (string-match ".rw.r-.r-." (nth 8 attributes)))
|
|
864 (user-login-name))
|
|
865 (t
|
|
866 (vc-true-locking-user file))))))
|
|
867
|
|
868 (defun vc-true-locking-user (file)
|
|
869 ;; The slow but reliable version
|
|
870 (vc-fetch-properties file)
|
|
871 (vc-file-getprop file 'vc-locking-user))
|
|
872
|
|
873 (defun vc-latest-version (file)
|
|
874 ;; Return version level of the latest version of FILE
|
|
875 (vc-fetch-properties file)
|
|
876 (vc-file-getprop file 'vc-latest-version))
|
|
877
|
|
878 (defun vc-your-latest-version (file)
|
|
879 ;; Return version level of the latest version of FILE checked in by you
|
|
880 (vc-fetch-properties file)
|
|
881 (vc-file-getprop file 'vc-your-latest-version))
|
|
882
|
|
883 ;; Collect back-end-dependent stuff here
|
|
884 ;;
|
|
885 ;; Everything eventually funnels through these functions. To implement
|
|
886 ;; support for a new version-control system, add another branch to the
|
|
887 ;; vc-backend-dispatch macro (in vc-hooks.el) and fill it in in each call.
|
|
888
|
|
889 (defmacro vc-backend-dispatch (f s r)
|
|
890 "Execute FORM1 or FORM2 depending on whether we're using SCCS or RCS."
|
|
891 (list 'let (list (list 'type (list 'vc-backend-deduce f)))
|
|
892 (list 'cond
|
|
893 (list (list 'eq 'type (quote 'SCCS)) s) ;; SCCS
|
|
894 (list (list 'eq 'type (quote 'RCS)) r) ;; RCS
|
|
895 )))
|
|
896
|
|
897 (defun vc-lock-file (file)
|
|
898 ;; Generate lock file name corresponding to FILE
|
|
899 (let ((master (vc-name file)))
|
|
900 (and
|
|
901 master
|
|
902 (string-match "\\(.*/\\)s\\.\\(.*\\)" master)
|
|
903 (concat
|
|
904 (substring master (match-beginning 1) (match-end 1))
|
|
905 "p."
|
|
906 (substring master (match-beginning 2) (match-end 2))))))
|
|
907
|
|
908
|
|
909 (defun vc-fetch-properties (file)
|
|
910 ;; Re-fetch all properties associated with the given file.
|
|
911 ;; Currently these properties are:
|
|
912 ;; vc-locking-user
|
|
913 ;; vc-locked-version
|
|
914 ;; vc-latest-version
|
|
915 ;; vc-your-latest-version
|
|
916 (vc-backend-dispatch
|
|
917 file
|
|
918 ;; SCCS
|
|
919 (progn
|
|
920 (vc-master-info (vc-lock-file file)
|
|
921 (list
|
|
922 "^[^ ]+ [^ ]+ \\([^ ]+\\)"
|
|
923 "^\\([^ ]+\\)")
|
|
924 file
|
|
925 '(vc-locking-user vc-locked-version))
|
|
926 (vc-master-info (vc-name file)
|
|
927 (list
|
|
928 "^\001d D \\([^ ]+\\)"
|
|
929 (concat "^\001d D \\([^ ]+\\) .* "
|
|
930 (regexp-quote (user-login-name)) " ")
|
|
931 )
|
|
932 file
|
|
933 '(vc-latest-version vc-your-latest-version))
|
|
934 )
|
|
935 ;; RCS
|
|
936 (vc-log-info "rlog" file
|
|
937 (list
|
|
938 "^locks: strict\n\t\\([^:]+\\)"
|
|
939 "^locks: strict\n\t[^:]+: \\(.+\\)"
|
|
940 "^revision[\t ]+\\([0-9.]+\\).*\ndate: \\([ /0-9:]+\\);"
|
|
941 (concat
|
|
942 "^revision[\t ]+\\([0-9.]+\\).*locked by: "
|
|
943 (regexp-quote (user-login-name))
|
|
944 ";\ndate: \\([ /0-9:]+\\);"))
|
|
945 '(vc-locking-user vc-locked-version
|
|
946 vc-latest-version vc-your-latest-version))
|
|
947 ))
|
|
948
|
|
949 (defun vc-backend-subdirectory-name (&optional file)
|
|
950 ;; Where the master and lock files for the current directory are kept
|
|
951 (symbol-name
|
|
952 (or
|
|
953 (and file (vc-backend-deduce file))
|
|
954 vc-default-back-end
|
|
955 (setq vc-default-back-end (if (vc-find-binary "rcs") 'RCS 'SCCS)))))
|
|
956
|
|
957 (defun vc-backend-admin (file &optional rev comment)
|
|
958 ;; Register a file into the version-control system
|
|
959 ;; Automatically retrieves a read-only version of the file with
|
|
960 ;; keywords expanded if vc-keep-workfiles is non-nil, otherwise
|
|
961 ;; it deletes the workfile.
|
|
962 (vc-file-clearprops file)
|
|
963 (or vc-default-back-end
|
|
964 (setq vc-default-back-end (if (vc-find-binary "rcs") 'RCS 'SCCS)))
|
|
965 (message "Registering %s..." file)
|
|
966 (let ((backend
|
|
967 (cond
|
|
968 ((file-exists-p (vc-backend-subdirectory-name)) vc-default-back-end)
|
|
969 ((file-exists-p "RCS") 'RCS)
|
|
970 ((file-exists-p "SCCS") 'SCCS)
|
|
971 (t vc-default-back-end))))
|
|
972 (cond ((eq backend 'SCCS)
|
|
973 (vc-do-command 0 "admin" file ;; SCCS
|
|
974 (and rev (concat "-r" rev))
|
|
975 "-fb"
|
|
976 (concat "-i" file)
|
|
977 (and comment (concat "-y" comment))
|
|
978 (format
|
|
979 (car (rassq 'SCCS vc-master-templates))
|
|
980 (or (file-name-directory file) "")
|
|
981 (file-name-nondirectory file)))
|
|
982 (delete-file file)
|
|
983 (if vc-keep-workfiles
|
|
984 (vc-do-command 0 "get" file)))
|
|
985 ((eq backend 'RCS)
|
|
986 (vc-do-command 0 "ci" file ;; RCS
|
|
987 (concat (if vc-keep-workfiles "-u" "-r") rev)
|
|
988 (and comment (concat "-t-" comment))
|
|
989 file)
|
|
990 )))
|
|
991 (message "Registering %s...done" file)
|
|
992 )
|
|
993
|
|
994 (defun vc-backend-checkout (file &optional writeable rev)
|
|
995 ;; Retrieve a copy of a saved version into a workfile
|
|
996 (message "Checking out %s..." file)
|
|
997 (vc-backend-dispatch file
|
|
998 (progn
|
|
999 (vc-do-command 0 "get" file ;; SCCS
|
|
1000 (if writeable "-e")
|
|
1001 (and rev (concat "-r" (vc-lookup-triple file rev))))
|
|
1002 )
|
|
1003 (vc-do-command 0 "co" file ;; RCS
|
|
1004 (if writeable "-l")
|
|
1005 (and rev (concat "-r" rev)))
|
|
1006 )
|
|
1007 (vc-file-setprop file 'vc-checkout-time (nth 5 (file-attributes file)))
|
|
1008 (message "Checking out %s...done" file)
|
|
1009 )
|
|
1010
|
|
1011 (defun vc-backend-logentry-check (file)
|
|
1012 (vc-backend-dispatch file
|
|
1013 (if (>= (- (region-end) (region-beginning)) 512) ;; SCCS
|
|
1014 (progn
|
|
1015 (goto-char 512)
|
|
1016 (error
|
|
1017 "Log must be less than 512 characters. Point is now at char 512.")))
|
|
1018 nil)
|
|
1019 )
|
|
1020
|
|
1021 (defun vc-backend-checkin (file &optional rev comment)
|
|
1022 ;; Register changes to FILE as level REV with explanatory COMMENT.
|
|
1023 ;; Automatically retrieves a read-only version of the file with
|
|
1024 ;; keywords expanded if vc-keep-workfiles is non-nil, otherwise
|
|
1025 ;; it deletes the workfile.
|
|
1026 (message "Checking in %s..." file)
|
|
1027 (vc-backend-dispatch file
|
|
1028 (progn
|
|
1029 (vc-do-command 0 "delta" file
|
|
1030 (if rev (concat "-r" rev))
|
|
1031 (concat "-y" comment))
|
|
1032 (if vc-keep-workfiles
|
|
1033 (vc-do-command 0 "get" file))
|
|
1034 )
|
|
1035 (vc-do-command 0 "ci" file
|
|
1036 (concat (if vc-keep-workfiles "-u" "-r") rev)
|
|
1037 (concat "-m" comment))
|
|
1038 )
|
|
1039 (vc-file-setprop file 'vc-locking-user nil)
|
|
1040 (message "Checking in %s...done" file)
|
|
1041 )
|
|
1042
|
|
1043 (defun vc-backend-revert (file)
|
|
1044 ;; Revert file to latest checked-in version.
|
|
1045 (message "Reverting %s..." file)
|
|
1046 (vc-backend-dispatch
|
|
1047 file
|
|
1048 (progn ;; SCCS
|
|
1049 (vc-do-command 0 "unget" file nil)
|
|
1050 (vc-do-command 0 "get" file nil))
|
|
1051 (progn
|
|
1052 (delete-file file) ;; RCS
|
|
1053 (vc-do-command 0 "co" file "-u")))
|
|
1054 (vc-file-setprop file 'vc-locking-user nil)
|
|
1055 (message "Reverting %s...done" file)
|
|
1056 )
|
|
1057
|
|
1058 (defun vc-backend-steal (file &optional rev)
|
|
1059 ;; Steal the lock on the current workfile. Needs RCS 5.6.2 or later for -M.
|
|
1060 (message "Stealing lock on %s..." file)
|
|
1061 (progn
|
|
1062 (vc-do-command 0 "unget" file "-n" (if rev (concat "-r" rev)))
|
|
1063 (vc-do-command 0 "get" file "-g" (if rev (concat "-r" rev)))
|
|
1064 )
|
|
1065 (progn
|
|
1066 (vc-do-command 0 "rcs" file "-M" (concat "-u" rev))
|
|
1067 (vc-do-command 0 "rcs" file (concat "-l" rev))
|
|
1068 )
|
|
1069 (vc-file-setprop file 'vc-locking-user (user-login-name))
|
|
1070 (message "Stealing lock on %s...done" file)
|
|
1071 )
|
|
1072
|
|
1073 (defun vc-backend-uncheck (file target)
|
|
1074 ;; Undo the latest checkin. Note: this code will have to get a lot
|
|
1075 ;; smarter when we support multiple branches.
|
|
1076 (message "Removing last change from %s..." file)
|
|
1077 (vc-backend-dispatch file
|
|
1078 (vc-do-command 0 "rmdel" file (concat "-r" target))
|
|
1079 (vc-do-command 0 "rcs" file (concat "-o" target))
|
|
1080 )
|
|
1081 (message "Removing last change from %s...done" file)
|
|
1082 )
|
|
1083
|
|
1084 (defun vc-backend-print-log (file)
|
|
1085 ;; Print change log associated with FILE to buffer *vc*.
|
|
1086 (vc-do-command 0
|
|
1087 (vc-backend-dispatch file "prs" "rlog")
|
|
1088 file)
|
|
1089 )
|
|
1090
|
|
1091 (defun vc-backend-assign-name (file name)
|
|
1092 ;; Assign to a FILE's latest version a given NAME.
|
|
1093 (vc-backend-dispatch file
|
|
1094 (vc-add-triple name file (vc-latest-version file)) ;; SCCS
|
|
1095 (vc-do-command 0 "rcs" file (concat "-n" name ":")) ;; RCS
|
|
1096 ))
|
|
1097
|
|
1098 (defun vc-backend-diff (file oldvers &optional newvers)
|
|
1099 ;; Get a difference report between two versions
|
|
1100 (apply 'vc-do-command 1
|
|
1101 (or (vc-backend-dispatch file "vcdiff" "rcsdiff")
|
|
1102 (error (format "File %s is not under version control." file)))
|
|
1103 file
|
|
1104 (and oldvers (concat "-r" oldvers))
|
|
1105 (and newvers (concat "-r" newvers))
|
|
1106 vc-diff-options
|
|
1107 ))
|
|
1108
|
|
1109 (defun vc-check-headers ()
|
|
1110 "Check if the current file has any headers in it."
|
|
1111 (interactive)
|
|
1112 (save-excursion
|
|
1113 (goto-char (point-min))
|
|
1114 (vc-backend-dispatch buffer-file-name
|
|
1115 (re-search-forward "%[MIRLBSDHTEGUYFPQCZWA]%" nil t) ;; SCCS
|
|
1116 (re-search-forward "\\$[A-Za-z\300-\326\330-\366\370-\377]+\\(: [\t -#%-\176\240-\377]*\\)?\\$" nil t) ;; RCS
|
|
1117 )
|
|
1118 ))
|
|
1119
|
|
1120 ;; Back-end-dependent stuff ends here.
|
|
1121
|
|
1122 ;; Set up key bindings for use while editing log messages
|
|
1123
|
|
1124 (defun vc-log-mode ()
|
|
1125 "Minor mode for driving version-control tools.
|
|
1126 These bindings are added to the global keymap when you enter this mode:
|
|
1127 \\[vc-next-action] perform next logical version-control operation on current file
|
|
1128 \\[vc-register] register current file
|
|
1129 \\[vc-toggle-read-only] like next-action, but won't register files
|
|
1130 \\[vc-insert-headers] insert version-control headers in current file
|
|
1131 \\[vc-print-log] display change history of current file
|
|
1132 \\[vc-revert-buffer] revert buffer to latest version
|
|
1133 \\[vc-cancel-version] undo latest checkin
|
|
1134 \\[vc-diff] show diffs between file versions
|
|
1135 \\[vc-directory] show all files locked by any user in or below .
|
|
1136 \\[vc-update-change-log] add change log entry from recent checkins
|
|
1137
|
|
1138 While you are entering a change log message for a version, the following
|
|
1139 additional bindings will be in effect.
|
|
1140
|
|
1141 \\[vc-finish-logentry] proceed with check in, ending log message entry
|
|
1142
|
|
1143 Whenever you do a checkin, your log comment is added to a ring of
|
|
1144 saved comments. These can be recalled as follows:
|
|
1145
|
|
1146 \\[vc-next-comment] replace region with next message in comment ring
|
|
1147 \\[vc-previous-comment] replace region with previous message in comment ring
|
|
1148 \\[vc-search-comment-reverse] search backward for regexp in the comment ring
|
|
1149 \\[vc-search-comment-forward] search backward for regexp in the comment ring
|
|
1150
|
|
1151 Entry to the change-log submode calls the value of text-mode-hook, then
|
|
1152 the value of vc-log-mode-hook.
|
|
1153
|
|
1154 Global user options:
|
|
1155 vc-initial-comment If non-nil, require user to enter a change
|
|
1156 comment upon first checkin of the file.
|
|
1157
|
|
1158 vc-keep-workfiles Non-nil value prevents workfiles from being
|
|
1159 deleted when changes are checked in
|
|
1160
|
|
1161 vc-suppress-confirm Suppresses some confirmation prompts,
|
|
1162 notably for reversions.
|
|
1163
|
|
1164 vc-diff-options A list consisting of the flags
|
|
1165 to be used for generating context diffs.
|
|
1166
|
|
1167 vc-header-strings Which keywords to insert when adding headers
|
|
1168 with \\[vc-insert-headers]. Defaults to
|
|
1169 '(\"\%\W\%\") under SCCS, '(\"\$Id\$\") under RCS.
|
|
1170
|
|
1171 vc-static-header-alist By default, version headers inserted in C files
|
|
1172 get stuffed in a static string area so that
|
|
1173 ident(RCS) or what(SCCS) can see them in the
|
|
1174 compiled object code. You can override this
|
|
1175 by setting this variable to nil, or change
|
|
1176 the header template by changing it.
|
|
1177
|
|
1178 vc-command-messages if non-nil, display run messages from the
|
|
1179 actual version-control utilities (this is
|
|
1180 intended primarily for people hacking vc
|
|
1181 itself).
|
|
1182 "
|
|
1183 (interactive)
|
|
1184 (set-syntax-table text-mode-syntax-table)
|
|
1185 (use-local-map vc-log-entry-mode)
|
|
1186 (setq local-abbrev-table text-mode-abbrev-table)
|
|
1187 (setq major-mode 'vc-log-mode)
|
|
1188 (setq mode-name "VC-Log")
|
|
1189 (make-local-variable 'vc-log-file)
|
|
1190 (make-local-variable 'vc-log-version)
|
|
1191 (set-buffer-modified-p nil)
|
|
1192 (setq buffer-file-name nil)
|
|
1193 (run-hooks 'text-mode-hook 'vc-log-mode-hook)
|
|
1194 )
|
|
1195
|
|
1196 ;; Initialization code, to be done just once at load-time
|
|
1197 (if vc-log-entry-mode
|
|
1198 nil
|
|
1199 (setq vc-log-entry-mode (make-sparse-keymap))
|
|
1200 (define-key vc-log-entry-mode "\M-n" 'vc-next-comment)
|
|
1201 (define-key vc-log-entry-mode "\M-p" 'vc-previous-comment)
|
|
1202 (define-key vc-log-entry-mode "\M-r" 'vc-comment-search-backward)
|
|
1203 (define-key vc-log-entry-mode "\M-s" 'vc-comment-search-forward)
|
|
1204 (define-key vc-log-entry-mode "\C-c\C-c" 'vc-finish-logentry)
|
|
1205 )
|
|
1206
|
|
1207 ;;; These things should probably be generally available
|
|
1208
|
|
1209 (defun vc-shrink-to-fit ()
|
|
1210 "Shrink a window vertically until it's just large enough to contain its text"
|
|
1211 (let ((minsize (1+ (count-lines (point-min) (point-max)))))
|
|
1212 (if (< minsize (window-height))
|
|
1213 (let ((window-min-height 2))
|
|
1214 (shrink-window (- (window-height) minsize))))))
|
|
1215
|
|
1216 (defun vc-file-tree-walk (func dir &rest args)
|
|
1217 "Apply a given function to dir and all files underneath it, recursively."
|
|
1218 (apply 'funcall func dir args)
|
|
1219 (and (file-directory-p dir)
|
|
1220 (mapcar
|
|
1221 (function (lambda (f) (or
|
|
1222 (string-equal f ".")
|
|
1223 (string-equal f "..")
|
|
1224 (file-symlink-p f) ;; Avoid possible loops
|
|
1225 (apply 'vc-file-tree-walk
|
|
1226 func
|
|
1227 (if (= (aref dir (1- (length dir))) ?/)
|
|
1228 (concat dir f)
|
|
1229 (concat dir "/" f))
|
|
1230 args))))
|
|
1231 (directory-files dir))))
|
|
1232
|
|
1233 (provide 'vc)
|
|
1234
|
|
1235 ;;; DEVELOPER'S NOTES ON CONCURRENCY PROBLEMS IN THIS CODE
|
|
1236 ;;;
|
|
1237 ;;; These may be useful to anyone who has to debug or extend the package.
|
|
1238 ;;;
|
|
1239 ;;; A fundamental problem in VC is that there are time windows between
|
|
1240 ;;; vc-next-action's computations of the file's version-control state and
|
|
1241 ;;; the actions that change it. This is a window open to lossage in a
|
|
1242 ;;; multi-user environment; someone else could nip in and change the state
|
|
1243 ;;; of the master during it.
|
|
1244 ;;;
|
|
1245 ;;; The performance problem is that rlog/prs calls are very expensive; we want
|
|
1246 ;;; to avoid them as much as possible.
|
|
1247 ;;;
|
|
1248 ;;; ANALYSIS:
|
|
1249 ;;;
|
|
1250 ;;; The performance problem, it turns out, simplifies in practice to the
|
|
1251 ;;; problem of making vc-locking-user fast. The two other functions that call
|
|
1252 ;;; prs/rlog will not be so commonly used that the slowdown is a problem; one
|
|
1253 ;;; makes snapshots, the other deletes the calling user's last change in the
|
|
1254 ;;; master.
|
|
1255 ;;;
|
|
1256 ;;; The race condition implies that we have to either (a) lock the master
|
|
1257 ;;; during the entire execution of vc-next-action, or (b) detect and
|
|
1258 ;;; recover from errors resulting from dispatch on an out-of-date state.
|
|
1259 ;;;
|
|
1260 ;;; Alternative (a) appears to be unfeasible. The problem is that we can't
|
|
1261 ;;; guarantee that the lock will ever be removed. Suppose a user starts a
|
|
1262 ;;; checkin, the change message buffer pops up, and the user, having wandered
|
|
1263 ;;; off to do something else, simply forgets about it?
|
|
1264 ;;;
|
|
1265 ;;; Alternative (b), on the other hand, works well with a cheap way to speed up
|
|
1266 ;;; vc-locking-user. Usually, if a file is registered, we can read its locked/
|
|
1267 ;;; unlocked state and its current owner from its permissions.
|
|
1268 ;;;
|
|
1269 ;;; This shortcut will fail if someone has manually changed the workfile's
|
|
1270 ;;; permissions; also if developers are munging the workfile in several
|
|
1271 ;;; directories, with symlinks to a master (in this latter case, the
|
|
1272 ;;; permissions shortcut will fail to detect a lock asserted from another
|
|
1273 ;;; directory).
|
|
1274 ;;;
|
|
1275 ;;; Note that these cases correspond exactly to the errors which could happen
|
|
1276 ;;; because of a competing checkin/checkout race in between two instances of
|
|
1277 ;;; vc-next-action.
|
|
1278 ;;;
|
|
1279 ;;; For VC's purposes, a workfile/master pair may have the following states:
|
|
1280 ;;;
|
|
1281 ;;; A. Unregistered. There is a workfile, there is no master.
|
|
1282 ;;;
|
|
1283 ;;; B. Registered and not locked by anyone.
|
|
1284 ;;;
|
|
1285 ;;; C. Locked by calling user and unchanged.
|
|
1286 ;;;
|
|
1287 ;;; D. Locked by the calling user and changed.
|
|
1288 ;;;
|
|
1289 ;;; E. Locked by someone other than the calling user.
|
|
1290 ;;;
|
|
1291 ;;; This makes for 25 states and 20 error conditions. Here's the matrix:
|
|
1292 ;;;
|
|
1293 ;;; VC's idea of state
|
|
1294 ;;; |
|
|
1295 ;;; V Actual state RCS action SCCS action Effect
|
|
1296 ;;; A B C D E
|
|
1297 ;;; A . 1 2 3 4 ci -u -t- admin -fb -i<file> initial admin
|
|
1298 ;;; B 5 . 6 7 8 co -l get -e checkout
|
|
1299 ;;; C 9 10 . 11 12 co -u unget; get revert
|
|
1300 ;;; D 13 14 15 . 16 ci -u -m<comment> delta -y<comment>; get checkin
|
|
1301 ;;; E 17 18 19 20 . rcs -u -M ; rcs -l unget -n ; get -g steal lock
|
|
1302 ;;;
|
|
1303 ;;; All commands take the master file name as a last argument (not shown).
|
|
1304 ;;;
|
|
1305 ;;; In the discussion below, a "self-race" is a pathological situation in
|
|
1306 ;;; which VC operations are being attempted simultaneously by two or more
|
|
1307 ;;; Emacsen running under the same username.
|
|
1308 ;;;
|
|
1309 ;;; The vc-next-action code has the following windows:
|
|
1310 ;;;
|
|
1311 ;;; Window P:
|
|
1312 ;;; Between the check for existence of a master file and the call to
|
|
1313 ;;; admin/checkin in vc-buffer-admin (apparent state A). This window may
|
|
1314 ;;; never close if the initial-comment feature is on.
|
|
1315 ;;;
|
|
1316 ;;; Window Q:
|
|
1317 ;;; Between the call to vc-workfile-unchanged-p in and the immediately
|
|
1318 ;;; following revert (apparent state C).
|
|
1319 ;;;
|
|
1320 ;;; Window R:
|
|
1321 ;;; Between the call to vc-workfile-unchanged-p in and the following
|
|
1322 ;;; checkin (apparent state D). This window may never close.
|
|
1323 ;;;
|
|
1324 ;;; Window S:
|
|
1325 ;;; Between the unlock and the immediately following checkout during a
|
|
1326 ;;; revert operation (apparent state C). Included in window Q.
|
|
1327 ;;;
|
|
1328 ;;; Window T:
|
|
1329 ;;; Between vc-locking-user and the following checkout (apparent state B).
|
|
1330 ;;;
|
|
1331 ;;; Window U:
|
|
1332 ;;; Between vc-locking-user and the following revert (apparent state C).
|
|
1333 ;;; Includes windows Q and S.
|
|
1334 ;;;
|
|
1335 ;;; Window V:
|
|
1336 ;;; Between vc-locking-user and the following checkin (apparent state
|
|
1337 ;;; D). This window may never be closed if the user fails to complete the
|
|
1338 ;;; checkin message. Includes window R.
|
|
1339 ;;;
|
|
1340 ;;; Window W:
|
|
1341 ;;; Between vc-locking-user and the following steal-lock (apparent
|
|
1342 ;;; state E). This window may never cloce if the user fails to complete
|
|
1343 ;;; the steal-lock message. Includes window X.
|
|
1344 ;;;
|
|
1345 ;;; Window X:
|
|
1346 ;;; Between the unlock and the immediately following re-lock during a
|
|
1347 ;;; steal-lock operation (apparent state E). This window may never cloce
|
|
1348 ;;; if the user fails to complete the steal-lock message.
|
|
1349 ;;;
|
|
1350 ;;; Errors:
|
|
1351 ;;;
|
|
1352 ;;; Apparent state A ---
|
|
1353 ;;;
|
|
1354 ;;; 1. File looked unregistered but is actually registered and not locked.
|
|
1355 ;;;
|
|
1356 ;;; Potential cause: someone else's admin during window P, with
|
|
1357 ;;; caller's admin happening before their checkout.
|
|
1358 ;;;
|
|
1359 ;;; RCS: ci will fail with a "no lock set by <user>" message.
|
|
1360 ;;; SCCS: admin will fail with error (ad19).
|
|
1361 ;;;
|
|
1362 ;;; We can let these errors be passed up to the user.
|
|
1363 ;;;
|
|
1364 ;;; 2. File looked unregistered but is actually locked by caller, unchanged.
|
|
1365 ;;;
|
|
1366 ;;; Potential cause: self-race during window P.
|
|
1367 ;;;
|
|
1368 ;;; RCS: will revert the file to the last saved version and unlock it.
|
|
1369 ;;; SCCS: will fail with error (ad19).
|
|
1370 ;;;
|
|
1371 ;;; Either of these consequences is acceptable.
|
|
1372 ;;;
|
|
1373 ;;; 3. File looked unregistered but is actually locked by caller, changed.
|
|
1374 ;;;
|
|
1375 ;;; Potential cause: self-race during window P.
|
|
1376 ;;;
|
|
1377 ;;; RCS: will register the caller's workfile as a delta with a
|
|
1378 ;;; null change comment (the -t- switch will be ignored).
|
|
1379 ;;; SCCS: will fail with error (ad19).
|
|
1380 ;;;
|
|
1381 ;;; 4. File looked unregistered but is locked by someone else.
|
|
1382 ;;;
|
|
1383 ;;; Potential cause: someone else's admin during window P, with
|
|
1384 ;;; caller's admin happening *after* their checkout.
|
|
1385 ;;;
|
|
1386 ;;; RCS: will fail with a "no lock set by <user>" message.
|
|
1387 ;;; SCCS: will fail with error (ad19).
|
|
1388 ;;;
|
|
1389 ;;; We can let these errors be passed up to the user.
|
|
1390 ;;;
|
|
1391 ;;; Apparent state B ---
|
|
1392 ;;;
|
|
1393 ;;; 5. File looked registered and not locked, but is actually unregistered.
|
|
1394 ;;;
|
|
1395 ;;; Potential cause: master file got nuked during window P.
|
|
1396 ;;;
|
|
1397 ;;; RCS: will fail with "RCS/<file>: No such file or directory"
|
|
1398 ;;; SCCS: will fail with error ut4.
|
|
1399 ;;;
|
|
1400 ;;; We can let these errors be passed up to the user.
|
|
1401 ;;;
|
|
1402 ;;; 6. File looked registered and not locked, but is actually locked by the
|
|
1403 ;;; calling user and unchanged.
|
|
1404 ;;;
|
|
1405 ;;; Potential cause: self-race during window T.
|
|
1406 ;;;
|
|
1407 ;;; RCS: in the same directory as the previous workfile, co -l will fail
|
|
1408 ;;; with "co error: writable foo exists; checkout aborted". In any other
|
|
1409 ;;; directory, checkout will succeed.
|
|
1410 ;;; SCCS: will fail with ge17.
|
|
1411 ;;;
|
|
1412 ;;; Either of these consequences is acceptable.
|
|
1413 ;;;
|
|
1414 ;;; 7. File looked registered and not locked, but is actually locked by the
|
|
1415 ;;; calling user and changed.
|
|
1416 ;;;
|
|
1417 ;;; As case 6.
|
|
1418 ;;;
|
|
1419 ;;; 8. File looked registered and not locked, but is actually locked by another
|
|
1420 ;;; user.
|
|
1421 ;;;
|
|
1422 ;;; Potential cause: someone else checks it out during window T.
|
|
1423 ;;;
|
|
1424 ;;; RCS: co error: revision 1.3 already locked by <user>
|
|
1425 ;;; SCCS: fails with ge4 (in directory) or ut7 (outside it).
|
|
1426 ;;;
|
|
1427 ;;; We can let these errors be passed up to the user.
|
|
1428 ;;;
|
|
1429 ;;; Apparent state C ---
|
|
1430 ;;;
|
|
1431 ;;; 9. File looks locked by calling user and unchanged, but is unregistered.
|
|
1432 ;;;
|
|
1433 ;;; As case 5.
|
|
1434 ;;;
|
|
1435 ;;; 10. File looks locked by calling user and unchanged, but is actually not
|
|
1436 ;;; locked.
|
|
1437 ;;;
|
|
1438 ;;; Potential cause: a self-race in window U, or by the revert's
|
|
1439 ;;; landing during window X of some other user's steal-lock or window S
|
|
1440 ;;; of another user's revert.
|
|
1441 ;;;
|
|
1442 ;;; RCS: succeeds, refreshing the file from the identical version in
|
|
1443 ;;; the master.
|
|
1444 ;;; SCCS: fails with error ut4 (p file nonexistent).
|
|
1445 ;;;
|
|
1446 ;;; Either of these consequences is acceptable.
|
|
1447 ;;;
|
|
1448 ;;; 11. File is locked by calling user. It looks unchanged, but is actually
|
|
1449 ;;; changed.
|
|
1450 ;;;
|
|
1451 ;;; Potential cause: the file would have to be touched by a self-race
|
|
1452 ;;; during window Q.
|
|
1453 ;;;
|
|
1454 ;;; The revert will succeed, removing whatever changes came with
|
|
1455 ;;; the touch. It is theoretically possible that work could be lost.
|
|
1456 ;;;
|
|
1457 ;;; 12. File looks like it's locked by the calling user and unchanged, but
|
|
1458 ;;; it's actually locked by someone else.
|
|
1459 ;;;
|
|
1460 ;;; Potential cause: a steal-lock in window V.
|
|
1461 ;;;
|
|
1462 ;;; RCS: co error: revision <rev> locked by <user>; use co -r or rcs -u
|
|
1463 ;;; SCCS: fails with error un2
|
|
1464 ;;;
|
|
1465 ;;; We can pass these errors up to the user.
|
|
1466 ;;;
|
|
1467 ;;; Apparent state D ---
|
|
1468 ;;;
|
|
1469 ;;; 13. File looks like it's locked by the calling user and changed, but it's
|
|
1470 ;;; actually unregistered.
|
|
1471 ;;;
|
|
1472 ;;; Potential cause: master file got nuked during window P.
|
|
1473 ;;;
|
|
1474 ;;; RCS: Checks in the user's version as an initial delta.
|
|
1475 ;;; SCCS: will fail with error ut4.
|
|
1476 ;;;
|
|
1477 ;;; This case is kind of nasty. It means VC may fail to detect the
|
|
1478 ;;; loss of previous version information.
|
|
1479 ;;;
|
|
1480 ;;; 14. File looks like it's locked by the calling user and changed, but it's
|
|
1481 ;;; actually unlocked.
|
|
1482 ;;;
|
|
1483 ;;; Potential cause: self-race in window V, or the checkin happening
|
|
1484 ;;; during the window X of someone else's steal-lock or window S of
|
|
1485 ;;; someone else's revert.
|
|
1486 ;;;
|
|
1487 ;;; RCS: ci will fail with "no lock set by <user>".
|
|
1488 ;;; SCCS: delta will fail with error ut4.
|
|
1489 ;;;
|
|
1490 ;;; 15. File looks like it's locked by the calling user and changed, but it's
|
|
1491 ;;; actually locked by the calling user and unchanged.
|
|
1492 ;;;
|
|
1493 ;;; Potential cause: another self-race --- a whole checkin/checkout
|
|
1494 ;;; sequence by the calling user would have to land in window R.
|
|
1495 ;;;
|
|
1496 ;;; SCCS: checks in a redundant delta and leaves the file unlocked as usual.
|
|
1497 ;;; RCS: reverts to the file state as of the second user's checkin, leaving
|
|
1498 ;;; the file unlocked.
|
|
1499 ;;;
|
|
1500 ;;; It is theoretically possible that work could be lost under RCS.
|
|
1501 ;;;
|
|
1502 ;;; 16. File looks like it's locked by the calling user and changed, but it's
|
|
1503 ;;; actually locked by a different user.
|
|
1504 ;;;
|
|
1505 ;;; RCS: ci error: no lock set by <user>
|
|
1506 ;;; SCCS: unget will fail with error un2
|
|
1507 ;;;
|
|
1508 ;;; We can pass these errors up to the user.
|
|
1509 ;;;
|
|
1510 ;;; Apparent state E ---
|
|
1511 ;;;
|
|
1512 ;;; 17. File looks like it's locked by some other user, but it's actually
|
|
1513 ;;; unregistered.
|
|
1514 ;;;
|
|
1515 ;;; As case 13.
|
|
1516 ;;;
|
|
1517 ;;; 18. File looks like it's locked by some other user, but it's actually
|
|
1518 ;;; unlocked.
|
|
1519 ;;;
|
|
1520 ;;; Potential cause: someone released a lock during window W.
|
|
1521 ;;;
|
|
1522 ;;; RCS: The calling user will get the lock on the file.
|
|
1523 ;;; SCCS: unget -n will fail with cm4.
|
|
1524 ;;;
|
|
1525 ;;; Either of these consequences will be OK.
|
|
1526 ;;;
|
|
1527 ;;; 19. File looks like it's locked by some other user, but it's actually
|
|
1528 ;;; locked by the calling user and unchanged.
|
|
1529 ;;;
|
|
1530 ;;; Potential cause: the other user relinquishing a lock followed by
|
|
1531 ;;; a self-race, both in window W.
|
|
1532 ;;;
|
|
1533 ;;; Under both RCS and SCCS, both unlock and lock will succeed, making
|
|
1534 ;;; the sequence a no-op.
|
|
1535 ;;;
|
|
1536 ;;; 20. File looks like it's locked by some other user, but it's actually
|
|
1537 ;;; locked by the calling user and changed.
|
|
1538 ;;;
|
|
1539 ;;; As case 19.
|
|
1540 ;;;
|
|
1541 ;;; PROBLEM CASES:
|
|
1542 ;;;
|
|
1543 ;;; In order of decreasing severity:
|
|
1544 ;;;
|
|
1545 ;;; Cases 11 and 15 under RCS are the only one that potentially lose work.
|
|
1546 ;;; They would require a self-race for this to happen.
|
|
1547 ;;;
|
|
1548 ;;; Case 13 in RCS loses information about previous deltas, retaining
|
|
1549 ;;; only the information in the current workfile. This can only happen
|
|
1550 ;;; if the master file gets nuked in window P.
|
|
1551 ;;;
|
|
1552 ;;; Case 3 in RCS and case 15 under SCCS insert a redundant delta with
|
|
1553 ;;; no change comment in the master. This would require a self-race in
|
|
1554 ;;; window P or R respectively.
|
|
1555 ;;;
|
|
1556 ;;; Cases 2, 10, 19 and 20 do extra work, but make no changes.
|
|
1557 ;;;
|
|
1558 ;;; Unfortunately, it appears to me that no recovery is possible in these
|
|
1559 ;;; cases. They don't yield error messages, so there's no way to tell that
|
|
1560 ;;; a race condition has occurred.
|
|
1561 ;;;
|
|
1562 ;;; All other cases don't change either the workfile or the master, and
|
|
1563 ;;; trigger command errors which the user will see.
|
|
1564 ;;;
|
|
1565 ;;; Thus, there is no explicit recovery code.
|
|
1566
|
|
1567 ;;; vc.el ends here
|