vc.el 135 KB
Newer Older
Eric S. Raymond's avatar
Eric S. Raymond committed
1 2
;;; vc.el --- drive a version-control system from within Emacs

3
;; Copyright (C) 1992, 93, 94, 95, 96, 97, 1998 Free Software Foundation, Inc.
Eric S. Raymond's avatar
Eric S. Raymond committed
4

5 6
;; Author:     Eric S. Raymond <esr@snark.thyrsus.com>
;; Maintainer: Andre Spiegel <spiegel@inf.fu-berlin.de>
Eric S. Raymond's avatar
Eric S. Raymond committed
7

8
;; $Id: vc.el,v 1.251 1999/08/27 07:59:22 schwab Exp eliz $
9

Eric S. Raymond's avatar
Eric S. Raymond committed
10 11 12 13 14 15 16 17 18 19 20 21 22
;; This file is part of GNU Emacs.

;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
Erik Naggum's avatar
Erik Naggum committed
23 24 25
;; along with GNU Emacs; see the file COPYING.  If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
Eric S. Raymond's avatar
Eric S. Raymond committed
26 27 28

;;; Commentary:

29 30
;; This mode is fully documented in the Emacs user's manual.
;;
Eric S. Raymond's avatar
Eric S. Raymond committed
31 32 33
;; This was designed and implemented by Eric Raymond <esr@snark.thyrsus.com>.
;; Paul Eggert <eggert@twinsun.com>, Sebastian Kremer <sk@thp.uni-koeln.de>,
;; and Richard Stallman contributed valuable criticism, support, and testing.
34
;; CVS support was added by Per Cederqvist <ceder@lysator.liu.se>
35
;; in Jan-Feb 1994.  Further enhancements came from ttn@netcom.com and
36
;; Andre Spiegel <spiegel@inf.fu-berlin.de>.
Eric S. Raymond's avatar
Eric S. Raymond committed
37
;;
38
;; Supported version-control systems presently include SCCS, RCS, and CVS.
39 40 41 42 43
;;
;; Some features will not work with old RCS versions.  Where
;; appropriate, VC finds out which version you have, and allows or
;; disallows those features (stealing locks, for example, works only 
;; from 5.6.2 onwards).
44 45 46
;; Even initial checkins will fail if your RCS version is so old that ci
;; doesn't understand -t-; this has been known to happen to people running
;; NExTSTEP 3.0. 
Eric S. Raymond's avatar
Eric S. Raymond committed
47
;;
48 49
;; You can support the RCS -x option by adding pairs to the 
;; vc-master-templates list.
Eric S. Raymond's avatar
Eric S. Raymond committed
50 51 52 53
;;
;; Proper function of the SCCS diff commands requires the shellscript vcdiff
;; to be installed somewhere on Emacs's path for executables.
;;
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
;;
Eric S. Raymond's avatar
Eric S. Raymond committed
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.
Eric S. Raymond's avatar
Eric S. Raymond committed
61 62 63
;;
;; The vc code maintains some internal state in order to reduce expensive
;; version-control operations to a minimum.  Some names are only computed
64
;; once.  If you perform version control operations with RCS/SCCS/CVS while
Eric S. Raymond's avatar
Eric S. Raymond committed
65 66 67 68 69 70 71 72 73
;; vc's back is turned, or move/rename master files while vc is running,
;; vc may get seriously confused.  Don't do these things!
;;
;; Developer's notes on some concurrency issues are included at the end of
;; the file.

;;; Code:

(require 'vc-hooks)
74
(require 'ring)
75
(eval-when-compile (require 'dired))	; for dired-map-over-marks macro
76 77 78 79 80

(if (not (assoc 'vc-parent-buffer minor-mode-alist))
    (setq minor-mode-alist
	  (cons '(vc-parent-buffer vc-parent-buffer-name)
		minor-mode-alist)))
Eric S. Raymond's avatar
Eric S. Raymond committed
81

82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98
;; To implement support for a new version-control system, add another
;; branch to the vc-backend-dispatch macro and fill it in in each
;; call.  The variable vc-master-templates in vc-hooks.el will also
;; have to change.

(defmacro vc-backend-dispatch (f s r c)
  "Execute FORM1, FORM2 or FORM3 for SCCS, RCS or CVS respectively.
If FORM3 is `RCS', use FORM2 for CVS as well as RCS.
\(CVS shares some code with RCS)."
  (list 'let (list (list 'type (list 'vc-backend f)))
	(list 'cond
	      (list (list 'eq 'type (quote 'SCCS)) s)	;; SCCS
	      (list (list 'eq 'type (quote 'RCS)) r)	;; RCS
	      (list (list 'eq 'type (quote 'CVS)) 	;; CVS
		    (if (eq c 'RCS) r c))
	      )))

Eric S. Raymond's avatar
Eric S. Raymond committed
99 100
;; General customization

101 102 103 104 105 106 107 108 109
(defgroup vc nil
  "Version-control system in Emacs."
  :group 'tools)

(defcustom vc-suppress-confirm nil
  "*If non-nil, treat user as expert; suppress yes-no prompts on some things."
  :type 'boolean
  :group 'vc)

110 111 112 113 114 115 116 117
(defcustom vc-delete-logbuf-window t
  "*If non-nil, delete the *VC-log* buffer and window after each logical action.
If nil, bury that buffer instead.
This is most useful if you have multiple windows on a frame and would like to
preserve the setting."
  :type 'boolean
  :group 'vc)

118 119 120 121 122
(defcustom vc-initial-comment nil
  "*If non-nil, prompt for initial comment when a file is registered."
  :type 'boolean
  :group 'vc)

123 124 125 126
(defcustom vc-default-init-version "1.1"
  "*A string used as the default version number when a new file is registered.
This can be overriden by giving a prefix argument to \\[vc-register]."
  :type 'string
Dan Nicolaescu's avatar
Dan Nicolaescu committed
127 128
  :group 'vc
  :version "20.3")
129

130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164
(defcustom vc-command-messages nil
  "*If non-nil, display run messages from back-end commands."
  :type 'boolean
  :group 'vc)

(defcustom vc-checkin-switches nil
  "*A string or list of strings specifying extra switches for checkin.
These are passed to the checkin program by \\[vc-checkin]."
  :type '(choice (const :tag "None" nil)
		 (string :tag "Argument String")
		 (repeat :tag "Argument List"
			 :value ("")
			 string))
  :group 'vc)

(defcustom vc-checkout-switches nil
  "*A string or list of strings specifying extra switches for checkout.
These are passed to the checkout program by \\[vc-checkout]."
  :type '(choice (const :tag "None" nil)
		 (string :tag "Argument String")
		 (repeat :tag "Argument List"
			 :value ("")
			 string))
  :group 'vc)

(defcustom vc-register-switches nil
  "*A string or list of strings; extra switches for registering a file.
These are passed to the checkin program by \\[vc-register]."
  :type '(choice (const :tag "None" nil)
		 (string :tag "Argument String")
		 (repeat :tag "Argument List"
			 :value ("")
			 string))
  :group 'vc)

165 166 167 168 169 170 171 172 173 174 175 176
(defcustom vc-dired-recurse t
  "*If non-nil, show directory trees recursively in VC Dired."
  :type 'boolean
  :group 'vc
  :version "20.3")

(defcustom vc-dired-terse-display t
  "*If non-nil, show only locked files in VC Dired."
  :type 'boolean
  :group 'vc
  :version "20.3")

177 178 179 180
(defcustom vc-directory-exclusion-list '("SCCS" "RCS" "CVS")
  "*List of directory names to be ignored while recursively walking file trees."
  :type '(repeat string)
  :group 'vc)
181

182 183 184
(defconst vc-maximum-comment-ring-size 32
  "Maximum number of saved comments in the comment ring.")

185 186 187 188
;;; This is duplicated in diff.el.
(defvar diff-switches "-c"
  "*A string or list of strings specifying switches to be be passed to diff.")

189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229
(defcustom vc-annotate-color-map
  '(( 26.3672 . "#FF0000")
    ( 52.7344 . "#FF3800")
    ( 79.1016 . "#FF7000")
    (105.4688 . "#FFA800")
    (131.8359 . "#FFE000")
    (158.2031 . "#E7FF00")
    (184.5703 . "#AFFF00")
    (210.9375 . "#77FF00")
    (237.3047 . "#3FFF00")
    (263.6719 . "#07FF00")
    (290.0391 . "#00FF31")
    (316.4063 . "#00FF69")
    (342.7734 . "#00FFA1")
    (369.1406 . "#00FFD9")
    (395.5078 . "#00EEFF")
    (421.8750 . "#00B6FF")
    (448.2422 . "#007EFF"))
  "*Association list of age versus color, for \\[vc-annotate].
Ages are given in units of 2**-16 seconds.
Default is eighteen steps using a twenty day increment."
  :type 'sexp
  :group 'vc)

(defcustom vc-annotate-very-old-color "#0046FF"
  "*Color for lines older than CAR of last cons in `vc-annotate-color-map'."
  :type 'string
  :group 'vc)

(defcustom vc-annotate-background "black"
  "*Background color for \\[vc-annotate].
Default color is used if nil."
  :type 'string
  :group 'vc)

(defcustom vc-annotate-menu-elements '(2 0.5 0.1 0.01)
  "*Menu elements for the mode-specific menu of VC-Annotate mode.
List of factors, used to expand/compress the time scale.  See `vc-annotate'."
  :type 'sexp
  :group 'vc)

230
;;;###autoload
231
(defcustom vc-checkin-hook nil
Dave Love's avatar
Dave Love committed
232
  "*Normal hook (list of functions) run after a checkin is done.
233 234
See `run-hooks'."
  :type 'hook
Dave Love's avatar
Dave Love committed
235
  :options '(vc-comment-to-change-log)
236
  :group 'vc)
237

238
;;;###autoload
239 240 241 242 243
(defcustom vc-before-checkin-hook nil
  "*Normal hook (list of functions) run before a file gets checked in.  
See `run-hooks'."
  :type 'hook
  :group 'vc)
244

245 246 247 248 249 250
;;;###autoload
(defcustom vc-annotate-mode-hook nil
  "*Hooks to run when VC-Annotate mode is turned on."
  :type 'hook
  :group 'vc)

Eric S. Raymond's avatar
Eric S. Raymond committed
251 252
;; Header-insertion hair

253
(defcustom vc-header-alist
254
  '((SCCS "\%W\%") (RCS "\$Id\$") (CVS "\$Id\$"))
255 256 257
  "*Header keywords to be inserted by `vc-insert-headers'.
Must be a list of two-element lists, the first element of each must
be `RCS', `CVS', or `SCCS'.  The second element is the string to
258 259 260 261 262 263 264 265 266 267
be inserted for this particular backend."
  :type '(repeat (list :format "%v"
		       (choice :tag "System"
			       (const SCCS)
			       (const RCS)
			       (const CVS))
		       (string :tag "Header")))
  :group 'vc)

(defcustom vc-static-header-alist
Eric S. Raymond's avatar
Eric S. Raymond committed
268 269 270 271
  '(("\\.c$" .
     "\n#ifndef lint\nstatic char vcid[] = \"\%s\";\n#endif /* lint */\n"))
  "*Associate static header string templates with file types.  A \%s in the
template is replaced with the first string associated with the file's
272 273 274 275 276
version-control type in `vc-header-alist'."
  :type '(repeat (cons :format "%v"
		       (regexp :tag "File Type")
		       (string :tag "Header String")))
  :group 'vc)
277

278
(defcustom vc-comment-alist
Eric S. Raymond's avatar
Eric S. Raymond committed
279 280 281 282
  '((nroff-mode ".\\\"" ""))
  "*Special comment delimiters to be used in generating vc headers only.
Add an entry in this list if you need to override the normal comment-start
and comment-end variables.  This will only be necessary if the mode language
283 284 285 286 287 288
is sensitive to blank lines."
  :type '(repeat (list :format "%v"
		       (symbol :tag "Mode")
		       (string :tag "Comment Start")
		       (string :tag "Comment End")))
  :group 'vc)
Eric S. Raymond's avatar
Eric S. Raymond committed
289

290
;; Default is to be extra careful for super-user.
291
(defcustom vc-checkout-carefully (= (user-uid) 0)
292 293
  "*Non-nil means be extra-careful in checkout.
Verify that the file really is not locked
294 295 296
and that its contents match what the master file says."
  :type 'boolean
  :group 'vc)
297

298
(defcustom vc-rcs-release nil
299
  "*The release number of your RCS installation, as a string.
300 301
If nil, VC itself computes this value when it is first needed."
  :type '(choice (const :tag "Auto" nil)
Markus Rost's avatar
Markus Rost committed
302 303
		 string 
		 (const :tag "Unknown" unknown))
304
  :group 'vc)
305

306
(defcustom vc-sccs-release nil
307
  "*The release number of your SCCS installation, as a string.
308 309
If nil, VC itself computes this value when it is first needed."
  :type '(choice (const :tag "Auto" nil)
Markus Rost's avatar
Markus Rost committed
310 311
		 string 
		 (const :tag "Unknown" unknown))
312
  :group 'vc)
313

314
(defcustom vc-cvs-release nil
315
  "*The release number of your CVS installation, as a string.
316 317
If nil, VC itself computes this value when it is first needed."
  :type '(choice (const :tag "Auto" nil)
Markus Rost's avatar
Markus Rost committed
318 319
		 string 
		 (const :tag "Unknown" unknown))
320
  :group 'vc)
321

Eric S. Raymond's avatar
Eric S. Raymond committed
322 323 324
;; Variables the user doesn't need to know about.
(defvar vc-log-entry-mode nil)
(defvar vc-log-operation nil)
325
(defvar vc-log-after-operation-hook nil)
326
(defvar vc-checkout-writable-buffer-hook 'vc-checkout-writable-buffer)
Richard M. Stallman's avatar
Richard M. Stallman committed
327 328 329
;; In a log entry buffer, this is a local variable
;; that points to the buffer for which it was made
;; (either a file, or a VC dired buffer).
330
(defvar vc-parent-buffer nil)
331
(defvar vc-parent-buffer-name nil)
Eric S. Raymond's avatar
Eric S. Raymond committed
332

333 334 335
(defvar vc-log-file)
(defvar vc-log-version)

Eric S. Raymond's avatar
Eric S. Raymond committed
336 337
(defconst vc-name-assoc-file "VC-names")

338
(defvar vc-dired-mode nil)
339 340
(make-variable-buffer-local 'vc-dired-mode)

341
(defvar vc-comment-ring (make-ring vc-maximum-comment-ring-size))
342 343 344
(defvar vc-comment-ring-index nil)
(defvar vc-last-comment-match nil)

345 346 347 348 349 350 351
;;; Find and compare backend releases

(defun vc-backend-release (backend)
  ;; Returns which backend release is installed on this system.
  (cond
   ((eq backend 'RCS)
    (or vc-rcs-release
352
	(and (zerop (vc-do-command nil nil "rcs" nil nil "-V"))
353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408
	     (save-excursion
	       (set-buffer (get-buffer "*vc*"))
	       (setq vc-rcs-release
		     (car (vc-parse-buffer
			   '(("^RCS version \\([0-9.]+ *.*\\)" 1)))))))
	(setq vc-rcs-release 'unknown)))
   ((eq backend 'CVS)
    (or vc-cvs-release
	(and (zerop (vc-do-command nil 1 "cvs" nil nil "-v"))
	     (save-excursion
	       (set-buffer (get-buffer "*vc*"))
	       (setq vc-cvs-release
		     (car (vc-parse-buffer
			   '(("^Concurrent Versions System (CVS) \\([0-9.]+\\)"
			      1)))))))
	(setq vc-cvs-release 'unknown)))
     ((eq backend 'SCCS)
      vc-sccs-release)))

(defun vc-release-greater-or-equal (r1 r2)
  ;; Compare release numbers, represented as strings.
  ;; Release components are assumed cardinal numbers, not decimal
  ;; fractions (5.10 is a higher release than 5.9).  Omitted fields
  ;; are considered lower (5.6.7 is earlier than 5.6.7.1).
  ;; Comparison runs till the end of the string is found, or a
  ;; non-numeric component shows up (5.6.7 is earlier than "5.6.7 beta",
  ;; which is probably not what you want in some cases).
  ;;   This code is suitable for existing RCS release numbers.  
  ;; CVS releases are handled reasonably, too (1.3 < 1.4* < 1.5).
  (let (v1 v2 i1 i2)
    (catch 'done
      (or (and (string-match "^\\.?\\([0-9]+\\)" r1)
	       (setq i1 (match-end 0))
	       (setq v1 (string-to-number (match-string 1 r1)))
	       (or (and (string-match "^\\.?\\([0-9]+\\)" r2)
			(setq i2 (match-end 0))
			(setq v2 (string-to-number (match-string 1 r2)))
			(if (> v1 v2) (throw 'done t)
			  (if (< v1 v2) (throw 'done nil)
			    (throw 'done
				   (vc-release-greater-or-equal
				    (substring r1 i1)
				    (substring r2 i2)))))))
		   (throw 'done t)))
	  (or (and (string-match "^\\.?\\([0-9]+\\)" r2)
		   (throw 'done nil))
	      (throw 'done t)))))

(defun vc-backend-release-p (backend release)
  ;; Return t if we have RELEASE of BACKEND or better
  (let (i r (ri 0) (ii 0) is rs (installation (vc-backend-release backend)))
    (if (not (eq installation 'unknown))
	(cond
	 ((or (eq backend 'RCS) (eq backend 'CVS))
	  (vc-release-greater-or-equal installation release))))))

409 410 411 412 413 414
;;; functions that operate on RCS revision numbers

(defun vc-trunk-p (rev)
  ;; return t if REV is a revision on the trunk
  (not (eq nil (string-match "\\`[0-9]+\\.[0-9]+\\'" rev))))

415 416 417 418
(defun vc-branch-p (rev)
  ;; return t if REV is a branch revision
  (not (eq nil (string-match "\\`[0-9]+\\(\\.[0-9]+\\.[0-9]+\\)*\\'" rev))))

419 420 421 422
(defun vc-branch-part (rev)
  ;; return the branch part of a revision number REV
  (substring rev 0 (string-match "\\.[0-9]+\\'" rev)))

423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442
(defun vc-minor-part (rev)
  ;; return the minor version number of a revision number REV
  (string-match "[0-9]+\\'" rev)
  (substring rev (match-beginning 0) (match-end 0)))

(defun vc-previous-version (rev)
  ;; guess the previous version number
  (let ((branch (vc-branch-part rev))
        (minor-num (string-to-number (vc-minor-part rev))))
    (if (> minor-num 1)
        ;; version does probably not start a branch or release
        (concat branch "." (number-to-string (1- minor-num)))
      (if (vc-trunk-p rev)
          ;; we are at the beginning of the trunk --
          ;; don't know anything to return here
          ""
        ;; we are at the beginning of a branch --
        ;; return version of starting point
        (vc-branch-part branch)))))

Eric S. Raymond's avatar
Eric S. Raymond committed
443 444
;; File property caching

445 446 447 448 449 450
(defun vc-clear-context ()
  "Clear all cached file properties and the comment ring."
  (interactive)
  (fillarray vc-file-prop-obarray nil)
  ;; Note: there is potential for minor lossage here if there is an open
  ;; log buffer with a nonzero local value of vc-comment-ring-index.
451
  (setq vc-comment-ring (make-ring vc-maximum-comment-ring-size)))
452

453 454 455 456 457 458 459 460 461 462 463
(defun vc-file-clear-masterprops (file)
  ;; clear all properties of FILE that were retrieved
  ;; from the master file
  (vc-file-setprop file 'vc-latest-version nil)
  (vc-file-setprop file 'vc-your-latest-version nil)
  (vc-backend-dispatch file
     (progn   ;; SCCS
       (vc-file-setprop file 'vc-master-locks nil))
     (progn   ;; RCS
       (vc-file-setprop file 'vc-default-branch nil)
       (vc-file-setprop file 'vc-head-version nil)
464
       (vc-file-setprop file 'vc-master-workfile-version nil)
465 466 467
       (vc-file-setprop file 'vc-master-locks nil))
     (progn
       (vc-file-setprop file 'vc-cvs-status nil))))
468

469 470 471 472 473
(defun vc-head-version (file)
  ;; Return the RCS head version of FILE 
  (cond ((vc-file-getprop file 'vc-head-version))
	(t (vc-fetch-master-properties file)
	   (vc-file-getprop file 'vc-head-version))))
474

Eric S. Raymond's avatar
Eric S. Raymond committed
475 476
;; Random helper functions

477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493
(defun vc-latest-on-branch-p (file)
  ;; return t iff the current workfile version of FILE is
  ;; the latest on its branch.
  (vc-backend-dispatch file
     ;; SCCS
     (string= (vc-workfile-version file) (vc-latest-version file)) 
     ;; RCS
     (let ((workfile-version (vc-workfile-version file)) tip-version)
       (if (vc-trunk-p workfile-version) 
	   (progn 
	     ;; Re-fetch the head version number.  This is to make
             ;; sure that no-one has checked in a new version behind
	     ;; our back.
	     (vc-fetch-master-properties file)
	     (string= (vc-file-getprop file 'vc-head-version)
		      workfile-version))
	 ;; If we are not on the trunk, we need to examine the
494 495
	 ;; whole current branch.  (vc-master-workfile-version 
         ;; is not what we need.)
496 497 498 499 500 501 502 503 504 505
	 (save-excursion
	   (set-buffer (get-buffer-create "*vc-info*"))
	   (vc-insert-file (vc-name file) "^desc")
	   (setq tip-version (car (vc-parse-buffer (list (list 
             (concat "^\\(" (regexp-quote (vc-branch-part workfile-version))
		     "\\.[0-9]+\\)\ndate[ \t]+\\([0-9.]+\\);") 1 2)))))
	   (if (get-buffer "*vc-info*") 
	       (kill-buffer (get-buffer "*vc-info*")))
	   (string= tip-version workfile-version))))
     ;; CVS
506
     t))
507

508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540
;;; Two macros for elisp programming
;;;###autoload
(defmacro with-vc-file (file comment &rest body)
  "Execute BODY, checking out a writable copy of FILE first if necessary.
After BODY has been executed, check-in FILE with COMMENT (a string).  
FILE is passed through `expand-file-name'; BODY executed within 
`save-excursion'.  If FILE is not under version control, or locked by 
somebody else, signal error."
  `(let ((file (expand-file-name ,file)))
     (or (vc-registered file)
	 (error (format "File not under version control: `%s'" file)))
     (let ((locking-user (vc-locking-user file)))
       (cond ((and (not locking-user)
                   (eq (vc-checkout-model file) 'manual))
              (vc-checkout file t))
             ((and (stringp locking-user)
                   (not (string= locking-user (vc-user-login-name))))
              (error (format "`%s' is locking `%s'" locking-user file)))))
     (save-excursion
       ,@body)
     (vc-checkin file nil ,comment)))

;;;###autoload
(defmacro edit-vc-file (file comment &rest body)
  "Edit FILE under version control, executing BODY.  Checkin with COMMENT.
This macro uses `with-vc-file', passing args to it.
However, before executing BODY, find FILE, and after BODY, save buffer."
  `(with-vc-file
    ,file ,comment
    (find-file ,file)
    ,@body
    (save-buffer)))

541 542 543 544 545 546 547 548 549 550
(defun vc-ensure-vc-buffer ()
  ;; Make sure that the current buffer visits a version-controlled file.
  (if vc-dired-mode
      (set-buffer (find-file-noselect (dired-get-filename)))
    (while vc-parent-buffer
      (pop-to-buffer vc-parent-buffer))
    (if (not (buffer-file-name))
	(error "Buffer %s is not associated with a file" (buffer-name))
      (if (not (vc-backend (buffer-file-name)))
	  (error "File %s is not under version control" (buffer-file-name))))))
551

Eric S. Raymond's avatar
Eric S. Raymond committed
552
(defvar vc-binary-assoc nil)
553 554 555 556
(defvar vc-binary-suffixes
  (if (memq system-type '(ms-dos windows-nt))
      '(".exe" ".com" ".bat" ".cmd" ".btm" "")
    '("")))
Eric S. Raymond's avatar
Eric S. Raymond committed
557 558 559
(defun vc-find-binary (name)
  "Look for a command anywhere on the subprocess-command search path."
  (or (cdr (assoc name vc-binary-assoc))
560 561 562 563 564
      (catch 'found
	(mapcar
	 (function 
	  (lambda (s)
	    (if s
565 566 567 568 569 570 571 572 573 574 575 576
		(let ((full (concat s "/" name))
		      (suffixes vc-binary-suffixes)
		      candidate)
		  (while suffixes
		    (setq candidate (concat full (car suffixes)))
		    (if (and (file-executable-p candidate)
			     (not (file-directory-p candidate)))
			(progn
			  (setq vc-binary-assoc
				(cons (cons name candidate) vc-binary-assoc))
			  (throw 'found candidate))
		      (setq suffixes (cdr suffixes))))))))
577 578
	 exec-path)
	nil)))
Eric S. Raymond's avatar
Eric S. Raymond committed
579

580
(defun vc-do-command (buffer okstatus command file last &rest flags)
Eric S. Raymond's avatar
Eric S. Raymond committed
581
  "Execute a version-control command, notifying user and checking for errors.
582 583 584 585 586 587 588 589 590 591
Output from COMMAND goes to BUFFER, or *vc* if BUFFER is nil.  The
command is considered successful if its exit status does not exceed
OKSTATUS (if OKSTATUS is nil, that means to ignore errors).  FILE is
the name of the working file (may also be nil, to execute commands
that don't expect a file name).  If FILE is non-nil, the argument LAST
indicates what filename should actually be passed to the command: if
it is `MASTER', the name of FILE's master file is used, if it is
`WORKFILE', then FILE is passed through unchanged.  If an optional
list of FLAGS is present, that is inserted into the command line
before the filename."
592
  (and file (setq file (expand-file-name file)))
593
  (if (not buffer) (setq buffer "*vc*"))
Eric S. Raymond's avatar
Eric S. Raymond committed
594
  (if vc-command-messages
595
      (message "Running %s on %s..." command file))
596
  (let ((obuf (current-buffer)) (camefrom (current-buffer))
Eric S. Raymond's avatar
Eric S. Raymond committed
597
	(squeezed nil)
598
	(olddir default-directory)
599
	vc-file status)
600
    (set-buffer (get-buffer-create buffer))
601 602 603
    (set (make-local-variable 'vc-parent-buffer) camefrom)
    (set (make-local-variable 'vc-parent-buffer-name)
	 (concat " from " (buffer-name camefrom)))
604
    (setq default-directory olddir)
605
    
Eric S. Raymond's avatar
Eric S. Raymond committed
606
    (erase-buffer)
607

Eric S. Raymond's avatar
Eric S. Raymond committed
608 609 610
    (mapcar
     (function (lambda (s) (and s (setq squeezed (append squeezed (list s))))))
     flags)
611
    (if (and (eq last 'MASTER) file (setq vc-file (vc-name file)))
Eric S. Raymond's avatar
Eric S. Raymond committed
612
	(setq squeezed (append squeezed (list vc-file))))
613
    (if (and file (eq last 'WORKFILE))
614 615 616 617 618 619
	(progn
	  (let* ((pwd (expand-file-name default-directory))
		 (preflen (length pwd)))
	    (if (string= (substring file 0 preflen) pwd)
		(setq file (substring file preflen))))
	  (setq squeezed (append squeezed (list file)))))
620
    (let ((exec-path (append vc-path exec-path))
621 622 623
	  ;; Add vc-path to PATH for the execution of this command.
	  (process-environment
	   (cons (concat "PATH=" (getenv "PATH")
624 625
			 path-separator
			 (mapconcat 'identity vc-path path-separator))
626
		 process-environment))
627
	  (w32-quote-process-args t))
628
      (setq status (apply 'call-process command nil t nil squeezed)))
Eric S. Raymond's avatar
Eric S. Raymond committed
629
    (goto-char (point-max))
630
    (set-buffer-modified-p nil)
631
    (forward-line -1)
632
    (if (or (not (integerp status)) (and okstatus (< okstatus status)))
Eric S. Raymond's avatar
Eric S. Raymond committed
633
	(progn
634
	  (pop-to-buffer buffer)
Eric S. Raymond's avatar
Eric S. Raymond committed
635
	  (goto-char (point-min))
636
	  (shrink-window-if-larger-than-buffer)
637 638 639 640
	  (error "Running %s...FAILED (%s)" command
		 (if (integerp status)
		     (format "status %d" status)
		   status))
Eric S. Raymond's avatar
Eric S. Raymond committed
641 642
	  )
      (if vc-command-messages
643
	  (message "Running %s...OK" command))
Eric S. Raymond's avatar
Eric S. Raymond committed
644 645 646 647 648
      )
    (set-buffer obuf)
    status)
  )

649 650 651
;;; Save a bit of the text around POSN in the current buffer, to help
;;; us find the corresponding position again later.  This works even
;;; if all markers are destroyed or corrupted.
652
;;; A lot of this was shamelessly lifted from Sebastian Kremer's rcs.el mode.
653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678
(defun vc-position-context (posn)
  (list posn
	(buffer-size)
	(buffer-substring posn
			  (min (point-max) (+ posn 100)))))

;;; Return the position of CONTEXT in the current buffer, or nil if we
;;; couldn't find it.
(defun vc-find-position-by-context (context)
  (let ((context-string (nth 2 context)))
    (if (equal "" context-string)
	(point-max)
      (save-excursion
	(let ((diff (- (nth 1 context) (buffer-size))))
	  (if (< diff 0) (setq diff (- diff)))
	  (goto-char (nth 0 context))
	  (if (or (search-forward context-string nil t)
		  ;; Can't use search-backward since the match may continue
		  ;; after point.
		  (progn (goto-char (- (point) diff (length context-string)))
			 ;; goto-char doesn't signal an error at
			 ;; beginning of buffer like backward-char would
			 (search-forward context-string nil t)))
	      ;; to beginning of OSTRING
	      (- (point) (length context-string))))))))

679 680 681 682 683 684 685 686 687
(defun vc-context-matches-p (posn context)
  ;; Returns t if POSN matches CONTEXT, nil otherwise.
  (let* ((context-string (nth 2 context))
	 (len (length context-string))
	 (end (+ posn len)))
    (if (> end (1+ (buffer-size)))
	nil
      (string= context-string (buffer-substring posn end)))))

688 689 690
(defun vc-buffer-context ()
  ;; Return a list '(point-context mark-context reparse); from which
  ;; vc-restore-buffer-context can later restore the context.
691
  (let ((point-context (vc-position-context (point)))
692 693 694 695
	;; Use mark-marker to avoid confusion in transient-mark-mode.
	(mark-context  (if (eq (marker-buffer (mark-marker)) (current-buffer))
			   (vc-position-context (mark-marker))))
	;; Make the right thing happen in transient-mark-mode.
696 697 698 699 700 701 702 703
	(mark-active nil)
	;; We may want to reparse the compilation buffer after revert
	(reparse (and (boundp 'compilation-error-list) ;compile loaded
		      (let ((curbuf (current-buffer)))
			;; Construct a list; each elt is nil or a buffer
			;; iff that buffer is a compilation output buffer
			;; that contains markers into the current buffer.
			(save-excursion
704 705
			  (mapcar (function
				   (lambda (buffer)
706 707 708 709 710
				    (set-buffer buffer)
				    (let ((errors (or
						   compilation-old-error-list
						   compilation-error-list))
					  (buffer-error-marked-p nil))
711
				      (while (and (consp errors)
712
						  (not buffer-error-marked-p))
713
					(and (markerp (cdr (car errors)))
714 715
					     (eq buffer
						 (marker-buffer
716
						  (cdr (car errors))))
717
					     (setq buffer-error-marked-p t))
718
					(setq errors (cdr errors)))
719
				      (if buffer-error-marked-p buffer))))
720
				  (buffer-list)))))))
721 722 723 724 725 726 727 728
    (list point-context mark-context reparse)))

(defun vc-restore-buffer-context (context)
  ;; Restore point/mark, and reparse any affected compilation buffers.
  ;; CONTEXT is that which vc-buffer-context returns.
  (let ((point-context (nth 0 context))
	(mark-context (nth 1 context))
	(reparse (nth 2 context)))
729 730 731 732 733 734 735 736 737 738 739 740 741 742 743
    ;; Reparse affected compilation buffers.
    (while reparse
      (if (car reparse)
	  (save-excursion
	    (set-buffer (car reparse))
	    (let ((compilation-last-buffer (current-buffer)) ;select buffer
		  ;; Record the position in the compilation buffer of
		  ;; the last error next-error went to.
		  (error-pos (marker-position
			      (car (car-safe compilation-error-list)))))
	      ;; Reparse the error messages as far as they were parsed before.
	      (compile-reinitialize-errors '(4) compilation-parsing-end)
	      ;; Move the pointer up to find the error we were at before
	      ;; reparsing.  Now next-error should properly go to the next one.
	      (while (and compilation-error-list
744
			  (/= error-pos (car (car compilation-error-list))))
745 746
		(setq compilation-error-list (cdr compilation-error-list))))))
      (setq reparse (cdr reparse)))
747

748 749 750 751
    ;; if necessary, restore point and mark
    (if (not (vc-context-matches-p (point) point-context))
	(let ((new-point (vc-find-position-by-context point-context)))
	  (if new-point (goto-char new-point))))
752 753 754 755 756
    (and mark-active
         mark-context
         (not (vc-context-matches-p (mark) mark-context))
         (let ((new-mark (vc-find-position-by-context mark-context)))
           (if new-mark (set-mark new-mark))))))
757

758 759 760 761 762 763 764
(defun vc-revert-buffer1 (&optional arg no-confirm)
  ;; Revert buffer, try to keep point and mark where user expects them in spite
  ;; of changes because of expanded version-control key words.
  ;; This is quite important since otherwise typeahead won't work as expected.
  (interactive "P")
  (widen)
  (let ((context (vc-buffer-context)))
765 766 767 768 769 770 771 772
    ;; Use save-excursion here, because it may be able to restore point
    ;; and mark properly even in cases where vc-restore-buffer-context
    ;; would fail.  However, save-excursion might also get it wrong -- 
    ;; in this case, vc-restore-buffer-context gives it a second try.
    (save-excursion
      ;; t means don't call normal-mode; 
      ;; that's to preserve various minor modes.
      (revert-buffer arg no-confirm t))
773 774
    (vc-restore-buffer-context context)))

Eric S. Raymond's avatar
Eric S. Raymond committed
775

776
(defun vc-buffer-sync (&optional not-urgent)
Eric S. Raymond's avatar
Eric S. Raymond committed
777
  ;; Make sure the current buffer and its working file are in sync
778
  ;; NOT-URGENT means it is ok to continue if the user says not to save.
779
  (if (buffer-modified-p)
780 781 782 783 784 785 786
      (if (or vc-suppress-confirm
	      (y-or-n-p (format "Buffer %s modified; save it? " (buffer-name))))
	  (save-buffer)
	(if not-urgent
	    nil
	  (error "Aborted")))))

Eric S. Raymond's avatar
Eric S. Raymond committed
787

788
(defun vc-workfile-unchanged-p (file &optional want-differences-if-changed)
Eric S. Raymond's avatar
Eric S. Raymond committed
789 790 791
  ;; Has the given workfile changed since last checkout?
  (let ((checkout-time (vc-file-getprop file 'vc-checkout-time))
	(lastmod (nth 5 (file-attributes file))))
792 793 794
    (or (equal checkout-time lastmod)
	(and (or (not checkout-time) want-differences-if-changed)
	     (let ((unchanged (zerop (vc-backend-diff file nil nil
795
					  (not want-differences-if-changed)))))
796 797 798
	       ;; 0 stands for an unknown time; it can't match any mod time.
	       (vc-file-setprop file 'vc-checkout-time (if unchanged lastmod 0))
	       unchanged)))))
Eric S. Raymond's avatar
Eric S. Raymond committed
799

800 801
(defun vc-next-action-on-file (file verbose &optional comment)
  ;;; If comment is specified, it will be used as an admin or checkin comment.
802
  (let ((vc-type (vc-backend file))
803
	owner version buffer)
804 805
    (cond

806 807 808
     ;; If the file is not under version control, register it
     ((not vc-type)
      (vc-register verbose comment))
809

810 811 812 813 814
     ;; CVS: changes to the master file need to be 
     ;; merged back into the working file
     ((and (eq vc-type 'CVS)
	   (or (eq (vc-cvs-status file) 'needs-checkout)
	       (eq (vc-cvs-status file) 'needs-merge)))
815 816 817 818
      (if (or vc-dired-mode
	      (yes-or-no-p 
	       (format "%s is not up-to-date.  Merge in changes now? "
		       (buffer-name))))
819
	  (progn
820 821 822 823 824 825 826 827
	    (if vc-dired-mode
		(and (setq buffer (get-file-buffer file))
		     (buffer-modified-p buffer)
		     (switch-to-buffer-other-window buffer)
		     (vc-buffer-sync t))
	      (setq buffer (current-buffer))
	      (vc-buffer-sync t))
	    (if (and buffer (buffer-modified-p buffer)
828
		     (not (yes-or-no-p 
829 830 831
			   (format 
			    "Buffer %s modified; merge file on disc anyhow? " 
			    (buffer-name buffer)))))
832
		(error "Merge aborted"))
833 834 835 836 837 838 839
	    (let ((status (vc-backend-merge-news file)))
              (and buffer
                   (vc-resynch-buffer file t 
                                      (not (buffer-modified-p buffer))))
              (if (not (zerop status))
                  (if (y-or-n-p "Conflicts detected.  Resolve them now? ")
                      (vc-resolve-conflicts)))))
840 841
	(error "%s needs update" (buffer-name))))

842 843 844 845 846 847 848
     ;; For CVS files with implicit checkout: if unmodified, don't do anything
     ((and (eq vc-type 'CVS)
           (eq (vc-checkout-model file) 'implicit)
           (not (vc-locking-user file))
           (not verbose))
      (message "%s is up to date" (buffer-name)))

849
     ;; If there is no lock on the file, assert one and get it.
850 851 852 853 854
     ((not (setq owner (vc-locking-user file)))
      ;; With implicit checkout, make sure not to lose unsaved changes.
      (and (eq (vc-checkout-model file) 'implicit)
           (buffer-modified-p buffer)
           (vc-buffer-sync))
855
      (if (and vc-checkout-carefully
856
	       (not (vc-workfile-unchanged-p file t)))
857
	  (if (save-window-excursion
858
		(pop-to-buffer "*vc-diff*")
859 860 861 862 863 864 865 866 867 868
		(goto-char (point-min))
		(insert-string (format "Changes to %s since last lock:\n\n"
				       file))
		(not (beep))
		(yes-or-no-p
		      (concat "File has unlocked changes, "
		       "claim lock retaining changes? ")))
	      (progn (vc-backend-steal file)
		     (vc-mode-line file))
	    (if (not (yes-or-no-p "Revert to checked-in version, instead? "))
Richard M. Stallman's avatar
Richard M. Stallman committed
869
		(error "Checkout aborted")
870 871 872
	      (vc-revert-buffer1 t t)
	      (vc-checkout-writable-buffer file))
	    )
873 874
	(if verbose 
	    (if (not (eq vc-type 'SCCS))
875 876
		(vc-checkout file nil 
		   (read-string "Branch or version to move to: "))
Richard M. Stallman's avatar
Richard M. Stallman committed
877
	      (error "Sorry, this is not implemented for SCCS"))
878 879 880 881 882 883 884
	  (if (vc-latest-on-branch-p file)
	      (vc-checkout-writable-buffer file)
	    (if (yes-or-no-p 
		 "This is not the latest version.  Really lock it?  ")
		(vc-checkout-writable-buffer file)
	      (if (yes-or-no-p "Lock the latest version instead? ")
		  (vc-checkout-writable-buffer file
885 886 887
		     (if (vc-trunk-p (vc-workfile-version file)) 
                         ""  ;; this means check out latest on trunk
                       (vc-branch-part (vc-workfile-version file)))))))
888
	  )))
889 890

     ;; a checked-out version exists, but the user may not own the lock
891
     ((and (not (eq vc-type 'CVS))
892
	   (not (string-equal owner (vc-user-login-name))))
893
      (if comment
894
	  (error "Sorry, you can't steal the lock on %s this way" file))
895 896
      (and (eq vc-type 'RCS)
	   (not (vc-backend-release-p 'RCS "5.6.2"))
Richard M. Stallman's avatar
Richard M. Stallman committed
897
	   (error "File is locked by %s" owner))
898 899
      (vc-steal-lock
       file
900 901
       (if verbose (read-string "Version to steal: ")
	 (vc-workfile-version file))
902
       owner))
903

904
     ;; OK, user owns the lock on the file
905
     (t
906 907 908
	  (if vc-dired-mode 
	      (find-file-other-window file) 
	    (find-file file))
909

910 911 912 913 914 915 916 917
	  ;; If the file on disk is newer, then the user just
	  ;; said no to rereading it.  So the user probably wishes to
	  ;; overwrite the file with the buffer's contents, and check 
	  ;; that in.
	  (if (not (verify-visited-file-modtime (current-buffer)))
	      (if (yes-or-no-p "Replace file on disk with buffer contents? ")
		  (write-file (buffer-file-name))
		(error "Aborted"))
918
            ;; if buffer is not saved, give user a chance to do it
919
	    (vc-buffer-sync))
920 921 922 923 924 925

	  ;; Revert if file is unchanged and buffer is too.
	  ;; If buffer is modified, that means the user just said no
	  ;; to saving it; in that case, don't revert,
	  ;; because the user might intend to save
	  ;; after finishing the log entry.
926
	  (if (and (vc-workfile-unchanged-p file) 
927
		   (not (buffer-modified-p)))
928 929 930 931 932
	       ;; DO NOT revert the file without asking the user!
	      (cond 
	       ((yes-or-no-p "Revert to master version? ")
		(vc-backend-revert file)
		(vc-resynch-window file t t)))
933 934 935 936 937 938 939

	    ;; user may want to set nonstandard parameters
	    (if verbose
		(setq version (read-string "New version level: ")))

	    ;; OK, let's do the checkin
	    (vc-checkin file version comment)
940
	    )))))
941

942 943
(defvar vc-dired-window-configuration)

944
(defun vc-next-action-dired (file rev comment)
945 946
  ;; Do a vc-next-action-on-file on all the marked files, possibly 
  ;; passing on the log comment we've just entered.
947
  (let ((dired-buffer (current-buffer))
948
	(dired-dir default-directory))
949
    (dired-map-over-marks
950
     (let ((file (dired-get-filename)))
951
       (message "Processing %s..." file)
952 953
       ;; Adjust the default directory so that checkouts
       ;; go to the right place.
954 955 956 957 958 959 960
       (let ((default-directory (file-name-directory file)))
         (vc-next-action-on-file file nil comment)
         (set-buffer dired-buffer))
       ;; Make sure that files don't vanish
       ;; after they are checked in.
       (let ((vc-dired-terse-mode nil))
         (dired-do-redisplay file))
961
       (set-window-configuration vc-dired-window-configuration)
962
       (message "Processing %s...done" file))
963 964
    nil t))
  (dired-move-to-filename))
965

Jim Blandy's avatar
Jim Blandy committed
966
;; Here's the major entry point.
Eric S. Raymond's avatar
Eric S. Raymond committed
967

Jim Blandy's avatar
Jim Blandy committed
968
;;;###autoload
Eric S. Raymond's avatar
Eric S. Raymond committed
969 970
(defun vc-next-action (verbose)
  "Do the next logical checkin or checkout operation on the current file.
971 972 973 974 975 976 977 978
   If you call this from within a VC dired buffer with no files marked,
it will operate on the file in the current line.
   If you call this from within a VC dired buffer, and one or more
files are marked, it will accept a log message and then operate on
each one.  The log message will be used as a comment for any register
or checkin operations, but ignored when doing checkouts.  Attempted
lock steals will raise an error.
   A prefix argument lets you specify the version number to use.
979 980

For RCS and SCCS files:
Eric S. Raymond's avatar
Eric S. Raymond committed
981
   If the file is not already registered, this registers it for version
982
control.
Eric S. Raymond's avatar
Eric S. Raymond committed
983
   If the file is registered and not locked by anyone, this checks out
984
a writable and locked file ready for editing.
Eric S. Raymond's avatar
Eric S. Raymond committed
985 986 987
   If the file is checked out and locked by the calling user, this
first checks to see if the file has changed since checkout.  If not,
it performs a revert.
988 989
   If the file has been changed, this pops up a buffer for entry
of a log message; when the message has been entered, it checks in the
Eric S. Raymond's avatar
Eric S. Raymond committed
990
resulting changes along with the log message as change commentary.  If
991
the variable `vc-keep-workfiles' is non-nil (which is its default), a
Eric S. Raymond's avatar
Eric S. Raymond committed
992 993
read-only copy of the changed file is left in place afterwards.
   If the file is registered and locked by someone else, you are given
994
the option to steal the lock.
995 996 997 998 999 1000 1001 1002 1003 1004

For CVS files:
   If the file is not already registered, this registers it for version
control.  This does a \"cvs add\", but no \"cvs commit\".
   If the file is added but not committed, it is committed.
   If your working file is changed, but the repository file is
unchanged, this pops up a buffer for entry of a log message; when the
message has been entered, it checks in the resulting changes along
with the logmessage as change commentary.  A writable file is retained.
   If the repository file is changed, you are asked if you want to
1005
merge in the changes into your working copy."
1006

Eric S. Raymond's avatar
Eric S. Raymond committed
1007
  (interactive "P")
1008 1009 1010
  (catch 'nogo
    (if vc-dired-mode
	(let ((files (dired-get-marked-files)))
1011 1012
          (set (make-local-variable 'vc-dired-window-configuration)
               (current-window-configuration))
1013 1014
	  (if (string= "" 
		 (mapconcat
1015 1016
	             (function (lambda (f)
			 (if (eq (vc-backend f) 'CVS)
1017 1018
			     (if (or (eq (vc-cvs-status f) 'locally-modified)
				     (eq (vc-cvs-status f) 'locally-added))
1019 1020 1021 1022 1023 1024 1025
				 "@" "")
			   (if (vc-locking-user f) "@" ""))))
		     files ""))
		(vc-next-action-dired nil nil "dummy")
	      (vc-start-entry nil nil nil
			      "Enter a change comment for the marked files."
			      'vc-next-action-dired))
1026
	    (throw 'nogo nil)))
1027 1028 1029 1030 1031
    (while vc-parent-buffer
      (pop-to-buffer vc-parent-buffer))
    (if buffer-file-name
        (vc-next-action-on-file buffer-file-name verbose)
      (error "Buffer %s is not associated with a file" (buffer-name)))))
Eric S. Raymond's avatar
Eric S. Raymond committed
1032 1033 1034

;;; These functions help the vc-next-action entry point

1035
(defun vc-checkout-writable-buffer (&optional file rev)
1036
  "Retrieve a writable copy of the latest version of the current buffer's file."
1037
  (vc-checkout (or file (buffer-file-name)) t rev)
1038 1039
  )

Jim Blandy's avatar
Jim Blandy committed
1040
;;;###autoload
1041
(defun vc-register (&optional override comment)
Eric S. Raymond's avatar
Eric S. Raymond committed
1042 1043
  "Register the current file into your version-control system."
  (interactive "P")
1044 1045
  (or buffer-file-name
      (error "No visited file"))
1046 1047 1048 1049 1050 1051
  (let ((master (vc-name buffer-file-name)))
    (and master (file-exists-p master)
	 (error "This file is already registered"))
    (and master
	 (not (y-or-n-p "Previous master file has vanished.  Make a new one? "))
	 (error "This file is already registered")))