(Fw32_battery_status): Fix computation of %t (h:min) format.
[bpt/emacs.git] / lisp / vc.el
CommitLineData
66321b2f 1;;; vc.el --- drive a version-control system from within Emacs
594722a8 2
0d30b337 3;; Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 2000,
f52749ed
GM
4;; 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008
5;; Free Software Foundation, Inc.
594722a8 6
0e362f54
GM
7;; Author: FSF (see below for full credits)
8;; Maintainer: Andre Spiegel <spiegel@gnu.org>
284b3043 9;; Keywords: tools
594722a8
ER
10
11;; This file is part of GNU Emacs.
12
13;; GNU Emacs is free software; you can redistribute it and/or modify
14;; it under the terms of the GNU General Public License as published by
b4aa6026 15;; the Free Software Foundation; either version 3, or (at your option)
594722a8
ER
16;; any later version.
17
18;; GNU Emacs is distributed in the hope that it will be useful,
19;; but WITHOUT ANY WARRANTY; without even the implied warranty of
20;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
21;; GNU General Public License for more details.
22
23;; You should have received a copy of the GNU General Public License
b578f267 24;; along with GNU Emacs; see the file COPYING. If not, write to the
086add15
LK
25;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
26;; Boston, MA 02110-1301, USA.
594722a8 27
0e362f54
GM
28;;; Credits:
29
30;; VC was initially designed and implemented by Eric S. Raymond
61de26cb 31;; <esr@thyrsus.com> in 1992. Over the years, many other people have
0e362f54 32;; contributed substantial amounts of work to VC. These include:
61de26cb 33;;
0e362f54
GM
34;; Per Cederqvist <ceder@lysator.liu.se>
35;; Paul Eggert <eggert@twinsun.com>
36;; Sebastian Kremer <sk@thp.uni-koeln.de>
37;; Martin Lorentzson <martinl@gnu.org>
166a0ef7 38;; Dave Love <fx@gnu.org>
0e362f54 39;; Stefan Monnier <monnier@cs.yale.edu>
7fbb4797
DN
40;; Thien-Thi Nguyen <ttn@gnu.org>
41;; Dan Nicolaescu <dann@ics.uci.edu>
6f1ecae4 42;; J.D. Smith <jdsmith@alum.mit.edu>
0e362f54
GM
43;; Andre Spiegel <spiegel@gnu.org>
44;; Richard Stallman <rms@gnu.org>
61de26cb
ER
45;;
46;; In July 2007 ESR returned and redesigned the mode to cope better
47;; with modern version-control systems that do commits by fileset
48;; rather than per individual file.
49;;
50;; Features in the new version:
51;; * Key commands (vc-next-action = C-x v v, vc-print-log = C-x v l, vc-revert
a7192ddb 52;; = C-x v u, vc-rollback = C-x v c, vc-diff = C-x v =, vc-update = C-x v +)
61de26cb
ER
53;; now operate on filesets rather than individual files.
54;; * The fileset for a command is either (a) all marked files in VC-dired
55;; mode, (b) the currently visited file if it's under version control,
56;; or (c) the current directory if the visited buffer is not under
a7192ddb 57;; version control and a wildcarding-enable flag has been set.
61de26cb 58;;
a7192ddb
SM
59;; If you maintain a client of the mode or customize it in your .emacs,
60;; note that some backend functions which formerly took single file arguments
61de26cb
ER
61;; now take a list of files. These include: register, checkin, print-log,
62;; rollback, and diff.
0e362f54 63
594722a8
ER
64;;; Commentary:
65
1a2f456b
ER
66;; This mode is fully documented in the Emacs user's manual.
67;;
c0edfa75 68;; Supported version-control systems presently include CVS, RCS, GNU
5e8c0b8b
DN
69;; Arch, Subversion, Bzr, Git, Mercurial, Meta-CVS, Monotone and SCCS
70;; (or its free replacement, CSSC).
b0c9bc8c
AS
71;;
72;; Some features will not work with old RCS versions. Where
73;; appropriate, VC finds out which version you have, and allows or
0e362f54 74;; disallows those features (stealing locks, for example, works only
b0c9bc8c 75;; from 5.6.2 onwards).
632e9525
RS
76;; Even initial checkins will fail if your RCS version is so old that ci
77;; doesn't understand -t-; this has been known to happen to people running
0e362f54 78;; NExTSTEP 3.0.
594722a8 79;;
0e362f54 80;; You can support the RCS -x option by customizing vc-rcs-master-templates.
594722a8
ER
81;;
82;; Proper function of the SCCS diff commands requires the shellscript vcdiff
83;; to be installed somewhere on Emacs's path for executables.
84;;
1a2f456b 85;; If your site uses the ChangeLog convention supported by Emacs, the
93a142e1
DN
86;; function `log-edit-comment-to-change-log' could prove a useful checkin hook,
87;; although you might prefer to use C-c C-a (i.e. `log-edit-insert-changelog')
1cca5da4 88;; from the commit buffer instead or to set `log-edit-setup-invert'.
1a2f456b 89;;
594722a8
ER
90;; The vc code maintains some internal state in order to reduce expensive
91;; version-control operations to a minimum. Some names are only computed
3b37b179 92;; once. If you perform version control operations with the backend while
594722a8
ER
93;; vc's back is turned, or move/rename master files while vc is running,
94;; vc may get seriously confused. Don't do these things!
95;;
96;; Developer's notes on some concurrency issues are included at the end of
97;; the file.
0e362f54 98;;
fcb500ea
AS
99;; ADDING SUPPORT FOR OTHER BACKENDS
100;;
101;; VC can use arbitrary version control systems as a backend. To add
102;; support for a new backend named SYS, write a library vc-sys.el that
103;; contains functions of the form `vc-sys-...' (note that SYS is in lower
104;; case for the function and library names). VC will use that library if
105;; you put the symbol SYS somewhere into the list of
106;; `vc-handled-backends'. Then, for example, if `vc-sys-registered'
107;; returns non-nil for a file, all SYS-specific versions of VC commands
108;; will be available for that file.
109;;
110;; VC keeps some per-file information in the form of properties (see
111;; vc-file-set/getprop in vc-hooks.el). The backend-specific functions
112;; do not generally need to be aware of these properties. For example,
ac3f4c6f 113;; `vc-sys-working-revision' should compute the working revision and
fcb500ea
AS
114;; return it; it should not look it up in the property, and it needn't
115;; store it there either. However, if a backend-specific function does
116;; store a value in a property, that value takes precedence over any
99cb8c8b 117;; value that the generic code might want to set (check for uses of
fcb500ea
AS
118;; the macro `with-vc-properties' in vc.el).
119;;
120;; In the list of functions below, each identifier needs to be prepended
121;; with `vc-sys-'. Some of the functions are mandatory (marked with a
122;; `*'), others are optional (`-').
123;;
8cdd17b4
ER
124;; BACKEND PROPERTIES
125;;
126;; * revision-granularity
127;;
61de26cb
ER
128;; Takes no arguments. Returns either 'file or 'repository. Backends
129;; that return 'file have per-file revision numbering; backends
130;; that return 'repository have per-repository revision numbering,
131;; so a revision level implicitly identifies a changeset
a7192ddb 132;;
fcb500ea
AS
133;; STATE-QUERYING FUNCTIONS
134;;
0e362f54 135;; * registered (file)
fcb500ea 136;;
37a5e97a 137;; Return non-nil if FILE is registered in this backend. Both this
73770b03
DN
138;; function as well as `state' should be careful to fail gracefully
139;; in the event that the backend executable is absent. It is
140;; preferable that this function's body is autoloaded, that way only
141;; calling vc-registered does not cause the backend to be loaded
142;; (all the vc-FOO-registered functions are called to try to find
143;; the controlling backend for FILE.
fcb500ea 144;;
99cb8c8b 145;; * state (file)
fcb500ea
AS
146;;
147;; Return the current version control state of FILE. For a list of
148;; possible values, see `vc-state'. This function should do a full and
149;; reliable state computation; it is usually called immediately after
150;; C-x v v. If you want to use a faster heuristic when visiting a
3702367b
ER
151;; file, put that into `state-heuristic' below. Note that under most
152;; VCSes this won't be called at all, dir-state or dir-stus is used instead.
fcb500ea 153;;
0e362f54 154;; - state-heuristic (file)
fcb500ea
AS
155;;
156;; If provided, this function is used to estimate the version control
157;; state of FILE at visiting time. It should be considerably faster
158;; than the implementation of `state'. For a list of possible values,
159;; see the doc string of `vc-state'.
160;;
0e362f54 161;; - dir-state (dir)
fcb500ea 162;;
484c1b1f 163;; If provided, this function is used to find the version control
df49d02e 164;; state of as many files as possible in DIR, and all subdirectories
484c1b1f
ER
165;; of DIR, in a fast way; it is used to avoid expensive indivitual
166;; vc-state calls. The function should not return anything, but
55adbcc2
DN
167;; rather store the files' states into the corresponding properties.
168;; Two properties are required: `vc-backend' and `vc-state'. (Note:
169;; in older versions this method was not required to recurse into
170;; subdirectories.)
fcb500ea 171;;
c1b51374 172;; - dir-status (dir update-function)
00ca5ce2 173;;
1b3f2d4e
DN
174;; Produce RESULT: a list of lists of the form (FILE VC-STATE EXTRA)
175;; for the files in DIR.
176;; EXTRA can be used for backend specific information about FILE.
177;; If a command needs to be run to compute this list, it should be
178;; run asynchronously using (current-buffer) as the buffer for the
179;; command. When RESULT is computed, it should be passed back by
c1b51374 180;; doing: (funcall UPDATE-FUNCTION RESULT nil).
d63aa41f 181;; If the backend uses a process filter, hence it produces partial results,
5a84a937 182;; they can be passed back by doing:
c1b51374
SM
183;; (funcall UPDATE-FUNCTION RESULT t)
184;; and then do a (funcall UPDATE-FUNCTION RESULT nil)
5a84a937 185;; when all the results have been computed.
e1aec6fb 186;; To provide more backend specific functionality for `vc-dir'
5a84a937 187;; the following functions might be needed: `status-extra-headers',
fb0ac090 188;; `status-printer', `extra-status-menu' and `dir-status-files'.
e1aec6fb
SM
189;; This function is used by `vc-dir', a replacement for
190;; `vc-dired'. vc-dir is still under development, and is NOT
5a84a937
DN
191;; feature complete. As such, the requirements for this function
192;; might change. This is a replacement for `dir-state'.
00ca5ce2 193;;
fb0ac090
AJ
194;; - dir-status-files (dir files default-state update-function)
195;;
196;; This function is identical to dir-status except that it should
197;; only report status for the specified FILES. Also it needs to
198;; report on all requested files, including up-to-date or ignored
199;; files. If not provided, the default is to consider that the files
200;; are in DEFAULT-STATE.
201;;
15c5c970 202;; - status-extra-headers (dir)
115c0061 203;;
e1aec6fb 204;; Return a string that will be added to the *vc-dir* buffer header.
15c5c970 205;;
58f10bff
DN
206;; - status-printer (fileinfo)
207;;
e1aec6fb 208;; Pretty print the `vc-dir-fileinfo' FILEINFO.
58f10bff 209;; If a backend needs to show more information than the default FILE
e1aec6fb
SM
210;; and STATE in the vc-dir listing, it can store that extra
211;; information in `vc-dir-fileinfo->extra'. This function can be
212;; used to display that extra information in the *vc-dir* buffer.
58f10bff 213;;
5a84a937
DN
214;; - status-fileinfo-extra (file)
215;;
e1aec6fb 216;; Compute `vc-dir-fileinfo->extra' for FILE.
5a84a937 217;;
ac3f4c6f 218;; * working-revision (file)
fcb500ea 219;;
ac3f4c6f 220;; Return the working revision of FILE. This is the revision fetched
61de26cb 221;; by the last checkout or upate, not necessarily the same thing as the
a7192ddb 222;; head or tip revision. Should return "0" for a file added but not yet
61de26cb 223;; committed.
fcb500ea
AS
224;;
225;; - latest-on-branch-p (file)
226;;
ac3f4c6f
ER
227;; Return non-nil if the working revision of FILE is the latest revision
228;; on its branch (many VCSes call this the 'tip' or 'head' revision).
0d0e9356 229;; The default implementation always returns t, which means that
ac3f4c6f 230;; working with non-current revisions is not supported by default.
fcb500ea 231;;
e0607aaa 232;; * checkout-model (files)
fcb500ea 233;;
e0607aaa 234;; Indicate whether FILES need to be "checked out" before they can be
fcb500ea
AS
235;; edited. See `vc-checkout-model' for a list of possible values.
236;;
aae91380 237;; - workfile-unchanged-p (file)
fcb500ea 238;;
ac3f4c6f
ER
239;; Return non-nil if FILE is unchanged from the working revision.
240;; This function should do a brief comparison of FILE's contents
241;; with those of the repository master of the working revision. If
242;; the backend does not have such a brief-comparison feature, the
243;; default implementation of this function can be used, which
244;; delegates to a full vc-BACKEND-diff. (Note that vc-BACKEND-diff
245;; must not run asynchronously in this case, see variable
0d0e9356 246;; `vc-disable-async-diff'.)
fcb500ea 247;;
0e362f54 248;; - mode-line-string (file)
fcb500ea 249;;
3a12f9f8 250;; If provided, this function should return the VC-specific mode
a7192ddb 251;; line string for FILE. The returned string should have a
3a12f9f8
DN
252;; `help-echo' property which is the text to be displayed as a
253;; tooltip when the mouse hovers over the VC entry on the mode-line.
254;; The default implementation deals well with all states that
255;; `vc-state' can return.
fcb500ea 256;;
0a299408 257;; - prettify-state-info (file)
fcb500ea
AS
258;;
259;; Translate the `vc-state' property of FILE into a string that can be
0a299408 260;; used in a human-readable buffer. The default implementation deals well
fcb500ea
AS
261;; with all states that `vc-state' can return.
262;;
263;; STATE-CHANGING FUNCTIONS
264;;
61de26cb 265;; * create-repo (backend)
8cdd17b4 266;;
a7192ddb
SM
267;; Create an empty repository in the current directory and initialize
268;; it so VC mode can add files to it. For file-oriented systems, this
8cdd17b4
ER
269;; need do no more than create a subdirectory with the right name.
270;;
271;; * register (files &optional rev comment)
fcb500ea 272;;
8cdd17b4
ER
273;; Register FILES in this backend. Optionally, an initial revision REV
274;; and an initial description of the file, COMMENT, may be specified,
275;; but it is not guaranteed that the backend will do anything with this.
ecd50f65 276;; The implementation should pass the value of vc-register-switches
a7192ddb 277;; to the backend command. (Note: in older versions of VC, this
8cdd17b4 278;; command took a single file argument and not a list.)
fcb500ea 279;;
ac3f4c6f 280;; - init-revision (file)
b470cb65 281;;
ac3f4c6f 282;; The initial revision to use when registering FILE if one is not
b470cb65 283;; specified by the user. If not provided, the variable
ac3f4c6f 284;; vc-default-init-revision is used instead.
b470cb65 285;;
099bd78a 286;; - responsible-p (file)
fcb500ea
AS
287;;
288;; Return non-nil if this backend considers itself "responsible" for
289;; FILE, which can also be a directory. This function is used to find
290;; out what backend to use for registration of new files and for things
291;; like change log generation. The default implementation always
292;; returns nil.
293;;
0e362f54 294;; - could-register (file)
fcb500ea
AS
295;;
296;; Return non-nil if FILE could be registered under this backend. The
297;; default implementation always returns t.
298;;
aae91380 299;; - receive-file (file rev)
fcb500ea
AS
300;;
301;; Let this backend "receive" a file that is already registered under
302;; another backend. The default implementation simply calls `register'
303;; for FILE, but it can be overridden to do something more specific,
304;; e.g. keep revision numbers consistent or choose editing modes for
305;; FILE that resemble those of the other backend.
306;;
307;; - unregister (file)
308;;
309;; Unregister FILE from this backend. This is only needed if this
310;; backend may be used as a "more local" backend for temporary editing.
311;;
8cdd17b4 312;; * checkin (files rev comment)
fcb500ea 313;;
8cdd17b4
ER
314;; Commit changes in FILES to this backend. If REV is non-nil, that
315;; should become the new revision number (not all backends do
316;; anything with it). COMMENT is used as a check-in comment. The
317;; implementation should pass the value of vc-checkin-switches to
a7192ddb 318;; the backend command. (Note: in older versions of VC, this
8cdd17b4 319;; command took a single file argument and not a list.)
fcb500ea 320;;
ac3f4c6f 321;; * find-revision (file rev buffer)
fd8160f7
SM
322;;
323;; Fetch revision REV of file FILE and put it into BUFFER.
324;; If REV is the empty string, fetch the head of the trunk.
325;; The implementation should pass the value of vc-checkout-switches
326;; to the backend command.
327;;
9e6da495 328;; * checkout (file &optional editable rev)
fcb500ea
AS
329;;
330;; Check out revision REV of FILE into the working area. If EDITABLE
331;; is non-nil, FILE should be writable by the user and if locking is
332;; used for FILE, a lock should also be set. If REV is non-nil, that
ac3f4c6f 333;; is the revision to check out (default is the working revision).
4279775b
AS
334;; If REV is t, that means to check out the head of the current branch;
335;; if it is the empty string, check out the head of the trunk.
336;; The implementation should pass the value of vc-checkout-switches
fd8160f7 337;; to the backend command.
fcb500ea 338;;
bbfc07d3 339;; * revert (file &optional contents-done)
fcb500ea 340;;
ac3f4c6f 341;; Revert FILE back to the working revision. If optional
bbfc07d3
AS
342;; arg CONTENTS-DONE is non-nil, then the contents of FILE have
343;; already been reverted from a version backup, and this function
344;; only needs to update the status of FILE within the backend.
fcb500ea 345;;
8cdd17b4 346;; - rollback (files)
fcb500ea 347;;
ac3f4c6f
ER
348;; Remove the tip revision of each of FILES from the repository. If
349;; this function is not provided, trying to cancel a revision is
8cdd17b4
ER
350;; caught as an error. (Most backends don't provide it.) (Also
351;; note that older versions of this backend command were called
352;; 'cancel-version' and took a single file arg, not a list of
353;; files.)
fcb500ea 354;;
aae91380 355;; - merge (file rev1 rev2)
fcb500ea
AS
356;;
357;; Merge the changes between REV1 and REV2 into the current working file.
358;;
aae91380 359;; - merge-news (file)
fcb500ea
AS
360;;
361;; Merge recent changes from the current branch into FILE.
362;;
ac3f4c6f 363;; - steal-lock (file &optional revision)
fcb500ea 364;;
ac3f4c6f 365;; Steal any lock on the working revision of FILE, or on REVISION if
0d0e9356
ER
366;; that is provided. This function is only needed if locking is
367;; used for files under this backend, and if files can indeed be
368;; locked by other users.
fcb500ea 369;;
9b64a7f0
ER
370;; - modify-change-comment (files rev comment)
371;;
df49d02e 372;; Modify the change comments associated with the files at the
9b64a7f0
ER
373;; given revision. This is optional, many backends do not support it.
374;;
7fbb4797
DN
375;; - mark-resolved (files)
376;;
377;; Mark conflicts as resolved. Some VC systems need to run a
378;; command to mark conflicts as resolved.
379;;
fcb500ea
AS
380;; HISTORY FUNCTIONS
381;;
8cdd17b4 382;; * print-log (files &optional buffer)
fcb500ea 383;;
8cdd17b4
ER
384;; Insert the revision log for FILES into BUFFER, or the *vc* buffer
385;; if BUFFER is nil. (Note: older versions of this function expected
386;; only a single file argument.)
fcb500ea 387;;
37a5e97a
SM
388;; - log-view-mode ()
389;;
390;; Mode to use for the output of print-log. This defaults to
391;; `log-view-mode' and is expected to be changed (if at all) to a derived
392;; mode of `log-view-mode'.
393;;
ac3f4c6f 394;; - show-log-entry (revision)
fcb500ea 395;;
ac3f4c6f 396;; If provided, search the log entry for REVISION in the current buffer,
fcb500ea
AS
397;; and make sure it is displayed in the buffer's window. The default
398;; implementation of this function works for RCS-style logs.
399;;
aae91380 400;; - wash-log (file)
fcb500ea 401;;
61de26cb 402;; Remove all non-comment information from the output of print-log.
fcb500ea 403;;
aae91380 404;; - comment-history (file)
fcb500ea 405;;
d6ba9c39 406;; Return a string containing all log entries that were made for FILE.
fcb500ea
AS
407;; This is used for transferring a file from one backend to another,
408;; retaining comment information. The default implementation of this
409;; function does this by calling print-log and then wash-log, and
410;; returning the resulting buffer contents as a string.
411;;
aae91380 412;; - update-changelog (files)
fcb500ea
AS
413;;
414;; Using recent log entries, create ChangeLog entries for FILES, or for
415;; all files at or below the default-directory if FILES is nil. The
416;; default implementation runs rcs2log, which handles RCS- and
417;; CVS-style logs.
418;;
d7b60083 419;; * diff (files &optional rev1 rev2 buffer)
fcb500ea 420;;
ac9ff209
AS
421;; Insert the diff for FILE into BUFFER, or the *vc-diff* buffer if
422;; BUFFER is nil. If REV1 and REV2 are non-nil, report differences
ac3f4c6f
ER
423;; from REV1 to REV2. If REV1 is nil, use the working revision (as
424;; found in the repository) as the older revision; if REV2 is nil,
425;; use the current working-copy contents as the newer revision. This
426;; function should pass the value of (vc-switches BACKEND 'diff) to
427;; the backend command. It should return a status of either 0 (no
428;; differences found), or 1 (either non-empty diff or the diff is
429;; run asynchronously).
fcb500ea 430;;
a7192ddb 431;; - revision-completion-table (files)
4d83a657 432;;
a7192ddb 433;; Return a completion table for existing revisions of FILES.
4d83a657
SM
434;; The default is to not use any completion table.
435;;
3c42cc64 436;; - annotate-command (file buf &optional rev)
fcb500ea 437;;
3c42cc64 438;; If this function is provided, it should produce an annotated display
ac3f4c6f 439;; of FILE in BUF, relative to revision REV. Annotation means each line
3c42cc64
TTN
440;; of FILE displayed is prefixed with version information associated with
441;; its addition (deleted lines leave no history) and that the text of the
442;; file is fontified according to age.
fcb500ea 443;;
75665141 444;; - annotate-time ()
fcb500ea
AS
445;;
446;; Only required if `annotate-command' is defined for the backend.
75665141
AS
447;; Return the time of the next line of annotation at or after point,
448;; as a floating point fractional number of days. The helper
449;; function `vc-annotate-convert-time' may be useful for converting
450;; multi-part times as returned by `current-time' and `encode-time'
0ff9b955 451;; to this format. Return nil if no more lines of annotation appear
75665141
AS
452;; in the buffer. You can safely assume that point is placed at the
453;; beginning of each line, starting at `point-min'. The buffer that
454;; point is placed in is the Annotate output, as defined by the
946b248f
TTN
455;; relevant backend. This function also affects how much of the line
456;; is fontified; where it leaves point is where fontification begins.
75665141
AS
457;;
458;; - annotate-current-time ()
459;;
460;; Only required if `annotate-command' is defined for the backend,
461;; AND you'd like the current time considered to be anything besides
cb223bba 462;; (vc-annotate-convert-time (current-time)) -- i.e. the current
75665141
AS
463;; time with hours, minutes, and seconds included. Probably safe to
464;; ignore. Return the current-time, in units of fractional days.
fcb500ea 465;;
1b5a7343
AS
466;; - annotate-extract-revision-at-line ()
467;;
468;; Only required if `annotate-command' is defined for the backend.
469;; Invoked from a buffer in vc-annotate-mode, return the revision
470;; corresponding to the current line, or nil if there is no revision
471;; corresponding to the current line.
472;;
fcb500ea
AS
473;; SNAPSHOT SYSTEM
474;;
0e362f54 475;; - create-snapshot (dir name branchp)
fcb500ea
AS
476;;
477;; Take a snapshot of the current state of files under DIR and name it
478;; NAME. This should make sure that files are up-to-date before
479;; proceeding with the action. DIR can also be a file and if BRANCHP
480;; is specified, NAME should be created as a branch and DIR should be
481;; checked out under this new branch. The default implementation does
482;; not support branches but does a sanity check, a tree traversal and
483;; for each file calls `assign-name'.
484;;
485;; - assign-name (file name)
486;;
ac3f4c6f 487;; Give name NAME to the working revision of FILE, assuming it is
fcb500ea
AS
488;; up-to-date. Only used by the default version of `create-snapshot'.
489;;
0e362f54 490;; - retrieve-snapshot (dir name update)
fcb500ea
AS
491;;
492;; Retrieve a named snapshot of all registered files at or below DIR.
493;; If UPDATE is non-nil, then update buffers of any files in the
494;; snapshot that are currently visited. The default implementation
495;; does a sanity check whether there aren't any uncommitted changes at
496;; or below DIR, and then performs a tree walk, using the `checkout'
ac3f4c6f 497;; function to retrieve the corresponding revisions.
fcb500ea
AS
498;;
499;; MISCELLANEOUS
500;;
f4263e47
TTN
501;; - root (dir)
502;;
503;; Return DIR's "root" directory, that is, a parent directory of
504;; DIR for which the same backend as used for DIR applies. If no
505;; such parent exists, this function should return DIR.
506;;
aae91380 507;; - make-version-backups-p (file)
fcb500ea 508;;
ac3f4c6f 509;; Return non-nil if unmodified repository revisions of FILE should be
fcb500ea
AS
510;; backed up locally. If this is done, VC can perform `diff' and
511;; `revert' operations itself, without calling the backend system. The
512;; default implementation always returns nil.
513;;
a36319a4
SM
514;; - repository-hostname (dirname)
515;;
516;; Return the hostname that the backend will have to contact
517;; in order to operate on a file in DIRNAME. If the return value
0452b6e7 518;; is nil, it means that the repository is local.
a36319a4
SM
519;; This function is used in `vc-stay-local-p' which backends can use
520;; for their convenience.
521;;
ac3f4c6f 522;; - previous-revision (file rev)
869131a5 523;;
ac3f4c6f
ER
524;; Return the revision number that precedes REV for FILE, or nil if no such
525;; revision exists.
1b5a7343 526;;
ac3f4c6f 527;; - next-revision (file rev)
1b5a7343 528;;
ac3f4c6f
ER
529;; Return the revision number that follows REV for FILE, or nil if no such
530;; revision exists.
869131a5 531;;
aae91380 532;; - check-headers ()
fcb500ea
AS
533;;
534;; Return non-nil if the current buffer contains any version headers.
535;;
aae91380 536;; - clear-headers ()
fcb500ea
AS
537;;
538;; In the current buffer, reset all version headers to their unexpanded
539;; form. This function should be provided if the state-querying code
540;; for this backend uses the version headers to determine the state of
541;; a file. This function will then be called whenever VC changes the
542;; version control state in such a way that the headers would give
543;; wrong information.
544;;
a36319a4
SM
545;; - delete-file (file)
546;;
547;; Delete FILE and mark it as deleted in the repository. If this
548;; function is not provided, the command `vc-delete-file' will
549;; signal an error.
550;;
099bd78a 551;; - rename-file (old new)
fcb500ea
AS
552;;
553;; Rename file OLD to NEW, both in the working area and in the
a36319a4
SM
554;; repository. If this function is not provided, the renaming
555;; will be done by (vc-delete-file old) and (vc-register new).
86a65190 556;;
6e54fa53
SM
557;; - find-file-hook ()
558;;
81c63b50 559;; Operation called in current buffer when opening a file. This can
6e54fa53 560;; be used by the backend to setup some local variables it might need.
cb223bba 561;;
81c63b50
SM
562;; - find-file-not-found-hook ()
563;;
564;; Operation called in current buffer when opening a non-existing file.
565;; By default, this asks the user if she wants to check out the file.
cb223bba
DN
566;;
567;; - extra-menu ()
568;;
569;; Return a menu keymap, the items in the keymap will appear at the
570;; end of the Version Control menu. The goal is to allow backends
571;; to specify extra menu items that appear in the VC menu. This way
572;; you can provide menu entries for functionality that is specific
573;; to your backend and which does not map to any of the VC generic
574;; concepts.
6656ecaa
DN
575;;
576;; - extra-status-menu ()
577;;
25a4ea6d
DN
578;; Return a menu keymap, the items in the keymap will appear at the
579;; end of the VC Status menu. The goal is to allow backends to
580;; specify extra menu items that appear in the VC Status menu. This
581;; makes it possible to provide menu entries for functionality that
582;; is specific to a backend and which does not map to any of the VC
583;; generic concepts.
aae91380 584
ba463d9e
DN
585;;; Todo:
586
ba463d9e
DN
587;; - vc-update/vc-merge should deal with VC systems that don't
588;; update/merge on a file basis, but on a whole repository basis.
589;;
fc30d544
DN
590;; - deal with push/pull operations.
591;;
592;; - "snapshots" should be renamed to "branches", and thoroughly reworked.
593;;
7fbb4797
DN
594;; - when a file is in `conflict' state, turn on smerge-mode.
595;;
596;; - figure out what to do with conflicts that are not caused by the
7a3c8d3a
ER
597;; file contents, but by metadata or other causes. Example: File A
598;; gets renamed to B in one branch and to C in another and you merge
599;; the two branches. Or you locally add file FOO and then pull a
600;; change that also adds a new file FOO, ...
ba463d9e 601;;
fc30d544
DN
602;; - add a generic mechanism for remembering the current branch names,
603;; display the branch name in the mode-line. Replace
604;; vc-cvs-sticky-tag with that.
605;;
7a3c8d3a
ER
606;; - C-x v b does switch to a different backend, but the mode line is not
607;; adapted accordingly. Also, it considers RCS and CVS to be the same,
608;; which is pretty confusing.
609;;
5a84a937 610;; - vc-diff should be able to show the diff for all files in a
7fbb4797
DN
611;; changeset, especially for VC systems that have per repository
612;; version numbers. log-view should take advantage of this.
5a84a937 613;;
fc30d544
DN
614;; - make it easier to write logs. Maybe C-x 4 a should add to the log
615;; buffer, if one is present, instead of adding to the ChangeLog.
ba463d9e 616;;
9b4ab1b4
ER
617;; - add a mechanism for editing the underlying VCS's list of files
618;; to be ignored, when that's possible.
3b3cb336 619;;
5bd20ee6
DN
620;; - When vc-next-action calls vc-checkin it could pre-fill the
621;; *VC-log* buffer with some obvious items: the list of files that
622;; were added, the list of files that were removed. If the diff is
623;; available, maybe it could even call something like
624;; `diff-add-change-log-entries-other-window' to create a detailed
625;; skeleton for the log...
626;;
5bd20ee6
DN
627;; - a way to do repository wide log (instead of just per
628;; file/fileset) is needed. Doing it per directory might be enough...
7fbb4797 629;;
e1aec6fb 630;; - most vc-dir backends need more work. They might need to
7fbb4797
DN
631;; provide custom headers, use the `extra' field and deal with all
632;; possible VC states.
633;;
e1aec6fb 634;; - add function that calls vc-dir to `find-directory-functions'.
d6f47dff 635;;
d3201e0b
DN
636;; - vc-diff, vc-annotate, etc. need to deal better with unregistered
637;; files. Now that unregistered and ignored files are shown in
e1aec6fb 638;; vc-dired/vc-dir, it is possible that these commands are called
d3201e0b
DN
639;; for unregistered/ignored files.
640;;
3f08440f
DN
641;; - do not default to RCS anymore when the current directory is not
642;; controlled by any VCS and the user does C-x v v
643;;
5bd20ee6
DN
644;; - vc-create-snapshot and vc-retrieve-snapshot should update the
645;; buffers that might be visiting the affected files.
1cb119fd 646;;
a84615c7
SS
647;; - Using multiple backends needs work. Given a CVS directory with some
648;; files checked into git (but not all), using C-x v l to get a log file
649;; from a file only present in git, and then typing RET on some log entry,
18a083fd
ER
650;; vc will bombs out because it wants to see the file being in CVS.
651;; Those logs should likely use a local variable to hardware the VC they
652;; are supposed to work with.
653;;
7a3c8d3a
ER
654;; - Another important thing: merge all the status-like backend operations.
655;; We should remove dir-status, state, dir-state, and dir-status-files, and
656;; replace them with just `status' which takes a fileset and a continuation
657;; (like dir-status) and returns a buffer in which the process(es) are run
658;; (or nil if it worked synchronously). Hopefully we can define the old
659;; 4 operations in term of this one.
660;;
80296236
DN
661;; - backends that care about vc-stay-local should try to take it into
662;; account for vc-dir. Is this likely to be useful???
663;;
0a299408
ER
664;; - vc-dir listing needs a footer generated when it's done to make it obvious
665;; that it has finished.
666;;
7a3c8d3a 667
fcb500ea 668;;; Code:
0e362f54 669
594722a8 670(require 'vc-hooks)
92d1eebf 671(require 'vc-dispatcher)
64db3a90 672(require 'tool-bar)
7fbb4797 673(require 'ewoc)
64db3a90 674
b1ddeeb7 675(eval-when-compile
7b913185 676 (require 'dired)
4f61cc3e 677 (require 'cl))
b1ddeeb7 678
b5446276
DN
679(unless (assoc 'vc-parent-buffer minor-mode-alist)
680 (setq minor-mode-alist
681 (cons '(vc-parent-buffer vc-parent-buffer-name)
682 minor-mode-alist)))
594722a8
ER
683
684;; General customization
685
0101cc40
RS
686(defgroup vc nil
687 "Version-control system in Emacs."
688 :group 'tools)
689
690(defcustom vc-suppress-confirm nil
04864eb0 691 "If non-nil, treat user as expert; suppress yes-no prompts on some things."
0101cc40
RS
692 :type 'boolean
693 :group 'vc)
694
695(defcustom vc-initial-comment nil
04864eb0 696 "If non-nil, prompt for initial comment when a file is registered."
0101cc40
RS
697 :type 'boolean
698 :group 'vc)
699
ac3f4c6f
ER
700(defcustom vc-default-init-revision "1.1"
701 "A string used as the default revision number when a new file is registered.
b470cb65
AS
702This can be overridden by giving a prefix argument to \\[vc-register]. This
703can also be overridden by a particular VC backend."
0d53f466 704 :type 'string
cd32a7ba
DN
705 :group 'vc
706 :version "20.3")
0d53f466 707
0101cc40 708(defcustom vc-checkin-switches nil
04864eb0 709 "A string or list of strings specifying extra switches for checkin.
0101cc40
RS
710These are passed to the checkin program by \\[vc-checkin]."
711 :type '(choice (const :tag "None" nil)
712 (string :tag "Argument String")
713 (repeat :tag "Argument List"
714 :value ("")
715 string))
716 :group 'vc)
717
718(defcustom vc-checkout-switches nil
04864eb0 719 "A string or list of strings specifying extra switches for checkout.
0101cc40
RS
720These are passed to the checkout program by \\[vc-checkout]."
721 :type '(choice (const :tag "None" nil)
722 (string :tag "Argument String")
723 (repeat :tag "Argument List"
724 :value ("")
725 string))
726 :group 'vc)
727
728(defcustom vc-register-switches nil
04864eb0 729 "A string or list of strings; extra switches for registering a file.
0101cc40
RS
730These are passed to the checkin program by \\[vc-register]."
731 :type '(choice (const :tag "None" nil)
732 (string :tag "Argument String")
733 (repeat :tag "Argument List"
734 :value ("")
735 string))
736 :group 'vc)
737
acc5b122 738(defcustom vc-diff-switches nil
04864eb0 739 "A string or list of strings specifying switches for diff under VC.
b453817c
AS
740When running diff under a given BACKEND, VC concatenates the values of
741`diff-switches', `vc-diff-switches', and `vc-BACKEND-diff-switches' to
742get the switches for that command. Thus, `vc-diff-switches' should
743contain switches that are specific to version control, but not
744specific to any particular backend."
acc5b122
AS
745 :type '(choice (const :tag "None" nil)
746 (string :tag "Argument String")
747 (repeat :tag "Argument List"
748 :value ("")
749 string))
750 :group 'vc
751 :version "21.1")
752
48033a08
AS
753(defcustom vc-diff-knows-L nil
754 "*Indicates whether diff understands the -L option.
755The value is either `yes', `no', or nil. If it is nil, VC tries
756to use -L and sets this variable to remember whether it worked."
757 :type '(choice (const :tag "Work out" nil) (const yes) (const no))
758 :group 'vc)
759
f1d1d46a 760(defcustom vc-allow-async-revert nil
e4d26892 761 "Specifies whether the diff during \\[vc-revert] may be asynchronous.
f1d1d46a
AS
762Enabling this option means that you can confirm a revert operation even
763if the local changes in the file have not been found and displayed yet."
764 :type '(choice (const :tag "No" nil)
765 (const :tag "Yes" t))
766 :group 'vc
bf247b6e 767 :version "22.1")
f1d1d46a 768
7cad930d
AS
769;;;###autoload
770(defcustom vc-checkout-hook nil
04864eb0 771 "Normal hook (list of functions) run after checking out a file.
7cad930d
AS
772See `run-hooks'."
773 :type 'hook
774 :group 'vc
775 :version "21.1")
776
da7c8a12 777(defcustom vc-annotate-display-mode 'fullscale
6f1ecae4 778 "Which mode to color the output of \\[vc-annotate] with by default."
da7c8a12 779 :type '(choice (const :tag "By Color Map Range" nil)
75665141
AS
780 (const :tag "Scale to Oldest" scale)
781 (const :tag "Scale Oldest->Newest" fullscale)
782 (number :tag "Specify Fractional Number of Days"
783 :value "20.5"))
784 :group 'vc)
785
0e362f54
GM
786;;;###autoload
787(defcustom vc-checkin-hook nil
61de26cb 788 "Normal hook (list of functions) run after commit or file checkin.
1cca5da4 789See also `log-edit-done-hook'."
0e362f54 790 :type 'hook
1cca5da4 791 :options '(log-edit-comment-to-change-log)
0e362f54
GM
792 :group 'vc)
793
794;;;###autoload
795(defcustom vc-before-checkin-hook nil
61de26cb 796 "Normal hook (list of functions) run before a commit or a file checkin.
0e362f54
GM
797See `run-hooks'."
798 :type 'hook
799 :group 'vc)
800
0e362f54 801;; Annotate customization
7d2d9482 802(defcustom vc-annotate-color-map
da7c8a12
S
803 (if (and (tty-display-color-p) (<= (display-color-cells) 8))
804 ;; A custom sorted TTY colormap
805 (let* ((colors
806 (sort
807 (delq nil
808 (mapcar (lambda (x)
809 (if (not (or
810 (string-equal (car x) "white")
811 (string-equal (car x) "black") ))
812 (car x)))
813 (tty-color-alist)))
814 (lambda (a b)
815 (cond
816 ((or (string-equal a "red") (string-equal b "blue")) t)
817 ((or (string-equal b "red") (string-equal a "blue")) nil)
818 ((string-equal a "yellow") t)
819 ((string-equal b "yellow") nil)
820 ((string-equal a "cyan") t)
821 ((string-equal b "cyan") nil)
822 ((string-equal a "green") t)
823 ((string-equal b "green") nil)
824 ((string-equal a "magenta") t)
825 ((string-equal b "magenta") nil)
826 (t (string< a b))))))
827 (date 20.)
828 (delta (/ (- 360. date) (1- (length colors)))))
829 (mapcar (lambda (x)
830 (prog1
831 (cons date x)
832 (setq date (+ date delta)))) colors))
833 ;; Normal colormap: hue stepped from 0-240deg, value=1., saturation=0.75
834 '(( 20. . "#FF3F3F")
835 ( 40. . "#FF6C3F")
836 ( 60. . "#FF993F")
837 ( 80. . "#FFC63F")
838 (100. . "#FFF33F")
839 (120. . "#DDFF3F")
840 (140. . "#B0FF3F")
841 (160. . "#83FF3F")
842 (180. . "#56FF3F")
843 (200. . "#3FFF56")
844 (220. . "#3FFF83")
845 (240. . "#3FFFB0")
846 (260. . "#3FFFDD")
847 (280. . "#3FF3FF")
848 (300. . "#3FC6FF")
849 (320. . "#3F99FF")
850 (340. . "#3F6CFF")
851 (360. . "#3F3FFF")))
04864eb0 852 "Association list of age versus color, for \\[vc-annotate].
da7c8a12
S
853Ages are given in units of fractional days. Default is eighteen
854steps using a twenty day increment, from red to blue. For TTY
855displays with 8 or fewer colors, the default is red to blue with
856all other colors between (excluding black and white)."
0e362f54 857 :type 'alist
7d2d9482
RS
858 :group 'vc)
859
da7c8a12 860(defcustom vc-annotate-very-old-color "#3F3FFF"
04864eb0 861 "Color for lines older than the current color range in \\[vc-annotate]]."
7d2d9482
RS
862 :type 'string
863 :group 'vc)
864
865(defcustom vc-annotate-background "black"
04864eb0 866 "Background color for \\[vc-annotate].
7d2d9482 867Default color is used if nil."
14b7a0b5 868 :type '(choice (const :tag "Default background" nil) (color))
7d2d9482
RS
869 :group 'vc)
870
871(defcustom vc-annotate-menu-elements '(2 0.5 0.1 0.01)
04864eb0 872 "Menu elements for the mode-specific menu of VC-Annotate mode.
7d2d9482 873List of factors, used to expand/compress the time scale. See `vc-annotate'."
0e362f54 874 :type '(repeat number)
7d2d9482
RS
875 :group 'vc)
876
0e362f54
GM
877(defvar vc-annotate-mode-map
878 (let ((m (make-sparse-keymap)))
04864eb0
SM
879 (define-key m "A" 'vc-annotate-revision-previous-to-line)
880 (define-key m "D" 'vc-annotate-show-diff-revision-at-line)
f3ff0fe9 881 (define-key m "f" 'vc-annotate-find-revision-at-line)
04864eb0
SM
882 (define-key m "J" 'vc-annotate-revision-at-line)
883 (define-key m "L" 'vc-annotate-show-log-revision-at-line)
ac3f4c6f
ER
884 (define-key m "N" 'vc-annotate-next-revision)
885 (define-key m "P" 'vc-annotate-prev-revision)
886 (define-key m "W" 'vc-annotate-working-revision)
5731a8e0 887 (define-key m "V" 'vc-annotate-toggle-annotation-visibility)
0e362f54
GM
888 m)
889 "Local keymap used for VC-Annotate mode.")
67242a23 890
594722a8
ER
891;; Header-insertion hair
892
0101cc40 893(defcustom vc-static-header-alist
04864eb0 894 '(("\\.c\\'" .
594722a8 895 "\n#ifndef lint\nstatic char vcid[] = \"\%s\";\n#endif /* lint */\n"))
0e362f54
GM
896 "*Associate static header string templates with file types.
897A \%s in the template is replaced with the first string associated with
099bd78a 898the file's version control type in `vc-header-alist'."
0101cc40
RS
899 :type '(repeat (cons :format "%v"
900 (regexp :tag "File Type")
901 (string :tag "Header String")))
902 :group 'vc)
7b4f934d 903
0101cc40 904(defcustom vc-comment-alist
594722a8 905 '((nroff-mode ".\\\"" ""))
6f1ecae4 906 "*Special comment delimiters for generating VC headers.
099bd78a
SM
907Add an entry in this list if you need to override the normal `comment-start'
908and `comment-end' variables. This will only be necessary if the mode language
0101cc40
RS
909is sensitive to blank lines."
910 :type '(repeat (list :format "%v"
911 (symbol :tag "Mode")
912 (string :tag "Comment Start")
913 (string :tag "Comment End")))
914 :group 'vc)
594722a8 915
0101cc40 916(defcustom vc-checkout-carefully (= (user-uid) 0)
bf142f28 917 "*Non-nil means be extra-careful in checkout.
bbf97570 918Verify that the file really is not locked
0101cc40
RS
919and that its contents match what the master file says."
920 :type 'boolean
921 :group 'vc)
bf142f28
JB
922(make-obsolete-variable 'vc-checkout-carefully
923 "the corresponding checks are always done now."
924 "21.1")
bbf97570 925
0e362f54 926\f
83affd96 927;; Variables users don't need to see
594722a8 928
f1d1d46a
AS
929(defvar vc-disable-async-diff nil
930 "VC sets this to t locally to disable some async diff operations.
931Backends that offer asynchronous diffs should respect this variable
932in their implementation of vc-BACKEND-diff.")
933
594722a8
ER
934;; File property caching
935
8c0aaf40 936(defun vc-clear-context ()
11cdd167 937 "Clear all cached file properties."
8c0aaf40 938 (interactive)
11cdd167 939 (fillarray vc-file-prop-obarray 0))
8c0aaf40 940
d7b60083
ER
941(defmacro with-vc-properties (files form settings)
942 "Execute FORM, then maybe set per-file properties for FILES.
6f1ecae4
AS
943SETTINGS is an association list of property/value pairs. After
944executing FORM, set those properties from SETTINGS that have not yet
945been updated to their corresponding values."
b4e4e3a8 946 (declare (debug t))
169f0cae 947 `(let ((vc-touched-properties (list t)))
099bd78a 948 ,form
d7b60083 949 (dolist (file ,files)
a7192ddb
SM
950 (dolist (setting ,settings)
951 (let ((property (car setting)))
952 (unless (memq property vc-touched-properties)
953 (put (intern file vc-file-prop-obarray)
954 property (cdr setting))))))))
099bd78a 955
ec402ad4 956;; Two macros for elisp programming
61de26cb 957
709822e8
AS
958;;;###autoload
959(defmacro with-vc-file (file comment &rest body)
6f1ecae4 960 "Check out a writable copy of FILE if necessary, then execute BODY.
0e362f54
GM
961Check in FILE with COMMENT (a string) after BODY has been executed.
962FILE is passed through `expand-file-name'; BODY executed within
61de26cb 963`save-excursion'. If FILE is not under version control, or you are
a7192ddb 964using a locking version-control system and the file is locked by
709822e8 965somebody else, signal error."
b4e4e3a8 966 (declare (debug t) (indent 2))
169f0cae
AS
967 (let ((filevar (make-symbol "file")))
968 `(let ((,filevar (expand-file-name ,file)))
969 (or (vc-backend ,filevar)
2df5044f 970 (error "File not under version control: `%s'" file))
169f0cae
AS
971 (unless (vc-editable-p ,filevar)
972 (let ((state (vc-state ,filevar)))
f1180544 973 (if (stringp state)
2df5044f 974 (error "`%s' is locking `%s'" state ,filevar)
169f0cae
AS
975 (vc-checkout ,filevar t))))
976 (save-excursion
977 ,@body)
d7b60083 978 (vc-checkin (list ,filevar) nil ,comment))))
169f0cae 979
709822e8
AS
980;;;###autoload
981(defmacro edit-vc-file (file comment &rest body)
0e362f54
GM
982 "Edit FILE under version control, executing body.
983Checkin with COMMENT after executing BODY.
709822e8
AS
984This macro uses `with-vc-file', passing args to it.
985However, before executing BODY, find FILE, and after BODY, save buffer."
b4e4e3a8 986 (declare (debug t) (indent 2))
169f0cae
AS
987 (let ((filevar (make-symbol "file")))
988 `(let ((,filevar (expand-file-name ,file)))
989 (with-vc-file
990 ,filevar ,comment
991 (set-buffer (find-file-noselect ,filevar))
992 ,@body
993 (save-buffer)))))
994
d7b60083
ER
995;;; Code for deducing what fileset and backend to assume
996
2765044b
DN
997(defun vc-responsible-backend (file &optional register)
998 "Return the name of a backend system that is responsible for FILE.
999The optional argument REGISTER means that a backend suitable for
1000registration should be found.
1001
1002If REGISTER is nil, then if FILE is already registered, return the
1003backend of FILE. If FILE is not registered, or a directory, then the
1004first backend in `vc-handled-backends' that declares itself
1005responsible for FILE is returned. If no backend declares itself
1006responsible, return the first backend.
1007
1008If REGISTER is non-nil, return the first responsible backend under
1009which FILE is not yet registered. If there is no such backend, return
1010the first backend under which FILE is not yet registered, but could
1011be registered."
b5446276
DN
1012 (when (not vc-handled-backends)
1013 (error "No handled backends"))
2765044b
DN
1014 (or (and (not (file-directory-p file)) (not register) (vc-backend file))
1015 (catch 'found
1016 ;; First try: find a responsible backend. If this is for registration,
1017 ;; it must be a backend under which FILE is not yet registered.
1018 (dolist (backend vc-handled-backends)
1019 (and (or (not register)
1020 (not (vc-call-backend backend 'registered file)))
1021 (vc-call-backend backend 'responsible-p file)
1022 (throw 'found backend)))
1023 ;; no responsible backend
1024 (if (not register)
1025 ;; if this is not for registration, the first backend must do
1026 (car vc-handled-backends)
1027 ;; for registration, we need to find a new backend that
1028 ;; could register FILE
1029 (dolist (backend vc-handled-backends)
1030 (and (not (vc-call-backend backend 'registered file))
1031 (vc-call-backend backend 'could-register file)
1032 (throw 'found backend)))
1033 (error "No backend that could register")))))
1034
1035(defun vc-expand-dirs (file-or-dir-list)
1036 "Expands directories in a file list specification.
1037Only files already under version control are noticed."
1038 ;; FIXME: Kill this function.
1039 (let ((flattened '()))
1040 (dolist (node file-or-dir-list)
1041 (vc-file-tree-walk
b5446276 1042 node (lambda (f) (when (vc-backend f) (push f flattened)))))
2765044b
DN
1043 (nreverse flattened)))
1044
5bd20ee6
DN
1045(defun vc-deduce-fileset (&optional allow-directory-wildcard allow-unregistered
1046 include-files-not-directories)
a7192ddb
SM
1047 "Deduce a set of files and a backend to which to apply an operation.
1048
ae67f2d0 1049Return (BACKEND . FILESET).
a7192ddb
SM
1050If we're in VC-dired mode, the fileset is the list of marked files.
1051Otherwise, if we're looking at a buffer visiting a version-controlled file,
1052the fileset is a singleton containing this file.
1053If neither of these things is true, but ALLOW-DIRECTORY-WILDCARD is on
1054and we're in a dired buffer, select the current directory.
5bd20ee6
DN
1055If none of these conditions is met, but ALLOW_UNREGISTERED is on and the
1056visited file is not registered, return a singleton fileset containing it.
1057If INCLUDE-FILES-NOT-DIRECTORIES then if directories are marked,
1058return the list of files VC files in those directories instead of
1059the directories themselves.
a7192ddb 1060Otherwise, throw an error."
ae67f2d0
DN
1061 (let (backend)
1062 (cond
1063 (vc-dired-mode
1064 (let ((marked (dired-map-over-marks (dired-get-filename) nil)))
1065 (unless marked
1066 (error "No files have been selected."))
1067 ;; All members of the fileset must have the same backend
1068 (setq backend (vc-backend (car marked)))
1069 (dolist (f (cdr marked))
1070 (unless (eq (vc-backend f) backend)
1071 (error "All members of a fileset must be under the same version-control system.")))
1072 (cons backend marked)))
1073 ((eq major-mode 'vc-dir-mode)
1074 ;; FIXME: Maybe the backend should be stored in a buffer-local
1075 ;; variable?
1076 (cons (vc-responsible-backend default-directory)
5bd20ee6
DN
1077 (or
1078 (if include-files-not-directories
1079 (vc-dir-marked-only-files)
1080 (vc-dir-marked-files))
1081 (list (vc-dir-current-file)))))
ae67f2d0
DN
1082 ((setq backend (vc-backend buffer-file-name))
1083 (cons backend (list buffer-file-name)))
1084 ((and vc-parent-buffer (or (buffer-file-name vc-parent-buffer)
1085 (with-current-buffer vc-parent-buffer
1086 (or vc-dired-mode (eq major-mode 'vc-dir-mode)))))
1087 (progn
1088 (set-buffer vc-parent-buffer)
1089 (vc-deduce-fileset)))
1090 ;; This is guarded by an enabling arg so users won't potentially
1091 ;; shoot themselves in the foot by modifying a fileset they can't
1092 ;; verify by eyeball. Allow it for nondestructive commands like
1093 ;; making diffs, or possibly for destructive ones that have
1094 ;; confirmation prompts.
1095 ((and allow-directory-wildcard
1096 ;; I think this is a misfeature. For now, I'll leave it in, but
1097 ;; I'll disable it anywhere else than in dired buffers. --Stef
1098 (and (derived-mode-p 'dired-mode)
1099 (equal buffer-file-name nil)
1100 (equal list-buffers-directory default-directory)))
1101 (progn
1102 (message "All version-controlled files below %s selected."
1103 default-directory)
1104 (cons
1105 (vc-responsible-backend default-directory)
1106 (list default-directory))))
7a3c8d3a 1107 ;; If we're allowing unregistered fiiles and visiting one, select it.
ae67f2d0
DN
1108 ((and allow-unregistered (not (vc-registered buffer-file-name)))
1109 (cons (vc-responsible-backend
1110 (file-name-directory (buffer-file-name)))
1111 (list buffer-file-name)))
1112 (t (error "No fileset is available here.")))))
d7b60083 1113
2765044b
DN
1114(defun vc-ensure-vc-buffer ()
1115 "Make sure that the current buffer visits a version-controlled file."
ca8dfeda
DN
1116 (cond
1117 (vc-dired-mode
1118 (set-buffer (find-file-noselect (dired-get-filename))))
e1aec6fb
SM
1119 ((eq major-mode 'vc-dir-mode)
1120 (set-buffer (find-file-noselect (vc-dir-current-file))))
ca8dfeda 1121 (t
772111be 1122 (while (and vc-parent-buffer
cc72026b 1123 (buffer-live-p vc-parent-buffer)
772111be
MR
1124 ;; Avoid infinite looping when vc-parent-buffer and
1125 ;; current buffer are the same buffer.
1126 (not (eq vc-parent-buffer (current-buffer))))
2765044b
DN
1127 (set-buffer vc-parent-buffer))
1128 (if (not buffer-file-name)
1129 (error "Buffer %s is not associated with a file" (buffer-name))
b5446276
DN
1130 (unless (vc-backend buffer-file-name)
1131 (error "File %s is not under version control" buffer-file-name))))))
2765044b 1132
e0607aaa
SM
1133;;; Support for the C-x v v command.
1134;; This is where all the single-file-oriented code from before the fileset
1135;; rewrite lives.
61de26cb 1136
2765044b
DN
1137(defsubst vc-editable-p (file)
1138 "Return non-nil if FILE can be edited."
e0607aaa
SM
1139 (let ((backend (vc-backend file)))
1140 (and backend
70e2f6c7 1141 (or (eq (vc-checkout-model backend (list file)) 'implicit)
e0607aaa 1142 (memq (vc-state file) '(edited needs-merge conflict))))))
2765044b 1143
97d3f950 1144(defun vc-buffer-sync (&optional not-urgent)
099bd78a 1145 "Make sure the current buffer and its working file are in sync.
0e362f54 1146NOT-URGENT means it is ok to continue if the user says not to save."
b5446276
DN
1147 (when (buffer-modified-p)
1148 (if (or vc-suppress-confirm
1149 (y-or-n-p (format "Buffer %s modified; save it? " (buffer-name))))
1150 (save-buffer)
1151 (unless not-urgent
1152 (error "Aborted")))))
97d3f950 1153
484c1b1f
ER
1154(defun vc-compatible-state (p q)
1155 "Controls which states can be in the same commit."
1156 (or
1157 (eq p q)
1158 (and (member p '(edited added removed)) (member q '(edited added removed)))))
1159
2765044b
DN
1160;; Here's the major entry point.
1161
1162;;;###autoload
1163(defun vc-next-action (verbose)
d7b60083
ER
1164 "Do the next logical version control operation on the current fileset.
1165This requires that all files in the fileset be in the same state.
2765044b 1166
d7b60083
ER
1167For locking systems:
1168 If every file is not already registered, this registers each for version
2765044b 1169control.
d7b60083
ER
1170 If every file is registered and not locked by anyone, this checks out
1171a writable and locked file of each ready for editing.
1172 If every file is checked out and locked by the calling user, this
1173first checks to see if each file has changed since checkout. If not,
1174it performs a revert on that file.
1175 If every file has been changed, this pops up a buffer for entry
2765044b
DN
1176of a log message; when the message has been entered, it checks in the
1177resulting changes along with the log message as change commentary. If
1178the variable `vc-keep-workfiles' is non-nil (which is its default), a
d7b60083
ER
1179read-only copy of each changed file is left in place afterwards.
1180 If the affected file is registered and locked by someone else, you are
1181given the option to steal the lock(s).
1182
1183For merging systems:
1184 If every file is not already registered, this registers each one for version
1185control. This does an add, but not a commit.
1186 If every file is added but not committed, each one is committed.
1187 If every working file is changed, but the corresponding repository file is
2765044b
DN
1188unchanged, this pops up a buffer for entry of a log message; when the
1189message has been entered, it checks in the resulting changes along
1190with the logmessage as change commentary. A writable file is retained.
1191 If the repository file is changed, you are asked if you want to
1192merge in the changes into your working copy."
2765044b 1193 (interactive "P")
ae67f2d0 1194 (let* ((vc-fileset (vc-deduce-fileset nil t))
5bd20ee6
DN
1195 (vc-fileset-only-files (vc-deduce-fileset nil t t))
1196 (only-files (cdr vc-fileset-only-files))
e0607aaa 1197 (backend (car vc-fileset))
ae67f2d0 1198 (files (cdr vc-fileset))
5bd20ee6 1199 (state (vc-state (car only-files)))
e0607aaa 1200 (model (vc-checkout-model backend files))
ac3f4c6f 1201 revision)
ac2c49f4 1202
9eef6650 1203 ;; Verify that the fileset is homogeneous
5bd20ee6 1204 (dolist (file (cdr only-files))
ae67f2d0
DN
1205 ;; Ignore directories, they are compatible with anything.
1206 (unless (file-directory-p file)
1207 (unless (vc-compatible-state (vc-state file) state)
a094fe43
ER
1208 (error "%s:%s clashes with %s:%s"
1209 file (vc-state file) (car files) state))
70e2f6c7 1210 (unless (eq (vc-checkout-model backend (list file)) model)
ae67f2d0 1211 (error "Fileset has mixed checkout models"))))
d7b60083
ER
1212 ;; Check for buffers in the fileset not matching the on-disk contents.
1213 (dolist (file files)
1214 (let ((visited (get-file-buffer file)))
1215 (when visited
e1aec6fb 1216 (if (or vc-dired-mode (eq major-mode 'vc-dir-mode))
d7b60083
ER
1217 (switch-to-buffer-other-window visited)
1218 (set-buffer visited))
1219 ;; Check relation of buffer and file, and make sure
1220 ;; user knows what he's doing. First, finding the file
1221 ;; will check whether the file on disk is newer.
1222 ;; Ignore buffer-read-only during this test, and
1223 ;; preserve find-file-literally.
1224 (let ((buffer-read-only (not (file-writable-p file))))
1225 (find-file-noselect file nil find-file-literally))
1226 (if (not (verify-visited-file-modtime (current-buffer)))
1227 (if (yes-or-no-p (format "Replace %s on disk with buffer contents? " file))
1228 (write-file buffer-file-name)
1229 (error "Aborted"))
1230 ;; Now, check if we have unsaved changes.
1231 (vc-buffer-sync t)
e166638d
DN
1232 (when (buffer-modified-p)
1233 (or (y-or-n-p (message "Use %s on disk, keeping modified buffer? " file))
1234 (error "Aborted")))))))
0e362f54 1235 ;; Do the right thing
a7192ddb 1236 (cond
3c73c30e
ER
1237 ((eq state 'missing)
1238 (error "Fileset files are missing, so cannot be operated on."))
d7b60083 1239 ;; Files aren't registered
3702367b 1240 ((or (eq state 'unregistered)
e166638d 1241 (eq state 'ignored))
80296236 1242 (mapc (lambda (arg) (vc-register nil arg)) files))
ac3f4c6f 1243 ;; Files are up-to-date, or need a merge and user specified a revision
3702367b 1244 ((or (eq state 'up-to-date) (and verbose (eq state 'needs-update)))
0e362f54 1245 (cond
d7b60083 1246 (verbose
ac3f4c6f
ER
1247 ;; go to a different revision
1248 (setq revision (read-string "Branch, revision, or backend to move to: "))
1249 (let ((vsym (intern-soft (upcase revision))))
d7b60083 1250 (if (member vsym vc-handled-backends)
a7192ddb
SM
1251 (dolist (file files) (vc-transfer-file file vsym))
1252 (dolist (file files)
1253 (vc-checkout file (eq model 'implicit) revision)))))
d7b60083
ER
1254 ((not (eq model 'implicit))
1255 ;; check the files out
a7192ddb 1256 (dolist (file files) (vc-checkout file t)))
d7b60083 1257 (t
a7192ddb
SM
1258 ;; do nothing
1259 (message "Fileset is up-to-date"))))
1260 ;; Files have local changes
484c1b1f 1261 ((vc-compatible-state state 'edited)
d7b60083
ER
1262 (let ((ready-for-commit files))
1263 ;; If files are edited but read-only, give user a chance to correct
1264 (dolist (file files)
e166638d
DN
1265 (unless (file-writable-p file)
1266 ;; Make the file+buffer read-write.
1267 (unless (y-or-n-p (format "%s is edited but read-only; make it writable and continue?" file))
1268 (error "Aborted"))
1269 (set-file-modes file (logior (file-modes file) 128))
1270 (let ((visited (get-file-buffer file)))
1271 (when visited
1272 (with-current-buffer visited
1273 (toggle-read-only -1))))))
d7b60083
ER
1274 ;; Allow user to revert files with no changes
1275 (save-excursion
a7192ddb
SM
1276 (dolist (file files)
1277 (let ((visited (get-file-buffer file)))
1278 ;; For files with locking, if the file does not contain
1279 ;; any changes, just let go of the lock, i.e. revert.
e166638d
DN
1280 (when (and (not (eq model 'implicit))
1281 (vc-workfile-unchanged-p file)
1282 ;; If buffer is modified, that means the user just
1283 ;; said no to saving it; in that case, don't revert,
1284 ;; because the user might intend to save after
1285 ;; finishing the log entry and committing.
1286 (not (and visited (buffer-modified-p))))
1287 (vc-revert-file file)
1288 (delete file ready-for-commit)))))
d7b60083
ER
1289 ;; Remaining files need to be committed
1290 (if (not ready-for-commit)
1291 (message "No files remain to be committed")
1d502d5a 1292 (if (not verbose)
d7b60083
ER
1293 (vc-checkin ready-for-commit)
1294 (progn
ac3f4c6f
ER
1295 (setq revision (read-string "New revision or backend: "))
1296 (let ((vsym (intern (upcase revision))))
d7b60083 1297 (if (member vsym vc-handled-backends)
d36122a2 1298 (dolist (file files) (vc-transfer-file file vsym))
ac3f4c6f 1299 (vc-checkin ready-for-commit revision))))))))
d7b60083
ER
1300 ;; locked by somebody else (locking VCSes only)
1301 ((stringp state)
d36122a2
TTN
1302 ;; In the old days, we computed the revision once and used it on
1303 ;; the single file. Then, for the 2007-2008 fileset rewrite, we
1304 ;; computed the revision once (incorrectly, using a free var) and
1305 ;; used it on all files. To fix the free var bug, we can either
1306 ;; use `(car files)' or do what we do here: distribute the
1307 ;; revision computation among `files'. Although this may be
1308 ;; tedious for those backends where a "revision" is a trans-file
1309 ;; concept, it is nonetheless correct for both those and (more
1310 ;; importantly) for those where "revision" is a per-file concept.
1311 ;; If the intersection of the former group and "locking VCSes" is
1312 ;; non-empty [I vaguely doubt it --ttn], we can reinstate the
1313 ;; pre-computation approach of yore.
1314 (dolist (file files)
1315 (vc-steal-lock
1316 file (if verbose
1317 (read-string (format "%s revision to steal: " file))
1318 (vc-working-revision file))
1319 state)))
7fbb4797
DN
1320 ;; conflict
1321 ((eq state 'conflict)
1322 (vc-mark-resolved files))
3702367b
ER
1323 ;; needs-update
1324 ((eq state 'needs-update)
d7b60083 1325 (dolist (file files)
6f41eeb5 1326 (if (yes-or-no-p (format
ac3f4c6f 1327 "%s is not up-to-date. Get latest revision? "
0e362f54 1328 (file-name-nondirectory file)))
d7b60083 1329 (vc-checkout file (eq model 'implicit) t)
e166638d
DN
1330 (when (and (not (eq model 'implicit))
1331 (yes-or-no-p "Lock this revision? "))
1332 (vc-checkout file t)))))
d7b60083
ER
1333 ;; needs-merge
1334 ((eq state 'needs-merge)
1335 (dolist (file files)
e166638d 1336 (when (yes-or-no-p (format
0e362f54
GM
1337 "%s is not up-to-date. Merge in changes now? "
1338 (file-name-nondirectory file)))
e166638d 1339 (vc-maybe-resolve-conflicts file (vc-call merge-news file)))))
46e33aee 1340
d7b60083
ER
1341 ;; unlocked-changes
1342 ((eq state 'unlocked-changes)
1343 (dolist (file files)
b5446276
DN
1344 (when (not (equal buffer-file-name file))
1345 (find-file-other-window file))
0e362f54 1346 (if (save-window-excursion
ae67f2d0
DN
1347 (vc-diff-internal nil (cons (car vc-fileset) (list file))
1348 (vc-working-revision file) nil)
0e362f54 1349 (goto-char (point-min))
ceec5a0c 1350 (let ((inhibit-read-only t))
f4f34b33 1351 (insert
ceec5a0c 1352 (format "Changes to %s since last lock:\n\n" file)))
0e362f54
GM
1353 (not (beep))
1354 (yes-or-no-p (concat "File has unlocked changes. "
1355 "Claim lock retaining changes? ")))
1356 (progn (vc-call steal-lock file)
61de26cb 1357 (clear-visited-file-modtime)
0e362f54
GM
1358 ;; Must clear any headers here because they wouldn't
1359 ;; show that the file is locked now.
1360 (vc-clear-headers file)
a36319a4 1361 (write-file buffer-file-name)
0e362f54
GM
1362 (vc-mode-line file))
1363 (if (not (yes-or-no-p
ac3f4c6f 1364 "Revert to checked-in revision, instead? "))
0e362f54 1365 (error "Checkout aborted")
61de26cb 1366 (vc-revert-buffer-internal t t)
3702367b
ER
1367 (vc-checkout file t)))))
1368 ;; Unknown fileset state
1369 (t
1370 (error "Fileset is in an unknown state %s" state)))))
e1f297e6 1371
61de26cb
ER
1372(defun vc-create-repo (backend)
1373 "Create an empty repository in the current directory."
1374 (interactive
1375 (list
1376 (intern
1377 (upcase
1378 (completing-read
1379 "Create repository for: "
1380 (mapcar (lambda (b) (list (downcase (symbol-name b)))) vc-handled-backends)
1381 nil t)))))
1382 (vc-call-backend backend 'create-repo))
1383
637a8ae9 1384;;;###autoload
80296236 1385(defun vc-register (&optional set-revision fname comment)
30a308aa
DN
1386 "Register into a version control system.
1387If FNAME is given register that file, otherwise register the current file.
ac3f4c6f 1388With prefix argument SET-REVISION, allow user to specify initial revision
2765044b 1389level. If COMMENT is present, use that as an initial comment.
0e362f54 1390
2765044b
DN
1391The version control system to use is found by cycling through the list
1392`vc-handled-backends'. The first backend in that list which declares
1393itself responsible for the file (usually because other files in that
1394directory are already registered under that backend) will be used to
1395register the file. If no backend declares itself responsible, the
1396first backend that could register the file is used."
1397 (interactive "P")
30a308aa
DN
1398 (when (and (null fname) (null buffer-file-name)) (error "No visited file"))
1399
5f01100a 1400 (let ((bname (if fname (get-file-buffer fname) (current-buffer))))
30a308aa
DN
1401 (unless fname (setq fname buffer-file-name))
1402 (when (vc-backend fname)
1403 (if (vc-registered fname)
1404 (error "This file is already registered")
1405 (unless (y-or-n-p "Previous master file has vanished. Make a new one? ")
1406 (error "Aborted"))))
1407 ;; Watch out for new buffers of size 0: the corresponding file
1408 ;; does not exist yet, even though buffer-modified-p is nil.
1409 (when bname
1410 (with-current-buffer bname
b5446276 1411 (when (and (not (buffer-modified-p))
30a308aa
DN
1412 (zerop (buffer-size))
1413 (not (file-exists-p buffer-file-name)))
b5446276 1414 (set-buffer-modified-p t))
30a308aa 1415 (vc-buffer-sync)))
83affd96 1416 (vc-start-logentry (list fname)
30a308aa
DN
1417 (if set-revision
1418 (read-string (format "Initial revision level for %s: "
1419 fname))
1420 (vc-call-backend (vc-responsible-backend fname)
1421 'init-revision))
1422 (or comment (not vc-initial-comment))
1423 nil
1424 "Enter initial comment."
1425 (lambda (files rev comment)
1426 (dolist (file files)
1427 (message "Registering %s... " file)
1428 (let ((backend (vc-responsible-backend file t)))
1429 (vc-file-clearprops file)
1430 (vc-call-backend backend 'register (list file) rev comment)
1431 (vc-file-setprop file 'vc-backend backend)
1432 (unless vc-make-backup-files
1433 (make-local-variable 'backup-inhibited)
1434 (setq backup-inhibited t)))
1435 (message "Registering %s... done" file))))))
d7b60083
ER
1436
1437(defun vc-register-with (backend)
1438 "Register the current file with a specified back end."
1439 (interactive "SBackend: ")
b5446276
DN
1440 (when (not (member backend vc-handled-backends))
1441 (error "Unknown back end."))
d7b60083
ER
1442 (let ((vc-handled-backends (list backend)))
1443 (call-interactively 'vc-register)))
8989ab56 1444
c6d4f628 1445(defun vc-checkout (file &optional writable rev)
099bd78a
SM
1446 "Retrieve a copy of the revision REV of FILE.
1447If WRITABLE is non-nil, make sure the retrieved file is writable.
133a84aa
AS
1448REV defaults to the latest revision.
1449
1450After check-out, runs the normal hook `vc-checkout-hook'."
ffda0460
AS
1451 (and writable
1452 (not rev)
10b48cc4 1453 (vc-call make-version-backups-p file)
ffda0460 1454 (vc-up-to-date-p file)
10b48cc4 1455 (vc-make-version-backup file))
e0607aaa
SM
1456 (let ((backend (vc-backend file)))
1457 (with-vc-properties (list file)
1458 (condition-case err
af36f8ed 1459 (vc-call-backend backend 'checkout file writable rev)
e0607aaa
SM
1460 (file-error
1461 ;; Maybe the backend is not installed ;-(
1462 (when writable
1463 (let ((buf (get-file-buffer file)))
1464 (when buf (with-current-buffer buf (toggle-read-only -1)))))
1465 (signal (car err) (cdr err))))
70e2f6c7 1466 `((vc-state . ,(if (or (eq (vc-checkout-model backend (list file)) 'implicit)
e0607aaa
SM
1467 (not writable))
1468 (if (vc-call latest-on-branch-p file)
1469 'up-to-date
3702367b 1470 'needs-update)
e0607aaa
SM
1471 'edited))
1472 (vc-checkout-time . ,(nth 5 (file-attributes file))))))
7cad930d
AS
1473 (vc-resynch-buffer file t t)
1474 (run-hooks 'vc-checkout-hook))
594722a8 1475
7fbb4797
DN
1476(defun vc-mark-resolved (files)
1477 (with-vc-properties
1478 files
1479 (vc-call mark-resolved files)
1480 ;; XXX: Is this TRTD? Might not be.
1481 `((vc-state . edited))))
1482
0e362f54 1483(defun vc-steal-lock (file rev owner)
099bd78a 1484 "Steal the lock on FILE."
29fc1ce9 1485 (let (file-description)
29fc1ce9
RS
1486 (if rev
1487 (setq file-description (format "%s:%s" file rev))
1488 (setq file-description file))
b5446276
DN
1489 (when (not (yes-or-no-p (format "Steal the lock on %s from %s? "
1490 file-description owner)))
1491 (error "Steal canceled"))
869131a5
AS
1492 (message "Stealing lock on %s..." file)
1493 (with-vc-properties
d7b60083 1494 (list file)
869131a5
AS
1495 (vc-call steal-lock file rev)
1496 `((vc-state . edited)))
1497 (vc-resynch-buffer file t t)
1498 (message "Stealing lock on %s...done" file)
1499 ;; Write mail after actually stealing, because if the stealing
1500 ;; goes wrong, we don't want to send any mail.
1501 (compose-mail owner (format "Stolen lock on %s" file-description))
29fc1ce9 1502 (setq default-directory (expand-file-name "~/"))
29fc1ce9
RS
1503 (goto-char (point-max))
1504 (insert
1505 (format "I stole the lock on %s, " file-description)
1506 (current-time-string)
1507 ".\n")
1508 (message "Please explain why you stole the lock. Type C-c C-c when done.")))
594722a8 1509
d7b60083
ER
1510(defun vc-checkin (files &optional rev comment initial-contents)
1511 "Check in FILES.
ac3f4c6f 1512The optional argument REV may be a string specifying the new revision
0e362f54 1513level (if nil increment the current level). COMMENT is a comment
0ab66291
AS
1514string; if omitted, a buffer is popped up to accept a comment. If
1515INITIAL-CONTENTS is non-nil, then COMMENT is used as the initial contents
1516of the log entry buffer.
0e362f54
GM
1517
1518If `vc-keep-workfiles' is nil, FILE is deleted afterwards, provided
1519that the version control system supports this mode of operation.
861f3c29 1520
17f039f3
ER
1521Runs the normal hooks `vc-before-checkin-hook' and `vc-checkin-hook'."
1522 (when vc-before-checkin-hook
1523 (run-hooks 'vc-before-checkin-hook))
83affd96 1524 (vc-start-logentry
d7b60083 1525 files rev comment initial-contents
6f41eeb5 1526 "Enter a change comment."
d7b60083
ER
1527 (lambda (files rev comment)
1528 (message "Checking in %s..." (vc-delistify files))
0e362f54
GM
1529 ;; "This log message intentionally left almost blank".
1530 ;; RCS 5.7 gripes about white-space-only comments too.
1531 (or (and comment (string-match "[^\t\n ]" comment))
1532 (setq comment "*** empty log message ***"))
46e33aee 1533 (with-vc-properties
d7b60083
ER
1534 files
1535 ;; We used to change buffers to get local value of vc-checkin-switches,
1536 ;; but 'the' local buffer is not a well-defined concept for filesets.
1537 (progn
1538 (vc-call checkin files rev comment)
1539 (mapc 'vc-delete-automatic-version-backups files))
a3255400
SM
1540 `((vc-state . up-to-date)
1541 (vc-checkout-time . ,(nth 5 (file-attributes file)))
ac3f4c6f 1542 (vc-working-revision . nil)))
d7b60083 1543 (message "Checking in %s...done" (vc-delistify files)))
0e362f54 1544 'vc-checkin-hook))
594722a8 1545
2765044b
DN
1546;;; Additional entry points for examining version histories
1547
a7192ddb
SM
1548;; (defun vc-default-diff-tree (backend dir rev1 rev2)
1549;; "List differences for all registered files at and below DIR.
1550;; The meaning of REV1 and REV2 is the same as for `vc-revision-diff'."
1551;; ;; This implementation does an explicit tree walk, and calls
1552;; ;; vc-BACKEND-diff directly for each file. An optimization
1553;; ;; would be to use `vc-diff-internal', so that diffs can be local,
1554;; ;; and to call it only for files that are actually changed.
1555;; ;; However, this is expensive for some backends, and so it is left
1556;; ;; to backend-specific implementations.
1557;; (setq default-directory dir)
1558;; (vc-file-tree-walk
1559;; default-directory
1560;; (lambda (f)
1561;; (vc-exec-after
1562;; `(let ((coding-system-for-read (vc-coding-system-for-diff ',f)))
1563;; (message "Looking at %s" ',f)
1564;; (vc-call-backend ',(vc-backend f)
1565;; 'diff (list ',f) ',rev1 ',rev2))))))
2765044b
DN
1566
1567(defun vc-coding-system-for-diff (file)
1568 "Return the coding system for reading diff output for FILE."
1569 (or coding-system-for-read
1570 ;; if we already have this file open,
1571 ;; use the buffer's coding system
1572 (let ((buf (find-buffer-visiting file)))
b5446276
DN
1573 (when buf (with-current-buffer buf
1574 buffer-file-coding-system)))
2765044b
DN
1575 ;; otherwise, try to find one based on the file name
1576 (car (find-operation-coding-system 'insert-file-contents file))
1577 ;; and a final fallback
1578 'undecided))
1579
1580(defun vc-switches (backend op)
1581 (let ((switches
b5446276
DN
1582 (or (when backend
1583 (let ((sym (vc-make-backend-sym
1584 backend (intern (concat (symbol-name op)
1585 "-switches")))))
1586 (when (boundp sym) (symbol-value sym))))
2765044b 1587 (let ((sym (intern (format "vc-%s-switches" (symbol-name op)))))
b5446276 1588 (when (boundp sym) (symbol-value sym)))
2765044b
DN
1589 (cond
1590 ((eq op 'diff) diff-switches)))))
1591 (if (stringp switches) (list switches)
1592 ;; If not a list, return nil.
1593 ;; This is so we can set vc-diff-switches to t to override
1594 ;; any switches in diff-switches.
b5446276 1595 (when (listp switches) switches))))
594722a8 1596
2765044b
DN
1597;; Old def for compatibility with Emacs-21.[123].
1598(defmacro vc-diff-switches-list (backend) `(vc-switches ',backend 'diff))
1599(make-obsolete 'vc-diff-switches-list 'vc-switches "22.1")
1600
1d5b2149 1601(defun vc-diff-finish (buffer messages)
17f3909f 1602 ;; The empty sync output case has already been handled, so the only
fddde1f0 1603 ;; possibility of an empty output is for an async process.
1d5b2149
TTN
1604 (when (buffer-live-p buffer)
1605 (let ((window (get-buffer-window buffer t))
1606 (emptyp (zerop (buffer-size buffer))))
1607 (with-current-buffer buffer
1608 (and messages emptyp
1609 (let ((inhibit-read-only t))
1610 (insert (cdr messages) ".\n")
1611 (message "%s" (cdr messages))))
1612 (goto-char (point-min))
fddde1f0 1613 (when window
1d5b2149
TTN
1614 (shrink-window-if-larger-than-buffer window)))
1615 (when (and messages (not emptyp))
1616 (message "%sdone" (car messages))))))
d7b60083 1617
a7192ddb
SM
1618(defvar vc-diff-added-files nil
1619 "If non-nil, diff added files by comparing them to /dev/null.")
1620
ae67f2d0 1621(defun vc-diff-internal (async vc-fileset rev1 rev2 &optional verbose)
d7b60083
ER
1622 "Report diffs between two revisions of a fileset.
1623Diff output goes to the *vc-diff* buffer. The function
1624returns t if the buffer had changes, nil otherwise."
ae67f2d0
DN
1625 (let* ((files (cdr vc-fileset))
1626 (messages (cons (format "Finding changes in %s..."
1d5b2149
TTN
1627 (vc-delistify files))
1628 (format "No changes between %s and %s"
1629 (or rev1 "working revision")
1630 (or rev2 "workfile"))))
d7b60083
ER
1631 ;; Set coding system based on the first file. It's a kluge,
1632 ;; but the only way to set it for each file included would
1633 ;; be to call the back end separately for each file.
a7192ddb 1634 (coding-system-for-read
d7b60083
ER
1635 (if files (vc-coding-system-for-diff (car files)) 'undecided)))
1636 (vc-setup-buffer "*vc-diff*")
1d5b2149 1637 (message "%s" (car messages))
a7192ddb
SM
1638 ;; Many backends don't handle well the case of a file that has been
1639 ;; added but not yet committed to the repo (notably CVS and Subversion).
1640 ;; Do that work here so the backends don't have to futz with it. --ESR
1641 ;;
1642 ;; Actually most backends (including CVS) have options to control the
1643 ;; behavior since which one is better depends on the user and on the
1644 ;; situation). Worse yet: this code does not handle the case where
1645 ;; `file' is a directory which contains added files.
1646 ;; I made it conditional on vc-diff-added-files but it should probably
1647 ;; just be removed (or copied/moved to specific backends). --Stef.
1648 (when vc-diff-added-files
1649 (let ((filtered '()))
1650 (dolist (file files)
1651 (if (or (file-directory-p file)
1652 (not (string= (vc-working-revision file) "0")))
1653 (push file filtered)
1654 ;; This file is added but not yet committed;
1655 ;; there is no master file to diff against.
1656 (if (or rev1 rev2)
1657 (error "No revisions of %s exist" file)
1658 ;; We regard this as "changed".
1659 ;; Diff it against /dev/null.
1660 (apply 'vc-do-command "*vc-diff*"
1661 1 "diff" file
1662 (append (vc-switches nil 'diff) '("/dev/null"))))))
1663 (setq files (nreverse filtered))))
1664 (let ((vc-disable-async-diff (not async)))
ae67f2d0 1665 (vc-call-backend (car vc-fileset) 'diff files rev1 rev2 "*vc-diff*"))
d7b60083 1666 (set-buffer "*vc-diff*")
17f3909f
SM
1667 (if (and (zerop (buffer-size))
1668 (not (get-buffer-process (current-buffer))))
1669 ;; Treat this case specially so as not to pop the buffer.
1670 (progn
1d5b2149 1671 (message "%s" (cdr messages))
17f3909f 1672 nil)
e83d1fe8 1673 (diff-mode)
fe1919ab
DN
1674 ;; Make the *vc-diff* buffer read only, the diff-mode key
1675 ;; bindings are nicer for read only buffers. pcl-cvs does the
1676 ;; same thing.
1677 (setq buffer-read-only t)
1d5b2149
TTN
1678 (vc-exec-after `(vc-diff-finish ,(current-buffer) ',(when verbose
1679 messages)))
4befebc1
SM
1680 ;; Display the buffer, but at the end because it can change point.
1681 (pop-to-buffer (current-buffer))
17f3909f
SM
1682 ;; In the async case, we return t even if there are no differences
1683 ;; because we don't know that yet.
1684 t)))
594722a8 1685
637a8ae9 1686;;;###autoload
a7192ddb 1687(defun vc-version-diff (files rev1 rev2)
d7b60083 1688 "Report diffs between revisions of the fileset in the repository history."
0e362f54 1689 (interactive
ae67f2d0
DN
1690 (let* ((vc-fileset (vc-deduce-fileset t))
1691 (files (cdr vc-fileset))
d7b60083 1692 (first (car files))
d7b60083 1693 (completion-table
a7192ddb 1694 (vc-call revision-completion-table files))
d7b60083
ER
1695 (rev1-default nil)
1696 (rev2-default nil))
c0d66cb2 1697 (cond
ac3f4c6f 1698 ;; someday we may be able to do revision completion on non-singleton
d7b60083
ER
1699 ;; filesets, but not yet.
1700 ((/= (length files) 1)
1701 nil)
ac3f4c6f 1702 ;; if it's a directory, don't supply any revision default
d7b60083 1703 ((file-directory-p first)
c0d66cb2 1704 nil)
ac3f4c6f 1705 ;; if the file is not up-to-date, use working revision as older revision
d7b60083 1706 ((not (vc-up-to-date-p first))
ac3f4c6f
ER
1707 (setq rev1-default (vc-working-revision first)))
1708 ;; if the file is not locked, use last and previous revisions as defaults
c0d66cb2 1709 (t
ac3f4c6f
ER
1710 (setq rev1-default (vc-call previous-revision first
1711 (vc-working-revision first)))
b5446276 1712 (when (string= rev1-default "") (setq rev1-default nil))
ac3f4c6f 1713 (setq rev2-default (vc-working-revision first))))
c0d66cb2 1714 ;; construct argument list
4d83a657 1715 (let* ((rev1-prompt (if rev1-default
ac3f4c6f 1716 (concat "Older revision (default "
4d83a657 1717 rev1-default "): ")
ac3f4c6f
ER
1718 "Older revision: "))
1719 (rev2-prompt (concat "Newer revision (default "
4d83a657
SM
1720 (or rev2-default "current source") "): "))
1721 (rev1 (if completion-table
1722 (completing-read rev1-prompt completion-table
d7b60083 1723 nil nil nil nil rev1-default)
4d83a657
SM
1724 (read-string rev1-prompt nil nil rev1-default)))
1725 (rev2 (if completion-table
1726 (completing-read rev2-prompt completion-table
d7b60083 1727 nil nil nil nil rev2-default)
4d83a657 1728 (read-string rev2-prompt nil nil rev2-default))))
b5446276
DN
1729 (when (string= rev1 "") (setq rev1 nil))
1730 (when (string= rev2 "") (setq rev2 nil))
a7192ddb 1731 (list files rev1 rev2))))
ae67f2d0
DN
1732 (when (and (not rev1) rev2)
1733 (error "Not a valid revision range."))
1734 (vc-diff-internal
1735 t (cons (car (vc-deduce-fileset t)) files) rev1 rev2 (interactive-p)))
d7b60083 1736
a7192ddb
SM
1737;; (defun vc-contains-version-controlled-file (dir)
1738;; "Return t if DIR contains a version-controlled file, nil otherwise."
1739;; (catch 'found
1740;; (mapc (lambda (f) (and (not (file-directory-p f)) (vc-backend f) (throw 'found 't))) (directory-files dir))
1741;; nil))
727c4443 1742
d7b60083 1743;;;###autoload
a7192ddb 1744(defun vc-diff (historic &optional not-urgent)
ac3f4c6f 1745 "Display diffs between file revisions.
727c4443 1746Normally this compares the currently selected fileset with their
a7192ddb 1747working revisions. With a prefix argument HISTORIC, it reads two revision
727c4443
ER
1748designators specifying which revisions to compare.
1749
1750If no current fileset is available (that is, we are not in
1751VC-Dired mode and the visited file of the current buffer is not
a7192ddb
SM
1752under version control) and we're in a Dired buffer, use
1753the current directory.
1754The optional argument NOT-URGENT non-nil means it is ok to say no to
1755saving the buffer."
1756 (interactive (list current-prefix-arg t))
1757 (if historic
1758 (call-interactively 'vc-version-diff)
ae67f2d0
DN
1759 (when buffer-file-name (vc-buffer-sync not-urgent))
1760 (vc-diff-internal t (vc-deduce-fileset t) nil nil (interactive-p))))
727c4443 1761
2c87edc1 1762
f1818994 1763;;;###autoload
ac3f4c6f
ER
1764(defun vc-revision-other-window (rev)
1765 "Visit revision REV of the current file in another window.
1766If the current file is named `F', the revision is named `F.~REV~'.
6f1ecae4 1767If `F.~REV~' already exists, use it instead of checking it out again."
4d83a657
SM
1768 (interactive
1769 (save-current-buffer
1770 (vc-ensure-vc-buffer)
1771 (let ((completion-table
1772 (vc-call revision-completion-table buffer-file-name))
ac3f4c6f 1773 (prompt "Revision to visit (default is working revision): "))
4d83a657
SM
1774 (list
1775 (if completion-table
1776 (completing-read prompt completion-table)
1777 (read-string prompt))))))
b6909007 1778 (vc-ensure-vc-buffer)
5e011cb2 1779 (let* ((file buffer-file-name)
ac3f4c6f
ER
1780 (revision (if (string-equal rev "")
1781 (vc-working-revision file)
ac0aae44 1782 rev)))
ac3f4c6f 1783 (switch-to-buffer-other-window (vc-find-revision file revision))))
ac0aae44 1784
ac3f4c6f
ER
1785(defun vc-find-revision (file revision)
1786 "Read REVISION of FILE into a buffer and return the buffer."
1787 (let ((automatic-backup (vc-version-backup-file-name file revision))
fd8160f7 1788 (filebuf (or (get-file-buffer file) (current-buffer)))
ac3f4c6f 1789 (filename (vc-version-backup-file-name file revision 'manual)))
fd8160f7 1790 (unless (file-exists-p filename)
10b48cc4 1791 (if (file-exists-p automatic-backup)
fd8160f7
SM
1792 (rename-file automatic-backup filename nil)
1793 (message "Checking out %s..." filename)
1794 (with-current-buffer filebuf
1795 (let ((failed t))
1796 (unwind-protect
1797 (let ((coding-system-for-read 'no-conversion)
1798 (coding-system-for-write 'no-conversion))
1799 (with-temp-file filename
1800 (let ((outbuf (current-buffer)))
1801 ;; Change buffer to get local value of
1802 ;; vc-checkout-switches.
1803 (with-current-buffer filebuf
ac3f4c6f 1804 (vc-call find-revision file revision outbuf))))
fd8160f7 1805 (setq failed nil))
48b43130
DN
1806 (when (and failed (file-exists-p filename))
1807 (delete-file filename))))
fd8160f7
SM
1808 (vc-mode-line file))
1809 (message "Checking out %s...done" filename)))
48b43130
DN
1810 (let ((result-buf (find-file-noselect filename)))
1811 (with-current-buffer result-buf
83f1f73b 1812 ;; Set the parent buffer so that things like
48b43130 1813 ;; C-x v g, C-x v l, ... etc work.
25a4ea6d 1814 (set (make-local-variable 'vc-parent-buffer) filebuf))
48b43130 1815 result-buf)))
fd8160f7 1816
594722a8
ER
1817;; Header-insertion code
1818
637a8ae9 1819;;;###autoload
594722a8 1820(defun vc-insert-headers ()
6f1ecae4 1821 "Insert headers into a file for use with a version control system.
b524ce9f 1822Headers desired are inserted at point, and are pulled from
0e362f54 1823the variable `vc-BACKEND-header'."
594722a8 1824 (interactive)
b6909007 1825 (vc-ensure-vc-buffer)
594722a8
ER
1826 (save-excursion
1827 (save-restriction
1828 (widen)
b5446276
DN
1829 (when (or (not (vc-check-headers))
1830 (y-or-n-p "Version headers already exist. Insert another set? "))
1831 (let* ((delims (cdr (assq major-mode vc-comment-alist)))
1832 (comment-start-vc (or (car delims) comment-start "#"))
1833 (comment-end-vc (or (car (cdr delims)) comment-end ""))
1834 (hdsym (vc-make-backend-sym (vc-backend buffer-file-name)
1835 'header))
1836 (hdstrings (and (boundp hdsym) (symbol-value hdsym))))
1837 (dolist (s hdstrings)
1838 (insert comment-start-vc "\t" s "\t"
1839 comment-end-vc "\n"))
1840 (when vc-static-header-alist
1841 (dolist (f vc-static-header-alist)
1842 (when (string-match (car f) buffer-file-name)
1843 (insert (format (cdr f) (car hdstrings)))))))))))
594722a8 1844
0e362f54 1845(defun vc-clear-headers (&optional file)
099bd78a 1846 "Clear all version headers in the current buffer (or FILE).
6f1ecae4 1847The headers are reset to their non-expanded form."
0e362f54
GM
1848 (let* ((filename (or file buffer-file-name))
1849 (visited (find-buffer-visiting filename))
1850 (backend (vc-backend filename)))
1851 (when (vc-find-backend-function backend 'clear-headers)
6f41eeb5 1852 (if visited
0e362f54
GM
1853 (let ((context (vc-buffer-context)))
1854 ;; save-excursion may be able to relocate point and mark
1855 ;; properly. If it fails, vc-restore-buffer-context
1856 ;; will give it a second try.
1857 (save-excursion
1858 (vc-call-backend backend 'clear-headers))
1859 (vc-restore-buffer-context context))
7849e179 1860 (set-buffer (find-file-noselect filename))
0e362f54
GM
1861 (vc-call-backend backend 'clear-headers)
1862 (kill-buffer filename)))))
c8de1d91 1863
9b64a7f0
ER
1864(defun vc-modify-change-comment (files rev oldcomment)
1865 "Edit the comment associated with the given files and revision."
83affd96 1866 (vc-start-logentry
9b64a7f0
ER
1867 files rev oldcomment t
1868 "Enter a replacement change comment."
1869 (lambda (files rev comment)
df49d02e 1870 (vc-call-backend
9b64a7f0
ER
1871 ;; Less of a kluge than it looks like; log-view mode only passes
1872 ;; this function a singleton list. Arguments left in this form in
df49d02e
JB
1873 ;; case the more general operation ever becomes meaningful.
1874 (vc-responsible-backend (car files))
9b64a7f0
ER
1875 'modify-change-comment files rev comment))))
1876
b6909007 1877;;;###autoload
099bd78a 1878(defun vc-merge ()
ac3f4c6f
ER
1879 "Merge changes between two revisions into the current buffer's file.
1880This asks for two revisions to merge from in the minibuffer. If the
1881first revision is a branch number, then merge all changes from that
1882branch. If the first revision is empty, merge news, i.e. recent changes
099bd78a 1883from the current branch.
0e362f54
GM
1884
1885See Info node `Merging'."
099bd78a 1886 (interactive)
ccb141e8
AS
1887 (vc-ensure-vc-buffer)
1888 (vc-buffer-sync)
1889 (let* ((file buffer-file-name)
1890 (backend (vc-backend file))
0e362f54 1891 (state (vc-state file))
ac3f4c6f 1892 first-revision second-revision status)
0e362f54 1893 (cond
61de26cb 1894 ((stringp state) ;; Locking VCses only
0e362f54
GM
1895 (error "File is locked by %s" state))
1896 ((not (vc-editable-p file))
1897 (if (y-or-n-p
1898 "File must be checked out for merging. Check out now? ")
1899 (vc-checkout file t)
1900 (error "Merge aborted"))))
ac3f4c6f
ER
1901 (setq first-revision
1902 (read-string (concat "Branch or revision to merge from "
5b76833f 1903 "(default news on current branch): ")))
ac3f4c6f 1904 (if (string= first-revision "")
099bd78a
SM
1905 (if (not (vc-find-backend-function backend 'merge-news))
1906 (error "Sorry, merging news is not implemented for %s" backend)
1907 (setq status (vc-call merge-news file)))
1908 (if (not (vc-find-backend-function backend 'merge))
1909 (error "Sorry, merging is not implemented for %s" backend)
ac3f4c6f
ER
1910 (if (not (vc-branch-p first-revision))
1911 (setq second-revision
1912 (read-string "Second revision: "
1913 (concat (vc-branch-part first-revision) ".")))
1914 ;; We want to merge an entire branch. Set revisions
099bd78a 1915 ;; accordingly, so that vc-BACKEND-merge understands us.
ac3f4c6f
ER
1916 (setq second-revision first-revision)
1917 ;; first-revision must be the starting point of the branch
1918 (setq first-revision (vc-branch-part first-revision)))
1919 (setq status (vc-call merge file first-revision second-revision))))
099bd78a 1920 (vc-maybe-resolve-conflicts file status "WORKFILE" "MERGE SOURCE")))
0e362f54
GM
1921
1922(defun vc-maybe-resolve-conflicts (file status &optional name-A name-B)
1923 (vc-resynch-buffer file t (not (buffer-modified-p)))
1924 (if (zerop status) (message "Merge successful")
28e4e2b4 1925 (smerge-mode 1)
8dc87047 1926 (message "File contains conflicts.")))
ccb141e8
AS
1927
1928;;;###autoload
1168d6c2 1929(defalias 'vc-resolve-conflicts 'smerge-ediff)
18483cf0 1930
4f61cc3e
ER
1931;; VC Dired hook
1932;; FIXME: Remove Dired support when vc-dir is ready.
35d33ce7 1933
3d30b8bc 1934(defun vc-dired-hook ()
0e362f54
GM
1935 "Reformat the listing according to version control.
1936Called by dired after any portion of a vc-dired buffer has been read in."
3d30b8bc 1937 (message "Getting version information... ")
cdce374a
ER
1938 ;; if the backend supports it, get the state
1939 ;; of all files in this directory at once
1940 (let ((backend (vc-responsible-backend default-directory)))
1941 ;; check `backend' can really handle `default-directory'.
1942 (if (and (vc-call-backend backend 'responsible-p default-directory)
1943 (vc-find-backend-function backend 'dir-state))
1944 (vc-call-backend backend 'dir-state default-directory)))
df49d02e 1945 (let (filename
484c1b1f
ER
1946 (inhibit-read-only t)
1947 (buffer-undo-list t))
3d30b8bc 1948 (goto-char (point-min))
0e362f54
GM
1949 (while (not (eobp))
1950 (cond
3d30b8bc 1951 ;; subdir header line
cdce374a 1952 ((dired-get-subdir)
3d30b8bc
RS
1953 (forward-line 1)
1954 ;; erase (but don't remove) the "total" line
0e362f54
GM
1955 (delete-region (point) (line-end-position))
1956 (beginning-of-line)
1957 (forward-line 1))
1958 ;; file line
3d30b8bc
RS
1959 ((setq filename (dired-get-filename nil t))
1960 (cond
3b574573 1961 ;; subdir
3d30b8bc 1962 ((file-directory-p filename)
0e362f54
GM
1963 (cond
1964 ((member (file-name-nondirectory filename)
3b574573
AS
1965 vc-directory-exclusion-list)
1966 (let ((pos (point)))
1967 (dired-kill-tree filename)
1968 (goto-char pos)
1969 (dired-kill-line)))
1970 (vc-dired-terse-mode
633cee46
AS
1971 ;; Don't show directories in terse mode. Don't use
1972 ;; dired-kill-line to remove it, because in recursive listings,
1973 ;; that would remove the directory contents as well.
0e362f54 1974 (delete-region (line-beginning-position)
633cee46 1975 (progn (forward-line 1) (point))))
3b574573
AS
1976 ((string-match "\\`\\.\\.?\\'" (file-name-nondirectory filename))
1977 (dired-kill-line))
1978 (t
3d30b8bc 1979 (vc-dired-reformat-line nil)
3b574573 1980 (forward-line 1))))
c59a2442 1981 ;; Try to head off calling the expensive state query -
35d33ce7
ER
1982 ;; ignore object files, TeX intermediate files, and so forth.
1983 ((vc-dired-ignorable-p filename)
1984 (dired-kill-line))
c59a2442
ER
1985 ;; Ordinary file -- call the (possibly expensive) state query
1986 ;;
1987 ;; First case: unregistered or unknown. (Unknown shouldn't happen here)
1988 ((member (vc-state filename) '(nil unregistered))
1989 (if vc-dired-terse-mode
1990 (dired-kill-line)
1991 (vc-dired-reformat-line "?")
1992 (forward-line 1)))
df49d02e 1993 ;; Either we're in non-terse mode or it's out of date
c59a2442 1994 ((not (and vc-dired-terse-mode (vc-up-to-date-p filename)))
0a299408 1995 (vc-dired-reformat-line (vc-call prettify-state-info filename))
c59a2442 1996 (forward-line 1))
df49d02e
JB
1997 ;; Remaining cases are under version control but uninteresting
1998 (t
c59a2442 1999 (dired-kill-line))))
3d30b8bc 2000 ;; any other line
3b574573
AS
2001 (t (forward-line 1))))
2002 (vc-dired-purge))
2003 (message "Getting version information... done")
2004 (save-restriction
2005 (widen)
633cee46
AS
2006 (cond ((eq (count-lines (point-min) (point-max)) 1)
2007 (goto-char (point-min))
9580f1fd 2008 (message "No changes pending under %s" default-directory)))))
3b574573 2009
b1ddeeb7
ER
2010;; VC status implementation
2011
b1ddeeb7
ER
2012(defun vc-default-status-extra-headers (backend dir)
2013 ;; Be loud by default to remind people to add coded to display
2014 ;; backend specific headers.
2015 ;; XXX: change this to return nil before the release.
2016 "Extra : Add backend specific headers here")
2017
2018(defun vc-dir-headers (backend dir)
2019 "Display the headers in the *VC status* buffer.
2020It calls the `status-extra-headers' backend method to display backend
2021specific headers."
2022 (concat
2023 (propertize "VC backend : " 'face 'font-lock-type-face)
2024 (propertize (format "%s\n" backend) 'face 'font-lock-variable-name-face)
2025 (propertize "Working dir: " 'face 'font-lock-type-face)
2026 (propertize (format "%s\n" dir) 'face 'font-lock-variable-name-face)
2027 (vc-call-backend backend 'status-extra-headers dir)
2028 "\n"))
2029
2030(defun vc-default-status-printer (backend fileentry)
2031 "Pretty print FILEENTRY."
2032 ;; If you change the layout here, change vc-dir-move-to-goal-column.
2033 (let ((state
2034 (if (vc-dir-fileinfo->directory fileentry)
2035 'DIRECTORY
2036 (vc-dir-fileinfo->state fileentry))))
2037 (insert
2038 (propertize
2039 (format "%c" (if (vc-dir-fileinfo->marked fileentry) ?* ? ))
2040 'face 'font-lock-type-face)
2041 " "
2042 (propertize
2043 (format "%-20s" state)
2044 'face (cond ((eq state 'up-to-date) 'font-lock-builtin-face)
2045 ((memq state '(missing conflict)) 'font-lock-warning-face)
2046 (t 'font-lock-variable-name-face))
2047 'mouse-face 'highlight)
2048 " "
2049 (propertize
2050 (format "%s" (vc-dir-fileinfo->name fileentry))
2051 'face 'font-lock-function-name-face
2052 'mouse-face 'highlight))))
2053
b1ddeeb7
ER
2054(defun vc-default-extra-status-menu (backend)
2055 nil)
2056
783b505b
ER
2057;; This is used to that VC backends could add backend specific menu
2058;; items to vc-dir-menu-map.
2059(defun vc-dir-menu-map-filter (orig-binding)
2060 (when (and (symbolp orig-binding) (fboundp orig-binding))
2061 (setq orig-binding (indirect-function orig-binding)))
2062 (let ((ext-binding
2063 (vc-call-backend (vc-responsible-backend default-directory)
2064 'extra-status-menu)))
2065 (if (null ext-binding)
2066 orig-binding
2067 (append orig-binding
2068 '("----")
2069 ext-binding))))
b1ddeeb7
ER
2070
2071(defun vc-dir-refresh-files (files default-state)
2072 "Refresh some files in the VC status buffer."
2073 (let ((backend (vc-responsible-backend default-directory))
2074 (status-buffer (current-buffer))
2075 (def-dir default-directory))
2076 (vc-set-mode-line-busy-indicator)
2077 ;; Call the `dir-status-file' backend function.
2078 ;; `dir-status-file' is supposed to be asynchronous.
2079 ;; It should compute the results, and then call the function
2080 ;; passed as an argument in order to update the vc-dir buffer
2081 ;; with the results.
2082 (unless (buffer-live-p vc-dir-process-buffer)
2083 (setq vc-dir-process-buffer
2084 (generate-new-buffer (format " *VC-%s* tmp status" backend))))
2085 (lexical-let ((buffer (current-buffer)))
2086 (with-current-buffer vc-dir-process-buffer
2087 (cd def-dir)
2088 (erase-buffer)
2089 (vc-call-backend
2090 backend 'dir-status-files def-dir files default-state
2091 (lambda (entries &optional more-to-come)
2092 ;; ENTRIES is a list of (FILE VC_STATE EXTRA) items.
2093 ;; If MORE-TO-COME is true, then more updates will come from
2094 ;; the asynchronous process.
2095 (with-current-buffer buffer
2096 (vc-dir-update entries buffer)
2097 (unless more-to-come
2098 (setq mode-line-process nil)
2099 ;; Remove the ones that haven't been updated at all.
2100 ;; Those not-updated are those whose state is nil because the
2101 ;; file/dir doesn't exist and isn't versioned.
2102 (ewoc-filter vc-ewoc
2103 (lambda (info)
2104 (not (vc-dir-fileinfo->needs-update info))))))))))))
2105
2106(defun vc-dir-refresh ()
2107 "Refresh the contents of the VC status buffer.
2108Throw an error if another update process is in progress."
2109 (interactive)
2110 (if (vc-dir-busy)
2111 (error "Another update process is in progress, cannot run two at a time")
2112 (let ((backend (vc-responsible-backend default-directory))
2113 (status-buffer (current-buffer))
2114 (def-dir default-directory))
2115 (vc-set-mode-line-busy-indicator)
2116 ;; Call the `dir-status' backend function.
2117 ;; `dir-status' is supposed to be asynchronous.
2118 ;; It should compute the results, and then call the function
2119 ;; passed as an argument in order to update the vc-dir buffer
2120 ;; with the results.
2121
2122 ;; Create a buffer that can be used by `dir-status' and call
2123 ;; `dir-status' with this buffer as the current buffer. Use
2124 ;; `vc-dir-process-buffer' to remember this buffer, so that
2125 ;; it can be used later to kill the update process in case it
2126 ;; takes too long.
2127 (unless (buffer-live-p vc-dir-process-buffer)
2128 (setq vc-dir-process-buffer
2129 (generate-new-buffer (format " *VC-%s* tmp status" backend))))
2130 ;; set the needs-update flag on all entries
2131 (ewoc-map (lambda (info) (setf (vc-dir-fileinfo->needs-update info) t) nil)
2132 vc-ewoc)
2133 (lexical-let ((buffer (current-buffer)))
2134 (with-current-buffer vc-dir-process-buffer
2135 (cd def-dir)
2136 (erase-buffer)
2137 (vc-call-backend
2138 backend 'dir-status def-dir
2139 (lambda (entries &optional more-to-come)
2140 ;; ENTRIES is a list of (FILE VC_STATE EXTRA) items.
2141 ;; If MORE-TO-COME is true, then more updates will come from
2142 ;; the asynchronous process.
2143 (with-current-buffer buffer
2144 (vc-dir-update entries buffer)
2145 (unless more-to-come
2146 (let ((remaining
2147 (ewoc-collect
2148 vc-ewoc 'vc-dir-fileinfo->needs-update)))
2149 (if remaining
2150 (vc-dir-refresh-files
2151 (mapcar 'vc-dir-fileinfo->name remaining)
2152 'up-to-date)
2153 (setq mode-line-process nil))))))))))))
2154
b1ddeeb7
ER
2155(defun vc-dir-show-fileentry (file)
2156 "Insert an entry for a specific file into the current VC status listing.
2157This is typically used if the file is up-to-date (or has been added
2158outside of VC) and one wants to do some operation on it."
2159 (interactive "fShow file: ")
2160 (vc-dir-update (list (list (file-relative-name file) (vc-state file))) (current-buffer)))
2161
b1ddeeb7
ER
2162(defun vc-dir-hide-up-to-date ()
2163 "Hide up-to-date items from display."
2164 (interactive)
2165 (ewoc-filter
2166 vc-ewoc
2167 (lambda (crt) (not (eq (vc-dir-fileinfo->state crt) 'up-to-date)))))
2168
783b505b
ER
2169(defun vc-dir-register ()
2170 "Register the marked files, or the current file if no marks."
2171 (interactive)
2172 ;; FIXME: Just pass the fileset to vc-register.
2173 (mapc (lambda (arg) (vc-register nil arg))
2174 (or (vc-dir-marked-files) (list (vc-dir-current-file)))))
2175
b1ddeeb7 2176(defun vc-default-status-fileinfo-extra (backend file)
cb625535 2177 "Default absence of extra information returned for a file."
b1ddeeb7
ER
2178 nil)
2179
cb625535
ER
2180;; FIXME: Replace these with a more efficient dispatch
2181
2182(defun vc-generic-status-printer (fileentry)
2183 (let ((backend (vc-responsible-backend (vc-dir-fileinfo->name fileentry))))
2184 (vc-call-backend backend 'status-printer fileentry)))
2185
2186(defun vc-generic-state (file)
2187 (let ((backend (vc-responsible-backend file)))
2188 (vc-call-backend backend 'state)))
2189
2190(defun vc-generic-status-fileinfo-extra (file)
2191 (let ((backend (vc-responsible-backend file)))
2192 (vc-call-backend backend 'status-fileinfo-extra)))
2193
2194(defun vc-generic-dir-headers (dir)
2195 (let ((backend (vc-responsible-backend dir)))
2196 (vc-dir-headers backend dir)))
2197
2198(defun vc-make-backend-object (file-or-dir)
2199 (vc-create-client-object
2200 "VC status"
2201 (let ((backend (vc-responsible-backend file-or-dir)))
2202 (vc-dir-headers backend file-or-dir))
2203 #'vc-generic-status-printer
2204 #'vc-generic-state
2205 #'vc-generic-status-fileinfo-extra
2206 #'vc-dir-refresh))
2207
2208;;;###autoload
2209(defun vc-dir (dir)
2210 "Show the VC status for DIR."
2211 (interactive "DVC status for directory: ")
2212 (pop-to-buffer (vc-dir-prepare-status-buffer dir))
2213 (if (eq major-mode 'vc-dir-mode)
2214 (vc-dir-refresh)
2215 ;; Otherwise, initialize a new view using the dispatcher layer
2216 (progn
2217 ;; Build a capability object and hand it to the dispatcher initializer
a3e0b93f 2218 (vc-dir-mode (vc-make-backend-object dir))
cb625535
ER
2219 ;; Add VC-specific keybindings
2220 (let ((map (current-local-map)))
2221 (define-key map "=" 'vc-diff) ;; C-x v =
2222 (define-key map "a" 'vc-dir-register)
2223 (define-key map "+" 'vc-update) ;; C-x v +
2224 (define-key map "R" 'vc-revert) ;; u is taken by dispatcher unmark.
2225 (define-key map "A" 'vc-annotate) ;; g is taken by dispatcher referesh
2226 (define-key map "l" 'vc-print-log) ;; C-x v l
2227 (define-key map "x" 'vc-dir-hide-up-to-date)
2228 ))))
b1ddeeb7 2229
594722a8
ER
2230;; Named-configuration entry points
2231
0e362f54 2232(defun vc-snapshot-precondition (dir)
6f1ecae4 2233 "Scan the tree below DIR, looking for files not up-to-date.
099bd78a
SM
2234If any file is not up-to-date, return the name of the first such file.
2235\(This means, neither snapshot creation nor retrieval is allowed.\)
2236If one or more of the files are currently visited, return `visited'.
2237Otherwise, return nil."
503b5c85
RS
2238 (let ((status nil))
2239 (catch 'vc-locked-example
2240 (vc-file-tree-walk
0e362f54
GM
2241 dir
2242 (lambda (f)
2243 (if (not (vc-up-to-date-p f)) (throw 'vc-locked-example f)
b5446276 2244 (when (get-file-buffer f) (setq status 'visited)))))
503b5c85 2245 status)))
594722a8 2246
637a8ae9 2247;;;###autoload
0e362f54 2248(defun vc-create-snapshot (dir name branchp)
6f41eeb5 2249 "Descending recursively from DIR, make a snapshot called NAME.
ac3f4c6f
ER
2250For each registered file, the working revision becomes part of
2251the named configuration. If the prefix argument BRANCHP is
2252given, the snapshot is made as a new branch and the files are
2253checked out in that new branch."
0e362f54
GM
2254 (interactive
2255 (list (read-file-name "Directory: " default-directory default-directory t)
2256 (read-string "New snapshot name: ")
2257 current-prefix-arg))
2258 (message "Making %s... " (if branchp "branch" "snapshot"))
b5446276 2259 (when (file-directory-p dir) (setq dir (file-name-as-directory dir)))
0e362f54
GM
2260 (vc-call-backend (vc-responsible-backend dir)
2261 'create-snapshot dir name branchp)
2262 (message "Making %s... done" (if branchp "branch" "snapshot")))
2263
637a8ae9 2264;;;###autoload
0e362f54 2265(defun vc-retrieve-snapshot (dir name)
099bd78a 2266 "Descending recursively from DIR, retrieve the snapshot called NAME.
ac3f4c6f 2267If NAME is empty, it refers to the latest revisions.
099bd78a
SM
2268If locking is used for the files in DIR, then there must not be any
2269locked files at or below DIR (but if NAME is empty, locked files are
2270allowed and simply skipped)."
0e362f54
GM
2271 (interactive
2272 (list (read-file-name "Directory: " default-directory default-directory t)
ac3f4c6f 2273 (read-string "Snapshot name to retrieve (default latest revisions): ")))
0e362f54
GM
2274 (let ((update (yes-or-no-p "Update any affected buffers? "))
2275 (msg (if (or (not name) (string= name ""))
2276 (format "Updating %s... " (abbreviate-file-name dir))
2277 (format "Retrieving snapshot into %s... "
2278 (abbreviate-file-name dir)))))
8a26c165 2279 (message "%s" msg)
0e362f54
GM
2280 (vc-call-backend (vc-responsible-backend dir)
2281 'retrieve-snapshot dir name update)
8a26c165 2282 (message "%s" (concat msg "done"))))
0e362f54 2283
594722a8
ER
2284;; Miscellaneous other entry points
2285
637a8ae9 2286;;;###autoload
ac3f4c6f 2287(defun vc-print-log (&optional working-revision)
d7b60083 2288 "List the change log of the current fileset in a window.
ac3f4c6f 2289If WORKING-REVISION is non-nil, leave the point at that revision."
594722a8 2290 (interactive)
ae67f2d0
DN
2291 (let* ((vc-fileset (vc-deduce-fileset))
2292 (files (cdr vc-fileset))
2293 (backend (car vc-fileset))
ac3f4c6f 2294 (working-revision (or working-revision (vc-working-revision (car files)))))
5217a76a
SS
2295 ;; Don't switch to the output buffer before running the command,
2296 ;; so that any buffer-local settings in the vc-controlled
ac9ff209 2297 ;; buffer can be accessed by the command.
d7b60083
ER
2298 (vc-call-backend backend 'print-log files "*vc-change-log*")
2299 (pop-to-buffer "*vc-change-log*")
0e362f54 2300 (vc-exec-after
99cb8c8b 2301 `(let ((inhibit-read-only t))
d7b60083 2302 (vc-call-backend ',backend 'log-view-mode)
0e362f54
GM
2303 (goto-char (point-max)) (forward-line -1)
2304 (while (looking-at "=*\n")
2305 (delete-char (- (match-end 0) (match-beginning 0)))
2306 (forward-line -1))
2307 (goto-char (point-min))
b5446276
DN
2308 (when (looking-at "[\b\t\n\v\f\r ]+")
2309 (delete-char (- (match-end 0) (match-beginning 0))))
d7b60083 2310 (shrink-window-if-larger-than-buffer)
ac3f4c6f
ER
2311 ;; move point to the log entry for the working revision
2312 (vc-call-backend ',backend 'show-log-entry ',working-revision)
86e80023 2313 (setq vc-sentinel-movepoint (point))
99cb8c8b 2314 (set-buffer-modified-p nil)))))
594722a8 2315
637a8ae9 2316;;;###autoload
e4d26892 2317(defun vc-revert ()
d7b60083 2318 "Revert working copies of the selected fileset to their repository contents.
9c95ac44 2319This asks for confirmation if the buffer contents are not identical
ac3f4c6f 2320to the working revision (except for keyword expansion)."
594722a8 2321 (interactive)
ae67f2d0
DN
2322 (let* ((vc-fileset (vc-deduce-fileset))
2323 (files (cdr vc-fileset)))
d7b60083
ER
2324 ;; If any of the files is visited by the current buffer, make
2325 ;; sure buffer is saved. If the user says `no', abort since
2326 ;; we cannot show the changes and ask for confirmation to
2327 ;; discard them.
b5446276
DN
2328 (when (or (not files) (memq (buffer-file-name) files))
2329 (vc-buffer-sync nil))
d7b60083 2330 (dolist (file files)
a7192ddb 2331 (let ((buf (get-file-buffer file)))
b5446276 2332 (when (and buf (buffer-modified-p buf))
d7b60083 2333 (error "Please kill or save all modified buffers before reverting.")))
b5446276
DN
2334 (when (vc-up-to-date-p file)
2335 (unless (yes-or-no-p (format "%s seems up-to-date. Revert anyway? " file))
2336 (error "Revert canceled"))))
ae67f2d0 2337 (when (vc-diff-internal vc-allow-async-revert vc-fileset nil nil)
b5446276
DN
2338 (unless (yes-or-no-p (format "Discard changes in %s? " (vc-delistify files)))
2339 (error "Revert canceled"))
2340 (delete-windows-on "*vc-diff*")
2341 (kill-buffer "*vc-diff*"))
d7b60083 2342 (dolist (file files)
b5446276
DN
2343 (message "Reverting %s..." (vc-delistify files))
2344 (vc-revert-file file)
2345 (message "Reverting %s...done" (vc-delistify files)))))
594722a8 2346
637a8ae9 2347;;;###autoload
d7b60083
ER
2348(defun vc-rollback ()
2349 "Roll back (remove) the most recent changeset committed to the repository.
2350This may be either a file-level or a repository-level operation,
2351depending on the underlying version-control system."
2352 (interactive)
ae67f2d0
DN
2353 (let* ((vc-fileset (vc-deduce-fileset))
2354 (files (cdr vc-fileset))
2355 (backend (car vc-fileset))
d7b60083
ER
2356 (granularity (vc-call-backend backend 'revision-granularity)))
2357 (unless (vc-find-backend-function backend 'rollback)
2358 (error "Rollback is not supported in %s" backend))
b5446276
DN
2359 (when (and (not (eq granularity 'repository)) (/= (length files) 1))
2360 (error "Rollback requires a singleton fileset or repository versioning"))
2361 (when (not (vc-call latest-on-branch-p (car files)))
2362 (error "Rollback is only possible at the tip revision."))
d7b60083
ER
2363 ;; If any of the files is visited by the current buffer, make
2364 ;; sure buffer is saved. If the user says `no', abort since
2365 ;; we cannot show the changes and ask for confirmation to
2366 ;; discard them.
b5446276
DN
2367 (when (or (not files) (memq (buffer-file-name) files))
2368 (vc-buffer-sync nil))
d7b60083 2369 (dolist (file files)
b5446276
DN
2370 (when (buffer-modified-p (get-file-buffer file))
2371 (error "Please kill or save all modified buffers before rollback."))
2372 (when (not (vc-up-to-date-p file))
2373 (error "Please revert all modified workfiles before rollback.")))
d7b60083
ER
2374 ;; Accumulate changes associated with the fileset
2375 (vc-setup-buffer "*vc-diff*")
2376 (not-modified)
2377 (message "Finding changes...")
ac3f4c6f
ER
2378 (let* ((tip (vc-working-revision (car files)))
2379 (previous (vc-call previous-revision (car files) tip)))
ae67f2d0 2380 (vc-diff-internal nil vc-fileset previous tip))
a7192ddb 2381 ;; Display changes
d7b60083
ER
2382 (unless (yes-or-no-p "Discard these revisions? ")
2383 (error "Rollback canceled"))
2384 (delete-windows-on "*vc-diff*")
2385 (kill-buffer"*vc-diff*")
2386 ;; Do the actual reversions
2387 (message "Rolling back %s..." (vc-delistify files))
2388 (with-vc-properties
2389 files
2390 (vc-call-backend backend 'rollback files)
2391 `((vc-state . ,'up-to-date)
2392 (vc-checkout-time . , (nth 5 (file-attributes file)))
ac3f4c6f 2393 (vc-working-revision . nil)))
a7192ddb 2394 (dolist (f files) (vc-resynch-buffer f t t))
d7b60083 2395 (message "Rolling back %s...done" (vc-delistify files))))
0e362f54 2396
2765044b
DN
2397;;;###autoload
2398(define-obsolete-function-alias 'vc-revert-buffer 'vc-revert "23.1")
2399
2400;;;###autoload
2401(defun vc-update ()
ac3f4c6f 2402 "Update the current fileset's files to their tip revisions.
a7192ddb
SM
2403For each one that contains no changes, and is not locked, then this simply
2404replaces the work file with the latest revision on its branch. If the file
2405contains changes, and the backend supports merging news, then any recent
d7b60083 2406changes from the current branch are merged into the working file."
2765044b 2407 (interactive)
ae67f2d0
DN
2408 (let* ((vc-fileset (vc-deduce-fileset))
2409 (files (cdr vc-fileset))
2410 (backend (car vc-fileset)))
2411 (dolist (file files)
2412 (when (let ((buf (get-file-buffer file)))
2413 (and buf (buffer-modified-p buf)))
2414 (error "Please kill or save all modified buffers before updating."))
2415 (if (vc-up-to-date-p file)
2416 (vc-checkout file nil t)
70e2f6c7 2417 (if (eq (vc-checkout-model backend (list file)) 'locking)
ae67f2d0
DN
2418 (if (eq (vc-state file) 'edited)
2419 (error "%s"
2420 (substitute-command-keys
2421 "File is locked--type \\[vc-revert] to discard changes"))
2422 (error "Unexpected file state (%s) -- type %s"
2423 (vc-state file)
1f325d92 2424 (substitute-command-keys
ae67f2d0
DN
2425 "\\[vc-next-action] to correct")))
2426 (if (not (vc-find-backend-function backend 'merge-news))
2427 (error "Sorry, merging news is not implemented for %s"
2428 backend)
2429 (vc-maybe-resolve-conflicts file (vc-call merge-news file))))))))
2765044b
DN
2430
2431(defun vc-version-backup-file (file &optional rev)
2432 "Return name of backup file for revision REV of FILE.
2433If version backups should be used for FILE, and there exists
a7192ddb 2434such a backup for REV or the working revision of file, return
0d0e9356 2435its name; otherwise return nil."
2765044b
DN
2436 (when (vc-call make-version-backups-p file)
2437 (let ((backup-file (vc-version-backup-file-name file rev)))
2438 (if (file-exists-p backup-file)
2439 backup-file
2440 ;; there is no automatic backup, but maybe the user made one manually
2441 (setq backup-file (vc-version-backup-file-name file rev 'manual))
b5446276
DN
2442 (when (file-exists-p backup-file)
2443 backup-file)))))
2765044b
DN
2444
2445(defun vc-revert-file (file)
ac3f4c6f 2446 "Revert FILE back to the repository working revision it was based on."
2765044b 2447 (with-vc-properties
d7b60083 2448 (list file)
2765044b
DN
2449 (let ((backup-file (vc-version-backup-file file)))
2450 (when backup-file
2451 (copy-file backup-file file 'ok-if-already-exists 'keep-date)
2452 (vc-delete-automatic-version-backups file))
2453 (vc-call revert file backup-file))
2454 `((vc-state . up-to-date)
2455 (vc-checkout-time . ,(nth 5 (file-attributes file)))))
2456 (vc-resynch-buffer file t t))
2457
76e5906d 2458;;;###autoload
1d502d5a 2459(defun vc-switch-backend (file backend)
7849e179 2460 "Make BACKEND the current version control system for FILE.
1d502d5a
AS
2461FILE must already be registered in BACKEND. The change is not
2462permanent, only for the current session. This function only changes
7849e179
SM
2463VC's perspective on FILE, it does not register or unregister it.
2464By default, this command cycles through the registered backends.
2465To get a prompt, use a prefix argument."
2466 (interactive
1d502d5a 2467 (list
94ca88e3
AS
2468 (or buffer-file-name
2469 (error "There is no version-controlled file in this buffer"))
7849e179
SM
2470 (let ((backend (vc-backend buffer-file-name))
2471 (backends nil))
d7b60083
ER
2472 (unless backend
2473 (error "File %s is not under version control" buffer-file-name))
2474 ;; Find the registered backends.
2475 (dolist (backend vc-handled-backends)
2476 (when (vc-call-backend backend 'registered buffer-file-name)
2477 (push backend backends)))
2478 ;; Find the next backend.
2479 (let ((def (car (delq backend (append (memq backend backends) backends))))
2480 (others (delete backend backends)))
2481 (cond
2482 ((null others) (error "No other backend to switch to"))
2483 (current-prefix-arg
2484 (intern
2485 (upcase
2486 (completing-read
2487 (format "Switch to backend [%s]: " def)
2488 (mapcar (lambda (b) (list (downcase (symbol-name b)))) backends)
2489 nil t nil nil (downcase (symbol-name def))))))
2490 (t def))))))
ceec5a0c 2491 (unless (eq backend (vc-backend file))
ceec5a0c
SM
2492 (vc-file-clearprops file)
2493 (vc-file-setprop file 'vc-backend backend)
2494 ;; Force recomputation of the state
a3255400
SM
2495 (unless (vc-call-backend backend 'registered file)
2496 (vc-file-clearprops file)
2497 (error "%s is not registered in %s" file backend))
ceec5a0c 2498 (vc-mode-line file)))
1d502d5a 2499
21b50296 2500;;;###autoload
1d502d5a 2501(defun vc-transfer-file (file new-backend)
ceec5a0c 2502 "Transfer FILE to another version control system NEW-BACKEND.
1d502d5a 2503If NEW-BACKEND has a higher precedence than FILE's current backend
ceec5a0c 2504\(i.e. it comes earlier in `vc-handled-backends'), then register FILE in
ac3f4c6f 2505NEW-BACKEND, using the revision number from the current backend as the
1d502d5a
AS
2506base level. If NEW-BACKEND has a lower precedence than the current
2507backend, then commit all changes that were made under the current
2508backend to NEW-BACKEND, and unregister FILE from the current backend.
2509\(If FILE is not yet registered under NEW-BACKEND, register it.)"
72cfc5fb
AS
2510 (let* ((old-backend (vc-backend file))
2511 (edited (memq (vc-state file) '(edited needs-merge)))
2512 (registered (vc-call-backend new-backend 'registered file))
2513 (move
2514 (and registered ; Never move if not registered in new-backend yet.
2515 ;; move if new-backend comes later in vc-handled-backends
2516 (or (memq new-backend (memq old-backend vc-handled-backends))
ffda0460 2517 (y-or-n-p "Final transfer? "))))
72cfc5fb 2518 (comment nil))
ae67f2d0
DN
2519 (when (eq old-backend new-backend)
2520 (error "%s is the current backend of %s" new-backend file))
72cfc5fb
AS
2521 (if registered
2522 (set-file-modes file (logior (file-modes file) 128))
2523 ;; `registered' might have switched under us.
2524 (vc-switch-backend file old-backend)
ac3f4c6f 2525 (let* ((rev (vc-working-revision file))
c1b1b393 2526 (modified-file (and edited (make-temp-file file)))
ffda0460 2527 (unmodified-file (and modified-file (vc-version-backup-file file))))
72cfc5fb
AS
2528 ;; Go back to the base unmodified file.
2529 (unwind-protect
2530 (progn
ffda0460 2531 (when modified-file
c1b1b393 2532 (copy-file file modified-file 'ok-if-already-exists)
ffda0460
AS
2533 ;; If we have a local copy of the unmodified file, handle that
2534 ;; here and not in vc-revert-file because we don't want to
2535 ;; delete that copy -- it is still useful for OLD-BACKEND.
2536 (if unmodified-file
b4e4e3a8
SM
2537 (copy-file unmodified-file file
2538 'ok-if-already-exists 'keep-date)
ae67f2d0
DN
2539 (when (y-or-n-p "Get base revision from master? ")
2540 (vc-revert-file file))))
72cfc5fb 2541 (vc-call-backend new-backend 'receive-file file rev))
ffda0460 2542 (when modified-file
72cfc5fb 2543 (vc-switch-backend file new-backend)
70e2f6c7 2544 (unless (eq (vc-checkout-model new-backend (list file)) 'implicit)
72cfc5fb 2545 (vc-checkout file t nil))
ffda0460
AS
2546 (rename-file modified-file file 'ok-if-already-exists)
2547 (vc-file-setprop file 'vc-checkout-time nil)))))
72cfc5fb
AS
2548 (when move
2549 (vc-switch-backend file old-backend)
2550 (setq comment (vc-call comment-history file))
2551 (vc-call unregister file))
2552 (vc-switch-backend file new-backend)
2553 (when (or move edited)
1d502d5a 2554 (vc-file-setprop file 'vc-state 'edited)
ffda0460 2555 (vc-mode-line file)
0ab66291 2556 (vc-checkin file nil comment (stringp comment)))))
1d502d5a 2557
0e362f54
GM
2558(defun vc-rename-master (oldmaster newfile templates)
2559 "Rename OLDMASTER to be the master file for NEWFILE based on TEMPLATES."
2560 (let* ((dir (file-name-directory (expand-file-name oldmaster)))
2561 (newdir (or (file-name-directory newfile) ""))
2562 (newbase (file-name-nondirectory newfile))
2563 (masters
2564 ;; List of potential master files for `newfile'
2565 (mapcar
2566 (lambda (s) (vc-possible-master s newdir newbase))
2567 templates)))
b5446276
DN
2568 (when (or (file-symlink-p oldmaster)
2569 (file-symlink-p (file-name-directory oldmaster)))
2570 (error "This is unsafe in the presence of symbolic links"))
0e362f54
GM
2571 (rename-file
2572 oldmaster
2573 (catch 'found
2574 ;; If possible, keep the master file in the same directory.
b4e4e3a8 2575 (dolist (f masters)
ae67f2d0
DN
2576 (when (and f (string= (file-name-directory (expand-file-name f)) dir))
2577 (throw 'found f)))
0e362f54 2578 ;; If not, just use the first possible place.
b4e4e3a8
SM
2579 (dolist (f masters)
2580 (and f (or (not (setq dir (file-name-directory f)))
2581 (file-directory-p dir))
2582 (throw 'found f)))
0e362f54 2583 (error "New file lacks a version control directory")))))
594722a8 2584
a36319a4
SM
2585(defun vc-delete-file (file)
2586 "Delete file and mark it as such in the version control system."
2587 (interactive "fVC delete file: ")
484c3092 2588 (setq file (expand-file-name file))
c6e44350
AS
2589 (let ((buf (get-file-buffer file))
2590 (backend (vc-backend file)))
2591 (unless backend
86a65190 2592 (error "File %s is not under version control"
c6e44350 2593 (file-name-nondirectory file)))
a36319a4 2594 (unless (vc-find-backend-function backend 'delete-file)
c6e44350 2595 (error "Deleting files under %s is not supported in VC" backend))
b5446276 2596 (when (and buf (buffer-modified-p buf))
a84615c7
SS
2597 (error "Please save or undo your changes before deleting %s" file))
2598 (let ((state (vc-state file)))
2599 (when (eq state 'edited)
2600 (error "Please commit or undo your changes before deleting %s" file))
2601 (when (eq state 'conflict)
2602 (error "Please resolve the conflicts before deleting %s" file)))
ce5a3ac0 2603 (unless (y-or-n-p (format "Really want to delete %s? "
a36319a4
SM
2604 (file-name-nondirectory file)))
2605 (error "Abort!"))
775237d3
SS
2606 (unless (or (file-directory-p file) (null make-backup-files)
2607 (not (file-exists-p file)))
a36319a4
SM
2608 (with-current-buffer (or buf (find-file-noselect file))
2609 (let ((backup-inhibited nil))
484c3092
DN
2610 (backup-buffer))
2611 ;; If we didn't have a buffer visiting the file before this
2612 ;; command, kill the buffer created by the above
2613 ;; `find-file-noselect' call.
2614 (unless buf (kill-buffer (current-buffer)))))
a36319a4
SM
2615 (vc-call delete-file file)
2616 ;; If the backend hasn't deleted the file itself, let's do it for him.
b5446276 2617 (when (file-exists-p file) (delete-file file))
484c3092
DN
2618 ;; Forget what VC knew about the file.
2619 (vc-file-clearprops file)
2620 (vc-resynch-buffer file buf t)))
a36319a4 2621
29fc1ce9 2622;;;###autoload
594722a8 2623(defun vc-rename-file (old new)
34291cd2
RS
2624 "Rename file OLD to NEW, and rename its master file likewise."
2625 (interactive "fVC rename file: \nFRename to: ")
a36319a4 2626 (let ((oldbuf (get-file-buffer old)))
b5446276
DN
2627 (when (and oldbuf (buffer-modified-p oldbuf))
2628 (error "Please save files before moving them"))
2629 (when (get-file-buffer new)
2630 (error "Already editing new file name"))
2631 (when (file-exists-p new)
2632 (error "New file already exists"))
86a65190 2633 (let ((state (vc-state old)))
a36319a4
SM
2634 (unless (memq state '(up-to-date edited))
2635 (error "Please %s files before moving them"
2636 (if (stringp state) "check in" "update"))))
2637 (vc-call rename-file old new)
b4e4e3a8 2638 (vc-file-clearprops old)
0e362f54 2639 ;; Move the actual file (unless the backend did it already)
b5446276 2640 (when (file-exists-p old) (rename-file old new))
0e362f54
GM
2641 ;; ?? Renaming a file might change its contents due to keyword expansion.
2642 ;; We should really check out a new copy if the old copy was precisely equal
ac3f4c6f 2643 ;; to some checked-in revision. However, testing for this is tricky....
b5446276
DN
2644 (when oldbuf
2645 (with-current-buffer oldbuf
2646 (let ((buffer-read-only buffer-read-only))
2647 (set-visited-file-name new))
2648 (vc-backend new)
2649 (vc-mode-line new)
2650 (set-buffer-modified-p nil)))))
0e362f54 2651
637a8ae9 2652;;;###autoload
f35ecf88 2653(defun vc-update-change-log (&rest args)
0e362f54 2654 "Find change log file and add entries from recent version control logs.
d68e6990 2655Normally, find log entries for all registered files in the default
0e362f54 2656directory.
d68e6990 2657
099bd78a 2658With prefix arg of \\[universal-argument], only find log entries for the current buffer's file.
d68e6990
RS
2659
2660With any numeric prefix arg, find log entries for all currently visited
2661files that are under version control. This puts all the entries in the
2662log for the default directory, which may not be appropriate.
2663
099bd78a 2664From a program, any ARGS are assumed to be filenames for which
0e362f54 2665log entries should be gathered."
67242a23
RM
2666 (interactive
2667 (cond ((consp current-prefix-arg) ;C-u
2668 (list buffer-file-name))
2669 (current-prefix-arg ;Numeric argument.
2670 (let ((files nil)
2671 (buffers (buffer-list))
2672 file)
2673 (while buffers
2674 (setq file (buffer-file-name (car buffers)))
f3c61d82 2675 (and file (vc-backend file)
4b40fdea 2676 (setq files (cons file files)))
67242a23 2677 (setq buffers (cdr buffers)))
4b40fdea
PE
2678 files))
2679 (t
0e362f54
GM
2680 ;; Don't supply any filenames to backend; this means
2681 ;; it should find all relevant files relative to
2682 ;; the default-directory.
73a9679c 2683 nil)))
0e362f54
GM
2684 (vc-call-backend (vc-responsible-backend default-directory)
2685 'update-changelog args))
2686
ac3f4c6f 2687;;; The default back end. Assumes RCS-like revision numbering.
61de26cb
ER
2688
2689(defun vc-default-revision-granularity ()
2690 (error "Your backend will not work with this version of VC mode."))
2691
2765044b
DN
2692;; functions that operate on RCS revision numbers. This code should
2693;; also be moved into the backends. It stays for now, however, since
2694;; it is used in code below.
2695;;;###autoload
2696(defun vc-trunk-p (rev)
2697 "Return t if REV is a revision on the trunk."
2698 (not (eq nil (string-match "\\`[0-9]+\\.[0-9]+\\'" rev))))
2699
2700(defun vc-branch-p (rev)
2701 "Return t if REV is a branch revision."
2702 (not (eq nil (string-match "\\`[0-9]+\\(\\.[0-9]+\\.[0-9]+\\)*\\'" rev))))
2703
2704;;;###autoload
2705(defun vc-branch-part (rev)
2706 "Return the branch part of a revision number REV."
2707 (let ((index (string-match "\\.[0-9]+\\'" rev)))
b5446276
DN
2708 (when index
2709 (substring rev 0 index))))
2765044b
DN
2710
2711(defun vc-minor-part (rev)
ac3f4c6f 2712 "Return the minor revision number of a revision number REV."
2765044b
DN
2713 (string-match "[0-9]+\\'" rev)
2714 (substring rev (match-beginning 0) (match-end 0)))
2715
ac3f4c6f
ER
2716(defun vc-default-previous-revision (backend file rev)
2717 "Return the revision number immediately preceding REV for FILE,
2718or nil if there is no previous revision. This default
2719implementation works for MAJOR.MINOR-style revision numbers as
2765044b
DN
2720used by RCS and CVS."
2721 (let ((branch (vc-branch-part rev))
2722 (minor-num (string-to-number (vc-minor-part rev))))
2723 (when branch
2724 (if (> minor-num 1)
ac3f4c6f 2725 ;; revision does probably not start a branch or release
2765044b
DN
2726 (concat branch "." (number-to-string (1- minor-num)))
2727 (if (vc-trunk-p rev)
2728 ;; we are at the beginning of the trunk --
2729 ;; don't know anything to return here
2730 nil
2731 ;; we are at the beginning of a branch --
ac3f4c6f 2732 ;; return revision of starting point
2765044b
DN
2733 (vc-branch-part branch))))))
2734
ac3f4c6f
ER
2735(defun vc-default-next-revision (backend file rev)
2736 "Return the revision number immediately following REV for FILE,
2737or nil if there is no next revision. This default implementation
2738works for MAJOR.MINOR-style revision numbers as used by RCS
2765044b 2739and CVS."
ac3f4c6f 2740 (when (not (string= rev (vc-working-revision file)))
2765044b
DN
2741 (let ((branch (vc-branch-part rev))
2742 (minor-num (string-to-number (vc-minor-part rev))))
2743 (concat branch "." (number-to-string (1+ minor-num))))))
2744
2745(defun vc-default-responsible-p (backend file)
2746 "Indicate whether BACKEND is reponsible for FILE.
2747The default is to return nil always."
2748 nil)
2749
2750(defun vc-default-could-register (backend file)
2751 "Return non-nil if BACKEND could be used to register FILE.
2752The default implementation returns t for all files."
2753 t)
2754
2755(defun vc-default-latest-on-branch-p (backend file)
2756 "Return non-nil if FILE is the latest on its branch.
2757This default implementation always returns non-nil, which means that
ac3f4c6f 2758editing non-current revisions is not supported by default."
2765044b
DN
2759 t)
2760
ac3f4c6f 2761(defun vc-default-init-revision (backend) vc-default-init-revision)
2765044b 2762
45fd3a00
SM
2763(defalias 'vc-cvs-update-changelog 'vc-update-changelog-rcs2log)
2764(defalias 'vc-rcs-update-changelog 'vc-update-changelog-rcs2log)
2765;; FIXME: This should probably be moved to vc-rcs.el and replaced in
2766;; vc-cvs.el by code using cvs2cl.
0b8dce84 2767(defun vc-update-changelog-rcs2log (files)
099bd78a
SM
2768 "Default implementation of update-changelog.
2769Uses `rcs2log' which only works for RCS and CVS."
0e362f54 2770 ;; FIXME: We (c|sh)ould add support for cvs2cl
449decf5 2771 (let ((odefault default-directory)
124c852b
RS
2772 (changelog (find-change-log))
2773 ;; Presumably not portable to non-Unixy systems, along with rcs2log:
c1b1b393 2774 (tempfile (make-temp-file
57c298c4
EZ
2775 (expand-file-name "vc"
2776 (or small-temporary-file-directory
2777 temporary-file-directory))))
510f6466
AS
2778 (login-name (or user-login-name
2779 (format "uid%d" (number-to-string (user-uid)))))
b91916f3 2780 (full-name (or add-log-full-name
8172cd86
AS
2781 (user-full-name)
2782 (user-login-name)
2783 (format "uid%d" (number-to-string (user-uid)))))
b91916f3
RS
2784 (mailing-address (or add-log-mailing-address
2785 user-mail-address)))
124c852b 2786 (find-file-other-window changelog)
41dfb835
RS
2787 (barf-if-buffer-read-only)
2788 (vc-buffer-sync)
2789 (undo-boundary)
2790 (goto-char (point-min))
2791 (push-mark)
2792 (message "Computing change log entries...")
4b40fdea 2793 (message "Computing change log entries... %s"
124c852b
RS
2794 (unwind-protect
2795 (progn
0e362f54 2796 (setq default-directory odefault)
6f41eeb5
DL
2797 (if (eq 0 (apply 'call-process
2798 (expand-file-name "rcs2log"
2799 exec-directory)
0e362f54
GM
2800 nil (list t tempfile) nil
2801 "-c" changelog
510f6466 2802 "-u" (concat login-name
0e362f54
GM
2803 "\t" full-name
2804 "\t" mailing-address)
2805 (mapcar
2806 (lambda (f)
2807 (file-relative-name
d7b60083 2808 (expand-file-name f odefault)))
0e362f54
GM
2809 files)))
2810 "done"
04864eb0 2811 (pop-to-buffer (get-buffer-create "*vc*"))
124c852b 2812 (erase-buffer)
54ebae28 2813 (insert-file-contents tempfile)
124c852b 2814 "failed"))
0e362f54 2815 (setq default-directory (file-name-directory changelog))
124c852b 2816 (delete-file tempfile)))))
7d2d9482 2817
ac3f4c6f
ER
2818(defun vc-default-find-revision (backend file rev buffer)
2819 "Provide the new `find-revision' op based on the old `checkout' op.
2765044b 2820This is only for compatibility with old backends. They should be updated
ac3f4c6f 2821to provide the `find-revision' operation instead."
2765044b
DN
2822 (let ((tmpfile (make-temp-file (expand-file-name file))))
2823 (unwind-protect
2824 (progn
2825 (vc-call-backend backend 'checkout file nil rev tmpfile)
2826 (with-current-buffer buffer
2827 (insert-file-contents-literally tmpfile)))
2828 (delete-file tmpfile))))
2829
0a299408 2830(defun vc-default-prettify-state-info (backend file)
d7b60083
ER
2831 (let* ((state (vc-state file))
2832 (statestring
2833 (cond
2834 ((stringp state) (concat "(" state ")"))
45b24b4d 2835 ((eq state 'edited) "(modified)")
d7b60083 2836 ((eq state 'needs-merge) "(merge)")
3702367b 2837 ((eq state 'needs-update) "(update)")
0f67cc71 2838 ((eq state 'added) "(added)")
484c1b1f 2839 ((eq state 'removed) "(removed)")
722f037f
ER
2840 ((eq state 'ignored) "(ignored)") ;; dired-hook filters this out
2841 ((eq state 'unregistered) "?")
2842 ((eq state 'unlocked-changes) "(stale)")
2843 ((not state) "(unknown)")))
d7b60083
ER
2844 (buffer
2845 (get-file-buffer file))
2846 (modflag
2847 (if (and buffer (buffer-modified-p buffer)) "+" "")))
2848 (concat statestring modflag)))
2765044b
DN
2849
2850(defun vc-default-rename-file (backend old new)
2851 (condition-case nil
2852 (add-name-to-file old new)
2853 (error (rename-file old new)))
2854 (vc-delete-file old)
2855 (with-current-buffer (find-file-noselect new)
2856 (vc-register)))
2857
17f3909f 2858(defalias 'vc-default-check-headers 'ignore)
2765044b
DN
2859
2860(defun vc-default-log-view-mode (backend) (log-view-mode))
2861
2862(defun vc-default-show-log-entry (backend rev)
2863 (with-no-warnings
2864 (log-view-goto-rev rev)))
2865
2866(defun vc-default-comment-history (backend file)
2867 "Return a string with all log entries stored in BACKEND for FILE."
7fbb4797
DN
2868 (when (vc-find-backend-function backend 'print-log)
2869 (with-current-buffer "*vc*"
2870 (vc-call print-log (list file))
2871 (vc-call-backend backend 'wash-log)
2872 (buffer-string))))
2765044b 2873
2765044b
DN
2874(defun vc-default-receive-file (backend file rev)
2875 "Let BACKEND receive FILE from another version control system."
2876 (vc-call-backend backend 'register file rev ""))
2877
2878(defun vc-default-create-snapshot (backend dir name branchp)
2879 (when branchp
2880 (error "VC backend %s does not support module branches" backend))
2881 (let ((result (vc-snapshot-precondition dir)))
2882 (if (stringp result)
2883 (error "File %s is not up-to-date" result)
2884 (vc-file-tree-walk
2885 dir
2886 (lambda (f)
2887 (vc-call assign-name f name))))))
2888
2889(defun vc-default-retrieve-snapshot (backend dir name update)
2890 (if (string= name "")
2891 (progn
2892 (vc-file-tree-walk
2893 dir
2894 (lambda (f) (and
2895 (vc-up-to-date-p f)
2896 (vc-error-occurred
2897 (vc-call checkout f nil "")
b5446276 2898 (when update (vc-resynch-buffer f t t)))))))
2765044b
DN
2899 (let ((result (vc-snapshot-precondition dir)))
2900 (if (stringp result)
2901 (error "File %s is locked" result)
2902 (setq update (and (eq result 'visited) update))
2903 (vc-file-tree-walk
2904 dir
2905 (lambda (f) (vc-error-occurred
2906 (vc-call checkout f nil name)
b5446276 2907 (when update (vc-resynch-buffer f t t)))))))))
2765044b
DN
2908
2909(defun vc-default-revert (backend file contents-done)
2910 (unless contents-done
ac3f4c6f 2911 (let ((rev (vc-working-revision file))
2765044b
DN
2912 (file-buffer (or (get-file-buffer file) (current-buffer))))
2913 (message "Checking out %s..." file)
2914 (let ((failed t)
2915 (backup-name (car (find-backup-file-name file))))
2916 (when backup-name
2917 (copy-file file backup-name 'ok-if-already-exists 'keep-date)
2918 (unless (file-writable-p file)
2919 (set-file-modes file (logior (file-modes file) 128))))
2920 (unwind-protect
2921 (let ((coding-system-for-read 'no-conversion)
2922 (coding-system-for-write 'no-conversion))
2923 (with-temp-file file
2924 (let ((outbuf (current-buffer)))
2925 ;; Change buffer to get local value of vc-checkout-switches.
2926 (with-current-buffer file-buffer
2927 (let ((default-directory (file-name-directory file)))
ac3f4c6f 2928 (vc-call find-revision file rev outbuf)))))
2765044b
DN
2929 (setq failed nil))
2930 (when backup-name
2931 (if failed
2932 (rename-file backup-name file 'ok-if-already-exists)
2933 (and (not vc-make-backup-files) (delete-file backup-name))))))
2934 (message "Checking out %s...done" file))))
2935
17f3909f 2936(defalias 'vc-default-revision-completion-table 'ignore)
2765044b 2937
fb0ac090
AJ
2938(defun vc-default-dir-status-files (backend dir files default-state update-function)
2939 (funcall update-function
2940 (mapcar (lambda (file) (list file default-state)) files)))
2941
2765044b
DN
2942(defun vc-check-headers ()
2943 "Check if the current file has any headers in it."
2944 (interactive)
2945 (vc-call-backend (vc-backend buffer-file-name) 'check-headers))
2946
2947;;; Annotate functionality
7d2d9482 2948
f80f7bc2
RS
2949;; Declare globally instead of additional parameter to
2950;; temp-buffer-show-function (not possible to pass more than one
75665141
AS
2951;; parameter). The use of annotate-ratio is deprecated in favor of
2952;; annotate-mode, which replaces it with the more sensible "span-to
2953;; days", along with autoscaling support.
099bd78a 2954(defvar vc-annotate-ratio nil "Global variable.")
0e362f54 2955
1b5a7343 2956;; internal buffer-local variables
04864eb0 2957(defvar vc-annotate-backend nil)
1b5a7343
AS
2958(defvar vc-annotate-parent-file nil)
2959(defvar vc-annotate-parent-rev nil)
2960(defvar vc-annotate-parent-display-mode nil)
1b5a7343 2961
f66a6225
SM
2962(defconst vc-annotate-font-lock-keywords
2963 ;; The fontification is done by vc-annotate-lines instead of font-lock.
2964 '((vc-annotate-lines)))
2965
93113211 2966(define-derived-mode vc-annotate-mode fundamental-mode "Annotate"
6f1ecae4 2967 "Major mode for output buffers of the `vc-annotate' command.
7d2d9482
RS
2968
2969You can use the mode-specific menu to alter the time-span of the used
2970colors. See variable `vc-annotate-menu-elements' for customizing the
2971menu items."
5731a8e0
TTN
2972 ;; Frob buffer-invisibility-spec so that if it is originally a naked t,
2973 ;; it will become a list, to avoid initial annotations being invisible.
2974 (add-to-invisibility-spec 'foo)
2975 (remove-from-invisibility-spec 'foo)
f66a6225
SM
2976 (set (make-local-variable 'truncate-lines) t)
2977 (set (make-local-variable 'font-lock-defaults)
2978 '(vc-annotate-font-lock-keywords t))
04864eb0 2979 (view-mode 1))
7d2d9482 2980
5731a8e0
TTN
2981(defun vc-annotate-toggle-annotation-visibility ()
2982 "Toggle whether or not the annotation is visible."
2983 (interactive)
2984 (funcall (if (memq 'vc-annotate-annotation buffer-invisibility-spec)
2985 'remove-from-invisibility-spec
2986 'add-to-invisibility-spec)
2987 'vc-annotate-annotation)
2988 (force-window-update (current-buffer)))
2989
97461c84 2990(defun vc-annotate-display-default (ratio)
6f1ecae4 2991 "Display the output of \\[vc-annotate] using the default color range.
97461c84
SM
2992The color range is given by `vc-annotate-color-map', scaled by RATIO.
2993The current time is used as the offset."
2994 (interactive (progn (kill-local-variable 'vc-annotate-color-map) '(1.0)))
f80f7bc2 2995 (message "Redisplaying annotation...")
97461c84 2996 (vc-annotate-display ratio)
f80f7bc2 2997 (message "Redisplaying annotation...done"))
7d2d9482 2998
97461c84
SM
2999(defun vc-annotate-oldest-in-map (color-map)
3000 "Return the oldest time in the COLOR-MAP."
3001 ;; Since entries should be sorted, we can just use the last one.
3002 (caar (last color-map)))
6149bbfb 3003
5731a8e0
TTN
3004(defun vc-annotate-get-time-set-line-props ()
3005 (let ((bol (point))
3006 (date (vc-call-backend vc-annotate-backend 'annotate-time))
3007 (inhibit-read-only t))
f605fc58 3008 (assert (>= (point) bol))
5731a8e0
TTN
3009 (put-text-property bol (point) 'invisible 'vc-annotate-annotation)
3010 date))
3011
75665141 3012(defun vc-annotate-display-autoscale (&optional full)
946b248f 3013 "Highlight the output of \\[vc-annotate] using an autoscaled color map.
6f1ecae4 3014Autoscaling means that the map is scaled from the current time to the
f36e4afe 3015oldest annotation in the buffer, or, with prefix argument FULL, to
6f1ecae4 3016cover the range from the oldest annotation to the newest."
f36e4afe 3017 (interactive "P")
75665141
AS
3018 (let ((newest 0.0)
3019 (oldest 999999.) ;Any CVS users at the founding of Rome?
3020 (current (vc-annotate-convert-time (current-time)))
3021 date)
3022 (message "Redisplaying annotation...")
3023 ;; Run through this file and find the oldest and newest dates annotated.
3024 (save-excursion
3025 (goto-char (point-min))
7c33af85 3026 (while (not (eobp))
5731a8e0 3027 (when (setq date (vc-annotate-get-time-set-line-props))
b5446276
DN
3028 (when (> date newest)
3029 (setq newest date))
3030 (when (< date oldest)
3031 (setq oldest date)))
7c33af85 3032 (forward-line 1)))
75665141 3033 (vc-annotate-display
97461c84
SM
3034 (/ (- (if full newest current) oldest)
3035 (vc-annotate-oldest-in-map vc-annotate-color-map))
75665141 3036 (if full newest))
99cb8c8b
SS
3037 (message "Redisplaying annotation...done \(%s\)"
3038 (if full
3039 (format "Spanned from %.1f to %.1f days old"
75665141
AS
3040 (- current oldest)
3041 (- current newest))
3042 (format "Spanned to %.1f days old" (- current oldest))))))
3043
3044;; Menu -- Using easymenu.el
04864eb0
SM
3045(easy-menu-define vc-annotate-mode-menu vc-annotate-mode-map
3046 "VC Annotate Display Menu"
3047 `("VC-Annotate"
da7c8a12 3048 ["By Color Map Range" (unless (null vc-annotate-display-mode)
04864eb0
SM
3049 (setq vc-annotate-display-mode nil)
3050 (vc-annotate-display-select))
3051 :style toggle :selected (null vc-annotate-display-mode)]
97461c84 3052 ,@(let ((oldest-in-map (vc-annotate-oldest-in-map vc-annotate-color-map)))
04864eb0
SM
3053 (mapcar (lambda (element)
3054 (let ((days (* element oldest-in-map)))
07a95b81
SM
3055 `[,(format "Span %.1f days" days)
3056 (vc-annotate-display-select nil ,days)
3057 :style toggle :selected
3058 (eql vc-annotate-display-mode ,days) ]))
04864eb0
SM
3059 vc-annotate-menu-elements))
3060 ["Span ..."
07a95b81
SM
3061 (vc-annotate-display-select
3062 nil (float (string-to-number (read-string "Span how many days? "))))]
04864eb0
SM
3063 "--"
3064 ["Span to Oldest"
3065 (unless (eq vc-annotate-display-mode 'scale)
3066 (vc-annotate-display-select nil 'scale))
df04e22c 3067 :help
f3ff0fe9 3068 "Use an autoscaled color map from the oldest annotation to the current time"
04864eb0
SM
3069 :style toggle :selected
3070 (eq vc-annotate-display-mode 'scale)]
3071 ["Span Oldest->Newest"
3072 (unless (eq vc-annotate-display-mode 'fullscale)
3073 (vc-annotate-display-select nil 'fullscale))
df04e22c 3074 :help
f3ff0fe9 3075 "Use an autoscaled color map from the oldest to the newest annotation"
04864eb0
SM
3076 :style toggle :selected
3077 (eq vc-annotate-display-mode 'fullscale)]
3078 "--"
f3ff0fe9 3079 ["Toggle annotation visibility" vc-annotate-toggle-annotation-visibility
df04e22c 3080 :help
f3ff0fe9
DN
3081 "Toggle whether the annotation is visible or not"]
3082 ["Annotate previous revision" vc-annotate-prev-revision
3083 :help "Visit the annotation of the revision previous to this one"]
3084 ["Annotate next revision" vc-annotate-next-revision
3085 :help "Visit the annotation of the revision after this one"]
3086 ["Annotate revision at line" vc-annotate-revision-at-line
df04e22c 3087 :help
f3ff0fe9
DN
3088 "Visit the annotation of the revision identified in the current line"]
3089 ["Annotate revision previous to line" vc-annotate-revision-previous-to-line
3090 :help "Visit the annotation of the revision before the revision at line"]
3091 ["Annotate latest revision" vc-annotate-working-revision
3092 :help "Visit the annotation of the working revision of this file"]
3093 ["Show log of revision at line" vc-annotate-show-log-revision-at-line
3094 :help "Visit the log of the revision at line"]
3095 ["Show diff of revision at line" vc-annotate-show-diff-revision-at-line
df04e22c 3096 :help
f3ff0fe9
DN
3097 "Visit the diff of the revision at line from its previous revision"]
3098 ["Visit revision at line" vc-annotate-find-revision-at-line
3099 :help "Visit the revision identified in the current line"]))
75665141
AS
3100
3101(defun vc-annotate-display-select (&optional buffer mode)
6f1ecae4
AS
3102 "Highlight the output of \\[vc-annotate].
3103By default, the current buffer is highlighted, unless overridden by
3104BUFFER. `vc-annotate-display-mode' specifies the highlighting mode to
3105use; you may override this using the second optional arg MODE."
3106 (interactive)
b5446276 3107 (when mode (setq vc-annotate-display-mode mode))
8a8f8697 3108 (pop-to-buffer (or buffer (current-buffer)))
f66a6225 3109 (cond ((null vc-annotate-display-mode)
07a95b81
SM
3110 ;; The ratio is global, thus relative to the global color-map.
3111 (kill-local-variable 'vc-annotate-color-map)
97461c84
SM
3112 (vc-annotate-display-default (or vc-annotate-ratio 1.0)))
3113 ;; One of the auto-scaling modes
f66a6225 3114 ((eq vc-annotate-display-mode 'scale)
7c33af85 3115 (vc-exec-after `(vc-annotate-display-autoscale)))
f66a6225 3116 ((eq vc-annotate-display-mode 'fullscale)
7c33af85 3117 (vc-exec-after `(vc-annotate-display-autoscale t)))
75665141
AS
3118 ((numberp vc-annotate-display-mode) ; A fixed number of days lookback
3119 (vc-annotate-display-default
97461c84
SM
3120 (/ vc-annotate-display-mode
3121 (vc-annotate-oldest-in-map vc-annotate-color-map))))
f66a6225
SM
3122 (t (error "No such display mode: %s"
3123 vc-annotate-display-mode))))
0e362f54 3124
7d2d9482 3125;;;###autoload
bae9f9e3 3126(defun vc-annotate (file rev &optional display-mode buf move-point-to)
aa406465 3127 "Display the edit history of the current file using colors.
1cec418c
AS
3128
3129This command creates a buffer that shows, for each line of the current
aa406465 3130file, when it was last edited and by whom. Additionally, colors are
1cec418c 3131used to show the age of each line--blue means oldest, red means
aa406465 3132youngest, and intermediate colors indicate intermediate ages. By
1cec418c
AS
3133default, the time scale stretches back one year into the past;
3134everything that is older than that is shown in blue.
3135
3136With a prefix argument, this command asks two questions in the
ac3f4c6f
ER
3137minibuffer. First, you may enter a revision number; then the buffer
3138displays and annotates that revision instead of the working revision
eb407e67 3139\(type RET in the minibuffer to leave that default unchanged). Then,
ecd50f65
AS
3140you are prompted for the time span in days which the color range
3141should cover. For example, a time span of 20 days means that changes
3142over the past 20 days are shown in red to blue, according to their
3143age, and everything that is older than that is shown in blue.
1cec418c 3144
bae9f9e3
DN
3145If MOVE-POINT-TO is given, move the point to that line.
3146
1cec418c 3147Customization variables:
7d2d9482
RS
3148
3149`vc-annotate-menu-elements' customizes the menu elements of the
a7192ddb
SM
3150mode-specific menu. `vc-annotate-color-map' and
3151`vc-annotate-very-old-color' define the mapping of time to colors.
3152`vc-annotate-background' specifies the background color."
04864eb0
SM
3153 (interactive
3154 (save-current-buffer
3155 (vc-ensure-vc-buffer)
3156 (list buffer-file-name
ac3f4c6f 3157 (let ((def (vc-working-revision buffer-file-name)))
04864eb0
SM
3158 (if (null current-prefix-arg) def
3159 (read-string
ac3f4c6f 3160 (format "Annotate from revision (default %s): " def)
04864eb0
SM
3161 nil nil def)))
3162 (if (null current-prefix-arg)
3163 vc-annotate-display-mode
3164 (float (string-to-number
3165 (read-string "Annotate span days (default 20): "
3166 nil nil "20")))))))
b6909007 3167 (vc-ensure-vc-buffer)
04864eb0
SM
3168 (setq vc-annotate-display-mode display-mode) ;Not sure why. --Stef
3169 (let* ((temp-buffer-name (format "*Annotate %s (rev %s)*" (buffer-name) rev))
1867d8cb
TTN
3170 (temp-buffer-show-function 'vc-annotate-display-select)
3171 ;; If BUF is specified, we presume the caller maintains current line,
3172 ;; so we don't need to do it here. This implementation may give
3173 ;; strange results occasionally in the case of REV != WORKFILE-REV.
bae9f9e3 3174 (current-line (or move-point-to (unless buf (line-number-at-pos)))))
afe35502 3175 (message "Annotating...")
04864eb0
SM
3176 ;; If BUF is specified it tells in which buffer we should put the
3177 ;; annotations. This is used when switching annotations to another
3178 ;; revision, so we should update the buffer's name.
b5446276
DN
3179 (when buf (with-current-buffer buf
3180 (rename-buffer temp-buffer-name t)
3181 ;; In case it had to be uniquified.
3182 (setq temp-buffer-name (buffer-name))))
46e33aee 3183 (with-output-to-temp-buffer temp-buffer-name
da7c8a12
S
3184 (vc-call annotate-command file (get-buffer temp-buffer-name) rev)
3185 ;; we must setup the mode first, and then set our local
3186 ;; variables before the show-function is called at the exit of
3187 ;; with-output-to-temp-buffer
3188 (with-current-buffer temp-buffer-name
b5446276
DN
3189 (unless (equal major-mode 'vc-annotate-mode)
3190 (vc-annotate-mode))
da7c8a12
S
3191 (set (make-local-variable 'vc-annotate-backend) (vc-backend file))
3192 (set (make-local-variable 'vc-annotate-parent-file) file)
3193 (set (make-local-variable 'vc-annotate-parent-rev) rev)
3194 (set (make-local-variable 'vc-annotate-parent-display-mode)
3195 display-mode)))
cd42ec7d 3196
ebaac04d
SM
3197 (with-current-buffer temp-buffer-name
3198 (vc-exec-after
3199 `(progn
3200 ;; Ideally, we'd rather not move point if the user has already
3201 ;; moved it elsewhere, but really point here is not the position
3202 ;; of the user's cursor :-(
3203 (when ,current-line ;(and (bobp))
86e80023 3204 (goto-line ,current-line)
01823b77 3205 (setq vc-sentinel-movepoint (point)))
ebaac04d
SM
3206 (unless (active-minibuffer-window)
3207 (message "Annotating... done")))))))
7d2d9482 3208
ac3f4c6f
ER
3209(defun vc-annotate-prev-revision (prefix)
3210 "Visit the annotation of the revision previous to this one.
1b5a7343 3211
ac3f4c6f
ER
3212With a numeric prefix argument, annotate the revision that many
3213revisions previous."
1b5a7343 3214 (interactive "p")
ac3f4c6f 3215 (vc-annotate-warp-revision (- 0 prefix)))
1b5a7343 3216
ac3f4c6f
ER
3217(defun vc-annotate-next-revision (prefix)
3218 "Visit the annotation of the revision after this one.
1b5a7343 3219
ac3f4c6f
ER
3220With a numeric prefix argument, annotate the revision that many
3221revisions after."
1b5a7343 3222 (interactive "p")
ac3f4c6f 3223 (vc-annotate-warp-revision prefix))
1b5a7343 3224
ac3f4c6f
ER
3225(defun vc-annotate-working-revision ()
3226 "Visit the annotation of the working revision of this file."
1b5a7343
AS
3227 (interactive)
3228 (if (not (equal major-mode 'vc-annotate-mode))
3229 (message "Cannot be invoked outside of a vc annotate buffer")
ac3f4c6f 3230 (let ((warp-rev (vc-working-revision vc-annotate-parent-file)))
1b5a7343 3231 (if (equal warp-rev vc-annotate-parent-rev)
ac3f4c6f
ER
3232 (message "Already at revision %s" warp-rev)
3233 (vc-annotate-warp-revision warp-rev)))))
1b5a7343
AS
3234
3235(defun vc-annotate-extract-revision-at-line ()
3236 "Extract the revision number of the current line."
3237 ;; This function must be invoked from a buffer in vc-annotate-mode
1b5a7343
AS
3238 (vc-call-backend vc-annotate-backend 'annotate-extract-revision-at-line))
3239
3240(defun vc-annotate-revision-at-line ()
ac3f4c6f 3241 "Visit the annotation of the revision identified in the current line."
1b5a7343
AS
3242 (interactive)
3243 (if (not (equal major-mode 'vc-annotate-mode))
3244 (message "Cannot be invoked outside of a vc annotate buffer")
3245 (let ((rev-at-line (vc-annotate-extract-revision-at-line)))
3246 (if (not rev-at-line)
3247 (message "Cannot extract revision number from the current line")
3248 (if (equal rev-at-line vc-annotate-parent-rev)
ac3f4c6f
ER
3249 (message "Already at revision %s" rev-at-line)
3250 (vc-annotate-warp-revision rev-at-line))))))
1b5a7343 3251
f3ff0fe9
DN
3252(defun vc-annotate-find-revision-at-line ()
3253 "Visit the revision identified in the current line."
3254 (interactive)
3255 (if (not (equal major-mode 'vc-annotate-mode))
3256 (message "Cannot be invoked outside of a vc annotate buffer")
3257 (let ((rev-at-line (vc-annotate-extract-revision-at-line)))
3258 (if (not rev-at-line)
3259 (message "Cannot extract revision number from the current line")
3260 (vc-revision-other-window rev-at-line)))))
3261
1b5a7343 3262(defun vc-annotate-revision-previous-to-line ()
ac3f4c6f 3263 "Visit the annotation of the revision before the revision at line."
1b5a7343
AS
3264 (interactive)
3265 (if (not (equal major-mode 'vc-annotate-mode))
3266 (message "Cannot be invoked outside of a vc annotate buffer")
3267 (let ((rev-at-line (vc-annotate-extract-revision-at-line))
3268 (prev-rev nil))
3269 (if (not rev-at-line)
3270 (message "Cannot extract revision number from the current line")
3271 (setq prev-rev
ac3f4c6f
ER
3272 (vc-call previous-revision vc-annotate-parent-file rev-at-line))
3273 (vc-annotate-warp-revision prev-rev)))))
1b5a7343
AS
3274
3275(defun vc-annotate-show-log-revision-at-line ()
ac3f4c6f 3276 "Visit the log of the revision at line."
1b5a7343
AS
3277 (interactive)
3278 (if (not (equal major-mode 'vc-annotate-mode))
3279 (message "Cannot be invoked outside of a vc annotate buffer")
3280 (let ((rev-at-line (vc-annotate-extract-revision-at-line)))
3281 (if (not rev-at-line)
3282 (message "Cannot extract revision number from the current line")
3283 (vc-print-log rev-at-line)))))
3284
3285(defun vc-annotate-show-diff-revision-at-line ()
ac3f4c6f 3286 "Visit the diff of the revision at line from its previous revision."
1b5a7343
AS
3287 (interactive)
3288 (if (not (equal major-mode 'vc-annotate-mode))
3289 (message "Cannot be invoked outside of a vc annotate buffer")
3290 (let ((rev-at-line (vc-annotate-extract-revision-at-line))
3291 (prev-rev nil))
3292 (if (not rev-at-line)
3293 (message "Cannot extract revision number from the current line")
3294 (setq prev-rev
ac3f4c6f 3295 (vc-call previous-revision vc-annotate-parent-file rev-at-line))
1b5a7343 3296 (if (not prev-rev)
ac3f4c6f 3297 (message "Cannot diff from any revision prior to %s" rev-at-line)
1b5a7343 3298 (save-window-excursion
ae67f2d0
DN
3299 (vc-diff-internal
3300 nil
3301 (cons (vc-backend vc-annotate-parent-file)
3302 (list vc-annotate-parent-file))
3303 prev-rev rev-at-line))
1b5a7343
AS
3304 (switch-to-buffer "*vc-diff*"))))))
3305
ac3f4c6f
ER
3306(defun vc-annotate-warp-revision (revspec)
3307 "Annotate the revision described by REVSPEC.
1b5a7343 3308
ac3f4c6f 3309If REVSPEC is a positive integer, warp that many revisions
1b5a7343 3310forward, if possible, otherwise echo a warning message. If
ac3f4c6f 3311REVSPEC is a negative integer, warp that many revisions backward,
1b5a7343
AS
3312if possible, otherwise echo a warning message. If REVSPEC is a
3313string, then it describes a revision number, so warp to that
3314revision."
3315 (if (not (equal major-mode 'vc-annotate-mode))
3316 (message "Cannot be invoked outside of a vc annotate buffer")
da7c8a12
S
3317 (let* ((buf (current-buffer))
3318 (oldline (line-number-at-pos))
1b5a7343
AS
3319 (revspeccopy revspec)
3320 (newrev nil))
3321 (cond
3322 ((and (integerp revspec) (> revspec 0))
3323 (setq newrev vc-annotate-parent-rev)
3324 (while (and (> revspec 0) newrev)
ac3f4c6f 3325 (setq newrev (vc-call next-revision
1b5a7343
AS
3326 vc-annotate-parent-file newrev))
3327 (setq revspec (1- revspec)))
b5446276
DN
3328 (unless newrev
3329 (message "Cannot increment %d revisions from revision %s"
3330 revspeccopy vc-annotate-parent-rev)))
1b5a7343
AS
3331 ((and (integerp revspec) (< revspec 0))
3332 (setq newrev vc-annotate-parent-rev)
3333 (while (and (< revspec 0) newrev)
ac3f4c6f 3334 (setq newrev (vc-call previous-revision
1b5a7343
AS
3335 vc-annotate-parent-file newrev))
3336 (setq revspec (1+ revspec)))
b5446276
DN
3337 (unless newrev
3338 (message "Cannot decrement %d revisions from revision %s"
3339 (- 0 revspeccopy) vc-annotate-parent-rev)))
1b5a7343 3340 ((stringp revspec) (setq newrev revspec))
ac3f4c6f 3341 (t (error "Invalid argument to vc-annotate-warp-revision")))
1b5a7343 3342 (when newrev
04864eb0
SM
3343 (vc-annotate vc-annotate-parent-file newrev
3344 vc-annotate-parent-display-mode
bae9f9e3
DN
3345 buf
3346 ;; Pass the current line so that vc-annotate will
3347 ;; place the point in the line.
3348 (min oldline (progn (goto-char (point-max))
3349 (forward-line -1)
3350 (line-number-at-pos))))))))
1b5a7343 3351
f70419a8 3352(defun vc-annotate-compcar (threshold a-list)
6f1ecae4
AS
3353 "Test successive cons cells of A-LIST against THRESHOLD.
3354Return the first cons cell with a car that is not less than THRESHOLD,
3355nil if no such cell exists."
f70419a8
RS
3356 (let ((i 1)
3357 (tmp-cons (car a-list)))
3358 (while (and tmp-cons (< (car tmp-cons) threshold))
3359 (setq tmp-cons (car (nthcdr i a-list)))
3360 (setq i (+ i 1)))
3361 tmp-cons)) ; Return the appropriate value
3362
75665141 3363(defun vc-annotate-convert-time (time)
6f1ecae4
AS
3364 "Convert a time value to a floating-point number of days.
3365The argument TIME is a list as returned by `current-time' or
3366`encode-time', only the first two elements of that list are considered."
75665141
AS
3367 (/ (+ (* (float (car time)) (lsh 1 16)) (cadr time)) 24 3600))
3368
3369(defun vc-annotate-difference (&optional offset)
6f1ecae4
AS
3370 "Return the time span in days to the next annotation.
3371This calls the backend function annotate-time, and returns the
3372difference in days between the time returned and the current time,
3373or OFFSET if present."
5731a8e0 3374 (let ((next-time (vc-annotate-get-time-set-line-props)))
b5446276
DN
3375 (when next-time
3376 (- (or offset
3377 (vc-call-backend vc-annotate-backend 'annotate-current-time))
3378 next-time))))
75665141
AS
3379
3380(defun vc-default-annotate-current-time (backend)
3381 "Return the current time, encoded as fractional days."
3382 (vc-annotate-convert-time (current-time)))
99cb8c8b 3383
07577777
JPW
3384(defvar vc-annotate-offset nil)
3385
97461c84 3386(defun vc-annotate-display (ratio &optional offset)
6f1ecae4 3387 "Highlight `vc-annotate' output in the current buffer.
97461c84 3388RATIO, is the expansion that should be applied to `vc-annotate-color-map'.
bf142f28 3389The annotations are relative to the current time, unless overridden by OFFSET."
b5446276
DN
3390 (when (/= ratio 1.0)
3391 (set (make-local-variable 'vc-annotate-color-map)
3392 (mapcar (lambda (elem) (cons (* (car elem) ratio) (cdr elem)))
3393 vc-annotate-color-map)))
f66a6225
SM
3394 (set (make-local-variable 'vc-annotate-offset) offset)
3395 (font-lock-mode 1))
3396
f66a6225 3397(defun vc-annotate-lines (limit)
7c33af85
SM
3398 (while (< (point) limit)
3399 (let ((difference (vc-annotate-difference vc-annotate-offset))
3400 (start (point))
3401 (end (progn (forward-line 1) (point))))
3402 (when difference
3403 (let* ((color (or (vc-annotate-compcar difference vc-annotate-color-map)
3404 (cons nil vc-annotate-very-old-color)))
3405 ;; substring from index 1 to remove any leading `#' in the name
3406 (face-name (concat "vc-annotate-face-"
3407 (if (string-equal
3408 (substring (cdr color) 0 1) "#")
3409 (substring (cdr color) 1)
3410 (cdr color))))
3411 ;; Make the face if not done.
3412 (face (or (intern-soft face-name)
3413 (let ((tmp-face (make-face (intern face-name))))
3414 (set-face-foreground tmp-face (cdr color))
b5446276
DN
3415 (when vc-annotate-background
3416 (set-face-background tmp-face
3417 vc-annotate-background))
7c33af85
SM
3418 tmp-face)))) ; Return the face
3419 (put-text-property start end 'face face)))))
3420 ;; Pretend to font-lock there were no matches.
3421 nil)
7d2d9482 3422\f
594722a8
ER
3423
3424;; Set up key bindings for use while editing log messages
3425
d7b60083 3426(defun vc-log-edit (fileset)
928ef6d9 3427 "Set up `log-edit' for use with VC on FILE."
099bd78a 3428 (setq default-directory
d7b60083 3429 (with-current-buffer vc-parent-buffer default-directory))
93a142e1
DN
3430 (log-edit 'vc-finish-logentry
3431 nil
3432 `((log-edit-listfun . (lambda () ',fileset))
3433 (log-edit-diff-function . (lambda () (vc-diff nil)))))
d7b60083 3434 (set (make-local-variable 'vc-log-fileset) fileset)
ac3f4c6f 3435 (make-local-variable 'vc-log-revision)
099bd78a 3436 (set-buffer-modified-p nil)
0e362f54 3437 (setq buffer-file-name nil))
594722a8 3438
b1ddeeb7
ER
3439;; These things should probably be generally available
3440
3441(defun vc-file-tree-walk (dirname func &rest args)
3442 "Walk recursively through DIRNAME.
3443Invoke FUNC f ARGS on each VC-managed file f underneath it."
3444 (vc-file-tree-walk-internal (expand-file-name dirname) func args)
3445 (message "Traversing directory %s...done" dirname))
3446
3447(defun vc-file-tree-walk-internal (file func args)
3448 (if (not (file-directory-p file))
3449 (when (vc-backend file) (apply func file args))
3450 (message "Traversing directory %s..." (abbreviate-file-name file))
3451 (let ((dir (file-name-as-directory file)))
3452 (mapcar
3453 (lambda (f) (or
3454 (string-equal f ".")
3455 (string-equal f "..")
3456 (member f vc-directory-exclusion-list)
3457 (let ((dirf (expand-file-name f dir)))
3458 (or
3459 (file-symlink-p dirf) ;; Avoid possible loops.
3460 (vc-file-tree-walk-internal dirf func args)))))
3461 (directory-files dir)))))
3462
594722a8
ER
3463(provide 'vc)
3464
ec402ad4
SM
3465;; DEVELOPER'S NOTES ON CONCURRENCY PROBLEMS IN THIS CODE
3466;;
ec402ad4
SM
3467;; These may be useful to anyone who has to debug or extend the package.
3468;; (Note that this information corresponds to versions 5.x. Some of it
3469;; might have been invalidated by the additions to support branching
3470;; and RCS keyword lookup. AS, 1995/03/24)
3471;;
3472;; A fundamental problem in VC is that there are time windows between
3473;; vc-next-action's computations of the file's version-control state and
3474;; the actions that change it. This is a window open to lossage in a
3475;; multi-user environment; someone else could nip in and change the state
3476;; of the master during it.
3477;;
3478;; The performance problem is that rlog/prs calls are very expensive; we want
3479;; to avoid them as much as possible.
3480;;
3481;; ANALYSIS:
3482;;
3483;; The performance problem, it turns out, simplifies in practice to the
3484;; problem of making vc-state fast. The two other functions that call
3485;; prs/rlog will not be so commonly used that the slowdown is a problem; one
3486;; makes snapshots, the other deletes the calling user's last change in the
3487;; master.
3488;;
3489;; The race condition implies that we have to either (a) lock the master
3490;; during the entire execution of vc-next-action, or (b) detect and
3491;; recover from errors resulting from dispatch on an out-of-date state.
3492;;
3493;; Alternative (a) appears to be infeasible. The problem is that we can't
3494;; guarantee that the lock will ever be removed. Suppose a user starts a
3495;; checkin, the change message buffer pops up, and the user, having wandered
3496;; off to do something else, simply forgets about it?
3497;;
3498;; Alternative (b), on the other hand, works well with a cheap way to speed up
3499;; vc-state. Usually, if a file is registered, we can read its locked/
3500;; unlocked state and its current owner from its permissions.
3501;;
3502;; This shortcut will fail if someone has manually changed the workfile's
3503;; permissions; also if developers are munging the workfile in several
3504;; directories, with symlinks to a master (in this latter case, the
3505;; permissions shortcut will fail to detect a lock asserted from another
3506;; directory).
3507;;
3508;; Note that these cases correspond exactly to the errors which could happen
3509;; because of a competing checkin/checkout race in between two instances of
3510;; vc-next-action.
3511;;
3512;; For VC's purposes, a workfile/master pair may have the following states:
3513;;
3514;; A. Unregistered. There is a workfile, there is no master.
3515;;
3516;; B. Registered and not locked by anyone.
3517;;
3518;; C. Locked by calling user and unchanged.
3519;;
3520;; D. Locked by the calling user and changed.
3521;;
3522;; E. Locked by someone other than the calling user.
3523;;
3524;; This makes for 25 states and 20 error conditions. Here's the matrix:
3525;;
3526;; VC's idea of state
3527;; |
3528;; V Actual state RCS action SCCS action Effect
3529;; A B C D E
3530;; A . 1 2 3 4 ci -u -t- admin -fb -i<file> initial admin
3531;; B 5 . 6 7 8 co -l get -e checkout
3532;; C 9 10 . 11 12 co -u unget; get revert
3533;; D 13 14 15 . 16 ci -u -m<comment> delta -y<comment>; get checkin
3534;; E 17 18 19 20 . rcs -u -M -l unget -n ; get -g steal lock
3535;;
3536;; All commands take the master file name as a last argument (not shown).
3537;;
3538;; In the discussion below, a "self-race" is a pathological situation in
3539;; which VC operations are being attempted simultaneously by two or more
3540;; Emacsen running under the same username.
3541;;
3542;; The vc-next-action code has the following windows:
3543;;
3544;; Window P:
3545;; Between the check for existence of a master file and the call to
3546;; admin/checkin in vc-buffer-admin (apparent state A). This window may
3547;; never close if the initial-comment feature is on.
3548;;
3549;; Window Q:
3550;; Between the call to vc-workfile-unchanged-p in and the immediately
3551;; following revert (apparent state C).
3552;;
3553;; Window R:
3554;; Between the call to vc-workfile-unchanged-p in and the following
3555;; checkin (apparent state D). This window may never close.
3556;;
3557;; Window S:
3558;; Between the unlock and the immediately following checkout during a
3559;; revert operation (apparent state C). Included in window Q.
3560;;
3561;; Window T:
3562;; Between vc-state and the following checkout (apparent state B).
3563;;
3564;; Window U:
3565;; Between vc-state and the following revert (apparent state C).
3566;; Includes windows Q and S.
3567;;
3568;; Window V:
3569;; Between vc-state and the following checkin (apparent state
3570;; D). This window may never be closed if the user fails to complete the
3571;; checkin message. Includes window R.
3572;;
3573;; Window W:
3574;; Between vc-state and the following steal-lock (apparent
3575;; state E). This window may never close if the user fails to complete
3576;; the steal-lock message. Includes window X.
3577;;
3578;; Window X:
3579;; Between the unlock and the immediately following re-lock during a
3580;; steal-lock operation (apparent state E). This window may never close
3581;; if the user fails to complete the steal-lock message.
3582;;
3583;; Errors:
3584;;
3585;; Apparent state A ---
3586;;
3587;; 1. File looked unregistered but is actually registered and not locked.
3588;;
3589;; Potential cause: someone else's admin during window P, with
3590;; caller's admin happening before their checkout.
3591;;
3592;; RCS: Prior to version 5.6.4, ci fails with message
3593;; "no lock set by <user>". From 5.6.4 onwards, VC uses the new
3594;; ci -i option and the message is "<file>,v: already exists".
3595;; SCCS: admin will fail with error (ad19).
3596;;
3597;; We can let these errors be passed up to the user.
3598;;
3599;; 2. File looked unregistered but is actually locked by caller, unchanged.
3600;;
3601;; Potential cause: self-race during window P.
3602;;
3603;; RCS: Prior to version 5.6.4, reverts the file to the last saved
3604;; version and unlocks it. From 5.6.4 onwards, VC uses the new
3605;; ci -i option, failing with message "<file>,v: already exists".
3606;; SCCS: will fail with error (ad19).
3607;;
3608;; Either of these consequences is acceptable.
3609;;
3610;; 3. File looked unregistered but is actually locked by caller, changed.
3611;;
3612;; Potential cause: self-race during window P.
3613;;
3614;; RCS: Prior to version 5.6.4, VC registers the caller's workfile as
3615;; a delta with a null change comment (the -t- switch will be
3616;; ignored). From 5.6.4 onwards, VC uses the new ci -i option,
3617;; failing with message "<file>,v: already exists".
3618;; SCCS: will fail with error (ad19).
3619;;
3620;; 4. File looked unregistered but is locked by someone else.
0e362f54 3621;;;
ec402ad4
SM
3622;; Potential cause: someone else's admin during window P, with
3623;; caller's admin happening *after* their checkout.
3624;;
3625;; RCS: Prior to version 5.6.4, ci fails with a
3626;; "no lock set by <user>" message. From 5.6.4 onwards,
3627;; VC uses the new ci -i option, failing with message
3628;; "<file>,v: already exists".
3629;; SCCS: will fail with error (ad19).
3630;;
3631;; We can let these errors be passed up to the user.
3632;;
3633;; Apparent state B ---
3634;;
3635;; 5. File looked registered and not locked, but is actually unregistered.
3636;;
3637;; Potential cause: master file got nuked during window P.
3638;;
3639;; RCS: will fail with "RCS/<file>: No such file or directory"
3640;; SCCS: will fail with error ut4.
3641;;
3642;; We can let these errors be passed up to the user.
3643;;
3644;; 6. File looked registered and not locked, but is actually locked by the
3645;; calling user and unchanged.
3646;;
3647;; Potential cause: self-race during window T.
3648;;
3649;; RCS: in the same directory as the previous workfile, co -l will fail
3650;; with "co error: writable foo exists; checkout aborted". In any other
3651;; directory, checkout will succeed.
3652;; SCCS: will fail with ge17.
3653;;
3654;; Either of these consequences is acceptable.
3655;;
3656;; 7. File looked registered and not locked, but is actually locked by the
3657;; calling user and changed.
3658;;
3659;; As case 6.
3660;;
3661;; 8. File looked registered and not locked, but is actually locked by another
3662;; user.
3663;;
3664;; Potential cause: someone else checks it out during window T.
3665;;
3666;; RCS: co error: revision 1.3 already locked by <user>
3667;; SCCS: fails with ge4 (in directory) or ut7 (outside it).
3668;;
3669;; We can let these errors be passed up to the user.
3670;;
3671;; Apparent state C ---
3672;;
3673;; 9. File looks locked by calling user and unchanged, but is unregistered.
3674;;
3675;; As case 5.
3676;;
3677;; 10. File looks locked by calling user and unchanged, but is actually not
3678;; locked.
3679;;
3680;; Potential cause: a self-race in window U, or by the revert's
3681;; landing during window X of some other user's steal-lock or window S
3682;; of another user's revert.
3683;;
3684;; RCS: succeeds, refreshing the file from the identical version in
3685;; the master.
3686;; SCCS: fails with error ut4 (p file nonexistent).
3687;;
3688;; Either of these consequences is acceptable.
3689;;
3690;; 11. File is locked by calling user. It looks unchanged, but is actually
3691;; changed.
3692;;
3693;; Potential cause: the file would have to be touched by a self-race
3694;; during window Q.
3695;;
3696;; The revert will succeed, removing whatever changes came with
3697;; the touch. It is theoretically possible that work could be lost.
3698;;
3699;; 12. File looks like it's locked by the calling user and unchanged, but
3700;; it's actually locked by someone else.
3701;;
3702;; Potential cause: a steal-lock in window V.
3703;;
3704;; RCS: co error: revision <rev> locked by <user>; use co -r or rcs -u
3705;; SCCS: fails with error un2
3706;;
3707;; We can pass these errors up to the user.
3708;;
3709;; Apparent state D ---
3710;;
3711;; 13. File looks like it's locked by the calling user and changed, but it's
3712;; actually unregistered.
3713;;
3714;; Potential cause: master file got nuked during window P.
3715;;
3716;; RCS: Prior to version 5.6.4, checks in the user's version as an
3717;; initial delta. From 5.6.4 onwards, VC uses the new ci -j
3718;; option, failing with message "no such file or directory".
3719;; SCCS: will fail with error ut4.
3720;;
3721;; This case is kind of nasty. Under RCS prior to version 5.6.4,
3722;; VC may fail to detect the loss of previous version information.
3723;;
3724;; 14. File looks like it's locked by the calling user and changed, but it's
3725;; actually unlocked.
3726;;
3727;; Potential cause: self-race in window V, or the checkin happening
3728;; during the window X of someone else's steal-lock or window S of
3729;; someone else's revert.
3730;;
3731;; RCS: ci will fail with "no lock set by <user>".
3732;; SCCS: delta will fail with error ut4.
3733;;
3734;; 15. File looks like it's locked by the calling user and changed, but it's
3735;; actually locked by the calling user and unchanged.
3736;;
3737;; Potential cause: another self-race --- a whole checkin/checkout
3738;; sequence by the calling user would have to land in window R.
3739;;
3740;; SCCS: checks in a redundant delta and leaves the file unlocked as usual.
3741;; RCS: reverts to the file state as of the second user's checkin, leaving
3742;; the file unlocked.
3743;;
3744;; It is theoretically possible that work could be lost under RCS.
3745;;
3746;; 16. File looks like it's locked by the calling user and changed, but it's
3747;; actually locked by a different user.
3748;;
3749;; RCS: ci error: no lock set by <user>
3750;; SCCS: unget will fail with error un2
3751;;
3752;; We can pass these errors up to the user.
3753;;
3754;; Apparent state E ---
3755;;
3756;; 17. File looks like it's locked by some other user, but it's actually
3757;; unregistered.
3758;;
3759;; As case 13.
3760;;
3761;; 18. File looks like it's locked by some other user, but it's actually
3762;; unlocked.
3763;;
3764;; Potential cause: someone released a lock during window W.
3765;;
3766;; RCS: The calling user will get the lock on the file.
3767;; SCCS: unget -n will fail with cm4.
3768;;
3769;; Either of these consequences will be OK.
3770;;
3771;; 19. File looks like it's locked by some other user, but it's actually
3772;; locked by the calling user and unchanged.
3773;;
3774;; Potential cause: the other user relinquishing a lock followed by
3775;; a self-race, both in window W.
3776;;
3777;; Under both RCS and SCCS, both unlock and lock will succeed, making
3778;; the sequence a no-op.
3779;;
3780;; 20. File looks like it's locked by some other user, but it's actually
3781;; locked by the calling user and changed.
3782;;
3783;; As case 19.
3784;;
3785;; PROBLEM CASES:
3786;;
3787;; In order of decreasing severity:
3788;;
3789;; Cases 11 and 15 are the only ones that potentially lose work.
3790;; They would require a self-race for this to happen.
3791;;
3792;; Case 13 in RCS loses information about previous deltas, retaining
3793;; only the information in the current workfile. This can only happen
3794;; if the master file gets nuked in window P.
3795;;
3796;; Case 3 in RCS and case 15 under SCCS insert a redundant delta with
3797;; no change comment in the master. This would require a self-race in
3798;; window P or R respectively.
3799;;
3800;; Cases 2, 10, 19 and 20 do extra work, but make no changes.
3801;;
3802;; Unfortunately, it appears to me that no recovery is possible in these
3803;; cases. They don't yield error messages, so there's no way to tell that
3804;; a race condition has occurred.
3805;;
3806;; All other cases don't change either the workfile or the master, and
3807;; trigger command errors which the user will see.
3808;;
3809;; Thus, there is no explicit recovery code.
594722a8 3810
0452b6e7 3811;; arch-tag: ca82c1de-3091-4e26-af92-460abc6213a6
594722a8 3812;;; vc.el ends here