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

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

5 6
;; Author:     FSF (see below for full credits)
;; Maintainer: Andre Spiegel <spiegel@gnu.org>
Eric S. Raymond's avatar
Eric S. Raymond committed
7

8
;; $Id: vc.el,v 1.298 2001/03/10 10:44:35 spiegel Exp $
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 29 30 31 32 33 34 35
;;; Credits:

;; VC was initially designed and implemented by Eric S. Raymond
;; <esr@snark.thyrsus.com>.  Over the years, many people have
;; contributed substantial amounts of work to VC.  These include:
;;   Per Cederqvist <ceder@lysator.liu.se>
;;   Paul Eggert <eggert@twinsun.com>
;;   Sebastian Kremer <sk@thp.uni-koeln.de>
;;   Martin Lorentzson <martinl@gnu.org>
Dave Love's avatar
Dave Love committed
36
;;   Dave Love <fx@gnu.org>
37 38 39 40 41
;;   Stefan Monnier <monnier@cs.yale.edu>
;;   Andre Spiegel <spiegel@gnu.org>
;;   Richard Stallman <rms@gnu.org>
;;   ttn@netcom.com

Eric S. Raymond's avatar
Eric S. Raymond committed
42 43
;;; Commentary:

44 45
;; This mode is fully documented in the Emacs user's manual.
;;
46
;; Supported version-control systems presently include SCCS, RCS, and CVS.
47 48 49
;;
;; Some features will not work with old RCS versions.  Where
;; appropriate, VC finds out which version you have, and allows or
50
;; disallows those features (stealing locks, for example, works only
51
;; from 5.6.2 onwards).
52 53
;; 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
54
;; NExTSTEP 3.0.
Eric S. Raymond's avatar
Eric S. Raymond committed
55
;;
56
;; You can support the RCS -x option by customizing vc-rcs-master-templates.
Eric S. Raymond's avatar
Eric S. Raymond committed
57 58 59 60
;;
;; Proper function of the SCCS diff commands requires the shellscript vcdiff
;; to be installed somewhere on Emacs's path for executables.
;;
61
;; If your site uses the ChangeLog convention supported by Emacs, the
62
;; function vc-comment-to-change-log should prove a useful checkin hook.
63
;;
Eric S. Raymond's avatar
Eric S. Raymond committed
64 65
;; The vc code maintains some internal state in order to reduce expensive
;; version-control operations to a minimum.  Some names are only computed
66
;; once.  If you perform version control operations with RCS/SCCS/CVS while
Eric S. Raymond's avatar
Eric S. Raymond committed
67 68 69 70 71
;; 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.
72
;;
73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99
;; ADDING SUPPORT FOR OTHER BACKENDS
;;
;; VC can use arbitrary version control systems as a backend.  To add
;; support for a new backend named SYS, write a library vc-sys.el that
;; contains functions of the form `vc-sys-...' (note that SYS is in lower
;; case for the function and library names).  VC will use that library if
;; you put the symbol SYS somewhere into the list of
;; `vc-handled-backends'.  Then, for example, if `vc-sys-registered'
;; returns non-nil for a file, all SYS-specific versions of VC commands
;; will be available for that file.
;;
;; VC keeps some per-file information in the form of properties (see
;; vc-file-set/getprop in vc-hooks.el).  The backend-specific functions
;; do not generally need to be aware of these properties.  For example,
;; `vc-sys-workfile-version' should compute the workfile version and
;; return it; it should not look it up in the property, and it needn't
;; store it there either.  However, if a backend-specific function does
;; store a value in a property, that value takes precedence over any
;; value that the generic code might want to set (check for uses of 
;; the macro `with-vc-properties' in vc.el).
;;
;; In the list of functions below, each identifier needs to be prepended
;; with `vc-sys-'.  Some of the functions are mandatory (marked with a
;; `*'), others are optional (`-').
;;
;; STATE-QUERYING FUNCTIONS
;;
100
;; * registered (file)
101 102 103 104 105 106 107 108 109 110 111
;;
;;   Return non-nil if FILE is registered in this backend.
;;
;; * state (file) 
;;
;;   Return the current version control state of FILE.  For a list of
;;   possible values, see `vc-state'.  This function should do a full and
;;   reliable state computation; it is usually called immediately after
;;   C-x v v.  If you want to use a faster heuristic when visiting a
;;   file, put that into `state-heuristic' below.
;;
112
;; - state-heuristic (file)
113 114 115 116 117 118
;;
;;   If provided, this function is used to estimate the version control
;;   state of FILE at visiting time.  It should be considerably faster
;;   than the implementation of `state'.  For a list of possible values,
;;   see the doc string of `vc-state'.
;;
119
;; - dir-state (dir)
120 121 122 123 124 125
;;
;;   If provided, this function is used to find the version control state
;;   of all files in DIR in a fast way.  The function should not return
;;   anything, but rather store the files' states into the corresponding
;;   `vc-state' properties.
;;
126
;; * workfile-version (file)
127 128 129 130 131 132 133 134 135 136
;;
;;   Return the current workfile version of FILE.
;;
;; - latest-on-branch-p (file)
;;
;;   Return non-nil if the current workfile version of FILE is the latest
;;   on its branch.  The default implementation always returns t, which
;;   means that working with non-current versions is not supported by
;;   default.
;;
137
;; * checkout-model (file)
138 139 140 141
;;
;;   Indicate whether FILE needs to be "checked out" before it can be
;;   edited.  See `vc-checkout-model' for a list of possible values.
;;
142
;; - workfile-unchanged-p (file)
143 144 145 146 147 148 149 150
;;
;;   Return non-nil if FILE is unchanged from its current workfile
;;   version.  This function should do a brief comparison of FILE's
;;   contents with those of the master version.  If the backend does not
;;   have such a brief-comparison feature, the default implementation of
;;   this function can be used, which delegates to a full
;;   vc-BACKEND-diff.
;;
151
;; - mode-line-string (file)
152 153 154 155 156
;;
;;   If provided, this function should return the VC-specific mode line
;;   string for FILE.  The default implementation deals well with all
;;   states that `vc-state' can return.
;;
157
;; - dired-state-info (file)
158 159 160 161 162 163 164 165 166 167 168 169
;;
;;   Translate the `vc-state' property of FILE into a string that can be
;;   used in a vc-dired buffer.  The default implementation deals well
;;   with all states that `vc-state' can return.
;;
;; STATE-CHANGING FUNCTIONS
;;
;; * register (file &optional rev comment)
;;
;;   Register FILE in this backend.  Optionally, an initial revision REV
;;   and an initial description of the file, COMMENT, may be specified.
;;
170
;; - responsible-p (file)
171 172 173 174 175 176 177
;;
;;   Return non-nil if this backend considers itself "responsible" for
;;   FILE, which can also be a directory.  This function is used to find
;;   out what backend to use for registration of new files and for things
;;   like change log generation.  The default implementation always
;;   returns nil.
;;
178
;; - could-register (file)
179 180 181 182
;;
;;   Return non-nil if FILE could be registered under this backend.  The
;;   default implementation always returns t.
;;
183
;; - receive-file (file rev)
184 185 186 187 188 189 190 191 192 193 194 195
;;
;;   Let this backend "receive" a file that is already registered under
;;   another backend.  The default implementation simply calls `register'
;;   for FILE, but it can be overridden to do something more specific,
;;   e.g. keep revision numbers consistent or choose editing modes for
;;   FILE that resemble those of the other backend.
;;
;; - unregister (file)
;;
;;   Unregister FILE from this backend.  This is only needed if this
;;   backend may be used as a "more local" backend for temporary editing.
;;
196
;; * checkin (file rev comment)
197 198 199 200 201 202 203 204 205 206 207 208 209 210 211
;;
;;   Commit changes in FILE to this backend.  If REV is non-nil, that
;;   should become the new revision number.  COMMENT is used as a
;;   check-in comment.
;;
;; * checkout (file &optional editable rev destfile)
;;
;;   Check out revision REV of FILE into the working area.  If EDITABLE
;;   is non-nil, FILE should be writable by the user and if locking is
;;   used for FILE, a lock should also be set.  If REV is non-nil, that
;;   is the revision to check out (default is current workfile version);
;;   if REV is the empty string, that means to check out the head of the
;;   trunk.  If optional arg DESTFILE is given, it is an alternate
;;   filename to write the contents to.
;;
212
;; * revert (file)
213 214 215 216 217 218 219 220 221 222 223
;;
;;   Revert FILE back to the current workfile version.
;;
;; - cancel-version (file editable)
;;
;;   Cancel the current workfile version of FILE, i.e. remove it from the
;;   master.  EDITABLE non-nil means that FILE should be writable
;;   afterwards, and if locking is used for FILE, then a lock should also
;;   be set.  If this function is not provided, trying to cancel a
;;   version is caught as an error.
;;
224
;; - merge (file rev1 rev2)
225 226 227
;;
;;   Merge the changes between REV1 and REV2 into the current working file.
;;
228
;; - merge-news (file)
229 230 231
;;
;;   Merge recent changes from the current branch into FILE.
;;
232
;; - steal-lock (file &optional version)
233 234 235 236 237 238 239 240
;;
;;   Steal any lock on the current workfile version of FILE, or on
;;   VERSION if that is provided.  This function is only needed if
;;   locking is used for files under this backend, and if files can
;;   indeed be locked by other users.
;;
;; HISTORY FUNCTIONS
;;
241
;; * print-log (file)
242
;;
243
;;   Insert the revision log of FILE into the *vc* buffer.
244
;;
245
;; - show-log-entry (version)
246 247 248 249 250
;;
;;   If provided, search the log entry for VERSION in the current buffer,
;;   and make sure it is displayed in the buffer's window.  The default
;;   implementation of this function works for RCS-style logs.
;;
251
;; - wash-log (file)
252 253 254 255
;;
;;   Remove all non-comment information from the output of print-log.  The
;;   default implementation of this function works for RCS-style logs.
;;
256
;; - logentry-check ()
257 258 259 260 261 262
;;
;;   If defined, this function is run to find out whether the user
;;   entered a valid log entry for check-in.  The log entry is in the
;;   current buffer, and if it is not a valid one, the function should
;;   throw an error.
;;
263
;; - comment-history (file)
264 265 266 267 268 269 270
;;
;;   Return a string containing all log entries that were made for FILE.
;;   This is used for transferring a file from one backend to another,
;;   retaining comment information.  The default implementation of this
;;   function does this by calling print-log and then wash-log, and
;;   returning the resulting buffer contents as a string.
;;
271
;; - update-changelog (files)
272 273 274 275 276 277
;;
;;   Using recent log entries, create ChangeLog entries for FILES, or for
;;   all files at or below the default-directory if FILES is nil.  The
;;   default implementation runs rcs2log, which handles RCS- and
;;   CVS-style logs.
;;
278
;; * diff (file &optional rev1 rev2)
279
;;
280
;;   Insert the diff for FILE into the *vc-diff* buffer.  If REV1 and REV2
281 282 283 284 285 286 287
;;   are non-nil, report differences from REV1 to REV2.  If REV1 is nil,
;;   use the current workfile version (as found in the repository) as the
;;   older version; if REV2 is nil, use the current workfile contents as
;;   the newer version.  This function should return a status of either 0
;;   (no differences found), or 1 (either non-empty diff or the diff is
;;   run asynchronously).
;;
288
;; - annotate-command (file buf rev)
289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305
;;
;;   If this function is provided, it should produce an annotated version
;;   of FILE in BUF, relative to version REV.  This is currently only
;;   implemented for CVS, using the `cvs annotate' command.
;;
;; - annotate-difference (point)
;;
;;   Only required if `annotate-command' is defined for the backend.
;;   Return the difference between the age of the line at point and the
;;   current time.  Return NIL if there is no more comparison to be made
;;   in the buffer.  Return value as defined for `current-time'.  You can
;;   safely assume that point is placed at the beginning of each line,
;;   starting at `point-min'.  The buffer that point is placed in is the
;;   Annotate output, as defined by the relevant backend.
;;
;; SNAPSHOT SYSTEM
;;
306
;; - create-snapshot (dir name branchp)
307 308 309 310 311 312 313 314 315 316 317 318 319 320
;;
;;   Take a snapshot of the current state of files under DIR and name it
;;   NAME.  This should make sure that files are up-to-date before
;;   proceeding with the action.  DIR can also be a file and if BRANCHP
;;   is specified, NAME should be created as a branch and DIR should be
;;   checked out under this new branch.  The default implementation does
;;   not support branches but does a sanity check, a tree traversal and
;;   for each file calls `assign-name'.
;;
;; - assign-name (file name)
;;
;;   Give name NAME to the current version of FILE, assuming it is
;;   up-to-date.  Only used by the default version of `create-snapshot'.
;;
321
;; - retrieve-snapshot (dir name update)
322 323 324 325 326 327 328 329 330 331
;;
;;   Retrieve a named snapshot of all registered files at or below DIR.
;;   If UPDATE is non-nil, then update buffers of any files in the
;;   snapshot that are currently visited.  The default implementation
;;   does a sanity check whether there aren't any uncommitted changes at
;;   or below DIR, and then performs a tree walk, using the `checkout'
;;   function to retrieve the corresponding versions.
;;
;; MISCELLANEOUS
;;
332
;; - make-version-backups-p (file)
333 334 335 336 337 338
;;
;;   Return non-nil if unmodified repository versions of FILE should be
;;   backed up locally.  If this is done, VC can perform `diff' and
;;   `revert' operations itself, without calling the backend system.  The
;;   default implementation always returns nil.
;;
339
;; - check-headers ()
340 341 342
;;
;;   Return non-nil if the current buffer contains any version headers.
;;
343
;; - clear-headers ()
344 345 346 347 348 349 350 351
;;
;;   In the current buffer, reset all version headers to their unexpanded
;;   form.  This function should be provided if the state-querying code
;;   for this backend uses the version headers to determine the state of
;;   a file.  This function will then be called whenever VC changes the
;;   version control state in such a way that the headers would give
;;   wrong information.
;;
352
;; - rename-file (old new)
353 354 355 356
;;
;;   Rename file OLD to NEW, both in the working area and in the
;;   repository.  If this function is not provided, the command
;;   `vc-rename-file' will signal an error.
357

