(Ffile_attributes): Don't allow the device number become negative.
[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
e1aec6fb 587;; - vc-dir-kill-dir-status-process should not be specific to dir-status,
c1b51374
SM
588;; it should work for other async commands as well (pull/push/...).
589;;
ba463d9e
DN
590;; - vc-update/vc-merge should deal with VC systems that don't
591;; update/merge on a file basis, but on a whole repository basis.
592;;
fc30d544
DN
593;; - deal with push/pull operations.
594;;
595;; - "snapshots" should be renamed to "branches", and thoroughly reworked.
596;;
7fbb4797
DN
597;; - when a file is in `conflict' state, turn on smerge-mode.
598;;
599;; - figure out what to do with conflicts that are not caused by the
7a3c8d3a
ER
600;; file contents, but by metadata or other causes. Example: File A
601;; gets renamed to B in one branch and to C in another and you merge
602;; the two branches. Or you locally add file FOO and then pull a
603;; change that also adds a new file FOO, ...
ba463d9e 604;;
fc30d544
DN
605;; - add a generic mechanism for remembering the current branch names,
606;; display the branch name in the mode-line. Replace
607;; vc-cvs-sticky-tag with that.
608;;
7a3c8d3a
ER
609;; - C-x v b does switch to a different backend, but the mode line is not
610;; adapted accordingly. Also, it considers RCS and CVS to be the same,
611;; which is pretty confusing.
612;;
5a84a937 613;; - vc-diff should be able to show the diff for all files in a
7fbb4797
DN
614;; changeset, especially for VC systems that have per repository
615;; version numbers. log-view should take advantage of this.
5a84a937 616;;
ba463d9e
DN
617;; - the *VC-log* buffer needs font-locking.
618;;
fc30d544
DN
619;; - make it easier to write logs. Maybe C-x 4 a should add to the log
620;; buffer, if one is present, instead of adding to the ChangeLog.
ba463d9e 621;;
9b4ab1b4
ER
622;; - add a mechanism for editing the underlying VCS's list of files
623;; to be ignored, when that's possible.
3b3cb336 624;;
5bd20ee6
DN
625;; - When vc-next-action calls vc-checkin it could pre-fill the
626;; *VC-log* buffer with some obvious items: the list of files that
627;; were added, the list of files that were removed. If the diff is
628;; available, maybe it could even call something like
629;; `diff-add-change-log-entries-other-window' to create a detailed
630;; skeleton for the log...
631;;
632;; - Set `vc-dir-insert-directories' to t and check what operations
633;; and backends do not support directory arguments and fix them.
634;;
635;; - a way to do repository wide log (instead of just per
636;; file/fileset) is needed. Doing it per directory might be enough...
7fbb4797 637;;
e1aec6fb 638;; - most vc-dir backends need more work. They might need to
7fbb4797
DN
639;; provide custom headers, use the `extra' field and deal with all
640;; possible VC states.
641;;
e1aec6fb 642;; - add function that calls vc-dir to `find-directory-functions'.
d6f47dff 643;;
e1aec6fb 644;; - vc-dir needs mouse bindings.
4ac7bfcf 645;;
e1aec6fb 646;; - vc-dir needs more key bindings for VC actions.
0cc8ac2b 647;;
e1aec6fb 648;; - vc-dir toolbar needs more icons.
25a4ea6d 649;;
5bd20ee6
DN
650;; - vc-dir-next-line should not print an "end of buffer" message when
651;; invoked with the cursor on the last file.
ae67f2d0 652;;
80296236
DN
653;; - add commands to move to the prev/next directory in vc-dir.
654;;
655;; - document vc-dir in the manual.
656;;
d3201e0b
DN
657;; - vc-diff, vc-annotate, etc. need to deal better with unregistered
658;; files. Now that unregistered and ignored files are shown in
e1aec6fb 659;; vc-dired/vc-dir, it is possible that these commands are called
d3201e0b
DN
660;; for unregistered/ignored files.
661;;
3f08440f
DN
662;; - do not default to RCS anymore when the current directory is not
663;; controlled by any VCS and the user does C-x v v
664;;
5bd20ee6
DN
665;; - vc-create-snapshot and vc-retrieve-snapshot should update the
666;; buffers that might be visiting the affected files.
1cb119fd 667;;
a84615c7
SS
668;; - Using multiple backends needs work. Given a CVS directory with some
669;; files checked into git (but not all), using C-x v l to get a log file
670;; from a file only present in git, and then typing RET on some log entry,
18a083fd
ER
671;; vc will bombs out because it wants to see the file being in CVS.
672;; Those logs should likely use a local variable to hardware the VC they
673;; are supposed to work with.
674;;
7a3c8d3a
ER
675;; - Another important thing: merge all the status-like backend operations.
676;; We should remove dir-status, state, dir-state, and dir-status-files, and
677;; replace them with just `status' which takes a fileset and a continuation
678;; (like dir-status) and returns a buffer in which the process(es) are run
679;; (or nil if it worked synchronously). Hopefully we can define the old
680;; 4 operations in term of this one.
681;;
80296236
DN
682;; - backends that care about vc-stay-local should try to take it into
683;; account for vc-dir. Is this likely to be useful???
684;;
0a299408
ER
685;; - vc-dir listing needs a footer generated when it's done to make it obvious
686;; that it has finished.
687;;
7a3c8d3a 688
fcb500ea 689;;; Code:
0e362f54 690
594722a8 691(require 'vc-hooks)
92d1eebf 692(require 'vc-dispatcher)
64db3a90 693(require 'tool-bar)
7fbb4797 694(require 'ewoc)
64db3a90 695
b1ddeeb7
ER
696(eval-when-compile
697 (require 'cl)
698 (require 'dired) ; for dired-map-over-marks macro
699 (require 'dired-aux)) ; for dired-kill-{line,tree}
700
b5446276
DN
701(unless (assoc 'vc-parent-buffer minor-mode-alist)
702 (setq minor-mode-alist
703 (cons '(vc-parent-buffer vc-parent-buffer-name)
704 minor-mode-alist)))
594722a8
ER
705
706;; General customization
707
0101cc40
RS
708(defgroup vc nil
709 "Version-control system in Emacs."
710 :group 'tools)
711
712(defcustom vc-suppress-confirm nil
04864eb0 713 "If non-nil, treat user as expert; suppress yes-no prompts on some things."
0101cc40
RS
714 :type 'boolean
715 :group 'vc)
716
b1ddeeb7
ER
717(defcustom vc-delete-logbuf-window t
718 "If non-nil, delete the *VC-log* buffer and window after each logical action.
719If nil, bury that buffer instead.
720This is most useful if you have multiple windows on a frame and would like to
721preserve the setting."
722 :type 'boolean
723 :group 'vc)
724
0101cc40 725(defcustom vc-initial-comment nil
04864eb0 726 "If non-nil, prompt for initial comment when a file is registered."
0101cc40
RS
727 :type 'boolean
728 :group 'vc)
729
ac3f4c6f
ER
730(defcustom vc-default-init-revision "1.1"
731 "A string used as the default revision number when a new file is registered.
b470cb65
AS
732This can be overridden by giving a prefix argument to \\[vc-register]. This
733can also be overridden by a particular VC backend."
0d53f466 734 :type 'string
cd32a7ba
DN
735 :group 'vc
736 :version "20.3")
0d53f466 737
b1ddeeb7
ER
738(defcustom vc-command-messages nil
739 "If non-nil, display run messages from back-end commands."
740 :type 'boolean
741 :group 'vc)
742
0101cc40 743(defcustom vc-checkin-switches nil
04864eb0 744 "A string or list of strings specifying extra switches for checkin.
0101cc40
RS
745These are passed to the checkin program by \\[vc-checkin]."
746 :type '(choice (const :tag "None" nil)
747 (string :tag "Argument String")
748 (repeat :tag "Argument List"
749 :value ("")
750 string))
751 :group 'vc)
752
753(defcustom vc-checkout-switches nil
04864eb0 754 "A string or list of strings specifying extra switches for checkout.
0101cc40
RS
755These are passed to the checkout program by \\[vc-checkout]."
756 :type '(choice (const :tag "None" nil)
757 (string :tag "Argument String")
758 (repeat :tag "Argument List"
759 :value ("")
760 string))
761 :group 'vc)
762
763(defcustom vc-register-switches nil
04864eb0 764 "A string or list of strings; extra switches for registering a file.
0101cc40
RS
765These are passed to the checkin program by \\[vc-register]."
766 :type '(choice (const :tag "None" nil)
767 (string :tag "Argument String")
768 (repeat :tag "Argument List"
769 :value ("")
770 string))
771 :group 'vc)
772
b1ddeeb7
ER
773(defcustom vc-dired-listing-switches "-al"
774 "Switches passed to `ls' for vc-dired. MUST contain the `l' option."
775 :type 'string
776 :group 'vc
777 :version "21.1")
778
779(defcustom vc-dired-recurse t
780 "If non-nil, show directory trees recursively in VC Dired."
781 :type 'boolean
782 :group 'vc
783 :version "20.3")
784
785(defcustom vc-dired-terse-display t
786 "If non-nil, show only locked or locally modified files in VC Dired."
787 :type 'boolean
788 :group 'vc
789 :version "20.3")
790
acc5b122 791(defcustom vc-diff-switches nil
04864eb0 792 "A string or list of strings specifying switches for diff under VC.
b453817c
AS
793When running diff under a given BACKEND, VC concatenates the values of
794`diff-switches', `vc-diff-switches', and `vc-BACKEND-diff-switches' to
795get the switches for that command. Thus, `vc-diff-switches' should
796contain switches that are specific to version control, but not
797specific to any particular backend."
acc5b122
AS
798 :type '(choice (const :tag "None" nil)
799 (string :tag "Argument String")
800 (repeat :tag "Argument List"
801 :value ("")
802 string))
803 :group 'vc
804 :version "21.1")
805
48033a08
AS
806(defcustom vc-diff-knows-L nil
807 "*Indicates whether diff understands the -L option.
808The value is either `yes', `no', or nil. If it is nil, VC tries
809to use -L and sets this variable to remember whether it worked."
810 :type '(choice (const :tag "Work out" nil) (const yes) (const no))
811 :group 'vc)
812
f1d1d46a 813(defcustom vc-allow-async-revert nil
e4d26892 814 "Specifies whether the diff during \\[vc-revert] may be asynchronous.
f1d1d46a
AS
815Enabling this option means that you can confirm a revert operation even
816if the local changes in the file have not been found and displayed yet."
817 :type '(choice (const :tag "No" nil)
818 (const :tag "Yes" t))
819 :group 'vc
bf247b6e 820 :version "22.1")
f1d1d46a 821
7cad930d
AS
822;;;###autoload
823(defcustom vc-checkout-hook nil
04864eb0 824 "Normal hook (list of functions) run after checking out a file.
7cad930d
AS
825See `run-hooks'."
826 :type 'hook
827 :group 'vc
828 :version "21.1")
829
da7c8a12 830(defcustom vc-annotate-display-mode 'fullscale
6f1ecae4 831 "Which mode to color the output of \\[vc-annotate] with by default."
da7c8a12 832 :type '(choice (const :tag "By Color Map Range" nil)
75665141
AS
833 (const :tag "Scale to Oldest" scale)
834 (const :tag "Scale Oldest->Newest" fullscale)
835 (number :tag "Specify Fractional Number of Days"
836 :value "20.5"))
837 :group 'vc)
838
0e362f54
GM
839;;;###autoload
840(defcustom vc-checkin-hook nil
61de26cb 841 "Normal hook (list of functions) run after commit or file checkin.
1cca5da4 842See also `log-edit-done-hook'."
0e362f54 843 :type 'hook
1cca5da4 844 :options '(log-edit-comment-to-change-log)
0e362f54
GM
845 :group 'vc)
846
847;;;###autoload
848(defcustom vc-before-checkin-hook nil
61de26cb 849 "Normal hook (list of functions) run before a commit or a file checkin.
0e362f54
GM
850See `run-hooks'."
851 :type 'hook
852 :group 'vc)
853
b1ddeeb7
ER
854(defcustom vc-dir-mode-hook nil
855 "Normal hook run by `vc-dir-mode'.
856See `run-hooks'."
857 :type 'hook
858 :group 'vc)
859
0e362f54 860;; Annotate customization
7d2d9482 861(defcustom vc-annotate-color-map
da7c8a12
S
862 (if (and (tty-display-color-p) (<= (display-color-cells) 8))
863 ;; A custom sorted TTY colormap
864 (let* ((colors
865 (sort
866 (delq nil
867 (mapcar (lambda (x)
868 (if (not (or
869 (string-equal (car x) "white")
870 (string-equal (car x) "black") ))
871 (car x)))
872 (tty-color-alist)))
873 (lambda (a b)
874 (cond
875 ((or (string-equal a "red") (string-equal b "blue")) t)
876 ((or (string-equal b "red") (string-equal a "blue")) nil)
877 ((string-equal a "yellow") t)
878 ((string-equal b "yellow") nil)
879 ((string-equal a "cyan") t)
880 ((string-equal b "cyan") nil)
881 ((string-equal a "green") t)
882 ((string-equal b "green") nil)
883 ((string-equal a "magenta") t)
884 ((string-equal b "magenta") nil)
885 (t (string< a b))))))
886 (date 20.)
887 (delta (/ (- 360. date) (1- (length colors)))))
888 (mapcar (lambda (x)
889 (prog1
890 (cons date x)
891 (setq date (+ date delta)))) colors))
892 ;; Normal colormap: hue stepped from 0-240deg, value=1., saturation=0.75
893 '(( 20. . "#FF3F3F")
894 ( 40. . "#FF6C3F")
895 ( 60. . "#FF993F")
896 ( 80. . "#FFC63F")
897 (100. . "#FFF33F")
898 (120. . "#DDFF3F")
899 (140. . "#B0FF3F")
900 (160. . "#83FF3F")
901 (180. . "#56FF3F")
902 (200. . "#3FFF56")
903 (220. . "#3FFF83")
904 (240. . "#3FFFB0")
905 (260. . "#3FFFDD")
906 (280. . "#3FF3FF")
907 (300. . "#3FC6FF")
908 (320. . "#3F99FF")
909 (340. . "#3F6CFF")
910 (360. . "#3F3FFF")))
04864eb0 911 "Association list of age versus color, for \\[vc-annotate].
da7c8a12
S
912Ages are given in units of fractional days. Default is eighteen
913steps using a twenty day increment, from red to blue. For TTY
914displays with 8 or fewer colors, the default is red to blue with
915all other colors between (excluding black and white)."
0e362f54 916 :type 'alist
7d2d9482
RS
917 :group 'vc)
918
da7c8a12 919(defcustom vc-annotate-very-old-color "#3F3FFF"
04864eb0 920 "Color for lines older than the current color range in \\[vc-annotate]]."
7d2d9482
RS
921 :type 'string
922 :group 'vc)
923
924(defcustom vc-annotate-background "black"
04864eb0 925 "Background color for \\[vc-annotate].
7d2d9482 926Default color is used if nil."
14b7a0b5 927 :type '(choice (const :tag "Default background" nil) (color))
7d2d9482
RS
928 :group 'vc)
929
930(defcustom vc-annotate-menu-elements '(2 0.5 0.1 0.01)
04864eb0 931 "Menu elements for the mode-specific menu of VC-Annotate mode.
7d2d9482 932List of factors, used to expand/compress the time scale. See `vc-annotate'."
0e362f54 933 :type '(repeat number)
7d2d9482
RS
934 :group 'vc)
935
0e362f54
GM
936(defvar vc-annotate-mode-map
937 (let ((m (make-sparse-keymap)))
04864eb0
SM
938 (define-key m "A" 'vc-annotate-revision-previous-to-line)
939 (define-key m "D" 'vc-annotate-show-diff-revision-at-line)
f3ff0fe9 940 (define-key m "f" 'vc-annotate-find-revision-at-line)
04864eb0
SM
941 (define-key m "J" 'vc-annotate-revision-at-line)
942 (define-key m "L" 'vc-annotate-show-log-revision-at-line)
ac3f4c6f
ER
943 (define-key m "N" 'vc-annotate-next-revision)
944 (define-key m "P" 'vc-annotate-prev-revision)
945 (define-key m "W" 'vc-annotate-working-revision)
5731a8e0 946 (define-key m "V" 'vc-annotate-toggle-annotation-visibility)
0e362f54
GM
947 m)
948 "Local keymap used for VC-Annotate mode.")
67242a23 949
594722a8
ER
950;; Header-insertion hair
951
0101cc40 952(defcustom vc-static-header-alist
04864eb0 953 '(("\\.c\\'" .
594722a8 954 "\n#ifndef lint\nstatic char vcid[] = \"\%s\";\n#endif /* lint */\n"))
0e362f54
GM
955 "*Associate static header string templates with file types.
956A \%s in the template is replaced with the first string associated with
099bd78a 957the file's version control type in `vc-header-alist'."
0101cc40
RS
958 :type '(repeat (cons :format "%v"
959 (regexp :tag "File Type")
960 (string :tag "Header String")))
961 :group 'vc)
7b4f934d 962
0101cc40 963(defcustom vc-comment-alist
594722a8 964 '((nroff-mode ".\\\"" ""))
6f1ecae4 965 "*Special comment delimiters for generating VC headers.
099bd78a
SM
966Add an entry in this list if you need to override the normal `comment-start'
967and `comment-end' variables. This will only be necessary if the mode language
0101cc40
RS
968is sensitive to blank lines."
969 :type '(repeat (list :format "%v"
970 (symbol :tag "Mode")
971 (string :tag "Comment Start")
972 (string :tag "Comment End")))
973 :group 'vc)
594722a8 974
0101cc40 975(defcustom vc-checkout-carefully (= (user-uid) 0)
bf142f28 976 "*Non-nil means be extra-careful in checkout.
bbf97570 977Verify that the file really is not locked
0101cc40
RS
978and that its contents match what the master file says."
979 :type 'boolean
980 :group 'vc)
bf142f28
JB
981(make-obsolete-variable 'vc-checkout-carefully
982 "the corresponding checks are always done now."
983 "21.1")
bbf97570 984
0e362f54 985\f
83affd96 986;; Variables users don't need to see
594722a8 987
f1d1d46a
AS
988(defvar vc-disable-async-diff nil
989 "VC sets this to t locally to disable some async diff operations.
990Backends that offer asynchronous diffs should respect this variable
991in their implementation of vc-BACKEND-diff.")
992
b1ddeeb7
ER
993(defvar vc-dired-mode nil)
994(make-variable-buffer-local 'vc-dired-mode)
995
594722a8
ER
996;; File property caching
997
8c0aaf40 998(defun vc-clear-context ()
11cdd167 999 "Clear all cached file properties."
8c0aaf40 1000 (interactive)
11cdd167 1001 (fillarray vc-file-prop-obarray 0))
8c0aaf40 1002
d7b60083
ER
1003(defmacro with-vc-properties (files form settings)
1004 "Execute FORM, then maybe set per-file properties for FILES.
6f1ecae4
AS
1005SETTINGS is an association list of property/value pairs. After
1006executing FORM, set those properties from SETTINGS that have not yet
1007been updated to their corresponding values."
b4e4e3a8 1008 (declare (debug t))
169f0cae 1009 `(let ((vc-touched-properties (list t)))
099bd78a 1010 ,form
d7b60083 1011 (dolist (file ,files)
a7192ddb
SM
1012 (dolist (setting ,settings)
1013 (let ((property (car setting)))
1014 (unless (memq property vc-touched-properties)
1015 (put (intern file vc-file-prop-obarray)
1016 property (cdr setting))))))))
099bd78a 1017
ec402ad4 1018;; Two macros for elisp programming
61de26cb 1019
709822e8
AS
1020;;;###autoload
1021(defmacro with-vc-file (file comment &rest body)
6f1ecae4 1022 "Check out a writable copy of FILE if necessary, then execute BODY.
0e362f54
GM
1023Check in FILE with COMMENT (a string) after BODY has been executed.
1024FILE is passed through `expand-file-name'; BODY executed within
61de26cb 1025`save-excursion'. If FILE is not under version control, or you are
a7192ddb 1026using a locking version-control system and the file is locked by
709822e8 1027somebody else, signal error."
b4e4e3a8 1028 (declare (debug t) (indent 2))
169f0cae
AS
1029 (let ((filevar (make-symbol "file")))
1030 `(let ((,filevar (expand-file-name ,file)))
1031 (or (vc-backend ,filevar)
2df5044f 1032 (error "File not under version control: `%s'" file))
169f0cae
AS
1033 (unless (vc-editable-p ,filevar)
1034 (let ((state (vc-state ,filevar)))
f1180544 1035 (if (stringp state)
2df5044f 1036 (error "`%s' is locking `%s'" state ,filevar)
169f0cae
AS
1037 (vc-checkout ,filevar t))))
1038 (save-excursion
1039 ,@body)
d7b60083 1040 (vc-checkin (list ,filevar) nil ,comment))))
169f0cae 1041
709822e8
AS
1042;;;###autoload
1043(defmacro edit-vc-file (file comment &rest body)
0e362f54
GM
1044 "Edit FILE under version control, executing body.
1045Checkin with COMMENT after executing BODY.
709822e8
AS
1046This macro uses `with-vc-file', passing args to it.
1047However, before executing BODY, find FILE, and after BODY, save buffer."
b4e4e3a8 1048 (declare (debug t) (indent 2))
169f0cae
AS
1049 (let ((filevar (make-symbol "file")))
1050 `(let ((,filevar (expand-file-name ,file)))
1051 (with-vc-file
1052 ,filevar ,comment
1053 (set-buffer (find-file-noselect ,filevar))
1054 ,@body
1055 (save-buffer)))))
1056
b1ddeeb7
ER
1057(defun vc-position-context (posn)
1058 "Save a bit of the text around POSN in the current buffer.
1059Used to help us find the corresponding position again later
1060if markers are destroyed or corrupted."
1061 ;; A lot of this was shamelessly lifted from Sebastian Kremer's
1062 ;; rcs.el mode.
1063 (list posn
1064 (buffer-size)
1065 (buffer-substring posn
1066 (min (point-max) (+ posn 100)))))
1067
1068(defun vc-find-position-by-context (context)
1069 "Return the position of CONTEXT in the current buffer.
1070If CONTEXT cannot be found, return nil."
1071 (let ((context-string (nth 2 context)))
1072 (if (equal "" context-string)
1073 (point-max)
1074 (save-excursion
1075 (let ((diff (- (nth 1 context) (buffer-size))))
1076 (when (< diff 0) (setq diff (- diff)))
1077 (goto-char (nth 0 context))
1078 (if (or (search-forward context-string nil t)
1079 ;; Can't use search-backward since the match may continue
1080 ;; after point.
1081 (progn (goto-char (- (point) diff (length context-string)))
1082 ;; goto-char doesn't signal an error at
1083 ;; beginning of buffer like backward-char would
1084 (search-forward context-string nil t)))
1085 ;; to beginning of OSTRING
1086 (- (point) (length context-string))))))))
1087
1088(defun vc-context-matches-p (posn context)
1089 "Return t if POSN matches CONTEXT, nil otherwise."
1090 (let* ((context-string (nth 2 context))
1091 (len (length context-string))
1092 (end (+ posn len)))
1093 (if (> end (1+ (buffer-size)))
1094 nil
1095 (string= context-string (buffer-substring posn end)))))
1096
1097(defun vc-buffer-context ()
1098 "Return a list (POINT-CONTEXT MARK-CONTEXT REPARSE).
1099Used by `vc-restore-buffer-context' to later restore the context."
1100 (let ((point-context (vc-position-context (point)))
1101 ;; Use mark-marker to avoid confusion in transient-mark-mode.
1102 (mark-context (when (eq (marker-buffer (mark-marker)) (current-buffer))
1103 (vc-position-context (mark-marker))))
1104 ;; Make the right thing happen in transient-mark-mode.
1105 (mark-active nil)
1106 ;; The new compilation code does not use compilation-error-list any
1107 ;; more, so the code below is now ineffective and might as well
1108 ;; be disabled. -- Stef
1109 ;; ;; We may want to reparse the compilation buffer after revert
1110 ;; (reparse (and (boundp 'compilation-error-list) ;compile loaded
1111 ;; ;; Construct a list; each elt is nil or a buffer
1112 ;; ;; if that buffer is a compilation output buffer
1113 ;; ;; that contains markers into the current buffer.
1114 ;; (save-current-buffer
1115 ;; (mapcar (lambda (buffer)
1116 ;; (set-buffer buffer)
1117 ;; (let ((errors (or
1118 ;; compilation-old-error-list
1119 ;; compilation-error-list))
1120 ;; (buffer-error-marked-p nil))
1121 ;; (while (and (consp errors)
1122 ;; (not buffer-error-marked-p))
1123 ;; (and (markerp (cdr (car errors)))
1124 ;; (eq buffer
1125 ;; (marker-buffer
1126 ;; (cdr (car errors))))
1127 ;; (setq buffer-error-marked-p t))
1128 ;; (setq errors (cdr errors)))
1129 ;; (if buffer-error-marked-p buffer)))
1130 ;; (buffer-list)))))
1131 (reparse nil))
1132 (list point-context mark-context reparse)))
1133
1134(defun vc-restore-buffer-context (context)
1135 "Restore point/mark, and reparse any affected compilation buffers.
1136CONTEXT is that which `vc-buffer-context' returns."
1137 (let ((point-context (nth 0 context))
1138 (mark-context (nth 1 context))
1139 ;; (reparse (nth 2 context))
1140 )
1141 ;; The new compilation code does not use compilation-error-list any
1142 ;; more, so the code below is now ineffective and might as well
1143 ;; be disabled. -- Stef
1144 ;; ;; Reparse affected compilation buffers.
1145 ;; (while reparse
1146 ;; (if (car reparse)
1147 ;; (with-current-buffer (car reparse)
1148 ;; (let ((compilation-last-buffer (current-buffer)) ;select buffer
1149 ;; ;; Record the position in the compilation buffer of
1150 ;; ;; the last error next-error went to.
1151 ;; (error-pos (marker-position
1152 ;; (car (car-safe compilation-error-list)))))
1153 ;; ;; Reparse the error messages as far as they were parsed before.
1154 ;; (compile-reinitialize-errors '(4) compilation-parsing-end)
1155 ;; ;; Move the pointer up to find the error we were at before
1156 ;; ;; reparsing. Now next-error should properly go to the next one.
1157 ;; (while (and compilation-error-list
1158 ;; (/= error-pos (car (car compilation-error-list))))
1159 ;; (setq compilation-error-list (cdr compilation-error-list))))))
1160 ;; (setq reparse (cdr reparse)))
1161
1162 ;; if necessary, restore point and mark
1163 (if (not (vc-context-matches-p (point) point-context))
1164 (let ((new-point (vc-find-position-by-context point-context)))
1165 (when new-point (goto-char new-point))))
1166 (and mark-active
1167 mark-context
1168 (not (vc-context-matches-p (mark) mark-context))
1169 (let ((new-mark (vc-find-position-by-context mark-context)))
1170 (when new-mark (set-mark new-mark))))))
1171
d7b60083
ER
1172;;; Code for deducing what fileset and backend to assume
1173
2765044b
DN
1174(defun vc-responsible-backend (file &optional register)
1175 "Return the name of a backend system that is responsible for FILE.
1176The optional argument REGISTER means that a backend suitable for
1177registration should be found.
1178
1179If REGISTER is nil, then if FILE is already registered, return the
1180backend of FILE. If FILE is not registered, or a directory, then the
1181first backend in `vc-handled-backends' that declares itself
1182responsible for FILE is returned. If no backend declares itself
1183responsible, return the first backend.
1184
1185If REGISTER is non-nil, return the first responsible backend under
1186which FILE is not yet registered. If there is no such backend, return
1187the first backend under which FILE is not yet registered, but could
1188be registered."
b5446276
DN
1189 (when (not vc-handled-backends)
1190 (error "No handled backends"))
2765044b
DN
1191 (or (and (not (file-directory-p file)) (not register) (vc-backend file))
1192 (catch 'found
1193 ;; First try: find a responsible backend. If this is for registration,
1194 ;; it must be a backend under which FILE is not yet registered.
1195 (dolist (backend vc-handled-backends)
1196 (and (or (not register)
1197 (not (vc-call-backend backend 'registered file)))
1198 (vc-call-backend backend 'responsible-p file)
1199 (throw 'found backend)))
1200 ;; no responsible backend
1201 (if (not register)
1202 ;; if this is not for registration, the first backend must do
1203 (car vc-handled-backends)
1204 ;; for registration, we need to find a new backend that
1205 ;; could register FILE
1206 (dolist (backend vc-handled-backends)
1207 (and (not (vc-call-backend backend 'registered file))
1208 (vc-call-backend backend 'could-register file)
1209 (throw 'found backend)))
1210 (error "No backend that could register")))))
1211
1212(defun vc-expand-dirs (file-or-dir-list)
1213 "Expands directories in a file list specification.
1214Only files already under version control are noticed."
1215 ;; FIXME: Kill this function.
1216 (let ((flattened '()))
1217 (dolist (node file-or-dir-list)
1218 (vc-file-tree-walk
b5446276 1219 node (lambda (f) (when (vc-backend f) (push f flattened)))))
2765044b
DN
1220 (nreverse flattened)))
1221
5bd20ee6
DN
1222(defun vc-deduce-fileset (&optional allow-directory-wildcard allow-unregistered
1223 include-files-not-directories)
a7192ddb
SM
1224 "Deduce a set of files and a backend to which to apply an operation.
1225
ae67f2d0 1226Return (BACKEND . FILESET).
a7192ddb
SM
1227If we're in VC-dired mode, the fileset is the list of marked files.
1228Otherwise, if we're looking at a buffer visiting a version-controlled file,
1229the fileset is a singleton containing this file.
1230If neither of these things is true, but ALLOW-DIRECTORY-WILDCARD is on
1231and we're in a dired buffer, select the current directory.
5bd20ee6
DN
1232If none of these conditions is met, but ALLOW_UNREGISTERED is on and the
1233visited file is not registered, return a singleton fileset containing it.
1234If INCLUDE-FILES-NOT-DIRECTORIES then if directories are marked,
1235return the list of files VC files in those directories instead of
1236the directories themselves.
a7192ddb 1237Otherwise, throw an error."
ae67f2d0
DN
1238 (let (backend)
1239 (cond
1240 (vc-dired-mode
1241 (let ((marked (dired-map-over-marks (dired-get-filename) nil)))
1242 (unless marked
1243 (error "No files have been selected."))
1244 ;; All members of the fileset must have the same backend
1245 (setq backend (vc-backend (car marked)))
1246 (dolist (f (cdr marked))
1247 (unless (eq (vc-backend f) backend)
1248 (error "All members of a fileset must be under the same version-control system.")))
1249 (cons backend marked)))
1250 ((eq major-mode 'vc-dir-mode)
1251 ;; FIXME: Maybe the backend should be stored in a buffer-local
1252 ;; variable?
1253 (cons (vc-responsible-backend default-directory)
5bd20ee6
DN
1254 (or
1255 (if include-files-not-directories
1256 (vc-dir-marked-only-files)
1257 (vc-dir-marked-files))
1258 (list (vc-dir-current-file)))))
ae67f2d0
DN
1259 ((setq backend (vc-backend buffer-file-name))
1260 (cons backend (list buffer-file-name)))
1261 ((and vc-parent-buffer (or (buffer-file-name vc-parent-buffer)
1262 (with-current-buffer vc-parent-buffer
1263 (or vc-dired-mode (eq major-mode 'vc-dir-mode)))))
1264 (progn
1265 (set-buffer vc-parent-buffer)
1266 (vc-deduce-fileset)))
1267 ;; This is guarded by an enabling arg so users won't potentially
1268 ;; shoot themselves in the foot by modifying a fileset they can't
1269 ;; verify by eyeball. Allow it for nondestructive commands like
1270 ;; making diffs, or possibly for destructive ones that have
1271 ;; confirmation prompts.
1272 ((and allow-directory-wildcard
1273 ;; I think this is a misfeature. For now, I'll leave it in, but
1274 ;; I'll disable it anywhere else than in dired buffers. --Stef
1275 (and (derived-mode-p 'dired-mode)
1276 (equal buffer-file-name nil)
1277 (equal list-buffers-directory default-directory)))
1278 (progn
1279 (message "All version-controlled files below %s selected."
1280 default-directory)
1281 (cons
1282 (vc-responsible-backend default-directory)
1283 (list default-directory))))
7a3c8d3a 1284 ;; If we're allowing unregistered fiiles and visiting one, select it.
ae67f2d0
DN
1285 ((and allow-unregistered (not (vc-registered buffer-file-name)))
1286 (cons (vc-responsible-backend
1287 (file-name-directory (buffer-file-name)))
1288 (list buffer-file-name)))
1289 (t (error "No fileset is available here.")))))
d7b60083 1290
2765044b
DN
1291(defun vc-ensure-vc-buffer ()
1292 "Make sure that the current buffer visits a version-controlled file."
ca8dfeda
DN
1293 (cond
1294 (vc-dired-mode
1295 (set-buffer (find-file-noselect (dired-get-filename))))
e1aec6fb
SM
1296 ((eq major-mode 'vc-dir-mode)
1297 (set-buffer (find-file-noselect (vc-dir-current-file))))
ca8dfeda 1298 (t
772111be 1299 (while (and vc-parent-buffer
cc72026b 1300 (buffer-live-p vc-parent-buffer)
772111be
MR
1301 ;; Avoid infinite looping when vc-parent-buffer and
1302 ;; current buffer are the same buffer.
1303 (not (eq vc-parent-buffer (current-buffer))))
2765044b
DN
1304 (set-buffer vc-parent-buffer))
1305 (if (not buffer-file-name)
1306 (error "Buffer %s is not associated with a file" (buffer-name))
b5446276
DN
1307 (unless (vc-backend buffer-file-name)
1308 (error "File %s is not under version control" buffer-file-name))))))
2765044b 1309
e0607aaa
SM
1310;;; Support for the C-x v v command.
1311;; This is where all the single-file-oriented code from before the fileset
1312;; rewrite lives.
61de26cb 1313
2765044b
DN
1314(defsubst vc-editable-p (file)
1315 "Return non-nil if FILE can be edited."
e0607aaa
SM
1316 (let ((backend (vc-backend file)))
1317 (and backend
70e2f6c7 1318 (or (eq (vc-checkout-model backend (list file)) 'implicit)
e0607aaa 1319 (memq (vc-state file) '(edited needs-merge conflict))))))
2765044b 1320
61de26cb 1321(defun vc-revert-buffer-internal (&optional arg no-confirm)
6f1ecae4 1322 "Revert buffer, keeping point and mark where user expects them.
ac3f4c6f 1323Try to be clever in the face of changes due to expanded version-control
099bd78a
SM
1324key words. This is important for typeahead to work as expected.
1325ARG and NO-CONFIRM are passed on to `revert-buffer'."
c8de1d91
AS
1326 (interactive "P")
1327 (widen)
1328 (let ((context (vc-buffer-context)))
4b398f5d
AS
1329 ;; Use save-excursion here, because it may be able to restore point
1330 ;; and mark properly even in cases where vc-restore-buffer-context
0e362f54 1331 ;; would fail. However, save-excursion might also get it wrong --
4b398f5d
AS
1332 ;; in this case, vc-restore-buffer-context gives it a second try.
1333 (save-excursion
0e362f54 1334 ;; t means don't call normal-mode;
4b398f5d
AS
1335 ;; that's to preserve various minor modes.
1336 (revert-buffer arg no-confirm t))
c8de1d91
AS
1337 (vc-restore-buffer-context context)))
1338
97d3f950 1339(defun vc-buffer-sync (&optional not-urgent)
099bd78a 1340 "Make sure the current buffer and its working file are in sync.
0e362f54 1341NOT-URGENT means it is ok to continue if the user says not to save."
b5446276
DN
1342 (when (buffer-modified-p)
1343 (if (or vc-suppress-confirm
1344 (y-or-n-p (format "Buffer %s modified; save it? " (buffer-name))))
1345 (save-buffer)
1346 (unless not-urgent
1347 (error "Aborted")))))
97d3f950 1348
b1ddeeb7
ER
1349(defvar vc-dired-window-configuration)
1350
484c1b1f
ER
1351(defun vc-compatible-state (p q)
1352 "Controls which states can be in the same commit."
1353 (or
1354 (eq p q)
1355 (and (member p '(edited added removed)) (member q '(edited added removed)))))
1356
2765044b
DN
1357;; Here's the major entry point.
1358
1359;;;###autoload
1360(defun vc-next-action (verbose)
d7b60083
ER
1361 "Do the next logical version control operation on the current fileset.
1362This requires that all files in the fileset be in the same state.
2765044b 1363
d7b60083
ER
1364For locking systems:
1365 If every file is not already registered, this registers each for version
2765044b 1366control.
d7b60083
ER
1367 If every file is registered and not locked by anyone, this checks out
1368a writable and locked file of each ready for editing.
1369 If every file is checked out and locked by the calling user, this
1370first checks to see if each file has changed since checkout. If not,
1371it performs a revert on that file.
1372 If every file has been changed, this pops up a buffer for entry
2765044b
DN
1373of a log message; when the message has been entered, it checks in the
1374resulting changes along with the log message as change commentary. If
1375the variable `vc-keep-workfiles' is non-nil (which is its default), a
d7b60083
ER
1376read-only copy of each changed file is left in place afterwards.
1377 If the affected file is registered and locked by someone else, you are
1378given the option to steal the lock(s).
1379
1380For merging systems:
1381 If every file is not already registered, this registers each one for version
1382control. This does an add, but not a commit.
1383 If every file is added but not committed, each one is committed.
1384 If every working file is changed, but the corresponding repository file is
2765044b
DN
1385unchanged, this pops up a buffer for entry of a log message; when the
1386message has been entered, it checks in the resulting changes along
1387with the logmessage as change commentary. A writable file is retained.
1388 If the repository file is changed, you are asked if you want to
1389merge in the changes into your working copy."
2765044b 1390 (interactive "P")
ae67f2d0 1391 (let* ((vc-fileset (vc-deduce-fileset nil t))
5bd20ee6
DN
1392 (vc-fileset-only-files (vc-deduce-fileset nil t t))
1393 (only-files (cdr vc-fileset-only-files))
e0607aaa 1394 (backend (car vc-fileset))
ae67f2d0 1395 (files (cdr vc-fileset))
5bd20ee6 1396 (state (vc-state (car only-files)))
e0607aaa 1397 (model (vc-checkout-model backend files))
ac3f4c6f 1398 revision)
ac2c49f4 1399
9eef6650 1400 ;; Verify that the fileset is homogeneous
5bd20ee6 1401 (dolist (file (cdr only-files))
ae67f2d0
DN
1402 ;; Ignore directories, they are compatible with anything.
1403 (unless (file-directory-p file)
1404 (unless (vc-compatible-state (vc-state file) state)
a094fe43
ER
1405 (error "%s:%s clashes with %s:%s"
1406 file (vc-state file) (car files) state))
70e2f6c7 1407 (unless (eq (vc-checkout-model backend (list file)) model)
ae67f2d0 1408 (error "Fileset has mixed checkout models"))))
d7b60083
ER
1409 ;; Check for buffers in the fileset not matching the on-disk contents.
1410 (dolist (file files)
1411 (let ((visited (get-file-buffer file)))
1412 (when visited
e1aec6fb 1413 (if (or vc-dired-mode (eq major-mode 'vc-dir-mode))
d7b60083
ER
1414 (switch-to-buffer-other-window visited)
1415 (set-buffer visited))
1416 ;; Check relation of buffer and file, and make sure
1417 ;; user knows what he's doing. First, finding the file
1418 ;; will check whether the file on disk is newer.
1419 ;; Ignore buffer-read-only during this test, and
1420 ;; preserve find-file-literally.
1421 (let ((buffer-read-only (not (file-writable-p file))))
1422 (find-file-noselect file nil find-file-literally))
1423 (if (not (verify-visited-file-modtime (current-buffer)))
1424 (if (yes-or-no-p (format "Replace %s on disk with buffer contents? " file))
1425 (write-file buffer-file-name)
1426 (error "Aborted"))
1427 ;; Now, check if we have unsaved changes.
1428 (vc-buffer-sync t)
e166638d
DN
1429 (when (buffer-modified-p)
1430 (or (y-or-n-p (message "Use %s on disk, keeping modified buffer? " file))
1431 (error "Aborted")))))))
0e362f54 1432 ;; Do the right thing
a7192ddb 1433 (cond
3c73c30e
ER
1434 ((eq state 'missing)
1435 (error "Fileset files are missing, so cannot be operated on."))
d7b60083 1436 ;; Files aren't registered
3702367b 1437 ((or (eq state 'unregistered)
e166638d 1438 (eq state 'ignored))
80296236 1439 (mapc (lambda (arg) (vc-register nil arg)) files))
ac3f4c6f 1440 ;; Files are up-to-date, or need a merge and user specified a revision
3702367b 1441 ((or (eq state 'up-to-date) (and verbose (eq state 'needs-update)))
0e362f54 1442 (cond
d7b60083 1443 (verbose
ac3f4c6f
ER
1444 ;; go to a different revision
1445 (setq revision (read-string "Branch, revision, or backend to move to: "))
1446 (let ((vsym (intern-soft (upcase revision))))
d7b60083 1447 (if (member vsym vc-handled-backends)
a7192ddb
SM
1448 (dolist (file files) (vc-transfer-file file vsym))
1449 (dolist (file files)
1450 (vc-checkout file (eq model 'implicit) revision)))))
d7b60083
ER
1451 ((not (eq model 'implicit))
1452 ;; check the files out
a7192ddb 1453 (dolist (file files) (vc-checkout file t)))
d7b60083 1454 (t
a7192ddb
SM
1455 ;; do nothing
1456 (message "Fileset is up-to-date"))))
1457 ;; Files have local changes
484c1b1f 1458 ((vc-compatible-state state 'edited)
d7b60083
ER
1459 (let ((ready-for-commit files))
1460 ;; If files are edited but read-only, give user a chance to correct
1461 (dolist (file files)
e166638d
DN
1462 (unless (file-writable-p file)
1463 ;; Make the file+buffer read-write.
1464 (unless (y-or-n-p (format "%s is edited but read-only; make it writable and continue?" file))
1465 (error "Aborted"))
1466 (set-file-modes file (logior (file-modes file) 128))
1467 (let ((visited (get-file-buffer file)))
1468 (when visited
1469 (with-current-buffer visited
1470 (toggle-read-only -1))))))
d7b60083
ER
1471 ;; Allow user to revert files with no changes
1472 (save-excursion
a7192ddb
SM
1473 (dolist (file files)
1474 (let ((visited (get-file-buffer file)))
1475 ;; For files with locking, if the file does not contain
1476 ;; any changes, just let go of the lock, i.e. revert.
e166638d
DN
1477 (when (and (not (eq model 'implicit))
1478 (vc-workfile-unchanged-p file)
1479 ;; If buffer is modified, that means the user just
1480 ;; said no to saving it; in that case, don't revert,
1481 ;; because the user might intend to save after
1482 ;; finishing the log entry and committing.
1483 (not (and visited (buffer-modified-p))))
1484 (vc-revert-file file)
1485 (delete file ready-for-commit)))))
d7b60083
ER
1486 ;; Remaining files need to be committed
1487 (if (not ready-for-commit)
1488 (message "No files remain to be committed")
1d502d5a 1489 (if (not verbose)
d7b60083
ER
1490 (vc-checkin ready-for-commit)
1491 (progn
ac3f4c6f
ER
1492 (setq revision (read-string "New revision or backend: "))
1493 (let ((vsym (intern (upcase revision))))
d7b60083 1494 (if (member vsym vc-handled-backends)
d36122a2 1495 (dolist (file files) (vc-transfer-file file vsym))
ac3f4c6f 1496 (vc-checkin ready-for-commit revision))))))))
d7b60083
ER
1497 ;; locked by somebody else (locking VCSes only)
1498 ((stringp state)
d36122a2
TTN
1499 ;; In the old days, we computed the revision once and used it on
1500 ;; the single file. Then, for the 2007-2008 fileset rewrite, we
1501 ;; computed the revision once (incorrectly, using a free var) and
1502 ;; used it on all files. To fix the free var bug, we can either
1503 ;; use `(car files)' or do what we do here: distribute the
1504 ;; revision computation among `files'. Although this may be
1505 ;; tedious for those backends where a "revision" is a trans-file
1506 ;; concept, it is nonetheless correct for both those and (more
1507 ;; importantly) for those where "revision" is a per-file concept.
1508 ;; If the intersection of the former group and "locking VCSes" is
1509 ;; non-empty [I vaguely doubt it --ttn], we can reinstate the
1510 ;; pre-computation approach of yore.
1511 (dolist (file files)
1512 (vc-steal-lock
1513 file (if verbose
1514 (read-string (format "%s revision to steal: " file))
1515 (vc-working-revision file))
1516 state)))
7fbb4797
DN
1517 ;; conflict
1518 ((eq state 'conflict)
1519 (vc-mark-resolved files))
3702367b
ER
1520 ;; needs-update
1521 ((eq state 'needs-update)
d7b60083 1522 (dolist (file files)
6f41eeb5 1523 (if (yes-or-no-p (format
ac3f4c6f 1524 "%s is not up-to-date. Get latest revision? "
0e362f54 1525 (file-name-nondirectory file)))
d7b60083 1526 (vc-checkout file (eq model 'implicit) t)
e166638d
DN
1527 (when (and (not (eq model 'implicit))
1528 (yes-or-no-p "Lock this revision? "))
1529 (vc-checkout file t)))))
d7b60083
ER
1530 ;; needs-merge
1531 ((eq state 'needs-merge)
1532 (dolist (file files)
e166638d 1533 (when (yes-or-no-p (format
0e362f54
GM
1534 "%s is not up-to-date. Merge in changes now? "
1535 (file-name-nondirectory file)))
e166638d 1536 (vc-maybe-resolve-conflicts file (vc-call merge-news file)))))
46e33aee 1537
d7b60083
ER
1538 ;; unlocked-changes
1539 ((eq state 'unlocked-changes)
1540 (dolist (file files)
b5446276
DN
1541 (when (not (equal buffer-file-name file))
1542 (find-file-other-window file))
0e362f54 1543 (if (save-window-excursion
ae67f2d0
DN
1544 (vc-diff-internal nil (cons (car vc-fileset) (list file))
1545 (vc-working-revision file) nil)
0e362f54 1546 (goto-char (point-min))
ceec5a0c 1547 (let ((inhibit-read-only t))
f4f34b33 1548 (insert
ceec5a0c 1549 (format "Changes to %s since last lock:\n\n" file)))
0e362f54
GM
1550 (not (beep))
1551 (yes-or-no-p (concat "File has unlocked changes. "
1552 "Claim lock retaining changes? ")))
1553 (progn (vc-call steal-lock file)
61de26cb 1554 (clear-visited-file-modtime)
0e362f54
GM
1555 ;; Must clear any headers here because they wouldn't
1556 ;; show that the file is locked now.
1557 (vc-clear-headers file)
a36319a4 1558 (write-file buffer-file-name)
0e362f54
GM
1559 (vc-mode-line file))
1560 (if (not (yes-or-no-p
ac3f4c6f 1561 "Revert to checked-in revision, instead? "))
0e362f54 1562 (error "Checkout aborted")
61de26cb 1563 (vc-revert-buffer-internal t t)
3702367b
ER
1564 (vc-checkout file t)))))
1565 ;; Unknown fileset state
1566 (t
1567 (error "Fileset is in an unknown state %s" state)))))
e1f297e6 1568
61de26cb
ER
1569(defun vc-create-repo (backend)
1570 "Create an empty repository in the current directory."
1571 (interactive
1572 (list
1573 (intern
1574 (upcase
1575 (completing-read
1576 "Create repository for: "
1577 (mapcar (lambda (b) (list (downcase (symbol-name b)))) vc-handled-backends)
1578 nil t)))))
1579 (vc-call-backend backend 'create-repo))
1580
637a8ae9 1581;;;###autoload
80296236 1582(defun vc-register (&optional set-revision fname comment)
30a308aa
DN
1583 "Register into a version control system.
1584If FNAME is given register that file, otherwise register the current file.
ac3f4c6f 1585With prefix argument SET-REVISION, allow user to specify initial revision
2765044b 1586level. If COMMENT is present, use that as an initial comment.
0e362f54 1587
2765044b
DN
1588The version control system to use is found by cycling through the list
1589`vc-handled-backends'. The first backend in that list which declares
1590itself responsible for the file (usually because other files in that
1591directory are already registered under that backend) will be used to
1592register the file. If no backend declares itself responsible, the
1593first backend that could register the file is used."
1594 (interactive "P")
30a308aa
DN
1595 (when (and (null fname) (null buffer-file-name)) (error "No visited file"))
1596
5f01100a 1597 (let ((bname (if fname (get-file-buffer fname) (current-buffer))))
30a308aa
DN
1598 (unless fname (setq fname buffer-file-name))
1599 (when (vc-backend fname)
1600 (if (vc-registered fname)
1601 (error "This file is already registered")
1602 (unless (y-or-n-p "Previous master file has vanished. Make a new one? ")
1603 (error "Aborted"))))
1604 ;; Watch out for new buffers of size 0: the corresponding file
1605 ;; does not exist yet, even though buffer-modified-p is nil.
1606 (when bname
1607 (with-current-buffer bname
b5446276 1608 (when (and (not (buffer-modified-p))
30a308aa
DN
1609 (zerop (buffer-size))
1610 (not (file-exists-p buffer-file-name)))
b5446276 1611 (set-buffer-modified-p t))
30a308aa 1612 (vc-buffer-sync)))
83affd96 1613 (vc-start-logentry (list fname)
30a308aa
DN
1614 (if set-revision
1615 (read-string (format "Initial revision level for %s: "
1616 fname))
1617 (vc-call-backend (vc-responsible-backend fname)
1618 'init-revision))
1619 (or comment (not vc-initial-comment))
1620 nil
1621 "Enter initial comment."
1622 (lambda (files rev comment)
1623 (dolist (file files)
1624 (message "Registering %s... " file)
1625 (let ((backend (vc-responsible-backend file t)))
1626 (vc-file-clearprops file)
1627 (vc-call-backend backend 'register (list file) rev comment)
1628 (vc-file-setprop file 'vc-backend backend)
1629 (unless vc-make-backup-files
1630 (make-local-variable 'backup-inhibited)
1631 (setq backup-inhibited t)))
1632 (message "Registering %s... done" file))))))
d7b60083
ER
1633
1634(defun vc-register-with (backend)
1635 "Register the current file with a specified back end."
1636 (interactive "SBackend: ")
b5446276
DN
1637 (when (not (member backend vc-handled-backends))
1638 (error "Unknown back end."))
d7b60083
ER
1639 (let ((vc-handled-backends (list backend)))
1640 (call-interactively 'vc-register)))
8989ab56 1641
73e72da4
DN
1642(declare-function view-mode-exit "view" (&optional return-to-alist exit-action all-win))
1643
624b4662 1644(defun vc-resynch-window (file &optional keep noquery)
099bd78a
SM
1645 "If FILE is in the current buffer, either revert or unvisit it.
1646The choice between revert (to see expanded keywords) and unvisit depends on
1647`vc-keep-workfiles'. NOQUERY if non-nil inhibits confirmation for
0e362f54
GM
1648reverting. NOQUERY should be t *only* if it is known the only
1649difference between the buffer and the file is due to version control
1650rather than user editing!"
594722a8
ER
1651 (and (string= buffer-file-name file)
1652 (if keep
1653 (progn
61de26cb 1654 (vc-revert-buffer-internal t noquery)
0e362f54
GM
1655 ;; TODO: Adjusting view mode might no longer be necessary
1656 ;; after RMS change to files.el of 1999-08-08. Investigate
1657 ;; this when we install the new VC.
f8791ebe
AS
1658 (and view-read-only
1659 (if (file-writable-p file)
1660 (and view-mode
1661 (let ((view-old-buffer-read-only nil))
1662 (view-mode-exit)))
1663 (and (not view-mode)
1664 (not (eq (get major-mode 'mode-class) 'special))
1665 (view-mode-enter))))
594722a8 1666 (vc-mode-line buffer-file-name))
88a2ffaf 1667 (kill-buffer (current-buffer)))))
594722a8 1668
503b5c85 1669(defun vc-resynch-buffer (file &optional keep noquery)
0e362f54 1670 "If FILE is currently visited, resynch its buffer."
4b398f5d
AS
1671 (if (string= buffer-file-name file)
1672 (vc-resynch-window file keep noquery)
1673 (let ((buffer (get-file-buffer file)))
21f3a277
DN
1674 (when buffer
1675 (with-current-buffer buffer
1676 (vc-resynch-window file keep noquery)))))
6cdc3bc9 1677 (vc-directory-resynch-file file)
e1aec6fb 1678 (when (memq 'vc-dir-mark-buffer-changed after-save-hook)
21f3a277 1679 (let ((buffer (get-file-buffer file)))
e1aec6fb 1680 (vc-dir-mark-buffer-changed file))))
21f3a277 1681
c6d4f628 1682(defun vc-checkout (file &optional writable rev)
099bd78a
SM
1683 "Retrieve a copy of the revision REV of FILE.
1684If WRITABLE is non-nil, make sure the retrieved file is writable.
133a84aa
AS
1685REV defaults to the latest revision.
1686
1687After check-out, runs the normal hook `vc-checkout-hook'."
ffda0460
AS
1688 (and writable
1689 (not rev)
10b48cc4 1690 (vc-call make-version-backups-p file)
ffda0460 1691 (vc-up-to-date-p file)
10b48cc4 1692 (vc-make-version-backup file))
e0607aaa
SM
1693 (let ((backend (vc-backend file)))
1694 (with-vc-properties (list file)
1695 (condition-case err
af36f8ed 1696 (vc-call-backend backend 'checkout file writable rev)
e0607aaa
SM
1697 (file-error
1698 ;; Maybe the backend is not installed ;-(
1699 (when writable
1700 (let ((buf (get-file-buffer file)))
1701 (when buf (with-current-buffer buf (toggle-read-only -1)))))
1702 (signal (car err) (cdr err))))
70e2f6c7 1703 `((vc-state . ,(if (or (eq (vc-checkout-model backend (list file)) 'implicit)
e0607aaa
SM
1704 (not writable))
1705 (if (vc-call latest-on-branch-p file)
1706 'up-to-date
3702367b 1707 'needs-update)
e0607aaa
SM
1708 'edited))
1709 (vc-checkout-time . ,(nth 5 (file-attributes file))))))
7cad930d
AS
1710 (vc-resynch-buffer file t t)
1711 (run-hooks 'vc-checkout-hook))
594722a8 1712
7fbb4797
DN
1713(defun vc-mark-resolved (files)
1714 (with-vc-properties
1715 files
1716 (vc-call mark-resolved files)
1717 ;; XXX: Is this TRTD? Might not be.
1718 `((vc-state . edited))))
1719
0e362f54 1720(defun vc-steal-lock (file rev owner)
099bd78a 1721 "Steal the lock on FILE."
29fc1ce9 1722 (let (file-description)
29fc1ce9
RS
1723 (if rev
1724 (setq file-description (format "%s:%s" file rev))
1725 (setq file-description file))
b5446276
DN
1726 (when (not (yes-or-no-p (format "Steal the lock on %s from %s? "
1727 file-description owner)))
1728 (error "Steal canceled"))
869131a5
AS
1729 (message "Stealing lock on %s..." file)
1730 (with-vc-properties
d7b60083 1731 (list file)
869131a5
AS
1732 (vc-call steal-lock file rev)
1733 `((vc-state . edited)))
1734 (vc-resynch-buffer file t t)
1735 (message "Stealing lock on %s...done" file)
1736 ;; Write mail after actually stealing, because if the stealing
1737 ;; goes wrong, we don't want to send any mail.
1738 (compose-mail owner (format "Stolen lock on %s" file-description))
29fc1ce9 1739 (setq default-directory (expand-file-name "~/"))
29fc1ce9
RS
1740 (goto-char (point-max))
1741 (insert
1742 (format "I stole the lock on %s, " file-description)
1743 (current-time-string)
1744 ".\n")
1745 (message "Please explain why you stole the lock. Type C-c C-c when done.")))
594722a8 1746
d7b60083
ER
1747(defun vc-checkin (files &optional rev comment initial-contents)
1748 "Check in FILES.
ac3f4c6f 1749The optional argument REV may be a string specifying the new revision
0e362f54 1750level (if nil increment the current level). COMMENT is a comment
0ab66291
AS
1751string; if omitted, a buffer is popped up to accept a comment. If
1752INITIAL-CONTENTS is non-nil, then COMMENT is used as the initial contents
1753of the log entry buffer.
0e362f54
GM
1754
1755If `vc-keep-workfiles' is nil, FILE is deleted afterwards, provided
1756that the version control system supports this mode of operation.
861f3c29
DL
1757
1758Runs the normal hook `vc-checkin-hook'."
83affd96 1759 (vc-start-logentry
d7b60083 1760 files rev comment initial-contents
6f41eeb5 1761 "Enter a change comment."
d7b60083
ER
1762 (lambda (files rev comment)
1763 (message "Checking in %s..." (vc-delistify files))
0e362f54
GM
1764 ;; "This log message intentionally left almost blank".
1765 ;; RCS 5.7 gripes about white-space-only comments too.
1766 (or (and comment (string-match "[^\t\n ]" comment))
1767 (setq comment "*** empty log message ***"))
46e33aee 1768 (with-vc-properties
d7b60083
ER
1769 files
1770 ;; We used to change buffers to get local value of vc-checkin-switches,
1771 ;; but 'the' local buffer is not a well-defined concept for filesets.
1772 (progn
1773 (vc-call checkin files rev comment)
1774 (mapc 'vc-delete-automatic-version-backups files))
a3255400
SM
1775 `((vc-state . up-to-date)
1776 (vc-checkout-time . ,(nth 5 (file-attributes file)))
ac3f4c6f 1777 (vc-working-revision . nil)))
d7b60083 1778 (message "Checking in %s...done" (vc-delistify files)))
0e362f54 1779 'vc-checkin-hook))
594722a8 1780
b1ddeeb7
ER
1781(defun vc-finish-logentry (&optional nocomment)
1782 "Complete the operation implied by the current log entry.
1783Use the contents of the current buffer as a check-in or registration
1784comment. If the optional arg NOCOMMENT is non-nil, then don't check
1785the buffer contents as a comment."
1786 (interactive)
1787 ;; Check and record the comment, if any.
1788 (unless nocomment
1789 (run-hooks 'vc-logentry-check-hook))
1790 ;; Sync parent buffer in case the user modified it while editing the comment.
1791 ;; But not if it is a vc-dired buffer.
1792 (with-current-buffer vc-parent-buffer
1793 (or vc-dired-mode (eq major-mode 'vc-dir-mode) (vc-buffer-sync)))
1794 (unless vc-log-operation
1795 (error "No log operation is pending"))
1796 ;; save the parameters held in buffer-local variables
1797 (let ((log-operation vc-log-operation)
1798 (log-fileset vc-log-fileset)
1799 (log-revision vc-log-revision)
1800 (log-entry (buffer-string))
1801 (after-hook vc-log-after-operation-hook)
1802 (tmp-vc-parent-buffer vc-parent-buffer))
1803 (pop-to-buffer vc-parent-buffer)
1804 ;; OK, do it to it
1805 (save-excursion
1806 (funcall log-operation
1807 log-fileset
1808 log-revision
1809 log-entry))
1810 ;; Remove checkin window (after the checkin so that if that fails
1811 ;; we don't zap the *VC-log* buffer and the typing therein).
1812 ;; -- IMO this should be replaced with quit-window
1813 (let ((logbuf (get-buffer "*VC-log*")))
1814 (cond ((and logbuf vc-delete-logbuf-window)
1815 (delete-windows-on logbuf (selected-frame))
1816 ;; Kill buffer and delete any other dedicated windows/frames.
1817 (kill-buffer logbuf))
1818 (logbuf (pop-to-buffer "*VC-log*")
1819 (bury-buffer)
1820 (pop-to-buffer tmp-vc-parent-buffer))))
1821 ;; Now make sure we see the expanded headers
1822 (when log-fileset
1823 (mapc
1824 (lambda (file) (vc-resynch-buffer file vc-keep-workfiles t))
1825 log-fileset))
1826 (when vc-dired-mode
1827 (dired-move-to-filename))
1828 (when (eq major-mode 'vc-dir-mode)
1829 (vc-dir-move-to-goal-column))
1830 (run-hooks after-hook 'vc-finish-logentry-hook)))
1831
2765044b
DN
1832;;; Additional entry points for examining version histories
1833
a7192ddb
SM
1834;; (defun vc-default-diff-tree (backend dir rev1 rev2)
1835;; "List differences for all registered files at and below DIR.
1836;; The meaning of REV1 and REV2 is the same as for `vc-revision-diff'."
1837;; ;; This implementation does an explicit tree walk, and calls
1838;; ;; vc-BACKEND-diff directly for each file. An optimization
1839;; ;; would be to use `vc-diff-internal', so that diffs can be local,
1840;; ;; and to call it only for files that are actually changed.
1841;; ;; However, this is expensive for some backends, and so it is left
1842;; ;; to backend-specific implementations.
1843;; (setq default-directory dir)
1844;; (vc-file-tree-walk
1845;; default-directory
1846;; (lambda (f)
1847;; (vc-exec-after
1848;; `(let ((coding-system-for-read (vc-coding-system-for-diff ',f)))
1849;; (message "Looking at %s" ',f)
1850;; (vc-call-backend ',(vc-backend f)
1851;; 'diff (list ',f) ',rev1 ',rev2))))))
2765044b
DN
1852
1853(defun vc-coding-system-for-diff (file)
1854 "Return the coding system for reading diff output for FILE."
1855 (or coding-system-for-read
1856 ;; if we already have this file open,
1857 ;; use the buffer's coding system
1858 (let ((buf (find-buffer-visiting file)))
b5446276
DN
1859 (when buf (with-current-buffer buf
1860 buffer-file-coding-system)))
2765044b
DN
1861 ;; otherwise, try to find one based on the file name
1862 (car (find-operation-coding-system 'insert-file-contents file))
1863 ;; and a final fallback
1864 'undecided))
1865
1866(defun vc-switches (backend op)
1867 (let ((switches
b5446276
DN
1868 (or (when backend
1869 (let ((sym (vc-make-backend-sym
1870 backend (intern (concat (symbol-name op)
1871 "-switches")))))
1872 (when (boundp sym) (symbol-value sym))))
2765044b 1873 (let ((sym (intern (format "vc-%s-switches" (symbol-name op)))))
b5446276 1874 (when (boundp sym) (symbol-value sym)))
2765044b
DN
1875 (cond
1876 ((eq op 'diff) diff-switches)))))
1877 (if (stringp switches) (list switches)
1878 ;; If not a list, return nil.
1879 ;; This is so we can set vc-diff-switches to t to override
1880 ;; any switches in diff-switches.
b5446276 1881 (when (listp switches) switches))))
594722a8 1882
2765044b
DN
1883;; Old def for compatibility with Emacs-21.[123].
1884(defmacro vc-diff-switches-list (backend) `(vc-switches ',backend 'diff))
1885(make-obsolete 'vc-diff-switches-list 'vc-switches "22.1")
1886
1d5b2149 1887(defun vc-diff-finish (buffer messages)
17f3909f 1888 ;; The empty sync output case has already been handled, so the only
fddde1f0 1889 ;; possibility of an empty output is for an async process.
1d5b2149
TTN
1890 (when (buffer-live-p buffer)
1891 (let ((window (get-buffer-window buffer t))
1892 (emptyp (zerop (buffer-size buffer))))
1893 (with-current-buffer buffer
1894 (and messages emptyp
1895 (let ((inhibit-read-only t))
1896 (insert (cdr messages) ".\n")
1897 (message "%s" (cdr messages))))
1898 (goto-char (point-min))
fddde1f0 1899 (when window
1d5b2149
TTN
1900 (shrink-window-if-larger-than-buffer window)))
1901 (when (and messages (not emptyp))
1902 (message "%sdone" (car messages))))))
d7b60083 1903
a7192ddb
SM
1904(defvar vc-diff-added-files nil
1905 "If non-nil, diff added files by comparing them to /dev/null.")
1906
ae67f2d0 1907(defun vc-diff-internal (async vc-fileset rev1 rev2 &optional verbose)
d7b60083
ER
1908 "Report diffs between two revisions of a fileset.
1909Diff output goes to the *vc-diff* buffer. The function
1910returns t if the buffer had changes, nil otherwise."
ae67f2d0
DN
1911 (let* ((files (cdr vc-fileset))
1912 (messages (cons (format "Finding changes in %s..."
1d5b2149
TTN
1913 (vc-delistify files))
1914 (format "No changes between %s and %s"
1915 (or rev1 "working revision")
1916 (or rev2 "workfile"))))
d7b60083
ER
1917 ;; Set coding system based on the first file. It's a kluge,
1918 ;; but the only way to set it for each file included would
1919 ;; be to call the back end separately for each file.
a7192ddb 1920 (coding-system-for-read
d7b60083
ER
1921 (if files (vc-coding-system-for-diff (car files)) 'undecided)))
1922 (vc-setup-buffer "*vc-diff*")
1d5b2149 1923 (message "%s" (car messages))
a7192ddb
SM
1924 ;; Many backends don't handle well the case of a file that has been
1925 ;; added but not yet committed to the repo (notably CVS and Subversion).
1926 ;; Do that work here so the backends don't have to futz with it. --ESR
1927 ;;
1928 ;; Actually most backends (including CVS) have options to control the
1929 ;; behavior since which one is better depends on the user and on the
1930 ;; situation). Worse yet: this code does not handle the case where
1931 ;; `file' is a directory which contains added files.
1932 ;; I made it conditional on vc-diff-added-files but it should probably
1933 ;; just be removed (or copied/moved to specific backends). --Stef.
1934 (when vc-diff-added-files
1935 (let ((filtered '()))
1936 (dolist (file files)
1937 (if (or (file-directory-p file)
1938 (not (string= (vc-working-revision file) "0")))
1939 (push file filtered)
1940 ;; This file is added but not yet committed;
1941 ;; there is no master file to diff against.
1942 (if (or rev1 rev2)
1943 (error "No revisions of %s exist" file)
1944 ;; We regard this as "changed".
1945 ;; Diff it against /dev/null.
1946 (apply 'vc-do-command "*vc-diff*"
1947 1 "diff" file
1948 (append (vc-switches nil 'diff) '("/dev/null"))))))
1949 (setq files (nreverse filtered))))
1950 (let ((vc-disable-async-diff (not async)))
ae67f2d0 1951 (vc-call-backend (car vc-fileset) 'diff files rev1 rev2 "*vc-diff*"))
d7b60083 1952 (set-buffer "*vc-diff*")
17f3909f
SM
1953 (if (and (zerop (buffer-size))
1954 (not (get-buffer-process (current-buffer))))
1955 ;; Treat this case specially so as not to pop the buffer.
1956 (progn
1d5b2149 1957 (message "%s" (cdr messages))
17f3909f 1958 nil)
e83d1fe8 1959 (diff-mode)
fe1919ab
DN
1960 ;; Make the *vc-diff* buffer read only, the diff-mode key
1961 ;; bindings are nicer for read only buffers. pcl-cvs does the
1962 ;; same thing.
1963 (setq buffer-read-only t)
1d5b2149
TTN
1964 (vc-exec-after `(vc-diff-finish ,(current-buffer) ',(when verbose
1965 messages)))
4befebc1
SM
1966 ;; Display the buffer, but at the end because it can change point.
1967 (pop-to-buffer (current-buffer))
17f3909f
SM
1968 ;; In the async case, we return t even if there are no differences
1969 ;; because we don't know that yet.
1970 t)))
594722a8 1971
637a8ae9 1972;;;###autoload
a7192ddb 1973(defun vc-version-diff (files rev1 rev2)
d7b60083 1974 "Report diffs between revisions of the fileset in the repository history."
0e362f54 1975 (interactive
ae67f2d0
DN
1976 (let* ((vc-fileset (vc-deduce-fileset t))
1977 (files (cdr vc-fileset))
d7b60083 1978 (first (car files))
d7b60083 1979 (completion-table
a7192ddb 1980 (vc-call revision-completion-table files))
d7b60083
ER
1981 (rev1-default nil)
1982 (rev2-default nil))
c0d66cb2 1983 (cond
ac3f4c6f 1984 ;; someday we may be able to do revision completion on non-singleton
d7b60083
ER
1985 ;; filesets, but not yet.
1986 ((/= (length files) 1)
1987 nil)
ac3f4c6f 1988 ;; if it's a directory, don't supply any revision default
d7b60083 1989 ((file-directory-p first)
c0d66cb2 1990 nil)
ac3f4c6f 1991 ;; if the file is not up-to-date, use working revision as older revision
d7b60083 1992 ((not (vc-up-to-date-p first))
ac3f4c6f
ER
1993 (setq rev1-default (vc-working-revision first)))
1994 ;; if the file is not locked, use last and previous revisions as defaults
c0d66cb2 1995 (t
ac3f4c6f
ER
1996 (setq rev1-default (vc-call previous-revision first
1997 (vc-working-revision first)))
b5446276 1998 (when (string= rev1-default "") (setq rev1-default nil))
ac3f4c6f 1999 (setq rev2-default (vc-working-revision first))))
c0d66cb2 2000 ;; construct argument list
4d83a657 2001 (let* ((rev1-prompt (if rev1-default
ac3f4c6f 2002 (concat "Older revision (default "
4d83a657 2003 rev1-default "): ")
ac3f4c6f
ER
2004 "Older revision: "))
2005 (rev2-prompt (concat "Newer revision (default "
4d83a657
SM
2006 (or rev2-default "current source") "): "))
2007 (rev1 (if completion-table
2008 (completing-read rev1-prompt completion-table
d7b60083 2009 nil nil nil nil rev1-default)
4d83a657
SM
2010 (read-string rev1-prompt nil nil rev1-default)))
2011 (rev2 (if completion-table
2012 (completing-read rev2-prompt completion-table
d7b60083 2013 nil nil nil nil rev2-default)
4d83a657 2014 (read-string rev2-prompt nil nil rev2-default))))
b5446276
DN
2015 (when (string= rev1 "") (setq rev1 nil))
2016 (when (string= rev2 "") (setq rev2 nil))
a7192ddb 2017 (list files rev1 rev2))))
ae67f2d0
DN
2018 (when (and (not rev1) rev2)
2019 (error "Not a valid revision range."))
2020 (vc-diff-internal
2021 t (cons (car (vc-deduce-fileset t)) files) rev1 rev2 (interactive-p)))
d7b60083 2022
a7192ddb
SM
2023;; (defun vc-contains-version-controlled-file (dir)
2024;; "Return t if DIR contains a version-controlled file, nil otherwise."
2025;; (catch 'found
2026;; (mapc (lambda (f) (and (not (file-directory-p f)) (vc-backend f) (throw 'found 't))) (directory-files dir))
2027;; nil))
727c4443 2028
d7b60083 2029;;;###autoload
a7192ddb 2030(defun vc-diff (historic &optional not-urgent)
ac3f4c6f 2031 "Display diffs between file revisions.
727c4443 2032Normally this compares the currently selected fileset with their
a7192ddb 2033working revisions. With a prefix argument HISTORIC, it reads two revision
727c4443
ER
2034designators specifying which revisions to compare.
2035
2036If no current fileset is available (that is, we are not in
2037VC-Dired mode and the visited file of the current buffer is not
a7192ddb
SM
2038under version control) and we're in a Dired buffer, use
2039the current directory.
2040The optional argument NOT-URGENT non-nil means it is ok to say no to
2041saving the buffer."
2042 (interactive (list current-prefix-arg t))
2043 (if historic
2044 (call-interactively 'vc-version-diff)
ae67f2d0
DN
2045 (when buffer-file-name (vc-buffer-sync not-urgent))
2046 (vc-diff-internal t (vc-deduce-fileset t) nil nil (interactive-p))))
727c4443 2047
2c87edc1 2048
f1818994 2049;;;###autoload
ac3f4c6f
ER
2050(defun vc-revision-other-window (rev)
2051 "Visit revision REV of the current file in another window.
2052If the current file is named `F', the revision is named `F.~REV~'.
6f1ecae4 2053If `F.~REV~' already exists, use it instead of checking it out again."
4d83a657
SM
2054 (interactive
2055 (save-current-buffer
2056 (vc-ensure-vc-buffer)
2057 (let ((completion-table
2058 (vc-call revision-completion-table buffer-file-name))
ac3f4c6f 2059 (prompt "Revision to visit (default is working revision): "))
4d83a657
SM
2060 (list
2061 (if completion-table
2062 (completing-read prompt completion-table)
2063 (read-string prompt))))))
b6909007 2064 (vc-ensure-vc-buffer)
5e011cb2 2065 (let* ((file buffer-file-name)
ac3f4c6f
ER
2066 (revision (if (string-equal rev "")
2067 (vc-working-revision file)
ac0aae44 2068 rev)))
ac3f4c6f 2069 (switch-to-buffer-other-window (vc-find-revision file revision))))
ac0aae44 2070
ac3f4c6f
ER
2071(defun vc-find-revision (file revision)
2072 "Read REVISION of FILE into a buffer and return the buffer."
2073 (let ((automatic-backup (vc-version-backup-file-name file revision))
fd8160f7 2074 (filebuf (or (get-file-buffer file) (current-buffer)))
ac3f4c6f 2075 (filename (vc-version-backup-file-name file revision 'manual)))
fd8160f7 2076 (unless (file-exists-p filename)
10b48cc4 2077 (if (file-exists-p automatic-backup)
fd8160f7
SM
2078 (rename-file automatic-backup filename nil)
2079 (message "Checking out %s..." filename)
2080 (with-current-buffer filebuf
2081 (let ((failed t))
2082 (unwind-protect
2083 (let ((coding-system-for-read 'no-conversion)
2084 (coding-system-for-write 'no-conversion))
2085 (with-temp-file filename
2086 (let ((outbuf (current-buffer)))
2087 ;; Change buffer to get local value of
2088 ;; vc-checkout-switches.
2089 (with-current-buffer filebuf
ac3f4c6f 2090 (vc-call find-revision file revision outbuf))))
fd8160f7 2091 (setq failed nil))
48b43130
DN
2092 (when (and failed (file-exists-p filename))
2093 (delete-file filename))))
fd8160f7
SM
2094 (vc-mode-line file))
2095 (message "Checking out %s...done" filename)))
48b43130
DN
2096 (let ((result-buf (find-file-noselect filename)))
2097 (with-current-buffer result-buf
83f1f73b 2098 ;; Set the parent buffer so that things like
48b43130 2099 ;; C-x v g, C-x v l, ... etc work.
25a4ea6d 2100 (set (make-local-variable 'vc-parent-buffer) filebuf))
48b43130 2101 result-buf)))
fd8160f7 2102
594722a8
ER
2103;; Header-insertion code
2104
637a8ae9 2105;;;###autoload
594722a8 2106(defun vc-insert-headers ()
6f1ecae4 2107 "Insert headers into a file for use with a version control system.
b524ce9f 2108Headers desired are inserted at point, and are pulled from
0e362f54 2109the variable `vc-BACKEND-header'."
594722a8 2110 (interactive)
b6909007 2111 (vc-ensure-vc-buffer)
594722a8
ER
2112 (save-excursion
2113 (save-restriction
2114 (widen)
b5446276
DN
2115 (when (or (not (vc-check-headers))
2116 (y-or-n-p "Version headers already exist. Insert another set? "))
2117 (let* ((delims (cdr (assq major-mode vc-comment-alist)))
2118 (comment-start-vc (or (car delims) comment-start "#"))
2119 (comment-end-vc (or (car (cdr delims)) comment-end ""))
2120 (hdsym (vc-make-backend-sym (vc-backend buffer-file-name)
2121 'header))
2122 (hdstrings (and (boundp hdsym) (symbol-value hdsym))))
2123 (dolist (s hdstrings)
2124 (insert comment-start-vc "\t" s "\t"
2125 comment-end-vc "\n"))
2126 (when vc-static-header-alist
2127 (dolist (f vc-static-header-alist)
2128 (when (string-match (car f) buffer-file-name)
2129 (insert (format (cdr f) (car hdstrings)))))))))))
594722a8 2130
0e362f54 2131(defun vc-clear-headers (&optional file)
099bd78a 2132 "Clear all version headers in the current buffer (or FILE).
6f1ecae4 2133The headers are reset to their non-expanded form."
0e362f54
GM
2134 (let* ((filename (or file buffer-file-name))
2135 (visited (find-buffer-visiting filename))
2136 (backend (vc-backend filename)))
2137 (when (vc-find-backend-function backend 'clear-headers)
6f41eeb5 2138 (if visited
0e362f54
GM
2139 (let ((context (vc-buffer-context)))
2140 ;; save-excursion may be able to relocate point and mark
2141 ;; properly. If it fails, vc-restore-buffer-context
2142 ;; will give it a second try.
2143 (save-excursion
2144 (vc-call-backend backend 'clear-headers))
2145 (vc-restore-buffer-context context))
7849e179 2146 (set-buffer (find-file-noselect filename))
0e362f54
GM
2147 (vc-call-backend backend 'clear-headers)
2148 (kill-buffer filename)))))
c8de1d91 2149
9b64a7f0
ER
2150(defun vc-modify-change-comment (files rev oldcomment)
2151 "Edit the comment associated with the given files and revision."
83affd96 2152 (vc-start-logentry
9b64a7f0
ER
2153 files rev oldcomment t
2154 "Enter a replacement change comment."
2155 (lambda (files rev comment)
df49d02e 2156 (vc-call-backend
9b64a7f0
ER
2157 ;; Less of a kluge than it looks like; log-view mode only passes
2158 ;; this function a singleton list. Arguments left in this form in
df49d02e
JB
2159 ;; case the more general operation ever becomes meaningful.
2160 (vc-responsible-backend (car files))
9b64a7f0
ER
2161 'modify-change-comment files rev comment))))
2162
b6909007 2163;;;###autoload
099bd78a 2164(defun vc-merge ()
ac3f4c6f
ER
2165 "Merge changes between two revisions into the current buffer's file.
2166This asks for two revisions to merge from in the minibuffer. If the
2167first revision is a branch number, then merge all changes from that
2168branch. If the first revision is empty, merge news, i.e. recent changes
099bd78a 2169from the current branch.
0e362f54
GM
2170
2171See Info node `Merging'."
099bd78a 2172 (interactive)
ccb141e8
AS
2173 (vc-ensure-vc-buffer)
2174 (vc-buffer-sync)
2175 (let* ((file buffer-file-name)
2176 (backend (vc-backend file))
0e362f54 2177 (state (vc-state file))
ac3f4c6f 2178 first-revision second-revision status)
0e362f54 2179 (cond
61de26cb 2180 ((stringp state) ;; Locking VCses only
0e362f54
GM
2181 (error "File is locked by %s" state))
2182 ((not (vc-editable-p file))
2183 (if (y-or-n-p
2184 "File must be checked out for merging. Check out now? ")
2185 (vc-checkout file t)
2186 (error "Merge aborted"))))
ac3f4c6f
ER
2187 (setq first-revision
2188 (read-string (concat "Branch or revision to merge from "
5b76833f 2189 "(default news on current branch): ")))
ac3f4c6f 2190 (if (string= first-revision "")
099bd78a
SM
2191 (if (not (vc-find-backend-function backend 'merge-news))
2192 (error "Sorry, merging news is not implemented for %s" backend)
2193 (setq status (vc-call merge-news file)))
2194 (if (not (vc-find-backend-function backend 'merge))
2195 (error "Sorry, merging is not implemented for %s" backend)
ac3f4c6f
ER
2196 (if (not (vc-branch-p first-revision))
2197 (setq second-revision
2198 (read-string "Second revision: "
2199 (concat (vc-branch-part first-revision) ".")))
2200 ;; We want to merge an entire branch. Set revisions
099bd78a 2201 ;; accordingly, so that vc-BACKEND-merge understands us.
ac3f4c6f
ER
2202 (setq second-revision first-revision)
2203 ;; first-revision must be the starting point of the branch
2204 (setq first-revision (vc-branch-part first-revision)))
2205 (setq status (vc-call merge file first-revision second-revision))))
099bd78a 2206 (vc-maybe-resolve-conflicts file status "WORKFILE" "MERGE SOURCE")))
0e362f54
GM
2207
2208(defun vc-maybe-resolve-conflicts (file status &optional name-A name-B)
2209 (vc-resynch-buffer file t (not (buffer-modified-p)))
2210 (if (zerop status) (message "Merge successful")
28e4e2b4 2211 (smerge-mode 1)
8dc87047 2212 (message "File contains conflicts.")))
ccb141e8
AS
2213
2214;;;###autoload
1168d6c2 2215(defalias 'vc-resolve-conflicts 'smerge-ediff)
18483cf0 2216
b1ddeeb7
ER
2217;; The VC directory major mode. Coopt Dired for this.
2218;; All VC commands get mapped into logical equivalents.
2219
2220(defvar vc-dired-switches)
2221(defvar vc-dired-terse-mode)
2222
2223(defvar vc-dired-mode-map
2224 (let ((map (make-sparse-keymap))
2225 (vmap (make-sparse-keymap)))
2226 (define-key map "\C-xv" vmap)
2227 (define-key map "v" vmap)
2228 (set-keymap-parent vmap vc-prefix-map)
2229 (define-key vmap "t" 'vc-dired-toggle-terse-mode)
2230 map))
2231
2232(define-derived-mode vc-dired-mode dired-mode "Dired under "
2233 "The major mode used in VC directory buffers.
2234
2235It works like Dired, but lists only files under version control, with
2236the current VC state of each file being indicated in the place of the
2237file's link count, owner, group and size. Subdirectories are also
2238listed, and you may insert them into the buffer as desired, like in
2239Dired.
2240
2241All Dired commands operate normally, with the exception of `v', which
2242is redefined as the version control prefix, so that you can type
2243`vl', `v=' etc. to invoke `vc-print-log', `vc-diff', and the like on
2244the file named in the current Dired buffer line. `vv' invokes
2245`vc-next-action' on this file, or on all files currently marked.
2246There is a special command, `*l', to mark all files currently locked."
2247 ;; define-derived-mode does it for us in Emacs-21, but not in Emacs-20.
2248 ;; We do it here because dired might not be loaded yet
2249 ;; when vc-dired-mode-map is initialized.
2250 (set-keymap-parent vc-dired-mode-map dired-mode-map)
2251 (add-hook 'dired-after-readin-hook 'vc-dired-hook nil t)
2252 ;; The following is slightly modified from files.el,
2253 ;; because file lines look a bit different in vc-dired-mode
2254 ;; (the column before the date does not end in a digit).
2255 ;; albinus: It should be done in the original declaration. Problem
2256 ;; is the optional empty state-info; otherwise ")" would be good
2257 ;; enough as delimeter.
2258 (set (make-local-variable 'directory-listing-before-filename-regexp)
2259 (let* ((l "\\([A-Za-z]\\|[^\0-\177]\\)")
2260 ;; In some locales, month abbreviations are as short as 2 letters,
2261 ;; and they can be followed by ".".
2262 (month (concat l l "+\\.?"))
2263 (s " ")
2264 (yyyy "[0-9][0-9][0-9][0-9]")
2265 (dd "[ 0-3][0-9]")
2266 (HH:MM "[ 0-2][0-9]:[0-5][0-9]")
2267 (seconds "[0-6][0-9]\\([.,][0-9]+\\)?")
2268 (zone "[-+][0-2][0-9][0-5][0-9]")
2269 (iso-mm-dd "[01][0-9]-[0-3][0-9]")
2270 (iso-time (concat HH:MM "\\(:" seconds "\\( ?" zone "\\)?\\)?"))
2271 (iso (concat "\\(\\(" yyyy "-\\)?" iso-mm-dd "[ T]" iso-time
2272 "\\|" yyyy "-" iso-mm-dd "\\)"))
2273 (western (concat "\\(" month s "+" dd "\\|" dd "\\.?" s month "\\)"
2274 s "+"
2275 "\\(" HH:MM "\\|" yyyy "\\)"))
2276 (western-comma (concat month s "+" dd "," s "+" yyyy))
2277 ;; Japanese MS-Windows ls-lisp has one-digit months, and
2278 ;; omits the Kanji characters after month and day-of-month.
2279 (mm "[ 0-1]?[0-9]")
2280 (japanese
2281 (concat mm l "?" s dd l "?" s "+"
2282 "\\(" HH:MM "\\|" yyyy l "?" "\\)")))
2283 ;; the .* below ensures that we find the last match on a line
2284 (concat ".*" s
2285 "\\(" western "\\|" western-comma "\\|" japanese "\\|" iso "\\)"
2286 s "+")))
2287 (and (boundp 'vc-dired-switches)
2288 vc-dired-switches
2289 (set (make-local-variable 'dired-actual-switches)
2290 vc-dired-switches))
2291 (set (make-local-variable 'vc-dired-terse-mode) vc-dired-terse-display)
2292 (let ((backend-name (symbol-name (vc-responsible-backend
2293 default-directory))))
2294 (setq mode-name (concat mode-name backend-name))
2295 ;; Add menu after `vc-dired-mode-map' has `dired-mode-map' as the parent.
2296 (let ((vc-dire-menu-map (copy-keymap vc-menu-map)))
2297 (define-key-after (lookup-key vc-dired-mode-map [menu-bar]) [vc]
2298 (cons backend-name vc-dire-menu-map) 'subdir)))
2299 (setq vc-dired-mode t))
2300
2301(defun vc-dired-toggle-terse-mode ()
2302 "Toggle terse display in VC Dired."
2303 (interactive)
2304 (if (not vc-dired-mode)
2305 nil
2306 (setq vc-dired-terse-mode (not vc-dired-terse-mode))
2307 (if vc-dired-terse-mode
2308 (vc-dired-hook)
2309 (revert-buffer))))
2310
2311(defun vc-dired-mark-locked ()
2312 "Mark all files currently locked."
2313 (interactive)
2314 (dired-mark-if (let ((f (dired-get-filename nil t)))
2315 (and f
2316 (not (file-directory-p f))
2317 (not (vc-up-to-date-p f))))
2318 "locked file"))
2319
2320(define-key vc-dired-mode-map "*l" 'vc-dired-mark-locked)
2321
2322(defun vc-dired-reformat-line (vc-info)
2323 "Reformat a directory-listing line.
2324Replace various columns with version control information, VC-INFO.
2325This code, like dired, assumes UNIX -l format."
2326 (beginning-of-line)
2327 (when (re-search-forward
2328 ;; Match link count, owner, group, size. Group may be missing,
2329 ;; and only the size is present in OS/2 -l format.
2330 "^..[drwxlts-]+ \\( *[0-9]+\\( [^ ]+ +\\([^ ]+ +\\)?[0-9]+\\)?\\) "
2331 (line-end-position) t)
2332 (replace-match (substring (concat vc-info " ") 0 10)
2333 t t nil 1)))
2334
2335(defun vc-dired-ignorable-p (filename)
2336 "Should FILENAME be ignored in VC-Dired listings?"
2337 (catch t
2338 ;; Ignore anything that wouldn't be found by completion (.o, .la, etc.)
2339 (dolist (ignorable completion-ignored-extensions)
2340 (let ((ext (substring filename
2341 (- (length filename)
2342 (length ignorable)))))
2343 (if (string= ignorable ext) (throw t t))))
2344 ;; Ignore Makefiles derived from something else
2345 (when (string= (file-name-nondirectory filename) "Makefile")
2346 (let* ((dir (file-name-directory filename))
2347 (peers (directory-files (or dir default-directory))))
2348 (if (or (member "Makefile.in" peers) (member "Makefile.am" peers))
2349 (throw t t))))
2350 nil))
35d33ce7 2351
3d30b8bc 2352(defun vc-dired-hook ()
0e362f54
GM
2353 "Reformat the listing according to version control.
2354Called by dired after any portion of a vc-dired buffer has been read in."
3d30b8bc 2355 (message "Getting version information... ")
cdce374a
ER
2356 ;; if the backend supports it, get the state
2357 ;; of all files in this directory at once
2358 (let ((backend (vc-responsible-backend default-directory)))
2359 ;; check `backend' can really handle `default-directory'.
2360 (if (and (vc-call-backend backend 'responsible-p default-directory)
2361 (vc-find-backend-function backend 'dir-state))
2362 (vc-call-backend backend 'dir-state default-directory)))
df49d02e 2363 (let (filename
484c1b1f
ER
2364 (inhibit-read-only t)
2365 (buffer-undo-list t))
3d30b8bc 2366 (goto-char (point-min))
0e362f54
GM
2367 (while (not (eobp))
2368 (cond
3d30b8bc 2369 ;; subdir header line
cdce374a 2370 ((dired-get-subdir)
3d30b8bc
RS
2371 (forward-line 1)
2372 ;; erase (but don't remove) the "total" line
0e362f54
GM
2373 (delete-region (point) (line-end-position))
2374 (beginning-of-line)
2375 (forward-line 1))
2376 ;; file line
3d30b8bc
RS
2377 ((setq filename (dired-get-filename nil t))
2378 (cond
3b574573 2379 ;; subdir
3d30b8bc 2380 ((file-directory-p filename)
0e362f54
GM
2381 (cond
2382 ((member (file-name-nondirectory filename)
3b574573
AS
2383 vc-directory-exclusion-list)
2384 (let ((pos (point)))
2385 (dired-kill-tree filename)
2386 (goto-char pos)
2387 (dired-kill-line)))
2388 (vc-dired-terse-mode
633cee46
AS
2389 ;; Don't show directories in terse mode. Don't use
2390 ;; dired-kill-line to remove it, because in recursive listings,
2391 ;; that would remove the directory contents as well.
0e362f54 2392 (delete-region (line-beginning-position)
633cee46 2393 (progn (forward-line 1) (point))))
3b574573
AS
2394 ((string-match "\\`\\.\\.?\\'" (file-name-nondirectory filename))
2395 (dired-kill-line))
2396 (t
3d30b8bc 2397 (vc-dired-reformat-line nil)
3b574573 2398 (forward-line 1))))
c59a2442 2399 ;; Try to head off calling the expensive state query -
35d33ce7
ER
2400 ;; ignore object files, TeX intermediate files, and so forth.
2401 ((vc-dired-ignorable-p filename)
2402 (dired-kill-line))
c59a2442
ER
2403 ;; Ordinary file -- call the (possibly expensive) state query
2404 ;;
2405 ;; First case: unregistered or unknown. (Unknown shouldn't happen here)
2406 ((member (vc-state filename) '(nil unregistered))
2407 (if vc-dired-terse-mode
2408 (dired-kill-line)
2409 (vc-dired-reformat-line "?")
2410 (forward-line 1)))
df49d02e 2411 ;; Either we're in non-terse mode or it's out of date
c59a2442 2412 ((not (and vc-dired-terse-mode (vc-up-to-date-p filename)))
0a299408 2413 (vc-dired-reformat-line (vc-call prettify-state-info filename))
c59a2442 2414 (forward-line 1))
df49d02e
JB
2415 ;; Remaining cases are under version control but uninteresting
2416 (t
c59a2442 2417 (dired-kill-line))))
3d30b8bc 2418 ;; any other line
3b574573
AS
2419 (t (forward-line 1))))
2420 (vc-dired-purge))
2421 (message "Getting version information... done")
2422 (save-restriction
2423 (widen)
633cee46
AS
2424 (cond ((eq (count-lines (point-min) (point-max)) 1)
2425 (goto-char (point-min))
9580f1fd 2426 (message "No changes pending under %s" default-directory)))))
3b574573 2427
b1ddeeb7
ER
2428(defun vc-dired-purge ()
2429 "Remove empty subdirs."
2430 (goto-char (point-min))
2431 (while (dired-get-subdir)
2432 (forward-line 2)
2433 (if (dired-get-filename nil t)
2434 (if (not (dired-next-subdir 1 t))
2435 (goto-char (point-max)))
2436 (forward-line -2)
2437 (if (not (string= (dired-current-directory) default-directory))
2438 (dired-do-kill-lines t "")
2439 ;; We cannot remove the top level directory.
2440 ;; Just make it look a little nicer.
2441 (forward-line 1)
2442 (or (eobp) (kill-line))
2443 (if (not (dired-next-subdir 1 t))
2444 (goto-char (point-max))))))
2445 (goto-char (point-min)))
2446
2447(defun vc-dired-buffers-for-dir (dir)
2448 "Return a list of all vc-dired buffers that currently display DIR."
2449 (let (result)
2450 ;; Check whether dired is loaded.
2451 (when (fboundp 'dired-buffers-for-dir)
2452 (dolist (buffer (dired-buffers-for-dir dir))
2453 (with-current-buffer buffer
2454 (when vc-dired-mode
2455 (push buffer result)))))
2456 (nreverse result)))
2457
2458(defun vc-directory-resynch-file (file)
2459 "Update the entries for FILE in any VC Dired buffers that list it."
2460 ;;FIXME This needs to be implemented so it works for vc-dir
2461 (let ((buffers (vc-dired-buffers-for-dir (file-name-directory file))))
2462 (when buffers
2463 (mapcar (lambda (buffer)
2464 (with-current-buffer buffer
2465 (when (dired-goto-file file)
2466 ;; bind vc-dired-terse-mode to nil so that
2467 ;; files won't vanish when they are checked in
2468 (let ((vc-dired-terse-mode nil))
2469 (dired-do-redisplay 1)))))
2470 buffers))))
2471
2472;;;###autoload
2473(defun vc-directory (dir read-switches)
2474 "Create a buffer in VC Dired Mode for directory DIR.
2475
2476See Info node `VC Dired Mode'.
2477
2478With prefix arg READ-SWITCHES, specify a value to override
2479`dired-listing-switches' when generating the listing."
2480 (interactive "DDired under VC (directory): \nP")
2481 (let ((vc-dired-switches (concat vc-dired-listing-switches
2482 (if vc-dired-recurse "R" ""))))
2483 (if read-switches
2484 (setq vc-dired-switches
2485 (read-string "Dired listing switches: "
2486 vc-dired-switches)))
2487 (require 'dired)
2488 (require 'dired-aux)
2489 (switch-to-buffer
2490 (dired-internal-noselect (expand-file-name (file-name-as-directory dir))
2491 vc-dired-switches
2492 'vc-dired-mode))))
2493
2494;; VC status implementation
2495
2496;; Used to store information for the files displayed in the *VC status* buffer.
2497;; Each item displayed corresponds to one of these defstructs.
2498(defstruct (vc-dir-fileinfo
2499 (:copier nil)
2500 (:type list) ;So we can use `member' on lists of FIs.
2501 (:constructor
2502 ;; We could define it as an alias for `list'.
2503 vc-dir-create-fileinfo (name state &optional extra marked directory))
2504 (:conc-name vc-dir-fileinfo->))
2505 name ;Keep it as first, for `member'.
2506 state
2507 ;; For storing backend specific information.
2508 extra
2509 marked
2510 ;; To keep track of not updated files during a global refresh
2511 needs-update
2512 ;; To distinguish files and directories.
2513 directory)
2514
2515(defvar vc-ewoc nil)
2516
2517(defun vc-default-status-extra-headers (backend dir)
2518 ;; Be loud by default to remind people to add coded to display
2519 ;; backend specific headers.
2520 ;; XXX: change this to return nil before the release.
2521 "Extra : Add backend specific headers here")
2522
2523(defun vc-dir-headers (backend dir)
2524 "Display the headers in the *VC status* buffer.
2525It calls the `status-extra-headers' backend method to display backend
2526specific headers."
2527 (concat
2528 (propertize "VC backend : " 'face 'font-lock-type-face)
2529 (propertize (format "%s\n" backend) 'face 'font-lock-variable-name-face)
2530 (propertize "Working dir: " 'face 'font-lock-type-face)
2531 (propertize (format "%s\n" dir) 'face 'font-lock-variable-name-face)
2532 (vc-call-backend backend 'status-extra-headers dir)
2533 "\n"))
2534
2535(defun vc-default-status-printer (backend fileentry)
2536 "Pretty print FILEENTRY."
2537 ;; If you change the layout here, change vc-dir-move-to-goal-column.
2538 (let ((state
2539 (if (vc-dir-fileinfo->directory fileentry)
2540 'DIRECTORY
2541 (vc-dir-fileinfo->state fileentry))))
2542 (insert
2543 (propertize
2544 (format "%c" (if (vc-dir-fileinfo->marked fileentry) ?* ? ))
2545 'face 'font-lock-type-face)
2546 " "
2547 (propertize
2548 (format "%-20s" state)
2549 'face (cond ((eq state 'up-to-date) 'font-lock-builtin-face)
2550 ((memq state '(missing conflict)) 'font-lock-warning-face)
2551 (t 'font-lock-variable-name-face))
2552 'mouse-face 'highlight)
2553 " "
2554 (propertize
2555 (format "%s" (vc-dir-fileinfo->name fileentry))
2556 'face 'font-lock-function-name-face
2557 'mouse-face 'highlight))))
2558
2559(defun vc-dir-printer (fileentry)
2560 (let ((backend (vc-responsible-backend default-directory)))
2561 (vc-call-backend backend 'status-printer fileentry)))
2562
2563(defun vc-dir-move-to-goal-column ()
2564 ;; Used to keep the cursor on the file name column.
2565 (beginning-of-line)
2566 ;; Must be in sync with vc-default-status-printer.
2567 (forward-char 25))
2568
2569(defun vc-dir-prepare-status-buffer (dir &optional create-new)
2570 "Find a *vc-dir* buffer showing DIR, or create a new one."
2571 (setq dir (expand-file-name dir))
2572 (let* ((bname "*vc-dir*")
2573 ;; Look for another *vc-dir* buffer visiting the same directory.
2574 (buf (save-excursion
2575 (unless create-new
2576 (dolist (buffer (buffer-list))
2577 (set-buffer buffer)
2578 (when (and (eq major-mode 'vc-dir-mode)
2579 (string= (expand-file-name default-directory) dir))
2580 (return buffer)))))))
2581 (or buf
2582 ;; Create a new *vc-dir* buffer.
2583 (with-current-buffer (create-file-buffer bname)
2584 (cd dir)
2585 (vc-setup-buffer (current-buffer))
2586 ;; Reset the vc-parent-buffer-name so that it does not appear
2587 ;; in the mode-line.
2588 (setq vc-parent-buffer-name nil)
2589 (current-buffer)))))
2590
2591;;;###autoload
2592(defun vc-dir (dir)
2593 "Show the VC status for DIR."
2594 (interactive "DVC status for directory: ")
2595 (pop-to-buffer (vc-dir-prepare-status-buffer dir))
2596 (if (eq major-mode 'vc-dir-mode)
2597 (vc-dir-refresh)
2598 (vc-dir-mode)))
2599
2600(defvar vc-dir-menu-map
2601 (let ((map (make-sparse-keymap "VC-dir")))
2602 (define-key map [quit]
2603 '(menu-item "Quit" quit-window
2604 :help "Quit"))
2605 (define-key map [kill]
2606 '(menu-item "Kill Update Command" vc-dir-kill-dir-status-process
2607 :enable (vc-dir-busy)
2608 :help "Kill the command that updates VC status buffer"))
2609 (define-key map [refresh]
2610 '(menu-item "Refresh" vc-dir-refresh
2611 :enable (not (vc-dir-busy))
2612 :help "Refresh the contents of the VC status buffer"))
2613 (define-key map [remup]
2614 '(menu-item "Hide up-to-date" vc-dir-hide-up-to-date
2615 :help "Hide up-to-date items from display"))
2616 ;; Movement.
2617 (define-key map [sepmv] '("--"))
2618 (define-key map [next-line]
2619 '(menu-item "Next line" vc-dir-next-line
2620 :help "Go to the next line" :keys "n"))
2621 (define-key map [previous-line]
2622 '(menu-item "Previous line" vc-dir-previous-line
2623 :help "Go to the previous line"))
2624 ;; Marking.
2625 (define-key map [sepmrk] '("--"))
2626 (define-key map [unmark-all]
2627 '(menu-item "Unmark All" vc-dir-unmark-all-files
2628 :help "Unmark all files that are in the same state as the current file\
2629\nWith prefix argument unmark all files"))
2630 (define-key map [unmark-previous]
2631 '(menu-item "Unmark previous " vc-dir-unmark-file-up
2632 :help "Move to the previous line and unmark the file"))
2633
2634 (define-key map [mark-all]
2635 '(menu-item "Mark All" vc-dir-mark-all-files
2636 :help "Mark all files that are in the same state as the current file\
2637\nWith prefix argument mark all files"))
2638 (define-key map [unmark]
2639 '(menu-item "Unmark" vc-dir-unmark
2640 :help "Unmark the current file or all files in the region"))
2641
2642 (define-key map [mark]
2643 '(menu-item "Mark" vc-dir-mark
2644 :help "Mark the current file or all files in the region"))
2645
2646 (define-key map [sepopn] '("--"))
2647 (define-key map [open-other]
2648 '(menu-item "Open in other window" vc-dir-find-file-other-window
2649 :help "Find the file on the current line, in another window"))
2650 (define-key map [open]
2651 '(menu-item "Open file" vc-dir-find-file
2652 :help "Find the file on the current line"))
2653 ;; VC info details
2654 (define-key map [sepvcdet] '("--"))
2655 ;; FIXME: This needs a key binding. And maybe a better name
2656 ;; ("Insert" like PCL-CVS uses does not sound that great either)...
2657 (define-key map [ins]
2658 '(menu-item "Show File" vc-dir-show-fileentry
2659 :help "Show a file in the VC status listing even though it might be up to date"))
2660 (define-key map [annotate]
2661 '(menu-item "Annotate" vc-annotate
2662 :help "Display the edit history of the current file using colors"))
2663 (define-key map [diff]
2664 '(menu-item "Compare with Base Version" vc-diff
2665 :help "Compare file set with the base version"))
2666 (define-key map [log]
2667 '(menu-item "Show history" vc-print-log
2668 :help "List the change log of the current file set in a window"))
2669 ;; VC commands.
2670 (define-key map [sepvccmd] '("--"))
2671 (define-key map [update]
2672 '(menu-item "Update to latest version" vc-update
2673 :help "Update the current fileset's files to their tip revisions"))
2674 (define-key map [revert]
2675 '(menu-item "Revert to base version" vc-revert
2676 :help "Revert working copies of the selected fileset to their repository contents."))
2677 (define-key map [next-action]
2678 ;; FIXME: This really really really needs a better name!
2679 ;; And a key binding too.
2680 '(menu-item "Check In/Out" vc-next-action
2681 :help "Do the next logical version control operation on the current fileset"))
2682 (define-key map [register]
2683 '(menu-item "Register" vc-dir-register
2684 :help "Register file set into the version control system"))
2685 map)
2686 "Menu for VC status")
2687
2688(defalias 'vc-dir-menu-map vc-dir-menu-map)
2689
2690(defvar vc-dir-mode-map
2691 (let ((map (make-keymap)))
2692 (suppress-keymap map)
2693 ;; Marking.
2694 (define-key map "m" 'vc-dir-mark)
2695 (define-key map "M" 'vc-dir-mark-all-files)
2696 (define-key map "u" 'vc-dir-unmark)
2697 (define-key map "U" 'vc-dir-unmark-all-files)
2698 (define-key map "\C-?" 'vc-dir-unmark-file-up)
2699 (define-key map "\M-\C-?" 'vc-dir-unmark-all-files)
2700 ;; Movement.
2701 (define-key map "n" 'vc-dir-next-line)
2702 (define-key map " " 'vc-dir-next-line)
2703 (define-key map "\t" 'vc-dir-next-line)
2704 (define-key map "p" 'vc-dir-previous-line)
2705 (define-key map [backtab] 'vc-dir-previous-line)
2706 ;; VC commands.
2707 (define-key map "=" 'vc-diff) ;; C-x v =
2708 (define-key map "a" 'vc-dir-register)
2709 (define-key map "+" 'vc-update) ;; C-x v +
2710 (define-key map "R" 'vc-revert) ;; u is taken by unmark.
2711
2712 ;; Can't be "g" (as in vc map), so "A" for "Annotate".
2713 (define-key map "A" 'vc-annotate)
2714 (define-key map "l" 'vc-print-log) ;; C-x v l
2715 ;; The remainder.
2716 (define-key map "f" 'vc-dir-find-file)
2717 (define-key map "\C-m" 'vc-dir-find-file)
2718 (define-key map "o" 'vc-dir-find-file-other-window)
2719 (define-key map "x" 'vc-dir-hide-up-to-date)
2720 (define-key map "q" 'quit-window)
2721 (define-key map "g" 'vc-dir-refresh)
2722 (define-key map "\C-c\C-c" 'vc-dir-kill-dir-status-process)
2723 (define-key map [(down-mouse-3)] 'vc-dir-menu)
2724 (define-key map [(mouse-2)] 'vc-dir-toggle-mark)
2725
2726 ;; Hook up the menu.
2727 (define-key map [menu-bar vc-dir-mode]
2728 '(menu-item
2729 ;; This is used to that VC backends could add backend specific
2730 ;; menu items to vc-dir-menu-map.
2731 "VC Status" vc-dir-menu-map :filter vc-dir-menu-map-filter))
2732 map)
2733 "Keymap for VC status")
2734
2735(defun vc-default-extra-status-menu (backend)
2736 nil)
2737
2738;; This is used to that VC backends could add backend specific menu
2739;; items to vc-dir-menu-map.
2740(defun vc-dir-menu-map-filter (orig-binding)
2741 (when (and (symbolp orig-binding) (fboundp orig-binding))
2742 (setq orig-binding (indirect-function orig-binding)))
2743 (let ((ext-binding
2744 (vc-call-backend (vc-responsible-backend default-directory)
2745 'extra-status-menu)))
2746 (if (null ext-binding)
2747 orig-binding
2748 (append orig-binding
2749 '("----")
2750 ext-binding))))
2751
2752(defmacro vc-at-event (event &rest body)
2753 "Evaluate `body' wich point located at event-start of `event'.
2754If `body' uses `event', it should be a variable,
2755 otherwise it will be evaluated twice."
2756 (let ((posn (gensym "vc-at-event-posn")))
2757 `(let ((,posn (event-start ,event)))
2758 (save-excursion
2759 (set-buffer (window-buffer (posn-window ,posn)))
2760 (goto-char (posn-point ,posn))
2761 ,@body))))
2762
2763(defun vc-dir-menu (e)
2764 "Popup the VC status menu."
2765 (interactive "e")
2766 (vc-at-event e (popup-menu vc-dir-menu-map e)))
2767
2768(defvar vc-dir-tool-bar-map
2769 (let ((map (make-sparse-keymap)))
2770 (tool-bar-local-item-from-menu 'vc-dir-find-file "open"
2771 map vc-dir-mode-map)
2772 (tool-bar-local-item "bookmark_add"
2773 'vc-dir-toggle-mark 'vc-dir-toggle-mark map
2774 :help "Toggle mark on current item")
2775 (tool-bar-local-item-from-menu 'vc-dir-previous-line "left-arrow"
2776 map vc-dir-mode-map
2777 :rtl "right-arrow")
2778 (tool-bar-local-item-from-menu 'vc-dir-next-line "right-arrow"
2779 map vc-dir-mode-map
2780 :rtl "left-arrow")
2781 (tool-bar-local-item-from-menu 'vc-print-log "info"
2782 map vc-dir-mode-map)
2783 (tool-bar-local-item-from-menu 'vc-dir-refresh "refresh"
2784 map vc-dir-mode-map)
2785 (tool-bar-local-item-from-menu 'nonincremental-search-forward
2786 "search" map)
2787 (tool-bar-local-item-from-menu 'vc-dir-kill-dir-status-process "cancel"
2788 map vc-dir-mode-map)
2789 (tool-bar-local-item-from-menu 'quit-window "exit"
2790 map vc-dir-mode-map)
2791 map))
2792
2793(defvar vc-dir-process-buffer nil
2794 "The buffer used for the asynchronous call that computes the VC status.")
2795
2796(defun vc-dir-mode ()
2797 "Major mode for showing the VC status for a directory.
2798Marking/Unmarking key bindings and actions:
2799m - marks a file/directory or ff the region is active, mark all the files
2800 in region.
2801 Restrictions: - a file cannot be marked if any parent directory is marked
2802 - a directory cannot be marked if any child file or
2803 directory is marked
2804u - marks a file/directory or if the region is active, unmark all the files
2805 in region.
2806M - if the cursor is on a file: mark all the files with the same VC state as
2807 the current file
2808 - if the cursor is on a directory: mark all child files
2809 - with a prefix argument: mark all files
2810U - if the cursor is on a file: unmark all the files with the same VC state
2811 as the current file
2812 - if the cursor is on a directory: unmark all child files
2813 - with a prefix argument: unmark all files
2814
2815
2816\\{vc-dir-mode-map}"
2817 (setq mode-name "VC Status")
2818 (setq major-mode 'vc-dir-mode)
2819 (setq buffer-read-only t)
2820 (use-local-map vc-dir-mode-map)
2821 (set (make-local-variable 'tool-bar-map) vc-dir-tool-bar-map)
2822 (let ((buffer-read-only nil)
2823 (backend (vc-responsible-backend default-directory))
2824 entries)
2825 (erase-buffer)
2826 (set (make-local-variable 'vc-dir-process-buffer) nil)
2827 (set (make-local-variable 'vc-ewoc)
2828 (ewoc-create #'vc-dir-printer
2829 (vc-dir-headers backend default-directory)))
2830 (add-hook 'after-save-hook 'vc-dir-mark-buffer-changed)
2831 ;; Make sure that if the VC status buffer is killed, the update
2832 ;; process running in the background is also killed.
2833 (add-hook 'kill-buffer-query-functions 'vc-dir-kill-query nil t)
2834 (vc-dir-refresh))
2835 (run-hooks 'vc-dir-mode-hook))
2836
2837(put 'vc-dir-mode 'mode-class 'special)
2838
2839;; t if directories should be shown in vc-dir.
2840;; WORK IN PROGRESS! DO NOT SET this! ONLY set it if you want to help
2841;; write code for this feature. This variable will likely disappear
2842;; when the work is done.
2843(defvar vc-dir-insert-directories nil)
2844
2845(defun vc-dir-update (entries buffer &optional noinsert)
2846 "Update BUFFER's ewoc from the list of ENTRIES.
2847If NOINSERT, ignore elements on ENTRIES which are not in the ewoc."
2848 ;; Add ENTRIES to the vc-dir buffer BUFFER.
2849 (with-current-buffer buffer
2850 ;; Insert the entries sorted by name into the ewoc.
2851 ;; We assume the ewoc is sorted too, which should be the
2852 ;; case if we always add entries with vc-dir-update.
2853 (setq entries
2854 ;; Sort: first files and then subdirectories.
2855 ;; XXX: this is VERY inefficient, it computes the directory
2856 ;; names too many times
2857 (sort entries
2858 (lambda (entry1 entry2)
2859 (let ((dir1 (file-name-directory (expand-file-name (car entry1))))
2860 (dir2 (file-name-directory (expand-file-name (car entry2)))))
2861 (cond
2862 ((string< dir1 dir2) t)
2863 ((not (string= dir1 dir2)) nil)
2864 ((string< (car entry1) (car entry2))))))))
2865 (if (not vc-dir-insert-directories)
2866 (let ((entry (car entries))
2867 (node (ewoc-nth vc-ewoc 0)))
2868 (while (and entry node)
2869 (let ((entryfile (car entry))
2870 (nodefile (vc-dir-fileinfo->name (ewoc-data node))))
2871 (cond
2872 ((string-lessp nodefile entryfile)
2873 (setq node (ewoc-next vc-ewoc node)))
2874 ((string-lessp entryfile nodefile)
2875 (unless noinsert
2876 (ewoc-enter-before vc-ewoc node
2877 (apply 'vc-dir-create-fileinfo entry)))
2878 (setq entries (cdr entries) entry (car entries)))
2879 (t
2880 (setf (vc-dir-fileinfo->state (ewoc-data node)) (nth 1 entry))
2881 (setf (vc-dir-fileinfo->extra (ewoc-data node)) (nth 2 entry))
2882 (setf (vc-dir-fileinfo->needs-update (ewoc-data node)) nil)
2883 (ewoc-invalidate vc-ewoc node)
2884 (setq entries (cdr entries) entry (car entries))
2885 (setq node (ewoc-next vc-ewoc node))))))
2886 (unless (or node noinsert)
2887 ;; We're past the last node, all remaining entries go to the end.
2888 (while entries
2889 (ewoc-enter-last vc-ewoc
2890 (apply 'vc-dir-create-fileinfo (pop entries))))))
2891 ;; Insert directory entries in the right places.
2892 (let ((entry (car entries))
2893 (node (ewoc-nth vc-ewoc 0)))
2894 ;; Insert . if it is not present.
2895 (unless node
2896 (let ((rd (file-relative-name default-directory)))
2897 (ewoc-enter-last
2898 vc-ewoc (vc-dir-create-fileinfo
2899 rd nil nil nil (expand-file-name default-directory))))
2900 (setq node (ewoc-nth vc-ewoc 0)))
2901
2902 (while (and entry node)
2903 (let* ((entryfile (car entry))
2904 (entrydir (file-name-directory (expand-file-name entryfile)))
2905 (nodedir
2906 (or (vc-dir-fileinfo->directory (ewoc-data node))
2907 (file-name-directory
2908 (expand-file-name
2909 (vc-dir-fileinfo->name (ewoc-data node)))))))
2910 (cond
2911 ;; First try to find the directory.
2912 ((string-lessp nodedir entrydir)
2913 (setq node (ewoc-next vc-ewoc node)))
2914 ((string-equal nodedir entrydir)
2915 ;; Found the directory, find the place for the file name.
2916 (let ((nodefile (vc-dir-fileinfo->name (ewoc-data node))))
2917 (cond
2918 ((string-lessp nodefile entryfile)
2919 (setq node (ewoc-next vc-ewoc node)))
2920 ((string-equal nodefile entryfile)
2921 (setf (vc-dir-fileinfo->state (ewoc-data node)) (nth 1 entry))
2922 (setf (vc-dir-fileinfo->extra (ewoc-data node)) (nth 2 entry))
2923 (setf (vc-dir-fileinfo->needs-update (ewoc-data node)) nil)
2924 (ewoc-invalidate vc-ewoc node)
2925 (setq entries (cdr entries) entry (car entries))
2926 (setq node (ewoc-next vc-ewoc node)))
2927 (t
2928 (ewoc-enter-before vc-ewoc node
2929 (apply 'vc-dir-create-fileinfo entry))
2930 (setq entries (cdr entries) entry (car entries))))))
2931 (t
2932 ;; We need to insert a directory node
2933 (let ((rd (file-relative-name entrydir)))
2934 (ewoc-enter-last
2935 vc-ewoc (vc-dir-create-fileinfo rd nil nil nil entrydir)))
2936 ;; Now insert the node itself.
2937 (ewoc-enter-before vc-ewoc node
2938 (apply 'vc-dir-create-fileinfo entry))
2939 (setq entries (cdr entries) entry (car entries))))))
2940 ;; We're past the last node, all remaining entries go to the end.
2941 (unless (or node noinsert)
2942 (let* ((lastnode (ewoc-nth vc-ewoc -1))
2943 (lastdir
2944 (or (vc-dir-fileinfo->directory (ewoc-data lastnode))
2945 (file-name-directory
2946 (expand-file-name
2947 (vc-dir-fileinfo->name (ewoc-data lastnode)))))))
2948 (dolist (entry entries)
2949 (let ((entrydir (file-name-directory (expand-file-name (car entry)))))
2950 ;; Insert a directory node if needed.
2951 (unless (string-equal lastdir entrydir)
2952 (setq lastdir entrydir)
2953 (let ((rd (file-relative-name entrydir)))
2954 (ewoc-enter-last
2955 vc-ewoc (vc-dir-create-fileinfo rd nil nil nil entrydir))))
2956 ;; Now insert the node itself.
2957 (ewoc-enter-last vc-ewoc
2958 (apply 'vc-dir-create-fileinfo entry))))))))))
2959
2960(defun vc-dir-busy ()
2961 (and (buffer-live-p vc-dir-process-buffer)
2962 (get-buffer-process vc-dir-process-buffer)))
2963
2964(defun vc-dir-refresh-files (files default-state)
2965 "Refresh some files in the VC status buffer."
2966 (let ((backend (vc-responsible-backend default-directory))
2967 (status-buffer (current-buffer))
2968 (def-dir default-directory))
2969 (vc-set-mode-line-busy-indicator)
2970 ;; Call the `dir-status-file' backend function.
2971 ;; `dir-status-file' is supposed to be asynchronous.
2972 ;; It should compute the results, and then call the function
2973 ;; passed as an argument in order to update the vc-dir buffer
2974 ;; with the results.
2975 (unless (buffer-live-p vc-dir-process-buffer)
2976 (setq vc-dir-process-buffer
2977 (generate-new-buffer (format " *VC-%s* tmp status" backend))))
2978 (lexical-let ((buffer (current-buffer)))
2979 (with-current-buffer vc-dir-process-buffer
2980 (cd def-dir)
2981 (erase-buffer)
2982 (vc-call-backend
2983 backend 'dir-status-files def-dir files default-state
2984 (lambda (entries &optional more-to-come)
2985 ;; ENTRIES is a list of (FILE VC_STATE EXTRA) items.
2986 ;; If MORE-TO-COME is true, then more updates will come from
2987 ;; the asynchronous process.
2988 (with-current-buffer buffer
2989 (vc-dir-update entries buffer)
2990 (unless more-to-come
2991 (setq mode-line-process nil)
2992 ;; Remove the ones that haven't been updated at all.
2993 ;; Those not-updated are those whose state is nil because the
2994 ;; file/dir doesn't exist and isn't versioned.
2995 (ewoc-filter vc-ewoc
2996 (lambda (info)
2997 (not (vc-dir-fileinfo->needs-update info))))))))))))
2998
2999(defun vc-dir-refresh ()
3000 "Refresh the contents of the VC status buffer.
3001Throw an error if another update process is in progress."
3002 (interactive)
3003 (if (vc-dir-busy)
3004 (error "Another update process is in progress, cannot run two at a time")
3005 (let ((backend (vc-responsible-backend default-directory))
3006 (status-buffer (current-buffer))
3007 (def-dir default-directory))
3008 (vc-set-mode-line-busy-indicator)
3009 ;; Call the `dir-status' backend function.
3010 ;; `dir-status' is supposed to be asynchronous.
3011 ;; It should compute the results, and then call the function
3012 ;; passed as an argument in order to update the vc-dir buffer
3013 ;; with the results.
3014
3015 ;; Create a buffer that can be used by `dir-status' and call
3016 ;; `dir-status' with this buffer as the current buffer. Use
3017 ;; `vc-dir-process-buffer' to remember this buffer, so that
3018 ;; it can be used later to kill the update process in case it
3019 ;; takes too long.
3020 (unless (buffer-live-p vc-dir-process-buffer)
3021 (setq vc-dir-process-buffer
3022 (generate-new-buffer (format " *VC-%s* tmp status" backend))))
3023 ;; set the needs-update flag on all entries
3024 (ewoc-map (lambda (info) (setf (vc-dir-fileinfo->needs-update info) t) nil)
3025 vc-ewoc)
3026 (lexical-let ((buffer (current-buffer)))
3027 (with-current-buffer vc-dir-process-buffer
3028 (cd def-dir)
3029 (erase-buffer)
3030 (vc-call-backend
3031 backend 'dir-status def-dir
3032 (lambda (entries &optional more-to-come)
3033 ;; ENTRIES is a list of (FILE VC_STATE EXTRA) items.
3034 ;; If MORE-TO-COME is true, then more updates will come from
3035 ;; the asynchronous process.
3036 (with-current-buffer buffer
3037 (vc-dir-update entries buffer)
3038 (unless more-to-come
3039 (let ((remaining
3040 (ewoc-collect
3041 vc-ewoc 'vc-dir-fileinfo->needs-update)))
3042 (if remaining
3043 (vc-dir-refresh-files
3044 (mapcar 'vc-dir-fileinfo->name remaining)
3045 'up-to-date)
3046 (setq mode-line-process nil))))))))))))
3047
3048(defun vc-dir-kill-dir-status-process ()
3049 "Kill the temporary buffer and associated process."
3050 (interactive)
3051 (when (buffer-live-p vc-dir-process-buffer)
3052 (let ((proc (get-buffer-process vc-dir-process-buffer)))
3053 (when proc (delete-process proc))
3054 (setq vc-dir-process-buffer nil)
3055 (setq mode-line-process nil))))
3056
3057(defun vc-dir-kill-query ()
3058 ;; Make sure that when the VC status buffer is killed the update
3059 ;; process running in background is also killed.
3060 (if (vc-dir-busy)
3061 (when (y-or-n-p "Status update process running, really kill status buffer?")
3062 (vc-dir-kill-dir-status-process)
3063 t)
3064 t))
3065
3066(defun vc-dir-next-line (arg)
3067 "Go to the next line.
3068If a prefix argument is given, move by that many lines."
3069 (interactive "p")
3070 (ewoc-goto-next vc-ewoc arg)
3071 (vc-dir-move-to-goal-column))
3072
3073(defun vc-dir-previous-line (arg)
3074 "Go to the previous line.
3075If a prefix argument is given, move by that many lines."
3076 (interactive "p")
3077 (ewoc-goto-prev vc-ewoc arg)
3078 (vc-dir-move-to-goal-column))
3079
3080(defun vc-dir-mark-unmark (mark-unmark-function)
3081 (if (use-region-p)
3082 (let ((firstl (line-number-at-pos (region-beginning)))
3083 (lastl (line-number-at-pos (region-end))))
3084 (save-excursion
3085 (goto-char (region-beginning))
3086 (while (<= (line-number-at-pos) lastl)
3087 (funcall mark-unmark-function))))
3088 (funcall mark-unmark-function)))
3089
3090(defun vc-dir-parent-marked-p (arg)
3091 (when vc-dir-insert-directories
3092 ;; Return nil if none of the parent directories of arg is marked.
3093 (let* ((argdata (ewoc-data arg))
3094 (argdir
3095 (let ((crtdir (vc-dir-fileinfo->directory argdata)))
3096 (if crtdir
3097 crtdir
3098 (file-name-directory (expand-file-name
3099 (vc-dir-fileinfo->name argdata))))))
3100 (arglen (length argdir))
3101 (crt arg)
3102 data dir)
3103 ;; Go through the predecessors, checking if any directory that is
3104 ;; a parent is marked.
3105 (while (setq crt (ewoc-prev vc-ewoc crt))
3106 (setq data (ewoc-data crt))
3107 (setq dir
3108 (let ((crtdir (vc-dir-fileinfo->directory data)))
3109 (if crtdir
3110 crtdir
3111 (file-name-directory (expand-file-name
3112 (vc-dir-fileinfo->name data))))))
3113
3114 (when (and (vc-dir-fileinfo->directory data)
3115 (string-equal (substring argdir 0 (length dir)) dir))
3116 (when (vc-dir-fileinfo->marked data)
3117 (error "Cannot mark `%s', parent directory `%s' marked"
3118 (vc-dir-fileinfo->name argdata)
3119 (vc-dir-fileinfo->name data)))))
3120 nil)))
3121
3122(defun vc-dir-children-marked-p (arg)
3123 ;; Return nil if none of the children of arg is marked.
3124 (when vc-dir-insert-directories
3125 (let* ((argdata (ewoc-data arg))
3126 (argdir (vc-dir-fileinfo->directory argdata))
3127 (arglen (length argdir))
3128 (is-child t)
3129 (crt arg)
3130 data dir)
3131 (while (and is-child (setq crt (ewoc-next vc-ewoc crt)))
3132 (setq data (ewoc-data crt))
3133 (setq dir
3134 (let ((crtdir (vc-dir-fileinfo->directory data)))
3135 (if crtdir
3136 crtdir
3137 (file-name-directory (expand-file-name
3138 (vc-dir-fileinfo->name data))))))
3139 (if (string-equal argdir (substring dir 0 arglen))
3140 (when (vc-dir-fileinfo->marked data)
3141 (error "Cannot mark `%s', child `%s' marked"
3142 (vc-dir-fileinfo->name argdata)
3143 (vc-dir-fileinfo->name data)))
3144 ;; We are done, we got to an entry that is not a child of `arg'.
3145 (setq is-child nil)))
3146 nil)))
3147
3148(defun vc-dir-mark-file (&optional arg)
3149 ;; Mark ARG or the current file and move to the next line.
3150 (let* ((crt (or arg (ewoc-locate vc-ewoc)))
3151 (file (ewoc-data crt))
3152 (isdir (vc-dir-fileinfo->directory file)))
3153 (when (or (and isdir (not (vc-dir-children-marked-p crt)))
3154 (and (not isdir) (not (vc-dir-parent-marked-p crt))))
3155 (setf (vc-dir-fileinfo->marked file) t)
3156 (ewoc-invalidate vc-ewoc crt)
3157 (unless (or arg (mouse-event-p last-command-event))
3158 (vc-dir-next-line 1)))))
3159
3160(defun vc-dir-mark ()
3161 "Mark the current file or all files in the region.
3162If the region is active, mark all the files in the region.
3163Otherwise mark the file on the current line and move to the next
3164line."
3165 (interactive)
3166 (vc-dir-mark-unmark 'vc-dir-mark-file))
3167
3168(defun vc-dir-mark-all-files (arg)
3169 "Mark all files with the same state as the current one.
3170With a prefix argument mark all files.
3171If the current entry is a directory, mark all child files.
3172
3173The VC commands operate on files that are on the same state.
3174This command is intended to make it easy to select all files that
3175share the same state."
3176 (interactive "P")
3177 (if arg
3178 ;; Mark all files.
3179 (progn
3180 ;; First check that no directory is marked, we can't mark
3181 ;; files in that case.
3182 (ewoc-map
3183 (lambda (filearg)
3184 (when (and (vc-dir-fileinfo->directory filearg)
3185 (vc-dir-fileinfo->directory filearg))
3186 (error "Cannot mark all files, directory `%s' marked"
3187 (vc-dir-fileinfo->name filearg))))
3188 vc-ewoc)
3189 (ewoc-map
3190 (lambda (filearg)
3191 (unless (vc-dir-fileinfo->marked filearg)
3192 (setf (vc-dir-fileinfo->marked filearg) t)
3193 t))
3194 vc-ewoc))
3195 (let ((data (ewoc-data (ewoc-locate vc-ewoc))))
3196 (if (vc-dir-fileinfo->directory data)
3197 ;; It's a directory, mark child files.
3198 (let ((crt (ewoc-locate vc-ewoc)))
3199 (unless (vc-dir-children-marked-p crt)
3200 (while (setq crt (ewoc-next vc-ewoc crt))
3201 (let ((crt-data (ewoc-data crt)))
3202 (unless (vc-dir-fileinfo->directory crt-data)
3203 (setf (vc-dir-fileinfo->marked crt-data) t)
3204 (ewoc-invalidate vc-ewoc crt))))))
3205 ;; It's a file
3206 (let ((state (vc-dir-fileinfo->state data))
3207 (crt (ewoc-nth vc-ewoc 0)))
3208 (while crt
3209 (let ((crt-data (ewoc-data crt)))
3210 (when (and (not (vc-dir-fileinfo->marked crt-data))
3211 (eq (vc-dir-fileinfo->state crt-data) state)
3212 (not (vc-dir-fileinfo->directory crt-data)))
3213 (vc-dir-mark-file crt)))
3214 (setq crt (ewoc-next vc-ewoc crt))))))))
3215
3216(defun vc-dir-unmark-file ()
3217 ;; Unmark the current file and move to the next line.
3218 (let* ((crt (ewoc-locate vc-ewoc))
3219 (file (ewoc-data crt)))
3220 (setf (vc-dir-fileinfo->marked file) nil)
3221 (ewoc-invalidate vc-ewoc crt)
3222 (unless (mouse-event-p last-command-event)
3223 (vc-dir-next-line 1))))
3224
3225(defun vc-dir-unmark ()
3226 "Unmark the current file or all files in the region.
3227If the region is active, unmark all the files in the region.
3228Otherwise mark the file on the current line and move to the next
3229line."
3230 (interactive)
3231 (vc-dir-mark-unmark 'vc-dir-unmark-file))
3232
3233(defun vc-dir-unmark-file-up ()
3234 "Move to the previous line and unmark the file."
3235 (interactive)
3236 ;; If we're on the first line, we won't move up, but we will still
3237 ;; remove the mark. This seems a bit odd but it is what buffer-menu
3238 ;; does.
3239 (let* ((prev (ewoc-goto-prev vc-ewoc 1))
3240 (file (ewoc-data prev)))
3241 (setf (vc-dir-fileinfo->marked file) nil)
3242 (ewoc-invalidate vc-ewoc prev)
3243 (vc-dir-move-to-goal-column)))
3244
3245(defun vc-dir-unmark-all-files (arg)
3246 "Unmark all files with the same state as the current one.
3247With a prefix argument unmark all files.
3248If the current entry is a directory, unmark all the child files.
3249
3250The VC commands operate on files that are on the same state.
3251This command is intended to make it easy to deselect all files
3252that share the same state."
3253 (interactive "P")
3254 (if arg
3255 (ewoc-map
3256 (lambda (filearg)
3257 (when (vc-dir-fileinfo->marked filearg)
3258 (setf (vc-dir-fileinfo->marked filearg) nil)
3259 t))
3260 vc-ewoc)
3261 (let* ((crt (ewoc-locate vc-ewoc))
3262 (data (ewoc-data crt)))
3263 (if (vc-dir-fileinfo->directory data)
3264 ;; It's a directory, unmark child files.
3265 (while (setq crt (ewoc-next vc-ewoc crt))
3266 (let ((crt-data (ewoc-data crt)))
3267 (unless (vc-dir-fileinfo->directory crt-data)
3268 (setf (vc-dir-fileinfo->marked crt-data) nil)
3269 (ewoc-invalidate vc-ewoc crt))))
3270 ;; It's a file
3271 (let ((crt-state (vc-dir-fileinfo->state (ewoc-data crt))))
3272 (ewoc-map
3273 (lambda (filearg)
3274 (when (and (vc-dir-fileinfo->marked filearg)
3275 (eq (vc-dir-fileinfo->state filearg) crt-state))
3276 (setf (vc-dir-fileinfo->marked filearg) nil)
3277 t))
3278 vc-ewoc))))))
3279
3280(defun vc-dir-toggle-mark-file ()
3281 (let* ((crt (ewoc-locate vc-ewoc))
3282 (file (ewoc-data crt)))
3283 (if (vc-dir-fileinfo->marked file)
3284 (vc-dir-unmark-file)
3285 (vc-dir-mark-file))))
3286
3287(defun vc-dir-toggle-mark (e)
3288 (interactive "e")
3289 (vc-at-event e (vc-dir-mark-unmark 'vc-dir-toggle-mark-file)))
3290
3291(defun vc-dir-register ()
3292 "Register the marked files, or the current file if no marks."
3293 (interactive)
3294 ;; FIXME: Just pass the fileset to vc-register.
3295 (mapc (lambda (arg) (vc-register nil arg))
3296 (or (vc-dir-marked-files) (list (vc-dir-current-file)))))
3297
3298(defun vc-dir-delete-file ()
3299 "Delete the marked files, or the current file if no marks."
3300 (interactive)
3301 (mapc 'vc-delete-file (or (vc-dir-marked-files)
3302 (list (vc-dir-current-file)))))
3303
3304(defun vc-dir-show-fileentry (file)
3305 "Insert an entry for a specific file into the current VC status listing.
3306This is typically used if the file is up-to-date (or has been added
3307outside of VC) and one wants to do some operation on it."
3308 (interactive "fShow file: ")
3309 (vc-dir-update (list (list (file-relative-name file) (vc-state file))) (current-buffer)))
3310
3311(defun vc-dir-find-file ()
3312 "Find the file on the current line."
3313 (interactive)
3314 (find-file (vc-dir-current-file)))
3315
3316(defun vc-dir-find-file-other-window ()
3317 "Find the file on the current line, in another window."
3318 (interactive)
3319 (find-file-other-window (vc-dir-current-file)))
3320
3321(defun vc-dir-current-file ()
3322 (let ((node (ewoc-locate vc-ewoc)))
3323 (unless node
3324 (error "No file available."))
3325 (expand-file-name (vc-dir-fileinfo->name (ewoc-data node)))))
3326
3327(defun vc-dir-marked-files ()
3328 "Return the list of marked files."
3329 (mapcar
3330 (lambda (elem) (expand-file-name (vc-dir-fileinfo->name elem)))
3331 (ewoc-collect vc-ewoc 'vc-dir-fileinfo->marked)))
3332
3333(defun vc-dir-marked-only-files ()
3334 "Return the list of marked files, for marked directories, return child files."
3335
3336 (let ((crt (ewoc-nth vc-ewoc 0))
3337 result)
3338 (while crt
3339 (let ((crt-data (ewoc-data crt)))
3340 (if (vc-dir-fileinfo->marked crt-data)
3341 (if (vc-dir-fileinfo->directory crt-data)
3342 (let* ((dir (vc-dir-fileinfo->directory crt-data))
3343 (dirlen (length dir))
3344 data)
3345 (while
3346 (and (setq crt (ewoc-next vc-ewoc crt))
3347 (string-equal
3348 (substring
3349 (progn
3350 (setq data (ewoc-data crt))
3351 (let ((crtdir (vc-dir-fileinfo->directory data)))
3352 (if crtdir
3353 crtdir
3354 (file-name-directory
3355 (expand-file-name
3356 (vc-dir-fileinfo->name data))))))
3357 0 dirlen)
3358 dir))
3359 (unless (vc-dir-fileinfo->directory data)
3360 (push (vc-dir-fileinfo->name data) result))))
3361 (push (expand-file-name (vc-dir-fileinfo->name crt-data)) result)
3362 (setq crt (ewoc-next vc-ewoc crt)))
3363 (setq crt (ewoc-next vc-ewoc crt)))))
3364 result))
3365
3366(defun vc-dir-hide-up-to-date ()
3367 "Hide up-to-date items from display."
3368 (interactive)
3369 (ewoc-filter
3370 vc-ewoc
3371 (lambda (crt) (not (eq (vc-dir-fileinfo->state crt) 'up-to-date)))))
3372
3373(defun vc-default-status-fileinfo-extra (backend file)
3374 nil)
3375
3376(defun vc-dir-mark-buffer-changed (&optional fname)
3377 (let* ((file (or fname (expand-file-name buffer-file-name)))
3378 (found-vc-dir-buf nil))
3379 (save-excursion
3380 (dolist (status-buf (buffer-list))
3381 (set-buffer status-buf)
3382 ;; look for a vc-dir buffer that might show this file.
3383 (when (eq major-mode 'vc-dir-mode)
3384 (setq found-vc-dir-buf t)
3385 (let ((ddir (expand-file-name default-directory)))
3386 ;; This test is cvs-string-prefix-p
3387 (when (eq t (compare-strings file nil (length ddir) ddir nil nil))
3388 (let*
3389 ((file-short (substring file (length ddir)))
3390 (backend (vc-backend file))
3391 (state (and backend (vc-state file)))
3392 (extra
3393 (and backend
3394 (vc-call-backend backend 'status-fileinfo-extra file)))
3395 (entry
3396 (list file-short (if state state 'unregistered) extra)))
3397 (vc-dir-update (list entry) status-buf))))))
3398 ;; We didn't find any vc-dir buffers, remove the hook, it is
3399 ;; not needed.
3400 (unless found-vc-dir-buf (remove-hook 'after-save-hook 'vc-dir-mark-buffer-changed)))))
3401
594722a8
ER
3402;; Named-configuration entry points
3403
0e362f54 3404(defun vc-snapshot-precondition (dir)
6f1ecae4 3405 "Scan the tree below DIR, looking for files not up-to-date.
099bd78a
SM
3406If any file is not up-to-date, return the name of the first such file.
3407\(This means, neither snapshot creation nor retrieval is allowed.\)
3408If one or more of the files are currently visited, return `visited'.
3409Otherwise, return nil."
503b5c85
RS
3410 (let ((status nil))
3411 (catch 'vc-locked-example
3412 (vc-file-tree-walk
0e362f54
GM
3413 dir
3414 (lambda (f)
3415 (if (not (vc-up-to-date-p f)) (throw 'vc-locked-example f)
b5446276 3416 (when (get-file-buffer f) (setq status 'visited)))))
503b5c85 3417 status)))
594722a8 3418
637a8ae9 3419;;;###autoload
0e362f54 3420(defun vc-create-snapshot (dir name branchp)
6f41eeb5 3421 "Descending recursively from DIR, make a snapshot called NAME.
ac3f4c6f
ER
3422For each registered file, the working revision becomes part of
3423the named configuration. If the prefix argument BRANCHP is
3424given, the snapshot is made as a new branch and the files are
3425checked out in that new branch."
0e362f54
GM
3426 (interactive
3427 (list (read-file-name "Directory: " default-directory default-directory t)
3428 (read-string "New snapshot name: ")
3429 current-prefix-arg))
3430 (message "Making %s... " (if branchp "branch" "snapshot"))
b5446276 3431 (when (file-directory-p dir) (setq dir (file-name-as-directory dir)))
0e362f54
GM
3432 (vc-call-backend (vc-responsible-backend dir)
3433 'create-snapshot dir name branchp)
3434 (message "Making %s... done" (if branchp "branch" "snapshot")))
3435
637a8ae9 3436;;;###autoload
0e362f54 3437(defun vc-retrieve-snapshot (dir name)
099bd78a 3438 "Descending recursively from DIR, retrieve the snapshot called NAME.
ac3f4c6f 3439If NAME is empty, it refers to the latest revisions.
099bd78a
SM
3440If locking is used for the files in DIR, then there must not be any
3441locked files at or below DIR (but if NAME is empty, locked files are
3442allowed and simply skipped)."
0e362f54
GM
3443 (interactive
3444 (list (read-file-name "Directory: " default-directory default-directory t)
ac3f4c6f 3445 (read-string "Snapshot name to retrieve (default latest revisions): ")))
0e362f54
GM
3446 (let ((update (yes-or-no-p "Update any affected buffers? "))
3447 (msg (if (or (not name) (string= name ""))
3448 (format "Updating %s... " (abbreviate-file-name dir))
3449 (format "Retrieving snapshot into %s... "
3450 (abbreviate-file-name dir)))))
8a26c165 3451 (message "%s" msg)
0e362f54
GM
3452 (vc-call-backend (vc-responsible-backend dir)
3453 'retrieve-snapshot dir name update)
8a26c165 3454 (message "%s" (concat msg "done"))))
0e362f54 3455
594722a8
ER
3456;; Miscellaneous other entry points
3457
637a8ae9 3458;;;###autoload
ac3f4c6f 3459(defun vc-print-log (&optional working-revision)
d7b60083 3460 "List the change log of the current fileset in a window.
ac3f4c6f 3461If WORKING-REVISION is non-nil, leave the point at that revision."
594722a8 3462 (interactive)
ae67f2d0
DN
3463 (let* ((vc-fileset (vc-deduce-fileset))
3464 (files (cdr vc-fileset))
3465 (backend (car vc-fileset))
ac3f4c6f 3466 (working-revision (or working-revision (vc-working-revision (car files)))))
5217a76a
SS
3467 ;; Don't switch to the output buffer before running the command,
3468 ;; so that any buffer-local settings in the vc-controlled
ac9ff209 3469 ;; buffer can be accessed by the command.
d7b60083
ER
3470 (vc-call-backend backend 'print-log files "*vc-change-log*")
3471 (pop-to-buffer "*vc-change-log*")
0e362f54 3472 (vc-exec-after
99cb8c8b 3473 `(let ((inhibit-read-only t))
d7b60083 3474 (vc-call-backend ',backend 'log-view-mode)
0e362f54
GM
3475 (goto-char (point-max)) (forward-line -1)
3476 (while (looking-at "=*\n")
3477 (delete-char (- (match-end 0) (match-beginning 0)))
3478 (forward-line -1))
3479 (goto-char (point-min))
b5446276
DN
3480 (when (looking-at "[\b\t\n\v\f\r ]+")
3481 (delete-char (- (match-end 0) (match-beginning 0))))
d7b60083 3482 (shrink-window-if-larger-than-buffer)
ac3f4c6f
ER
3483 ;; move point to the log entry for the working revision
3484 (vc-call-backend ',backend 'show-log-entry ',working-revision)
86e80023 3485 (setq vc-sentinel-movepoint (point))
99cb8c8b 3486 (set-buffer-modified-p nil)))))
594722a8 3487
637a8ae9 3488;;;###autoload
e4d26892 3489(defun vc-revert ()
d7b60083 3490 "Revert working copies of the selected fileset to their repository contents.
9c95ac44 3491This asks for confirmation if the buffer contents are not identical
ac3f4c6f 3492to the working revision (except for keyword expansion)."
594722a8 3493 (interactive)
ae67f2d0
DN
3494 (let* ((vc-fileset (vc-deduce-fileset))
3495 (files (cdr vc-fileset)))
d7b60083
ER
3496 ;; If any of the files is visited by the current buffer, make
3497 ;; sure buffer is saved. If the user says `no', abort since
3498 ;; we cannot show the changes and ask for confirmation to
3499 ;; discard them.
b5446276
DN
3500 (when (or (not files) (memq (buffer-file-name) files))
3501 (vc-buffer-sync nil))
d7b60083 3502 (dolist (file files)
a7192ddb 3503 (let ((buf (get-file-buffer file)))
b5446276 3504 (when (and buf (buffer-modified-p buf))
d7b60083 3505 (error "Please kill or save all modified buffers before reverting.")))
b5446276
DN
3506 (when (vc-up-to-date-p file)
3507 (unless (yes-or-no-p (format "%s seems up-to-date. Revert anyway? " file))
3508 (error "Revert canceled"))))
ae67f2d0 3509 (when (vc-diff-internal vc-allow-async-revert vc-fileset nil nil)
b5446276
DN
3510 (unless (yes-or-no-p (format "Discard changes in %s? " (vc-delistify files)))
3511 (error "Revert canceled"))
3512 (delete-windows-on "*vc-diff*")
3513 (kill-buffer "*vc-diff*"))
d7b60083 3514 (dolist (file files)
b5446276
DN
3515 (message "Reverting %s..." (vc-delistify files))
3516 (vc-revert-file file)
3517 (message "Reverting %s...done" (vc-delistify files)))))
594722a8 3518
637a8ae9 3519;;;###autoload
d7b60083
ER
3520(defun vc-rollback ()
3521 "Roll back (remove) the most recent changeset committed to the repository.
3522This may be either a file-level or a repository-level operation,
3523depending on the underlying version-control system."
3524 (interactive)
ae67f2d0
DN
3525 (let* ((vc-fileset (vc-deduce-fileset))
3526 (files (cdr vc-fileset))
3527 (backend (car vc-fileset))
d7b60083
ER
3528 (granularity (vc-call-backend backend 'revision-granularity)))
3529 (unless (vc-find-backend-function backend 'rollback)
3530 (error "Rollback is not supported in %s" backend))
b5446276
DN
3531 (when (and (not (eq granularity 'repository)) (/= (length files) 1))
3532 (error "Rollback requires a singleton fileset or repository versioning"))
3533 (when (not (vc-call latest-on-branch-p (car files)))
3534 (error "Rollback is only possible at the tip revision."))
d7b60083
ER
3535 ;; If any of the files is visited by the current buffer, make
3536 ;; sure buffer is saved. If the user says `no', abort since
3537 ;; we cannot show the changes and ask for confirmation to
3538 ;; discard them.
b5446276
DN
3539 (when (or (not files) (memq (buffer-file-name) files))
3540 (vc-buffer-sync nil))
d7b60083 3541 (dolist (file files)
b5446276
DN
3542 (when (buffer-modified-p (get-file-buffer file))
3543 (error "Please kill or save all modified buffers before rollback."))
3544 (when (not (vc-up-to-date-p file))
3545 (error "Please revert all modified workfiles before rollback.")))
d7b60083
ER
3546 ;; Accumulate changes associated with the fileset
3547 (vc-setup-buffer "*vc-diff*")
3548 (not-modified)
3549 (message "Finding changes...")
ac3f4c6f
ER
3550 (let* ((tip (vc-working-revision (car files)))
3551 (previous (vc-call previous-revision (car files) tip)))
ae67f2d0 3552 (vc-diff-internal nil vc-fileset previous tip))
a7192ddb 3553 ;; Display changes
d7b60083
ER
3554 (unless (yes-or-no-p "Discard these revisions? ")
3555 (error "Rollback canceled"))
3556 (delete-windows-on "*vc-diff*")
3557 (kill-buffer"*vc-diff*")
3558 ;; Do the actual reversions
3559 (message "Rolling back %s..." (vc-delistify files))
3560 (with-vc-properties
3561 files
3562 (vc-call-backend backend 'rollback files)
3563 `((vc-state . ,'up-to-date)
3564 (vc-checkout-time . , (nth 5 (file-attributes file)))
ac3f4c6f 3565 (vc-working-revision . nil)))
a7192ddb 3566 (dolist (f files) (vc-resynch-buffer f t t))
d7b60083 3567 (message "Rolling back %s...done" (vc-delistify files))))
0e362f54 3568
2765044b
DN
3569;;;###autoload
3570(define-obsolete-function-alias 'vc-revert-buffer 'vc-revert "23.1")
3571
3572;;;###autoload
3573(defun vc-update ()
ac3f4c6f 3574 "Update the current fileset's files to their tip revisions.
a7192ddb
SM
3575For each one that contains no changes, and is not locked, then this simply
3576replaces the work file with the latest revision on its branch. If the file
3577contains changes, and the backend supports merging news, then any recent
d7b60083 3578changes from the current branch are merged into the working file."
2765044b 3579 (interactive)
ae67f2d0
DN
3580 (let* ((vc-fileset (vc-deduce-fileset))
3581 (files (cdr vc-fileset))
3582 (backend (car vc-fileset)))
3583 (dolist (file files)
3584 (when (let ((buf (get-file-buffer file)))
3585 (and buf (buffer-modified-p buf)))
3586 (error "Please kill or save all modified buffers before updating."))
3587 (if (vc-up-to-date-p file)
3588 (vc-checkout file nil t)
70e2f6c7 3589 (if (eq (vc-checkout-model backend (list file)) 'locking)
ae67f2d0
DN
3590 (if (eq (vc-state file) 'edited)
3591 (error "%s"
3592 (substitute-command-keys
3593 "File is locked--type \\[vc-revert] to discard changes"))
3594 (error "Unexpected file state (%s) -- type %s"
3595 (vc-state file)
1f325d92 3596 (substitute-command-keys
ae67f2d0
DN
3597 "\\[vc-next-action] to correct")))
3598 (if (not (vc-find-backend-function backend 'merge-news))
3599 (error "Sorry, merging news is not implemented for %s"
3600 backend)
3601 (vc-maybe-resolve-conflicts file (vc-call merge-news file))))))))
2765044b
DN
3602
3603(defun vc-version-backup-file (file &optional rev)
3604 "Return name of backup file for revision REV of FILE.
3605If version backups should be used for FILE, and there exists
a7192ddb 3606such a backup for REV or the working revision of file, return
0d0e9356 3607its name; otherwise return nil."
2765044b
DN
3608 (when (vc-call make-version-backups-p file)
3609 (let ((backup-file (vc-version-backup-file-name file rev)))
3610 (if (file-exists-p backup-file)
3611 backup-file
3612 ;; there is no automatic backup, but maybe the user made one manually
3613 (setq backup-file (vc-version-backup-file-name file rev 'manual))
b5446276
DN
3614 (when (file-exists-p backup-file)
3615 backup-file)))))
2765044b
DN
3616
3617(defun vc-revert-file (file)
ac3f4c6f 3618 "Revert FILE back to the repository working revision it was based on."
2765044b 3619 (with-vc-properties
d7b60083 3620 (list file)
2765044b
DN
3621 (let ((backup-file (vc-version-backup-file file)))
3622 (when backup-file
3623 (copy-file backup-file file 'ok-if-already-exists 'keep-date)
3624 (vc-delete-automatic-version-backups file))
3625 (vc-call revert file backup-file))
3626 `((vc-state . up-to-date)
3627 (vc-checkout-time . ,(nth 5 (file-attributes file)))))
3628 (vc-resynch-buffer file t t))
3629
76e5906d 3630;;;###autoload
1d502d5a 3631(defun vc-switch-backend (file backend)
7849e179 3632 "Make BACKEND the current version control system for FILE.
1d502d5a
AS
3633FILE must already be registered in BACKEND. The change is not
3634permanent, only for the current session. This function only changes
7849e179
SM
3635VC's perspective on FILE, it does not register or unregister it.
3636By default, this command cycles through the registered backends.
3637To get a prompt, use a prefix argument."
3638 (interactive
1d502d5a 3639 (list
94ca88e3
AS
3640 (or buffer-file-name
3641 (error "There is no version-controlled file in this buffer"))
7849e179
SM
3642 (let ((backend (vc-backend buffer-file-name))
3643 (backends nil))
d7b60083
ER
3644 (unless backend
3645 (error "File %s is not under version control" buffer-file-name))
3646 ;; Find the registered backends.
3647 (dolist (backend vc-handled-backends)
3648 (when (vc-call-backend backend 'registered buffer-file-name)
3649 (push backend backends)))
3650 ;; Find the next backend.
3651 (let ((def (car (delq backend (append (memq backend backends) backends))))
3652 (others (delete backend backends)))
3653 (cond
3654 ((null others) (error "No other backend to switch to"))
3655 (current-prefix-arg
3656 (intern
3657 (upcase
3658 (completing-read
3659 (format "Switch to backend [%s]: " def)
3660 (mapcar (lambda (b) (list (downcase (symbol-name b)))) backends)
3661 nil t nil nil (downcase (symbol-name def))))))
3662 (t def))))))
ceec5a0c 3663 (unless (eq backend (vc-backend file))
ceec5a0c
SM
3664 (vc-file-clearprops file)
3665 (vc-file-setprop file 'vc-backend backend)
3666 ;; Force recomputation of the state
a3255400
SM
3667 (unless (vc-call-backend backend 'registered file)
3668 (vc-file-clearprops file)
3669 (error "%s is not registered in %s" file backend))
ceec5a0c 3670 (vc-mode-line file)))
1d502d5a 3671
21b50296 3672;;;###autoload
1d502d5a 3673(defun vc-transfer-file (file new-backend)
ceec5a0c 3674 "Transfer FILE to another version control system NEW-BACKEND.
1d502d5a 3675If NEW-BACKEND has a higher precedence than FILE's current backend
ceec5a0c 3676\(i.e. it comes earlier in `vc-handled-backends'), then register FILE in
ac3f4c6f 3677NEW-BACKEND, using the revision number from the current backend as the
1d502d5a
AS
3678base level. If NEW-BACKEND has a lower precedence than the current
3679backend, then commit all changes that were made under the current
3680backend to NEW-BACKEND, and unregister FILE from the current backend.
3681\(If FILE is not yet registered under NEW-BACKEND, register it.)"
72cfc5fb
AS
3682 (let* ((old-backend (vc-backend file))
3683 (edited (memq (vc-state file) '(edited needs-merge)))
3684 (registered (vc-call-backend new-backend 'registered file))
3685 (move
3686 (and registered ; Never move if not registered in new-backend yet.
3687 ;; move if new-backend comes later in vc-handled-backends
3688 (or (memq new-backend (memq old-backend vc-handled-backends))
ffda0460 3689 (y-or-n-p "Final transfer? "))))
72cfc5fb 3690 (comment nil))
ae67f2d0
DN
3691 (when (eq old-backend new-backend)
3692 (error "%s is the current backend of %s" new-backend file))
72cfc5fb
AS
3693 (if registered
3694 (set-file-modes file (logior (file-modes file) 128))
3695 ;; `registered' might have switched under us.
3696 (vc-switch-backend file old-backend)
ac3f4c6f 3697 (let* ((rev (vc-working-revision file))
c1b1b393 3698 (modified-file (and edited (make-temp-file file)))
ffda0460 3699 (unmodified-file (and modified-file (vc-version-backup-file file))))
72cfc5fb
AS
3700 ;; Go back to the base unmodified file.
3701 (unwind-protect
3702 (progn
ffda0460 3703 (when modified-file
c1b1b393 3704 (copy-file file modified-file 'ok-if-already-exists)
ffda0460
AS
3705 ;; If we have a local copy of the unmodified file, handle that
3706 ;; here and not in vc-revert-file because we don't want to
3707 ;; delete that copy -- it is still useful for OLD-BACKEND.
3708 (if unmodified-file
b4e4e3a8
SM
3709 (copy-file unmodified-file file
3710 'ok-if-already-exists 'keep-date)
ae67f2d0
DN
3711 (when (y-or-n-p "Get base revision from master? ")
3712 (vc-revert-file file))))
72cfc5fb 3713 (vc-call-backend new-backend 'receive-file file rev))
ffda0460 3714 (when modified-file
72cfc5fb 3715 (vc-switch-backend file new-backend)
70e2f6c7 3716 (unless (eq (vc-checkout-model new-backend (list file)) 'implicit)
72cfc5fb 3717 (vc-checkout file t nil))
ffda0460
AS
3718 (rename-file modified-file file 'ok-if-already-exists)
3719 (vc-file-setprop file 'vc-checkout-time nil)))))
72cfc5fb
AS
3720 (when move
3721 (vc-switch-backend file old-backend)
3722 (setq comment (vc-call comment-history file))
3723 (vc-call unregister file))
3724 (vc-switch-backend file new-backend)
3725 (when (or move edited)
1d502d5a 3726 (vc-file-setprop file 'vc-state 'edited)
ffda0460 3727 (vc-mode-line file)
0ab66291 3728 (vc-checkin file nil comment (stringp comment)))))
1d502d5a 3729
0e362f54
GM
3730(defun vc-rename-master (oldmaster newfile templates)
3731 "Rename OLDMASTER to be the master file for NEWFILE based on TEMPLATES."
3732 (let* ((dir (file-name-directory (expand-file-name oldmaster)))
3733 (newdir (or (file-name-directory newfile) ""))
3734 (newbase (file-name-nondirectory newfile))
3735 (masters
3736 ;; List of potential master files for `newfile'
3737 (mapcar
3738 (lambda (s) (vc-possible-master s newdir newbase))
3739 templates)))
b5446276
DN
3740 (when (or (file-symlink-p oldmaster)
3741 (file-symlink-p (file-name-directory oldmaster)))
3742 (error "This is unsafe in the presence of symbolic links"))
0e362f54
GM
3743 (rename-file
3744 oldmaster
3745 (catch 'found
3746 ;; If possible, keep the master file in the same directory.
b4e4e3a8 3747 (dolist (f masters)
ae67f2d0
DN
3748 (when (and f (string= (file-name-directory (expand-file-name f)) dir))
3749 (throw 'found f)))
0e362f54 3750 ;; If not, just use the first possible place.
b4e4e3a8
SM
3751 (dolist (f masters)
3752 (and f (or (not (setq dir (file-name-directory f)))
3753 (file-directory-p dir))
3754 (throw 'found f)))
0e362f54 3755 (error "New file lacks a version control directory")))))
594722a8 3756
a36319a4
SM
3757(defun vc-delete-file (file)
3758 "Delete file and mark it as such in the version control system."
3759 (interactive "fVC delete file: ")
484c3092 3760 (setq file (expand-file-name file))
c6e44350
AS
3761 (let ((buf (get-file-buffer file))
3762 (backend (vc-backend file)))
3763 (unless backend
86a65190 3764 (error "File %s is not under version control"
c6e44350 3765 (file-name-nondirectory file)))
a36319a4 3766 (unless (vc-find-backend-function backend 'delete-file)
c6e44350 3767 (error "Deleting files under %s is not supported in VC" backend))
b5446276 3768 (when (and buf (buffer-modified-p buf))
a84615c7
SS
3769 (error "Please save or undo your changes before deleting %s" file))
3770 (let ((state (vc-state file)))
3771 (when (eq state 'edited)
3772 (error "Please commit or undo your changes before deleting %s" file))
3773 (when (eq state 'conflict)
3774 (error "Please resolve the conflicts before deleting %s" file)))
ce5a3ac0 3775 (unless (y-or-n-p (format "Really want to delete %s? "
a36319a4
SM
3776 (file-name-nondirectory file)))
3777 (error "Abort!"))
775237d3
SS
3778 (unless (or (file-directory-p file) (null make-backup-files)
3779 (not (file-exists-p file)))
a36319a4
SM
3780 (with-current-buffer (or buf (find-file-noselect file))
3781 (let ((backup-inhibited nil))
484c3092
DN
3782 (backup-buffer))
3783 ;; If we didn't have a buffer visiting the file before this
3784 ;; command, kill the buffer created by the above
3785 ;; `find-file-noselect' call.
3786 (unless buf (kill-buffer (current-buffer)))))
a36319a4
SM
3787 (vc-call delete-file file)
3788 ;; If the backend hasn't deleted the file itself, let's do it for him.
b5446276 3789 (when (file-exists-p file) (delete-file file))
484c3092
DN
3790 ;; Forget what VC knew about the file.
3791 (vc-file-clearprops file)
3792 (vc-resynch-buffer file buf t)))
a36319a4 3793
29fc1ce9 3794;;;###autoload
594722a8 3795(defun vc-rename-file (old new)
34291cd2
RS
3796 "Rename file OLD to NEW, and rename its master file likewise."
3797 (interactive "fVC rename file: \nFRename to: ")
a36319a4 3798 (let ((oldbuf (get-file-buffer old)))
b5446276
DN
3799 (when (and oldbuf (buffer-modified-p oldbuf))
3800 (error "Please save files before moving them"))
3801 (when (get-file-buffer new)
3802 (error "Already editing new file name"))
3803 (when (file-exists-p new)
3804 (error "New file already exists"))
86a65190 3805 (let ((state (vc-state old)))
a36319a4
SM
3806 (unless (memq state '(up-to-date edited))
3807 (error "Please %s files before moving them"
3808 (if (stringp state) "check in" "update"))))
3809 (vc-call rename-file old new)
b4e4e3a8 3810 (vc-file-clearprops old)
0e362f54 3811 ;; Move the actual file (unless the backend did it already)
b5446276 3812 (when (file-exists-p old) (rename-file old new))
0e362f54
GM
3813 ;; ?? Renaming a file might change its contents due to keyword expansion.
3814 ;; We should really check out a new copy if the old copy was precisely equal
ac3f4c6f 3815 ;; to some checked-in revision. However, testing for this is tricky....
b5446276
DN
3816 (when oldbuf
3817 (with-current-buffer oldbuf
3818 (let ((buffer-read-only buffer-read-only))
3819 (set-visited-file-name new))
3820 (vc-backend new)
3821 (vc-mode-line new)
3822 (set-buffer-modified-p nil)))))
0e362f54 3823
637a8ae9 3824;;;###autoload
f35ecf88 3825(defun vc-update-change-log (&rest args)
0e362f54 3826 "Find change log file and add entries from recent version control logs.
d68e6990 3827Normally, find log entries for all registered files in the default
0e362f54 3828directory.
d68e6990 3829
099bd78a 3830With prefix arg of \\[universal-argument], only find log entries for the current buffer's file.
d68e6990
RS
3831
3832With any numeric prefix arg, find log entries for all currently visited
3833files that are under version control. This puts all the entries in the
3834log for the default directory, which may not be appropriate.
3835
099bd78a 3836From a program, any ARGS are assumed to be filenames for which
0e362f54 3837log entries should be gathered."
67242a23
RM
3838 (interactive
3839 (cond ((consp current-prefix-arg) ;C-u
3840 (list buffer-file-name))
3841 (current-prefix-arg ;Numeric argument.
3842 (let ((files nil)
3843 (buffers (buffer-list))
3844 file)
3845 (while buffers
3846 (setq file (buffer-file-name (car buffers)))
f3c61d82 3847 (and file (vc-backend file)
4b40fdea 3848 (setq files (cons file files)))
67242a23 3849 (setq buffers (cdr buffers)))
4b40fdea
PE
3850 files))
3851 (t
0e362f54
GM
3852 ;; Don't supply any filenames to backend; this means
3853 ;; it should find all relevant files relative to
3854 ;; the default-directory.
73a9679c 3855 nil)))
0e362f54
GM
3856 (vc-call-backend (vc-responsible-backend default-directory)
3857 'update-changelog args))
3858
ac3f4c6f 3859;;; The default back end. Assumes RCS-like revision numbering.
61de26cb
ER
3860
3861(defun vc-default-revision-granularity ()
3862 (error "Your backend will not work with this version of VC mode."))
3863
2765044b
DN
3864;; functions that operate on RCS revision numbers. This code should
3865;; also be moved into the backends. It stays for now, however, since
3866;; it is used in code below.
3867;;;###autoload
3868(defun vc-trunk-p (rev)
3869 "Return t if REV is a revision on the trunk."
3870 (not (eq nil (string-match "\\`[0-9]+\\.[0-9]+\\'" rev))))
3871
3872(defun vc-branch-p (rev)
3873 "Return t if REV is a branch revision."
3874 (not (eq nil (string-match "\\`[0-9]+\\(\\.[0-9]+\\.[0-9]+\\)*\\'" rev))))
3875
3876;;;###autoload
3877(defun vc-branch-part (rev)
3878 "Return the branch part of a revision number REV."
3879 (let ((index (string-match "\\.[0-9]+\\'" rev)))
b5446276
DN
3880 (when index
3881 (substring rev 0 index))))
2765044b
DN
3882
3883(defun vc-minor-part (rev)
ac3f4c6f 3884 "Return the minor revision number of a revision number REV."
2765044b
DN
3885 (string-match "[0-9]+\\'" rev)
3886 (substring rev (match-beginning 0) (match-end 0)))
3887
ac3f4c6f
ER
3888(defun vc-default-previous-revision (backend file rev)
3889 "Return the revision number immediately preceding REV for FILE,
3890or nil if there is no previous revision. This default
3891implementation works for MAJOR.MINOR-style revision numbers as
2765044b
DN
3892used by RCS and CVS."
3893 (let ((branch (vc-branch-part rev))
3894 (minor-num (string-to-number (vc-minor-part rev))))
3895 (when branch
3896 (if (> minor-num 1)
ac3f4c6f 3897 ;; revision does probably not start a branch or release
2765044b
DN
3898 (concat branch "." (number-to-string (1- minor-num)))
3899 (if (vc-trunk-p rev)
3900 ;; we are at the beginning of the trunk --
3901 ;; don't know anything to return here
3902 nil
3903 ;; we are at the beginning of a branch --
ac3f4c6f 3904 ;; return revision of starting point
2765044b
DN
3905 (vc-branch-part branch))))))
3906
ac3f4c6f
ER
3907(defun vc-default-next-revision (backend file rev)
3908 "Return the revision number immediately following REV for FILE,
3909or nil if there is no next revision. This default implementation
3910works for MAJOR.MINOR-style revision numbers as used by RCS
2765044b 3911and CVS."
ac3f4c6f 3912 (when (not (string= rev (vc-working-revision file)))
2765044b
DN
3913 (let ((branch (vc-branch-part rev))
3914 (minor-num (string-to-number (vc-minor-part rev))))
3915 (concat branch "." (number-to-string (1+ minor-num))))))
3916
3917(defun vc-default-responsible-p (backend file)
3918 "Indicate whether BACKEND is reponsible for FILE.
3919The default is to return nil always."
3920 nil)
3921
3922(defun vc-default-could-register (backend file)
3923 "Return non-nil if BACKEND could be used to register FILE.
3924The default implementation returns t for all files."
3925 t)
3926
3927(defun vc-default-latest-on-branch-p (backend file)
3928 "Return non-nil if FILE is the latest on its branch.
3929This default implementation always returns non-nil, which means that
ac3f4c6f 3930editing non-current revisions is not supported by default."
2765044b
DN
3931 t)
3932
ac3f4c6f 3933(defun vc-default-init-revision (backend) vc-default-init-revision)
2765044b 3934
45fd3a00
SM
3935(defalias 'vc-cvs-update-changelog 'vc-update-changelog-rcs2log)
3936(defalias 'vc-rcs-update-changelog 'vc-update-changelog-rcs2log)
3937;; FIXME: This should probably be moved to vc-rcs.el and replaced in
3938;; vc-cvs.el by code using cvs2cl.
0b8dce84 3939(defun vc-update-changelog-rcs2log (files)
099bd78a
SM
3940 "Default implementation of update-changelog.
3941Uses `rcs2log' which only works for RCS and CVS."
0e362f54 3942 ;; FIXME: We (c|sh)ould add support for cvs2cl
449decf5 3943 (let ((odefault default-directory)
124c852b
RS
3944 (changelog (find-change-log))
3945 ;; Presumably not portable to non-Unixy systems, along with rcs2log:
c1b1b393 3946 (tempfile (make-temp-file
57c298c4
EZ
3947 (expand-file-name "vc"
3948 (or small-temporary-file-directory
3949 temporary-file-directory))))
510f6466
AS
3950 (login-name (or user-login-name
3951 (format "uid%d" (number-to-string (user-uid)))))
b91916f3 3952 (full-name (or add-log-full-name
8172cd86
AS
3953 (user-full-name)
3954 (user-login-name)
3955 (format "uid%d" (number-to-string (user-uid)))))
b91916f3
RS
3956 (mailing-address (or add-log-mailing-address
3957 user-mail-address)))
124c852b 3958 (find-file-other-window changelog)
41dfb835
RS
3959 (barf-if-buffer-read-only)
3960 (vc-buffer-sync)
3961 (undo-boundary)
3962 (goto-char (point-min))
3963 (push-mark)
3964 (message "Computing change log entries...")
4b40fdea 3965 (message "Computing change log entries... %s"
124c852b
RS
3966 (unwind-protect
3967 (progn
0e362f54 3968 (setq default-directory odefault)
6f41eeb5
DL
3969 (if (eq 0 (apply 'call-process
3970 (expand-file-name "rcs2log"
3971 exec-directory)
0e362f54
GM
3972 nil (list t tempfile) nil
3973 "-c" changelog
510f6466 3974 "-u" (concat login-name
0e362f54
GM
3975 "\t" full-name
3976 "\t" mailing-address)
3977 (mapcar
3978 (lambda (f)
3979 (file-relative-name
d7b60083 3980 (expand-file-name f odefault)))
0e362f54
GM
3981 files)))
3982 "done"
04864eb0 3983 (pop-to-buffer (get-buffer-create "*vc*"))
124c852b 3984 (erase-buffer)
54ebae28 3985 (insert-file-contents tempfile)
124c852b 3986 "failed"))
0e362f54 3987 (setq default-directory (file-name-directory changelog))
124c852b 3988 (delete-file tempfile)))))
7d2d9482 3989
ac3f4c6f
ER
3990(defun vc-default-find-revision (backend file rev buffer)
3991 "Provide the new `find-revision' op based on the old `checkout' op.
2765044b 3992This is only for compatibility with old backends. They should be updated
ac3f4c6f 3993to provide the `find-revision' operation instead."
2765044b
DN
3994 (let ((tmpfile (make-temp-file (expand-file-name file))))
3995 (unwind-protect
3996 (progn
3997 (vc-call-backend backend 'checkout file nil rev tmpfile)
3998 (with-current-buffer buffer
3999 (insert-file-contents-literally tmpfile)))
4000 (delete-file tmpfile))))
4001
0a299408 4002(defun vc-default-prettify-state-info (backend file)
d7b60083
ER
4003 (let* ((state (vc-state file))
4004 (statestring
4005 (cond
4006 ((stringp state) (concat "(" state ")"))
45b24b4d 4007 ((eq state 'edited) "(modified)")
d7b60083 4008 ((eq state 'needs-merge) "(merge)")
3702367b 4009 ((eq state 'needs-update) "(update)")
0f67cc71 4010 ((eq state 'added) "(added)")
484c1b1f 4011 ((eq state 'removed) "(removed)")
722f037f
ER
4012 ((eq state 'ignored) "(ignored)") ;; dired-hook filters this out
4013 ((eq state 'unregistered) "?")
4014 ((eq state 'unlocked-changes) "(stale)")
4015 ((not state) "(unknown)")))
d7b60083
ER
4016 (buffer
4017 (get-file-buffer file))
4018 (modflag
4019 (if (and buffer (buffer-modified-p buffer)) "+" "")))
4020 (concat statestring modflag)))
2765044b
DN
4021
4022(defun vc-default-rename-file (backend old new)
4023 (condition-case nil
4024 (add-name-to-file old new)
4025 (error (rename-file old new)))
4026 (vc-delete-file old)
4027 (with-current-buffer (find-file-noselect new)
4028 (vc-register)))
4029
17f3909f 4030(defalias 'vc-default-check-headers 'ignore)
2765044b
DN
4031
4032(defun vc-default-log-view-mode (backend) (log-view-mode))
4033
4034(defun vc-default-show-log-entry (backend rev)
4035 (with-no-warnings
4036 (log-view-goto-rev rev)))
4037
4038(defun vc-default-comment-history (backend file)
4039 "Return a string with all log entries stored in BACKEND for FILE."
7fbb4797
DN
4040 (when (vc-find-backend-function backend 'print-log)
4041 (with-current-buffer "*vc*"
4042 (vc-call print-log (list file))
4043 (vc-call-backend backend 'wash-log)
4044 (buffer-string))))
2765044b 4045
2765044b
DN
4046(defun vc-default-receive-file (backend file rev)
4047 "Let BACKEND receive FILE from another version control system."
4048 (vc-call-backend backend 'register file rev ""))
4049
4050(defun vc-default-create-snapshot (backend dir name branchp)
4051 (when branchp
4052 (error "VC backend %s does not support module branches" backend))
4053 (let ((result (vc-snapshot-precondition dir)))
4054 (if (stringp result)
4055 (error "File %s is not up-to-date" result)
4056 (vc-file-tree-walk
4057 dir
4058 (lambda (f)
4059 (vc-call assign-name f name))))))
4060
4061(defun vc-default-retrieve-snapshot (backend dir name update)
4062 (if (string= name "")
4063 (progn
4064 (vc-file-tree-walk
4065 dir
4066 (lambda (f) (and
4067 (vc-up-to-date-p f)
4068 (vc-error-occurred
4069 (vc-call checkout f nil "")
b5446276 4070 (when update (vc-resynch-buffer f t t)))))))
2765044b
DN
4071 (let ((result (vc-snapshot-precondition dir)))
4072 (if (stringp result)
4073 (error "File %s is locked" result)
4074 (setq update (and (eq result 'visited) update))
4075 (vc-file-tree-walk
4076 dir
4077 (lambda (f) (vc-error-occurred
4078 (vc-call checkout f nil name)
b5446276 4079 (when update (vc-resynch-buffer f t t)))))))))
2765044b
DN
4080
4081(defun vc-default-revert (backend file contents-done)
4082 (unless contents-done
ac3f4c6f 4083 (let ((rev (vc-working-revision file))
2765044b
DN
4084 (file-buffer (or (get-file-buffer file) (current-buffer))))
4085 (message "Checking out %s..." file)
4086 (let ((failed t)
4087 (backup-name (car (find-backup-file-name file))))
4088 (when backup-name
4089 (copy-file file backup-name 'ok-if-already-exists 'keep-date)
4090 (unless (file-writable-p file)
4091 (set-file-modes file (logior (file-modes file) 128))))
4092 (unwind-protect
4093 (let ((coding-system-for-read 'no-conversion)
4094 (coding-system-for-write 'no-conversion))
4095 (with-temp-file file
4096 (let ((outbuf (current-buffer)))
4097 ;; Change buffer to get local value of vc-checkout-switches.
4098 (with-current-buffer file-buffer
4099 (let ((default-directory (file-name-directory file)))
ac3f4c6f 4100 (vc-call find-revision file rev outbuf)))))
2765044b
DN
4101 (setq failed nil))
4102 (when backup-name
4103 (if failed
4104 (rename-file backup-name file 'ok-if-already-exists)
4105 (and (not vc-make-backup-files) (delete-file backup-name))))))
4106 (message "Checking out %s...done" file))))
4107
17f3909f 4108(defalias 'vc-default-revision-completion-table 'ignore)
2765044b 4109
fb0ac090
AJ
4110(defun vc-default-dir-status-files (backend dir files default-state update-function)
4111 (funcall update-function
4112 (mapcar (lambda (file) (list file default-state)) files)))
4113
2765044b
DN
4114(defun vc-check-headers ()
4115 "Check if the current file has any headers in it."
4116 (interactive)
4117 (vc-call-backend (vc-backend buffer-file-name) 'check-headers))
4118
4119;;; Annotate functionality
7d2d9482 4120
f80f7bc2
RS
4121;; Declare globally instead of additional parameter to
4122;; temp-buffer-show-function (not possible to pass more than one
75665141
AS
4123;; parameter). The use of annotate-ratio is deprecated in favor of
4124;; annotate-mode, which replaces it with the more sensible "span-to
4125;; days", along with autoscaling support.
099bd78a 4126(defvar vc-annotate-ratio nil "Global variable.")
0e362f54 4127
1b5a7343 4128;; internal buffer-local variables
04864eb0 4129(defvar vc-annotate-backend nil)
1b5a7343
AS
4130(defvar vc-annotate-parent-file nil)
4131(defvar vc-annotate-parent-rev nil)
4132(defvar vc-annotate-parent-display-mode nil)
1b5a7343 4133
f66a6225
SM
4134(defconst vc-annotate-font-lock-keywords
4135 ;; The fontification is done by vc-annotate-lines instead of font-lock.
4136 '((vc-annotate-lines)))
4137
93113211 4138(define-derived-mode vc-annotate-mode fundamental-mode "Annotate"
6f1ecae4 4139 "Major mode for output buffers of the `vc-annotate' command.
7d2d9482
RS
4140
4141You can use the mode-specific menu to alter the time-span of the used
4142colors. See variable `vc-annotate-menu-elements' for customizing the
4143menu items."
5731a8e0
TTN
4144 ;; Frob buffer-invisibility-spec so that if it is originally a naked t,
4145 ;; it will become a list, to avoid initial annotations being invisible.
4146 (add-to-invisibility-spec 'foo)
4147 (remove-from-invisibility-spec 'foo)
f66a6225
SM
4148 (set (make-local-variable 'truncate-lines) t)
4149 (set (make-local-variable 'font-lock-defaults)
4150 '(vc-annotate-font-lock-keywords t))
04864eb0 4151 (view-mode 1))
7d2d9482 4152
5731a8e0
TTN
4153(defun vc-annotate-toggle-annotation-visibility ()
4154 "Toggle whether or not the annotation is visible."
4155 (interactive)
4156 (funcall (if (memq 'vc-annotate-annotation buffer-invisibility-spec)
4157 'remove-from-invisibility-spec
4158 'add-to-invisibility-spec)
4159 'vc-annotate-annotation)
4160 (force-window-update (current-buffer)))
4161
97461c84 4162(defun vc-annotate-display-default (ratio)
6f1ecae4 4163 "Display the output of \\[vc-annotate] using the default color range.
97461c84
SM
4164The color range is given by `vc-annotate-color-map', scaled by RATIO.
4165The current time is used as the offset."
4166 (interactive (progn (kill-local-variable 'vc-annotate-color-map) '(1.0)))
f80f7bc2 4167 (message "Redisplaying annotation...")
97461c84 4168 (vc-annotate-display ratio)
f80f7bc2 4169 (message "Redisplaying annotation...done"))
7d2d9482 4170
97461c84
SM
4171(defun vc-annotate-oldest-in-map (color-map)
4172 "Return the oldest time in the COLOR-MAP."
4173 ;; Since entries should be sorted, we can just use the last one.
4174 (caar (last color-map)))
6149bbfb 4175
5731a8e0
TTN
4176(defun vc-annotate-get-time-set-line-props ()
4177 (let ((bol (point))
4178 (date (vc-call-backend vc-annotate-backend 'annotate-time))
4179 (inhibit-read-only t))
f605fc58 4180 (assert (>= (point) bol))
5731a8e0
TTN
4181 (put-text-property bol (point) 'invisible 'vc-annotate-annotation)
4182 date))
4183
75665141 4184(defun vc-annotate-display-autoscale (&optional full)
946b248f 4185 "Highlight the output of \\[vc-annotate] using an autoscaled color map.
6f1ecae4 4186Autoscaling means that the map is scaled from the current time to the
f36e4afe 4187oldest annotation in the buffer, or, with prefix argument FULL, to
6f1ecae4 4188cover the range from the oldest annotation to the newest."
f36e4afe 4189 (interactive "P")
75665141
AS
4190 (let ((newest 0.0)
4191 (oldest 999999.) ;Any CVS users at the founding of Rome?
4192 (current (vc-annotate-convert-time (current-time)))
4193 date)
4194 (message "Redisplaying annotation...")
4195 ;; Run through this file and find the oldest and newest dates annotated.
4196 (save-excursion
4197 (goto-char (point-min))
7c33af85 4198 (while (not (eobp))
5731a8e0 4199 (when (setq date (vc-annotate-get-time-set-line-props))
b5446276
DN
4200 (when (> date newest)
4201 (setq newest date))
4202 (when (< date oldest)
4203 (setq oldest date)))
7c33af85 4204 (forward-line 1)))
75665141 4205 (vc-annotate-display
97461c84
SM
4206 (/ (- (if full newest current) oldest)
4207 (vc-annotate-oldest-in-map vc-annotate-color-map))
75665141 4208 (if full newest))
99cb8c8b
SS
4209 (message "Redisplaying annotation...done \(%s\)"
4210 (if full
4211 (format "Spanned from %.1f to %.1f days old"
75665141
AS
4212 (- current oldest)
4213 (- current newest))
4214 (format "Spanned to %.1f days old" (- current oldest))))))
4215
4216;; Menu -- Using easymenu.el
04864eb0
SM
4217(easy-menu-define vc-annotate-mode-menu vc-annotate-mode-map
4218 "VC Annotate Display Menu"
4219 `("VC-Annotate"
da7c8a12 4220 ["By Color Map Range" (unless (null vc-annotate-display-mode)
04864eb0
SM
4221 (setq vc-annotate-display-mode nil)
4222 (vc-annotate-display-select))
4223 :style toggle :selected (null vc-annotate-display-mode)]
97461c84 4224 ,@(let ((oldest-in-map (vc-annotate-oldest-in-map vc-annotate-color-map)))
04864eb0
SM
4225 (mapcar (lambda (element)
4226 (let ((days (* element oldest-in-map)))
07a95b81
SM
4227 `[,(format "Span %.1f days" days)
4228 (vc-annotate-display-select nil ,days)
4229 :style toggle :selected
4230 (eql vc-annotate-display-mode ,days) ]))
04864eb0
SM
4231 vc-annotate-menu-elements))
4232 ["Span ..."
07a95b81
SM
4233 (vc-annotate-display-select
4234 nil (float (string-to-number (read-string "Span how many days? "))))]
04864eb0
SM
4235 "--"
4236 ["Span to Oldest"
4237 (unless (eq vc-annotate-display-mode 'scale)
4238 (vc-annotate-display-select nil 'scale))
df04e22c 4239 :help
f3ff0fe9 4240 "Use an autoscaled color map from the oldest annotation to the current time"
04864eb0
SM
4241 :style toggle :selected
4242 (eq vc-annotate-display-mode 'scale)]
4243 ["Span Oldest->Newest"
4244 (unless (eq vc-annotate-display-mode 'fullscale)
4245 (vc-annotate-display-select nil 'fullscale))
df04e22c 4246 :help
f3ff0fe9 4247 "Use an autoscaled color map from the oldest to the newest annotation"
04864eb0
SM
4248 :style toggle :selected
4249 (eq vc-annotate-display-mode 'fullscale)]
4250 "--"
f3ff0fe9 4251 ["Toggle annotation visibility" vc-annotate-toggle-annotation-visibility
df04e22c 4252 :help
f3ff0fe9
DN
4253 "Toggle whether the annotation is visible or not"]
4254 ["Annotate previous revision" vc-annotate-prev-revision
4255 :help "Visit the annotation of the revision previous to this one"]
4256 ["Annotate next revision" vc-annotate-next-revision
4257 :help "Visit the annotation of the revision after this one"]
4258 ["Annotate revision at line" vc-annotate-revision-at-line
df04e22c 4259 :help
f3ff0fe9
DN
4260 "Visit the annotation of the revision identified in the current line"]
4261 ["Annotate revision previous to line" vc-annotate-revision-previous-to-line
4262 :help "Visit the annotation of the revision before the revision at line"]
4263 ["Annotate latest revision" vc-annotate-working-revision
4264 :help "Visit the annotation of the working revision of this file"]
4265 ["Show log of revision at line" vc-annotate-show-log-revision-at-line
4266 :help "Visit the log of the revision at line"]
4267 ["Show diff of revision at line" vc-annotate-show-diff-revision-at-line
df04e22c 4268 :help
f3ff0fe9
DN
4269 "Visit the diff of the revision at line from its previous revision"]
4270 ["Visit revision at line" vc-annotate-find-revision-at-line
4271 :help "Visit the revision identified in the current line"]))
75665141
AS
4272
4273(defun vc-annotate-display-select (&optional buffer mode)
6f1ecae4
AS
4274 "Highlight the output of \\[vc-annotate].
4275By default, the current buffer is highlighted, unless overridden by
4276BUFFER. `vc-annotate-display-mode' specifies the highlighting mode to
4277use; you may override this using the second optional arg MODE."
4278 (interactive)
b5446276 4279 (when mode (setq vc-annotate-display-mode mode))
8a8f8697 4280 (pop-to-buffer (or buffer (current-buffer)))
f66a6225 4281 (cond ((null vc-annotate-display-mode)
07a95b81
SM
4282 ;; The ratio is global, thus relative to the global color-map.
4283 (kill-local-variable 'vc-annotate-color-map)
97461c84
SM
4284 (vc-annotate-display-default (or vc-annotate-ratio 1.0)))
4285 ;; One of the auto-scaling modes
f66a6225 4286 ((eq vc-annotate-display-mode 'scale)
7c33af85 4287 (vc-exec-after `(vc-annotate-display-autoscale)))
f66a6225 4288 ((eq vc-annotate-display-mode 'fullscale)
7c33af85 4289 (vc-exec-after `(vc-annotate-display-autoscale t)))
75665141
AS
4290 ((numberp vc-annotate-display-mode) ; A fixed number of days lookback
4291 (vc-annotate-display-default
97461c84
SM
4292 (/ vc-annotate-display-mode
4293 (vc-annotate-oldest-in-map vc-annotate-color-map))))
f66a6225
SM
4294 (t (error "No such display mode: %s"
4295 vc-annotate-display-mode))))
0e362f54 4296
7d2d9482 4297;;;###autoload
bae9f9e3 4298(defun vc-annotate (file rev &optional display-mode buf move-point-to)
aa406465 4299 "Display the edit history of the current file using colors.
1cec418c
AS
4300
4301This command creates a buffer that shows, for each line of the current
aa406465 4302file, when it was last edited and by whom. Additionally, colors are
1cec418c 4303used to show the age of each line--blue means oldest, red means
aa406465 4304youngest, and intermediate colors indicate intermediate ages. By
1cec418c
AS
4305default, the time scale stretches back one year into the past;
4306everything that is older than that is shown in blue.
4307
4308With a prefix argument, this command asks two questions in the
ac3f4c6f
ER
4309minibuffer. First, you may enter a revision number; then the buffer
4310displays and annotates that revision instead of the working revision
eb407e67 4311\(type RET in the minibuffer to leave that default unchanged). Then,
ecd50f65
AS
4312you are prompted for the time span in days which the color range
4313should cover. For example, a time span of 20 days means that changes
4314over the past 20 days are shown in red to blue, according to their
4315age, and everything that is older than that is shown in blue.
1cec418c 4316
bae9f9e3
DN
4317If MOVE-POINT-TO is given, move the point to that line.
4318
1cec418c 4319Customization variables:
7d2d9482
RS
4320
4321`vc-annotate-menu-elements' customizes the menu elements of the
a7192ddb
SM
4322mode-specific menu. `vc-annotate-color-map' and
4323`vc-annotate-very-old-color' define the mapping of time to colors.
4324`vc-annotate-background' specifies the background color."
04864eb0
SM
4325 (interactive
4326 (save-current-buffer
4327 (vc-ensure-vc-buffer)
4328 (list buffer-file-name
ac3f4c6f 4329 (let ((def (vc-working-revision buffer-file-name)))
04864eb0
SM
4330 (if (null current-prefix-arg) def
4331 (read-string
ac3f4c6f 4332 (format "Annotate from revision (default %s): " def)
04864eb0
SM
4333 nil nil def)))
4334 (if (null current-prefix-arg)
4335 vc-annotate-display-mode
4336 (float (string-to-number
4337 (read-string "Annotate span days (default 20): "
4338 nil nil "20")))))))
b6909007 4339 (vc-ensure-vc-buffer)
04864eb0
SM
4340 (setq vc-annotate-display-mode display-mode) ;Not sure why. --Stef
4341 (let* ((temp-buffer-name (format "*Annotate %s (rev %s)*" (buffer-name) rev))
1867d8cb
TTN
4342 (temp-buffer-show-function 'vc-annotate-display-select)
4343 ;; If BUF is specified, we presume the caller maintains current line,
4344 ;; so we don't need to do it here. This implementation may give
4345 ;; strange results occasionally in the case of REV != WORKFILE-REV.
bae9f9e3 4346 (current-line (or move-point-to (unless buf (line-number-at-pos)))))
afe35502 4347 (message "Annotating...")
04864eb0
SM
4348 ;; If BUF is specified it tells in which buffer we should put the
4349 ;; annotations. This is used when switching annotations to another
4350 ;; revision, so we should update the buffer's name.
b5446276
DN
4351 (when buf (with-current-buffer buf
4352 (rename-buffer temp-buffer-name t)
4353 ;; In case it had to be uniquified.
4354 (setq temp-buffer-name (buffer-name))))
46e33aee 4355 (with-output-to-temp-buffer temp-buffer-name
da7c8a12
S
4356 (vc-call annotate-command file (get-buffer temp-buffer-name) rev)
4357 ;; we must setup the mode first, and then set our local
4358 ;; variables before the show-function is called at the exit of
4359 ;; with-output-to-temp-buffer
4360 (with-current-buffer temp-buffer-name
b5446276
DN
4361 (unless (equal major-mode 'vc-annotate-mode)
4362 (vc-annotate-mode))
da7c8a12
S
4363 (set (make-local-variable 'vc-annotate-backend) (vc-backend file))
4364 (set (make-local-variable 'vc-annotate-parent-file) file)
4365 (set (make-local-variable 'vc-annotate-parent-rev) rev)
4366 (set (make-local-variable 'vc-annotate-parent-display-mode)
4367 display-mode)))
cd42ec7d 4368
ebaac04d
SM
4369 (with-current-buffer temp-buffer-name
4370 (vc-exec-after
4371 `(progn
4372 ;; Ideally, we'd rather not move point if the user has already
4373 ;; moved it elsewhere, but really point here is not the position
4374 ;; of the user's cursor :-(
4375 (when ,current-line ;(and (bobp))
86e80023 4376 (goto-line ,current-line)
01823b77 4377 (setq vc-sentinel-movepoint (point)))
ebaac04d
SM
4378 (unless (active-minibuffer-window)
4379 (message "Annotating... done")))))))
7d2d9482 4380
ac3f4c6f
ER
4381(defun vc-annotate-prev-revision (prefix)
4382 "Visit the annotation of the revision previous to this one.
1b5a7343 4383
ac3f4c6f
ER
4384With a numeric prefix argument, annotate the revision that many
4385revisions previous."
1b5a7343 4386 (interactive "p")
ac3f4c6f 4387 (vc-annotate-warp-revision (- 0 prefix)))
1b5a7343 4388
ac3f4c6f
ER
4389(defun vc-annotate-next-revision (prefix)
4390 "Visit the annotation of the revision after this one.
1b5a7343 4391
ac3f4c6f
ER
4392With a numeric prefix argument, annotate the revision that many
4393revisions after."
1b5a7343 4394 (interactive "p")
ac3f4c6f 4395 (vc-annotate-warp-revision prefix))
1b5a7343 4396
ac3f4c6f
ER
4397(defun vc-annotate-working-revision ()
4398 "Visit the annotation of the working revision of this file."
1b5a7343
AS
4399 (interactive)
4400 (if (not (equal major-mode 'vc-annotate-mode))
4401 (message "Cannot be invoked outside of a vc annotate buffer")
ac3f4c6f 4402 (let ((warp-rev (vc-working-revision vc-annotate-parent-file)))
1b5a7343 4403 (if (equal warp-rev vc-annotate-parent-rev)
ac3f4c6f
ER
4404 (message "Already at revision %s" warp-rev)
4405 (vc-annotate-warp-revision warp-rev)))))
1b5a7343
AS
4406
4407(defun vc-annotate-extract-revision-at-line ()
4408 "Extract the revision number of the current line."
4409 ;; This function must be invoked from a buffer in vc-annotate-mode
1b5a7343
AS
4410 (vc-call-backend vc-annotate-backend 'annotate-extract-revision-at-line))
4411
4412(defun vc-annotate-revision-at-line ()
ac3f4c6f 4413 "Visit the annotation of the revision identified in the current line."
1b5a7343
AS
4414 (interactive)
4415 (if (not (equal major-mode 'vc-annotate-mode))
4416 (message "Cannot be invoked outside of a vc annotate buffer")
4417 (let ((rev-at-line (vc-annotate-extract-revision-at-line)))
4418 (if (not rev-at-line)
4419 (message "Cannot extract revision number from the current line")
4420 (if (equal rev-at-line vc-annotate-parent-rev)
ac3f4c6f
ER
4421 (message "Already at revision %s" rev-at-line)
4422 (vc-annotate-warp-revision rev-at-line))))))
1b5a7343 4423
f3ff0fe9
DN
4424(defun vc-annotate-find-revision-at-line ()
4425 "Visit the revision identified in the current line."
4426 (interactive)
4427 (if (not (equal major-mode 'vc-annotate-mode))
4428 (message "Cannot be invoked outside of a vc annotate buffer")
4429 (let ((rev-at-line (vc-annotate-extract-revision-at-line)))
4430 (if (not rev-at-line)
4431 (message "Cannot extract revision number from the current line")
4432 (vc-revision-other-window rev-at-line)))))
4433
1b5a7343 4434(defun vc-annotate-revision-previous-to-line ()
ac3f4c6f 4435 "Visit the annotation of the revision before the revision at line."
1b5a7343
AS
4436 (interactive)
4437 (if (not (equal major-mode 'vc-annotate-mode))
4438 (message "Cannot be invoked outside of a vc annotate buffer")
4439 (let ((rev-at-line (vc-annotate-extract-revision-at-line))
4440 (prev-rev nil))
4441 (if (not rev-at-line)
4442 (message "Cannot extract revision number from the current line")
4443 (setq prev-rev
ac3f4c6f
ER
4444 (vc-call previous-revision vc-annotate-parent-file rev-at-line))
4445 (vc-annotate-warp-revision prev-rev)))))
1b5a7343
AS
4446
4447(defun vc-annotate-show-log-revision-at-line ()
ac3f4c6f 4448 "Visit the log of the revision at line."
1b5a7343
AS
4449 (interactive)
4450 (if (not (equal major-mode 'vc-annotate-mode))
4451 (message "Cannot be invoked outside of a vc annotate buffer")
4452 (let ((rev-at-line (vc-annotate-extract-revision-at-line)))
4453 (if (not rev-at-line)
4454 (message "Cannot extract revision number from the current line")
4455 (vc-print-log rev-at-line)))))
4456
4457(defun vc-annotate-show-diff-revision-at-line ()
ac3f4c6f 4458 "Visit the diff of the revision at line from its previous revision."
1b5a7343
AS
4459 (interactive)
4460 (if (not (equal major-mode 'vc-annotate-mode))
4461 (message "Cannot be invoked outside of a vc annotate buffer")
4462 (let ((rev-at-line (vc-annotate-extract-revision-at-line))
4463 (prev-rev nil))
4464 (if (not rev-at-line)
4465 (message "Cannot extract revision number from the current line")
4466 (setq prev-rev
ac3f4c6f 4467 (vc-call previous-revision vc-annotate-parent-file rev-at-line))
1b5a7343 4468 (if (not prev-rev)
ac3f4c6f 4469 (message "Cannot diff from any revision prior to %s" rev-at-line)
1b5a7343 4470 (save-window-excursion
ae67f2d0
DN
4471 (vc-diff-internal
4472 nil
4473 (cons (vc-backend vc-annotate-parent-file)
4474 (list vc-annotate-parent-file))
4475 prev-rev rev-at-line))
1b5a7343
AS
4476 (switch-to-buffer "*vc-diff*"))))))
4477
ac3f4c6f
ER
4478(defun vc-annotate-warp-revision (revspec)
4479 "Annotate the revision described by REVSPEC.
1b5a7343 4480
ac3f4c6f 4481If REVSPEC is a positive integer, warp that many revisions
1b5a7343 4482forward, if possible, otherwise echo a warning message. If
ac3f4c6f 4483REVSPEC is a negative integer, warp that many revisions backward,
1b5a7343
AS
4484if possible, otherwise echo a warning message. If REVSPEC is a
4485string, then it describes a revision number, so warp to that
4486revision."
4487 (if (not (equal major-mode 'vc-annotate-mode))
4488 (message "Cannot be invoked outside of a vc annotate buffer")
da7c8a12
S
4489 (let* ((buf (current-buffer))
4490 (oldline (line-number-at-pos))
1b5a7343
AS
4491 (revspeccopy revspec)
4492 (newrev nil))
4493 (cond
4494 ((and (integerp revspec) (> revspec 0))
4495 (setq newrev vc-annotate-parent-rev)
4496 (while (and (> revspec 0) newrev)
ac3f4c6f 4497 (setq newrev (vc-call next-revision
1b5a7343
AS
4498 vc-annotate-parent-file newrev))
4499 (setq revspec (1- revspec)))
b5446276
DN
4500 (unless newrev
4501 (message "Cannot increment %d revisions from revision %s"
4502 revspeccopy vc-annotate-parent-rev)))
1b5a7343
AS
4503 ((and (integerp revspec) (< revspec 0))
4504 (setq newrev vc-annotate-parent-rev)
4505 (while (and (< revspec 0) newrev)
ac3f4c6f 4506 (setq newrev (vc-call previous-revision
1b5a7343
AS
4507 vc-annotate-parent-file newrev))
4508 (setq revspec (1+ revspec)))
b5446276
DN
4509 (unless newrev
4510 (message "Cannot decrement %d revisions from revision %s"
4511 (- 0 revspeccopy) vc-annotate-parent-rev)))
1b5a7343 4512 ((stringp revspec) (setq newrev revspec))
ac3f4c6f 4513 (t (error "Invalid argument to vc-annotate-warp-revision")))
1b5a7343 4514 (when newrev
04864eb0
SM
4515 (vc-annotate vc-annotate-parent-file newrev
4516 vc-annotate-parent-display-mode
bae9f9e3
DN
4517 buf
4518 ;; Pass the current line so that vc-annotate will
4519 ;; place the point in the line.
4520 (min oldline (progn (goto-char (point-max))
4521 (forward-line -1)
4522 (line-number-at-pos))))))))
1b5a7343 4523
f70419a8 4524(defun vc-annotate-compcar (threshold a-list)
6f1ecae4
AS
4525 "Test successive cons cells of A-LIST against THRESHOLD.
4526Return the first cons cell with a car that is not less than THRESHOLD,
4527nil if no such cell exists."
f70419a8
RS
4528 (let ((i 1)
4529 (tmp-cons (car a-list)))
4530 (while (and tmp-cons (< (car tmp-cons) threshold))
4531 (setq tmp-cons (car (nthcdr i a-list)))
4532 (setq i (+ i 1)))
4533 tmp-cons)) ; Return the appropriate value
4534
75665141 4535(defun vc-annotate-convert-time (time)
6f1ecae4
AS
4536 "Convert a time value to a floating-point number of days.
4537The argument TIME is a list as returned by `current-time' or
4538`encode-time', only the first two elements of that list are considered."
75665141
AS
4539 (/ (+ (* (float (car time)) (lsh 1 16)) (cadr time)) 24 3600))
4540
4541(defun vc-annotate-difference (&optional offset)
6f1ecae4
AS
4542 "Return the time span in days to the next annotation.
4543This calls the backend function annotate-time, and returns the
4544difference in days between the time returned and the current time,
4545or OFFSET if present."
5731a8e0 4546 (let ((next-time (vc-annotate-get-time-set-line-props)))
b5446276
DN
4547 (when next-time
4548 (- (or offset
4549 (vc-call-backend vc-annotate-backend 'annotate-current-time))
4550 next-time))))
75665141
AS
4551
4552(defun vc-default-annotate-current-time (backend)
4553 "Return the current time, encoded as fractional days."
4554 (vc-annotate-convert-time (current-time)))
99cb8c8b 4555
07577777
JPW
4556(defvar vc-annotate-offset nil)
4557
97461c84 4558(defun vc-annotate-display (ratio &optional offset)
6f1ecae4 4559 "Highlight `vc-annotate' output in the current buffer.
97461c84 4560RATIO, is the expansion that should be applied to `vc-annotate-color-map'.
bf142f28 4561The annotations are relative to the current time, unless overridden by OFFSET."
b5446276
DN
4562 (when (/= ratio 1.0)
4563 (set (make-local-variable 'vc-annotate-color-map)
4564 (mapcar (lambda (elem) (cons (* (car elem) ratio) (cdr elem)))
4565 vc-annotate-color-map)))
f66a6225
SM
4566 (set (make-local-variable 'vc-annotate-offset) offset)
4567 (font-lock-mode 1))
4568
f66a6225 4569(defun vc-annotate-lines (limit)
7c33af85
SM
4570 (while (< (point) limit)
4571 (let ((difference (vc-annotate-difference vc-annotate-offset))
4572 (start (point))
4573 (end (progn (forward-line 1) (point))))
4574 (when difference
4575 (let* ((color (or (vc-annotate-compcar difference vc-annotate-color-map)
4576 (cons nil vc-annotate-very-old-color)))
4577 ;; substring from index 1 to remove any leading `#' in the name
4578 (face-name (concat "vc-annotate-face-"
4579 (if (string-equal
4580 (substring (cdr color) 0 1) "#")
4581 (substring (cdr color) 1)
4582 (cdr color))))
4583 ;; Make the face if not done.
4584 (face (or (intern-soft face-name)
4585 (let ((tmp-face (make-face (intern face-name))))
4586 (set-face-foreground tmp-face (cdr color))
b5446276
DN
4587 (when vc-annotate-background
4588 (set-face-background tmp-face
4589 vc-annotate-background))
7c33af85
SM
4590 tmp-face)))) ; Return the face
4591 (put-text-property start end 'face face)))))
4592 ;; Pretend to font-lock there were no matches.
4593 nil)
7d2d9482 4594\f
594722a8
ER
4595
4596;; Set up key bindings for use while editing log messages
4597
d7b60083 4598(defun vc-log-edit (fileset)
928ef6d9 4599 "Set up `log-edit' for use with VC on FILE."
099bd78a 4600 (setq default-directory
d7b60083 4601 (with-current-buffer vc-parent-buffer default-directory))
93a142e1
DN
4602 (log-edit 'vc-finish-logentry
4603 nil
4604 `((log-edit-listfun . (lambda () ',fileset))
4605 (log-edit-diff-function . (lambda () (vc-diff nil)))))
d7b60083 4606 (set (make-local-variable 'vc-log-fileset) fileset)
ac3f4c6f 4607 (make-local-variable 'vc-log-revision)
099bd78a 4608 (set-buffer-modified-p nil)
0e362f54 4609 (setq buffer-file-name nil))
594722a8 4610
b1ddeeb7
ER
4611;; These things should probably be generally available
4612
4613(defun vc-file-tree-walk (dirname func &rest args)
4614 "Walk recursively through DIRNAME.
4615Invoke FUNC f ARGS on each VC-managed file f underneath it."
4616 (vc-file-tree-walk-internal (expand-file-name dirname) func args)
4617 (message "Traversing directory %s...done" dirname))
4618
4619(defun vc-file-tree-walk-internal (file func args)
4620 (if (not (file-directory-p file))
4621 (when (vc-backend file) (apply func file args))
4622 (message "Traversing directory %s..." (abbreviate-file-name file))
4623 (let ((dir (file-name-as-directory file)))
4624 (mapcar
4625 (lambda (f) (or
4626 (string-equal f ".")
4627 (string-equal f "..")
4628 (member f vc-directory-exclusion-list)
4629 (let ((dirf (expand-file-name f dir)))
4630 (or
4631 (file-symlink-p dirf) ;; Avoid possible loops.
4632 (vc-file-tree-walk-internal dirf func args)))))
4633 (directory-files dir)))))
4634
594722a8
ER
4635(provide 'vc)
4636
ec402ad4
SM
4637;; DEVELOPER'S NOTES ON CONCURRENCY PROBLEMS IN THIS CODE
4638;;
ec402ad4
SM
4639;; These may be useful to anyone who has to debug or extend the package.
4640;; (Note that this information corresponds to versions 5.x. Some of it
4641;; might have been invalidated by the additions to support branching
4642;; and RCS keyword lookup. AS, 1995/03/24)
4643;;
4644;; A fundamental problem in VC is that there are time windows between
4645;; vc-next-action's computations of the file's version-control state and
4646;; the actions that change it. This is a window open to lossage in a
4647;; multi-user environment; someone else could nip in and change the state
4648;; of the master during it.
4649;;
4650;; The performance problem is that rlog/prs calls are very expensive; we want
4651;; to avoid them as much as possible.
4652;;
4653;; ANALYSIS:
4654;;
4655;; The performance problem, it turns out, simplifies in practice to the
4656;; problem of making vc-state fast. The two other functions that call
4657;; prs/rlog will not be so commonly used that the slowdown is a problem; one
4658;; makes snapshots, the other deletes the calling user's last change in the
4659;; master.
4660;;
4661;; The race condition implies that we have to either (a) lock the master
4662;; during the entire execution of vc-next-action, or (b) detect and
4663;; recover from errors resulting from dispatch on an out-of-date state.
4664;;
4665;; Alternative (a) appears to be infeasible. The problem is that we can't
4666;; guarantee that the lock will ever be removed. Suppose a user starts a
4667;; checkin, the change message buffer pops up, and the user, having wandered
4668;; off to do something else, simply forgets about it?
4669;;
4670;; Alternative (b), on the other hand, works well with a cheap way to speed up
4671;; vc-state. Usually, if a file is registered, we can read its locked/
4672;; unlocked state and its current owner from its permissions.
4673;;
4674;; This shortcut will fail if someone has manually changed the workfile's
4675;; permissions; also if developers are munging the workfile in several
4676;; directories, with symlinks to a master (in this latter case, the
4677;; permissions shortcut will fail to detect a lock asserted from another
4678;; directory).
4679;;
4680;; Note that these cases correspond exactly to the errors which could happen
4681;; because of a competing checkin/checkout race in between two instances of
4682;; vc-next-action.
4683;;
4684;; For VC's purposes, a workfile/master pair may have the following states:
4685;;
4686;; A. Unregistered. There is a workfile, there is no master.
4687;;
4688;; B. Registered and not locked by anyone.
4689;;
4690;; C. Locked by calling user and unchanged.
4691;;
4692;; D. Locked by the calling user and changed.
4693;;
4694;; E. Locked by someone other than the calling user.
4695;;
4696;; This makes for 25 states and 20 error conditions. Here's the matrix:
4697;;
4698;; VC's idea of state
4699;; |
4700;; V Actual state RCS action SCCS action Effect
4701;; A B C D E
4702;; A . 1 2 3 4 ci -u -t- admin -fb -i<file> initial admin
4703;; B 5 . 6 7 8 co -l get -e checkout
4704;; C 9 10 . 11 12 co -u unget; get revert
4705;; D 13 14 15 . 16 ci -u -m<comment> delta -y<comment>; get checkin
4706;; E 17 18 19 20 . rcs -u -M -l unget -n ; get -g steal lock
4707;;
4708;; All commands take the master file name as a last argument (not shown).
4709;;
4710;; In the discussion below, a "self-race" is a pathological situation in
4711;; which VC operations are being attempted simultaneously by two or more
4712;; Emacsen running under the same username.
4713;;
4714;; The vc-next-action code has the following windows:
4715;;
4716;; Window P:
4717;; Between the check for existence of a master file and the call to
4718;; admin/checkin in vc-buffer-admin (apparent state A). This window may
4719;; never close if the initial-comment feature is on.
4720;;
4721;; Window Q:
4722;; Between the call to vc-workfile-unchanged-p in and the immediately
4723;; following revert (apparent state C).
4724;;
4725;; Window R:
4726;; Between the call to vc-workfile-unchanged-p in and the following
4727;; checkin (apparent state D). This window may never close.
4728;;
4729;; Window S:
4730;; Between the unlock and the immediately following checkout during a
4731;; revert operation (apparent state C). Included in window Q.
4732;;
4733;; Window T:
4734;; Between vc-state and the following checkout (apparent state B).
4735;;
4736;; Window U:
4737;; Between vc-state and the following revert (apparent state C).
4738;; Includes windows Q and S.
4739;;
4740;; Window V:
4741;; Between vc-state and the following checkin (apparent state
4742;; D). This window may never be closed if the user fails to complete the
4743;; checkin message. Includes window R.
4744;;
4745;; Window W:
4746;; Between vc-state and the following steal-lock (apparent
4747;; state E). This window may never close if the user fails to complete
4748;; the steal-lock message. Includes window X.
4749;;
4750;; Window X:
4751;; Between the unlock and the immediately following re-lock during a
4752;; steal-lock operation (apparent state E). This window may never close
4753;; if the user fails to complete the steal-lock message.
4754;;
4755;; Errors:
4756;;
4757;; Apparent state A ---
4758;;
4759;; 1. File looked unregistered but is actually registered and not locked.
4760;;
4761;; Potential cause: someone else's admin during window P, with
4762;; caller's admin happening before their checkout.
4763;;
4764;; RCS: Prior to version 5.6.4, ci fails with message
4765;; "no lock set by <user>". From 5.6.4 onwards, VC uses the new
4766;; ci -i option and the message is "<file>,v: already exists".
4767;; SCCS: admin will fail with error (ad19).
4768;;
4769;; We can let these errors be passed up to the user.
4770;;
4771;; 2. File looked unregistered but is actually locked by caller, unchanged.
4772;;
4773;; Potential cause: self-race during window P.
4774;;
4775;; RCS: Prior to version 5.6.4, reverts the file to the last saved
4776;; version and unlocks it. From 5.6.4 onwards, VC uses the new
4777;; ci -i option, failing with message "<file>,v: already exists".
4778;; SCCS: will fail with error (ad19).
4779;;
4780;; Either of these consequences is acceptable.
4781;;
4782;; 3. File looked unregistered but is actually locked by caller, changed.
4783;;
4784;; Potential cause: self-race during window P.
4785;;
4786;; RCS: Prior to version 5.6.4, VC registers the caller's workfile as
4787;; a delta with a null change comment (the -t- switch will be
4788;; ignored). From 5.6.4 onwards, VC uses the new ci -i option,
4789;; failing with message "<file>,v: already exists".
4790;; SCCS: will fail with error (ad19).
4791;;
4792;; 4. File looked unregistered but is locked by someone else.
0e362f54 4793;;;
ec402ad4
SM
4794;; Potential cause: someone else's admin during window P, with
4795;; caller's admin happening *after* their checkout.
4796;;
4797;; RCS: Prior to version 5.6.4, ci fails with a
4798;; "no lock set by <user>" message. From 5.6.4 onwards,
4799;; VC uses the new ci -i option, failing with message
4800;; "<file>,v: already exists".
4801;; SCCS: will fail with error (ad19).
4802;;
4803;; We can let these errors be passed up to the user.
4804;;
4805;; Apparent state B ---
4806;;
4807;; 5. File looked registered and not locked, but is actually unregistered.
4808;;
4809;; Potential cause: master file got nuked during window P.
4810;;
4811;; RCS: will fail with "RCS/<file>: No such file or directory"
4812;; SCCS: will fail with error ut4.
4813;;
4814;; We can let these errors be passed up to the user.
4815;;
4816;; 6. File looked registered and not locked, but is actually locked by the
4817;; calling user and unchanged.
4818;;
4819;; Potential cause: self-race during window T.
4820;;
4821;; RCS: in the same directory as the previous workfile, co -l will fail
4822;; with "co error: writable foo exists; checkout aborted". In any other
4823;; directory, checkout will succeed.
4824;; SCCS: will fail with ge17.
4825;;
4826;; Either of these consequences is acceptable.
4827;;
4828;; 7. File looked registered and not locked, but is actually locked by the
4829;; calling user and changed.
4830;;
4831;; As case 6.
4832;;
4833;; 8. File looked registered and not locked, but is actually locked by another
4834;; user.
4835;;
4836;; Potential cause: someone else checks it out during window T.
4837;;
4838;; RCS: co error: revision 1.3 already locked by <user>
4839;; SCCS: fails with ge4 (in directory) or ut7 (outside it).
4840;;
4841;; We can let these errors be passed up to the user.
4842;;
4843;; Apparent state C ---
4844;;
4845;; 9. File looks locked by calling user and unchanged, but is unregistered.
4846;;
4847;; As case 5.
4848;;
4849;; 10. File looks locked by calling user and unchanged, but is actually not
4850;; locked.
4851;;
4852;; Potential cause: a self-race in window U, or by the revert's
4853;; landing during window X of some other user's steal-lock or window S
4854;; of another user's revert.
4855;;
4856;; RCS: succeeds, refreshing the file from the identical version in
4857;; the master.
4858;; SCCS: fails with error ut4 (p file nonexistent).
4859;;
4860;; Either of these consequences is acceptable.
4861;;
4862;; 11. File is locked by calling user. It looks unchanged, but is actually
4863;; changed.
4864;;
4865;; Potential cause: the file would have to be touched by a self-race
4866;; during window Q.
4867;;
4868;; The revert will succeed, removing whatever changes came with
4869;; the touch. It is theoretically possible that work could be lost.
4870;;
4871;; 12. File looks like it's locked by the calling user and unchanged, but
4872;; it's actually locked by someone else.
4873;;
4874;; Potential cause: a steal-lock in window V.
4875;;
4876;; RCS: co error: revision <rev> locked by <user>; use co -r or rcs -u
4877;; SCCS: fails with error un2
4878;;
4879;; We can pass these errors up to the user.
4880;;
4881;; Apparent state D ---
4882;;
4883;; 13. File looks like it's locked by the calling user and changed, but it's
4884;; actually unregistered.
4885;;
4886;; Potential cause: master file got nuked during window P.
4887;;
4888;; RCS: Prior to version 5.6.4, checks in the user's version as an
4889;; initial delta. From 5.6.4 onwards, VC uses the new ci -j
4890;; option, failing with message "no such file or directory".
4891;; SCCS: will fail with error ut4.
4892;;
4893;; This case is kind of nasty. Under RCS prior to version 5.6.4,
4894;; VC may fail to detect the loss of previous version information.
4895;;
4896;; 14. File looks like it's locked by the calling user and changed, but it's
4897;; actually unlocked.
4898;;
4899;; Potential cause: self-race in window V, or the checkin happening
4900;; during the window X of someone else's steal-lock or window S of
4901;; someone else's revert.
4902;;
4903;; RCS: ci will fail with "no lock set by <user>".
4904;; SCCS: delta will fail with error ut4.
4905;;
4906;; 15. File looks like it's locked by the calling user and changed, but it's
4907;; actually locked by the calling user and unchanged.
4908;;
4909;; Potential cause: another self-race --- a whole checkin/checkout
4910;; sequence by the calling user would have to land in window R.
4911;;
4912;; SCCS: checks in a redundant delta and leaves the file unlocked as usual.
4913;; RCS: reverts to the file state as of the second user's checkin, leaving
4914;; the file unlocked.
4915;;
4916;; It is theoretically possible that work could be lost under RCS.
4917;;
4918;; 16. File looks like it's locked by the calling user and changed, but it's
4919;; actually locked by a different user.
4920;;
4921;; RCS: ci error: no lock set by <user>
4922;; SCCS: unget will fail with error un2
4923;;
4924;; We can pass these errors up to the user.
4925;;
4926;; Apparent state E ---
4927;;
4928;; 17. File looks like it's locked by some other user, but it's actually
4929;; unregistered.
4930;;
4931;; As case 13.
4932;;
4933;; 18. File looks like it's locked by some other user, but it's actually
4934;; unlocked.
4935;;
4936;; Potential cause: someone released a lock during window W.
4937;;
4938;; RCS: The calling user will get the lock on the file.
4939;; SCCS: unget -n will fail with cm4.
4940;;
4941;; Either of these consequences will be OK.
4942;;
4943;; 19. File looks like it's locked by some other user, but it's actually
4944;; locked by the calling user and unchanged.
4945;;
4946;; Potential cause: the other user relinquishing a lock followed by
4947;; a self-race, both in window W.
4948;;
4949;; Under both RCS and SCCS, both unlock and lock will succeed, making
4950;; the sequence a no-op.
4951;;
4952;; 20. File looks like it's locked by some other user, but it's actually
4953;; locked by the calling user and changed.
4954;;
4955;; As case 19.
4956;;
4957;; PROBLEM CASES:
4958;;
4959;; In order of decreasing severity:
4960;;
4961;; Cases 11 and 15 are the only ones that potentially lose work.
4962;; They would require a self-race for this to happen.
4963;;
4964;; Case 13 in RCS loses information about previous deltas, retaining
4965;; only the information in the current workfile. This can only happen
4966;; if the master file gets nuked in window P.
4967;;
4968;; Case 3 in RCS and case 15 under SCCS insert a redundant delta with
4969;; no change comment in the master. This would require a self-race in
4970;; window P or R respectively.
4971;;
4972;; Cases 2, 10, 19 and 20 do extra work, but make no changes.
4973;;
4974;; Unfortunately, it appears to me that no recovery is possible in these
4975;; cases. They don't yield error messages, so there's no way to tell that
4976;; a race condition has occurred.
4977;;
4978;; All other cases don't change either the workfile or the master, and
4979;; trigger command errors which the user will see.
4980;;
4981;; Thus, there is no explicit recovery code.
594722a8 4982
0452b6e7 4983;; arch-tag: ca82c1de-3091-4e26-af92-460abc6213a6
594722a8 4984;;; vc.el ends here