358
;;; Code:
359

Eric S. Raymond's avatar
Eric S. Raymond committed
360
(require 'vc-hooks)
361
(require 'ring)
362
(eval-when-compile
363
  (require 'cl)
364 365 366
  (require 'compile)
  (require 'dired)      ; for dired-map-over-marks macro
  (require 'dired-aux))	; for dired-kill-{line,tree}
367 368 369 370 371

(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
372 373 374

;; General customization

375 376 377 378 379 380 381 382 383
(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)

384 385 386 387 388 389 390 391
(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)

392 393 394 395 396
(defcustom vc-initial-comment nil
  "*If non-nil, prompt for initial comment when a file is registered."
  :type 'boolean
  :group 'vc)

397 398
(defcustom vc-default-init-version "1.1"
  "*A string used as the default version number when a new file is registered.
399
This can be overridden by giving a prefix argument to \\[vc-register]."
400
  :type 'string
Dan Nicolaescu's avatar
Dan Nicolaescu committed
401 402
  :group 'vc
  :version "20.3")
403

404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438
(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)

439 440 441 442
(defcustom vc-dired-listing-switches "-al"
  "*Switches passed to `ls' for vc-dired.  MUST contain the `l' option."
  :type 'string
  :group 'vc
443
  :version "21.1")
444

445 446 447 448 449 450 451 452 453 454 455 456
(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")

457 458 459 460
(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)
461

462 463 464
(defconst vc-maximum-comment-ring-size 32
  "Maximum number of saved comments in the comment ring.")

465 466
;;; This is duplicated in diff.el.
(defvar diff-switches "-c"
467 468
  "*A string or list of strings specifying switches to be passed to diff.")

469 470 471 472 473 474 475 476 477 478 479 480
(defcustom vc-diff-switches nil
  "*A string or list of strings specifying switches for diff under VC.
There is also an option vc-BACKEND-diff-switches for each BACKEND that
VC can handle."
  :type '(choice (const :tag "None" nil)
		 (string :tag "Argument String")
		 (repeat :tag "Argument List"
			 :value ("")
			 string))
  :group 'vc
  :version "21.1")

481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501
;;;###autoload
(defcustom vc-checkin-hook nil
  "*Normal hook (list of functions) run after a checkin is done.
See `run-hooks'."
  :type 'hook
  :options '(vc-comment-to-change-log)
  :group 'vc)

;;;###autoload
(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)

(defcustom vc-logentry-check-hook nil
  "*Normal hook run by `vc-backend-logentry-check'.
Use this to impose your own rules on the entry in addition to any the
version control backend imposes itself."
  :type 'hook
  :group 'vc)
502

503
;; Annotate customization
504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524
(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."
525
  :type 'alist
526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541
  :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'."
542
  :type '(repeat number)
543 544
  :group 'vc)

545 546 547
;; vc-annotate functionality (CVS only).
(defvar vc-annotate-mode nil
  "Variable indicating if VC-Annotate mode is active.")
548

549 550 551 552 553
(defvar vc-annotate-mode-map
  (let ((m (make-sparse-keymap)))
    (define-key m [menu-bar] (make-sparse-keymap "VC-Annotate"))
    m)
  "Local keymap used for VC-Annotate mode.")
554

555 556
(defvar vc-annotate-mode-menu nil
  "Local keymap used for VC-Annotate mode's menu bar menu.")
557

Eric S. Raymond's avatar
Eric S. Raymond committed
558 559
;; Header-insertion hair

560
(defcustom vc-static-header-alist
Eric S. Raymond's avatar
Eric S. Raymond committed
561 562
  '(("\\.c$" .
     "\n#ifndef lint\nstatic char vcid[] = \"\%s\";\n#endif /* lint */\n"))
563 564
  "*Associate static header string templates with file types.
A \%s in the template is replaced with the first string associated with
565
the file's version control type in `vc-header-alist'."
566 567 568 569
  :type '(repeat (cons :format "%v"
		       (regexp :tag "File Type")
		       (string :tag "Header String")))
  :group 'vc)
570

571
(defcustom vc-comment-alist
Eric S. Raymond's avatar
Eric S. Raymond committed
572 573
  '((nroff-mode ".\\\"" ""))
  "*Special comment delimiters to be used in generating vc headers only.
574 575
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
576 577 578 579 580 581
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
582

583
;; Default is to be extra careful for super-user.
584 585
;; TODO: This variable is no longer used; the corresponding checks
;;       are always done now.  If that turns out to be fast enough,
586
;;       the variable can be obsoleted.
587
(defcustom vc-checkout-carefully (= (user-uid) 0)
588 589
  "*Non-nil means be extra-careful in checkout.
Verify that the file really is not locked
590 591 592
and that its contents match what the master file says."
  :type 'boolean
  :group 'vc)
593

594 595 596 597 598 599

;;; The main keymap

(defvar vc-prefix-map
  (let ((map (make-sparse-keymap)))
    (define-key map "a" 'vc-update-change-log)
600
    (define-key map "b" 'vc-switch-backend)
601 602 603 604 605 606 607 608 609 610 611 612 613 614 615
    (define-key map "c" 'vc-cancel-version)
    (define-key map "d" 'vc-directory)
    (define-key map "g" 'vc-annotate)
    (define-key map "h" 'vc-insert-headers)
    (define-key map "i" 'vc-register)
    (define-key map "l" 'vc-print-log)
    (define-key map "m" 'vc-merge)
    (define-key map "r" 'vc-retrieve-snapshot)
    (define-key map "s" 'vc-create-snapshot)
    (define-key map "u" 'vc-revert-buffer)
    (define-key map "v" 'vc-next-action)
    (define-key map "=" 'vc-diff)
    (define-key map "~" 'vc-version-other-window)
    map))
(fset 'vc-prefix-map vc-prefix-map)
616

617 618 619 620 621 622 623 624 625 626 627
;; Initialization code, to be done just once at load-time
(defvar vc-log-mode-map
  (let ((map (make-sparse-keymap)))
    (define-key map "\M-n" 'vc-next-comment)
    (define-key map "\M-p" 'vc-previous-comment)
    (define-key map "\M-r" 'vc-comment-search-reverse)
    (define-key map "\M-s" 'vc-comment-search-forward)
    (define-key map "\C-c\C-c" 'vc-finish-logentry)
    map))
;; Compatibility with old name.  Should we bother ?
(defvar vc-log-entry-mode vc-log-mode-map)
628

629

Eric S. Raymond's avatar
Eric S. Raymond committed
630 631
;; Variables the user doesn't need to know about.
(defvar vc-log-operation nil)
632
(defvar vc-log-after-operation-hook nil)
633
(defvar vc-annotate-buffers nil
634 635
  "Alist of current \"Annotate\" buffers and their corresponding backends.
The keys are \(BUFFER . BACKEND\).  See also `vc-annotate-get-backend'.")
Richard M. Stallman's avatar
Richard M. Stallman committed
636 637 638
;; 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).
639
(defvar vc-parent-buffer nil)
640
(put 'vc-parent-buffer 'permanent-local t)
641
(defvar vc-parent-buffer-name nil)
642
(put 'vc-parent-buffer-name 'permanent-local t)
Eric S. Raymond's avatar
Eric S. Raymond committed
643

644 645 646
(defvar vc-log-file)
(defvar vc-log-version)

647
(defvar vc-dired-mode nil)
648 649
(make-variable-buffer-local 'vc-dired-mode)

650
(defvar vc-comment-ring (make-ring vc-maximum-comment-ring-size))
651
(defvar vc-comment-ring-index nil)
652
(defvar vc-last-comment-match "")
653

654 655 656
;;; functions that operate on RCS revision numbers.  This code should
;;; also be moved into the backends.  It stays for now, however, since
;;; it is used in code below.
657
(defun vc-trunk-p (rev)
658
  "Return t if REV is a revision on the trunk."
659 660
  (not (eq nil (string-match "\\`[0-9]+\\.[0-9]+\\'" rev))))

661
(defun vc-branch-p (rev)
662
  "Return t if REV is a branch revision."
663 664
  (not (eq nil (string-match "\\`[0-9]+\\(\\.[0-9]+\\.[0-9]+\\)*\\'" rev))))

665
(defun vc-branch-part (rev)
666
  "Return the branch part of a revision number REV."
667 668
  (substring rev 0 (string-match "\\.[0-9]+\\'" rev)))

669
(defun vc-minor-part (rev)
670
  "Return the minor version number of a revision number REV."
671 672 673 674
  (string-match "[0-9]+\\'" rev)
  (substring rev (match-beginning 0) (match-end 0)))

(defun vc-previous-version (rev)
675
  "Guess the version number immediately preceding REV."
676 677 678 679 680 681 682 683 684 685 686 687 688
  (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
689 690
;; File property caching

691 692 693 694 695 696
(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.
697
  (setq vc-comment-ring (make-ring vc-maximum-comment-ring-size)))
698

699
(defmacro with-vc-properties (file form settings)
700 701 702 703
  "Execute FORM, then set per-file properties for FILE,
but only those that have not been set during the execution of FORM.
SETTINGS is a list of two-element lists, each of which has the
  form (PROPERTY . VALUE)."
704 705 706 707
  `(let ((vc-touched-properties (list t))
	 (filename ,file))
     ,form
     (mapcar (lambda (setting)
708
	       (let ((property (car setting)))
709
		 (unless (memq property vc-touched-properties)
710
		   (put (intern filename vc-file-prop-obarray)
711
			property (cdr setting)))))
712 713
	     ,settings)))

Eric S. Raymond's avatar
Eric S. Raymond committed
714 715
;; Random helper functions

716 717
(defsubst vc-editable-p (file)
  (or (eq (vc-checkout-model file) 'implicit)
718
      (memq (vc-state file) '(edited needs-merge))))
719

720 721 722
;;; Two macros for elisp programming
;;;###autoload
(defmacro with-vc-file (file comment &rest body)
723 724 725 726
  "Check out a writable copy of FILE if necessary and execute the body.
Check in FILE with COMMENT (a string) after BODY has been executed.
FILE is passed through `expand-file-name'; BODY executed within
`save-excursion'.  If FILE is not under version control, or locked by
727 728
somebody else, signal error."
  `(let ((file (expand-file-name ,file)))
729
     (or (vc-backend file)
730
	 (error (format "File not under version control: `%s'" file)))
731 732 733 734
     (unless (vc-editable-p file)
       (let ((state (vc-state file)))
	 (if (stringp state) (error (format "`%s' is locking `%s'" state file))
	   (vc-checkout file t))))
735 736 737
     (save-excursion
       ,@body)
     (vc-checkin file nil ,comment)))
738
(put 'with-vc-file 'indent-function 1)
739 740 741

;;;###autoload
(defmacro edit-vc-file (file comment &rest body)
742 743
  "Edit FILE under version control, executing body.
Checkin with COMMENT after executing BODY.
744 745 746 747
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
748
    (set-buffer (find-file-noselect ,file))
749 750
    ,@body
    (save-buffer)))
751
(put 'edit-vc-file 'indent-function 1)
752

753
(defun vc-ensure-vc-buffer ()
754
  "Make sure that the current buffer visits a version-controlled file."
755 756 757 758 759 760 761 762
  (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))))))
763

Eric S. Raymond's avatar
Eric S. Raymond committed
764
(defvar vc-binary-assoc nil)
765 766 767 768
(defvar vc-binary-suffixes
  (if (memq system-type '(ms-dos windows-nt))
      '(".exe" ".com" ".bat" ".cmd" ".btm" "")
    '("")))
769 770

(defun vc-process-filter (p s)
771
  "An alternative output filter for async process P.
772 773 774 775 776 777 778 779 780
The only difference with the default filter is to insert S after markers."
  (with-current-buffer (process-buffer p)
    (save-excursion
      (let ((inhibit-read-only t))
	(goto-char (process-mark p))
	(insert s)
	(set-marker (process-mark p) (point))))))

(defun vc-setup-buffer (&optional buf)
781
  "Prepare BUF for executing a VC command and make it the current buffer.
782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813
BUF defaults to \"*vc*\", can be a string and will be created if necessary."
  (unless buf (setq buf "*vc*"))
  (let ((camefrom (current-buffer))
	(olddir default-directory))
    (set-buffer (get-buffer-create buf))
    (kill-all-local-variables)
    (set (make-local-variable 'vc-parent-buffer) camefrom)
    (set (make-local-variable 'vc-parent-buffer-name)
	 (concat " from " (buffer-name camefrom)))
    (setq default-directory olddir)
    (let ((inhibit-read-only t))
      (erase-buffer))))

(defun vc-exec-after (code)
  "Eval CODE when the current buffer's process is done.
If the current buffer has no process, just evaluate CODE.
Else, add CODE to the process' sentinel."
  (let ((proc (get-buffer-process (current-buffer))))
    (cond
     ;; If there's no background process, just execute the code.
     ((null proc) (eval code))
     ;; If the background process has exited, reap it and try again
     ((eq (process-status proc) 'exit)
      (delete-process proc)
      (vc-exec-after code))
     ;; If a process is running, add CODE to the sentinel
     ((eq (process-status proc) 'run)
      (let ((sentinel (process-sentinel proc)))
	(set-process-sentinel proc
	  `(lambda (p s)
	     (with-current-buffer ',(current-buffer)
	       (goto-char (process-mark p))
814
	       ,@(append (cdr (cdr (cdr ;strip off `with-current-buffer buf
815 816 817 818 819 820 821 822 823 824 825 826 827
                                        ;             (goto-char...)'
			   (car (cdr (cdr ;strip off `lambda (p s)'
			    sentinel))))))
			 (list `(vc-exec-after ',code))))))))
     (t (error "Unexpected process state"))))
  nil)

(defvar vc-post-command-functions nil
  "Hook run at the end of `vc-do-command'.
Each function is called inside the buffer in which the command was run
and is passed 3 argument: the COMMAND, the FILE and the FLAGS.")

(defun vc-do-command (buffer okstatus command file &rest flags)
828
  "Execute a version control command, notifying user and checking for errors.
829 830 831 832 833 834 835 836
Output from COMMAND goes to BUFFER, or *vc* if BUFFER is nil or the
current buffer if BUFFER is t.  If the destination buffer is not
already current, set it up properly and erase it.  The command is
considered successful if its exit status does not exceed OKSTATUS (if
OKSTATUS is nil, that means to ignore errors, if it is 'async, that
means not to wait for termination of the subprocess).  FILE is the
name of the working file (may also be nil, to execute commands that
don't expect a file name).  If an optional list of FLAGS is present,
837
that is inserted into the command line before the filename."
838
  (and file (setq file (expand-file-name file)))
Eric S. Raymond's avatar
Eric S. Raymond committed
839
  (if vc-command-messages
840
      (message "Running %s on %s..." command file))
841
  (save-current-buffer
842 843 844 845 846
    (unless (or (eq buffer t)
                (and (stringp buffer)
                     (string= (buffer-name) buffer))
                (eq buffer (current-buffer)))
      (vc-setup-buffer buffer))
847 848 849 850 851 852 853 854 855 856 857 858 859 860 861 862 863 864 865 866
    (let ((squeezed nil)
	  (inhibit-read-only t)
	  (status 0))
      (setq squeezed (delq nil (copy-sequence flags)))
      (when file
	;; FIXME: file-relative-name can return a bogus result because
	;; it doesn't look at the actual file-system to see if symlinks
	;; come into play.
	(setq squeezed (append squeezed (list (file-relative-name file)))))
      (let ((exec-path (append vc-path exec-path))
	    ;; Add vc-path to PATH for the execution of this command.
	    (process-environment
	     (cons (concat "PATH=" (getenv "PATH")
			   path-separator
			   (mapconcat 'identity vc-path path-separator))
		   process-environment))
	    (w32-quote-process-args t))
	(if (eq okstatus 'async)
	    (let ((proc (apply 'start-process command (current-buffer) command
			       squeezed)))
867 868
              (unless (active-minibuffer-window)
                (message "Running %s in the background..." command))
869 870 871
	      ;;(set-process-sentinel proc (lambda (p msg) (delete-process p)))
	      (set-process-filter proc 'vc-process-filter)
	      (vc-exec-after
872 873
	       `(unless (active-minibuffer-window)
                  (message "Running %s in the background... done" ',command))))
874 875 876 877 878 879 880 881 882 883 884 885
	  (setq status (apply 'call-process command nil t nil squeezed))
	  (when (or (not (integerp status)) (and okstatus (< okstatus status)))
	    (pop-to-buffer (current-buffer))
	    (goto-char (point-min))
	    (shrink-window-if-larger-than-buffer)
	    (error "Running %s...FAILED (%s)" command
		   (if (integerp status) (format "status %d" status) status))))
	(if vc-command-messages
	    (message "Running %s...OK" command)))
      (vc-exec-after
       `(run-hook-with-args 'vc-post-command-functions ',command ',file ',flags))
      status)))
Eric S. Raymond's avatar
Eric S. Raymond committed
886

887
(defun vc-position-context (posn)
888 889 890
  "Save a bit of the text around POSN in the current buffer.
Used to help us find the corresponding position again later
if markers are destroyed or corrupted."
891 892
  ;; A lot of this was shamelessly lifted from Sebastian Kremer's
  ;; rcs.el mode.
893 894 895 896 897 898
  (list posn
	(buffer-size)
	(buffer-substring posn
			  (min (point-max) (+ posn 100)))))

(defun vc-find-position-by-context (context)
899
  "Return the position of CONTEXT in the current buffer, or nil if not found."
900 901 902 903 904 905 906 907 908 909 910 911 912 913 914 915 916
  (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))))))))

917
(defun vc-context-matches-p (posn context)
918
  "Return t if POSN matches CONTEXT, nil otherwise."
919 920 921 922 923 924 925
  (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)))))

926
(defun vc-buffer-context ()
927 928
  "Return a list (POINT-CONTEXT MARK-CONTEXT REPARSE).
Used by `vc-restore-buffer-context' to later restore the context."
929
  (let ((point-context (vc-position-context (point)))
930 931 932 933
	;; 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.
934 935 936 937 938 939 940 941
	(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
942
			  (mapcar (lambda (buffer)
943 944 945 946 947
				    (set-buffer buffer)
				    (let ((errors (or
						   compilation-old-error-list
						   compilation-error-list))
					  (buffer-error-marked-p nil))
948
				      (while (and (consp errors)
949
						  (not buffer-error-marked-p))
950
					(and (markerp (cdr (car errors)))
951 952
					     (eq buffer
						 (marker-buffer
953
						  (cdr (car errors))))
954
					     (setq buffer-error-marked-p t))
955
					(setq errors (cdr errors)))
956
				      (if buffer-error-marked-p buffer)))
957
				  (buffer-list)))))))
958 959 960
    (list point-context mark-context reparse)))

(defun vc-restore-buffer-context (context)
961
  "Restore point/mark, and reparse any affected compilation buffers.
962
CONTEXT is that which `vc-buffer-context' returns."
963 964 965
  (let ((point-context (nth 0 context))
	(mark-context (nth 1 context))
	(reparse (nth 2 context)))
966 967 968
    ;; Reparse affected compilation buffers.
    (while reparse
      (if (car reparse)
969
	  (with-current-buffer (car reparse)
970 971 972 973 974 975 976 977 978 979
	    (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
980
			  (/= error-pos (car (car compilation-error-list))))
981 982
		(setq compilation-error-list (cdr compilation-error-list))))))
      (setq reparse (cdr reparse)))
983

984 985 986 987
    ;; 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))))
988 989 990 991 992
    (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))))))
993

994
(defun vc-revert-buffer1 (&optional arg no-confirm)
995 996 997 998
  "Revert buffer, trying to keep point and mark where user expects them.
Tries to be clever in the face of changes due to expanded version control
key words.  This is important for typeahead to work as expected.
ARG and NO-CONFIRM are passed on to `revert-buffer'."
999 1000 1001
  (interactive "P")
  (widen)
  (let ((context (vc-buffer-context)))
1002 1003
    ;; Use save-excursion here, because it may be able to restore point
    ;; and mark properly even in cases where vc-restore-buffer-context
1004
    ;; would fail.  However, save-excursion might also get it wrong --
1005 1006
    ;; in this case, vc-restore-buffer-context gives it a second try.
    (save-excursion
1007
      ;; t means don't call normal-mode;
1008 1009
      ;; that's to preserve various minor modes.
      (revert-buffer arg no-confirm t))
1010 1011
    (vc-restore-buffer-context context)))

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

1013
(defun vc-buffer-sync (&optional not-urgent)
1014
  "Make sure the current buffer and its working file are in sync.
1015
NOT-URGENT means it is ok to continue if the user says not to save."
1016
  (if (buffer-modified-p)
1017 1018 1019
      (if (or vc-suppress-confirm
	      (y-or-n-p (format "Buffer %s modified; save it? " (buffer-name))))
	  (save-buffer)
1020
	(unless not-urgent
1021 1022
	  (error "Aborted")))))

André Spiegel's avatar
André Spiegel committed
1023 1024 1025 1026 1027 1028 1029 1030 1031 1032
(defun vc-workfile-unchanged-p (file)
  "Has FILE changed since last checkout?"
  (let ((checkout-time (vc-file-getprop file 'vc-checkout-time))
        (lastmod (nth 5 (file-attributes file))))
    (if checkout-time
        (equal checkout-time lastmod)
      (let ((unchanged (vc-call workfile-unchanged-p file)))
        (vc-file-setprop file 'vc-checkout-time (if unchanged lastmod 0))
        unchanged))))

1033
(defun vc-default-workfile-unchanged-p (backend file)
André Spiegel's avatar
André Spiegel committed
1034 1035 1036
  "Default check whether FILE is unchanged: diff against master version."
  (zerop (vc-call diff file (vc-workfile-version file))))

1037
(defun vc-default-latest-on-branch-p (backend file)
1038 1039 1040 1041
  "Default check whether the current workfile version of FILE is the 
latest on its branch."
  t)

1042 1043 1044 1045 1046
(defun vc-recompute-state (file)
  "Force a recomputation of the version control state of FILE.
The state is computed using the exact, and possibly expensive
function `vc-BACKEND-state', not the heuristic."
  (vc-file-setprop file 'vc-state (vc-call state file)))
1047

1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059
(defun vc-next-action-on-file (file verbose &optional comment)
  "Do The Right Thing for a given version-controlled FILE.
If COMMENT is specified, it will be used as an admin or checkin comment.
If VERBOSE is non-nil, query the user rather than using default parameters."
  (let ((visited (get-file-buffer file))
	state version)
    (when visited
      ;; Check relation of buffer and file, and make sure
      ;; user knows what he's doing.  First, finding the file
      ;; will check whether the file on disk is newer.
      (if vc-dired-mode
	  (find-file-other-window file)
1060
	(set-buffer (find-file-noselect file)))
1061 1062 1063 1064 1065 1066 1067 1068 1069
      (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"))
	;; Now, check if we have unsaved changes.
	(vc-buffer-sync t)
	(if (buffer-modified-p)
	    (or (y-or-n-p "Operate on disk file, keeping modified buffer? ")
		(error "Aborted")))))
1070

1071
    ;; Do the right thing
1072
    (if (not (vc-registered file))
1073 1074
	(vc-register verbose comment)
      (vc-recompute-state file)
1075
      (if visited (vc-mode-line file))
1076 1077 1078 1079 1080 1081 1082 1083
      (setq state (vc-state file))
      (cond
       ;; up-to-date
       ((or (eq state 'up-to-date)
	    (and verbose (eq state 'needs-patch)))
	(cond
	 (verbose
	  ;; go to a different version
1084
	  (setq version
1085
		(read-string "Branch, version, or backend to move to: "))
1086
	  (let ((vsym (intern-soft (upcase version))))
1087 1088
	    (if (member vsym vc-handled-backends)
		(vc-transfer-file file vsym)
1089
	      (vc-checkout file (eq (vc-checkout-model file) 'implicit)
1090
			   version))))
1091 1092 1093 1094