Line data Source code
1 : ;;; vc.el --- drive a version-control system from within Emacs -*- lexical-binding:t -*-
2 :
3 : ;; Copyright (C) 1992-1998, 2000-2017 Free Software Foundation, Inc.
4 :
5 : ;; Author: FSF (see below for full credits)
6 : ;; Maintainer: emacs-devel@gnu.org
7 : ;; Keywords: vc tools
8 :
9 : ;; This file is part of GNU Emacs.
10 :
11 : ;; GNU Emacs is free software: you can redistribute it and/or modify
12 : ;; it under the terms of the GNU General Public License as published by
13 : ;; the Free Software Foundation, either version 3 of the License, or
14 : ;; (at your option) any later version.
15 :
16 : ;; GNU Emacs is distributed in the hope that it will be useful,
17 : ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18 : ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19 : ;; GNU General Public License for more details.
20 :
21 : ;; You should have received a copy of the GNU General Public License
22 : ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
23 :
24 : ;;; Credits:
25 :
26 : ;; VC was initially designed and implemented by Eric S. Raymond
27 : ;; <esr@thyrsus.com> in 1992. Over the years, many other people have
28 : ;; contributed substantial amounts of work to VC. These include:
29 : ;;
30 : ;; Per Cederqvist <ceder@lysator.liu.se>
31 : ;; Paul Eggert <eggert@twinsun.com>
32 : ;; Sebastian Kremer <sk@thp.uni-koeln.de>
33 : ;; Martin Lorentzson <martinl@gnu.org>
34 : ;; Dave Love <fx@gnu.org>
35 : ;; Stefan Monnier <monnier@cs.yale.edu>
36 : ;; Thien-Thi Nguyen <ttn@gnu.org>
37 : ;; Dan Nicolaescu <dann@ics.uci.edu>
38 : ;; J.D. Smith <jdsmith@alum.mit.edu>
39 : ;; Andre Spiegel <spiegel@gnu.org>
40 : ;; Richard Stallman <rms@gnu.org>
41 : ;;
42 : ;; In July 2007 ESR returned and redesigned the mode to cope better
43 : ;; with modern version-control systems that do commits by fileset
44 : ;; rather than per individual file.
45 : ;;
46 : ;; If you maintain a client of the mode or customize it in your .emacs,
47 : ;; note that some backend functions which formerly took single file arguments
48 : ;; now take a list of files. These include: register, checkin, print-log,
49 : ;; and diff.
50 :
51 : ;;; Commentary:
52 :
53 : ;; This mode is fully documented in the Emacs user's manual.
54 : ;;
55 : ;; Supported version-control systems presently include CVS, RCS, SRC,
56 : ;; GNU Subversion, Bzr, Git, Mercurial, Monotone and SCCS (or its free
57 : ;; replacement, CSSC).
58 : ;;
59 : ;; If your site uses the ChangeLog convention supported by Emacs, the
60 : ;; function `log-edit-comment-to-change-log' could prove a useful checkin hook,
61 : ;; although you might prefer to use C-c C-a (i.e. `log-edit-insert-changelog')
62 : ;; from the commit buffer instead or to set `log-edit-setup-invert'.
63 : ;;
64 : ;; When using SCCS, RCS, CVS: be careful not to do repo surgery, or
65 : ;; operations like registrations and deletions and renames, outside VC
66 : ;; while VC is running. The support for these systems was designed
67 : ;; when disks were much slower, and the code maintains a lot of
68 : ;; internal state in order to reduce expensive operations to a
69 : ;; minimum. Thus, if you mess with the repo while VC's back is turned,
70 : ;; VC may get seriously confused.
71 : ;;
72 : ;; When using Subversion or a later system, anything you do outside VC
73 : ;; *through the VCS tools* should safely interlock with VC
74 : ;; operations. Under these VC does little state caching, because local
75 : ;; operations are assumed to be fast.
76 : ;;
77 : ;; The 'assumed to be fast' category includes SRC, even though it's
78 : ;; a wrapper around RCS.
79 : ;;
80 : ;; ADDING SUPPORT FOR OTHER BACKENDS
81 : ;;
82 : ;; VC can use arbitrary version control systems as a backend. To add
83 : ;; support for a new backend named SYS, write a library vc-sys.el that
84 : ;; contains functions of the form `vc-sys-...' (note that SYS is in lower
85 : ;; case for the function and library names). VC will use that library if
86 : ;; you put the symbol SYS somewhere into the list of
87 : ;; `vc-handled-backends'. Then, for example, if `vc-sys-registered'
88 : ;; returns non-nil for a file, all SYS-specific versions of VC commands
89 : ;; will be available for that file.
90 : ;;
91 : ;; VC keeps some per-file information in the form of properties (see
92 : ;; vc-file-set/getprop in vc-hooks.el). The backend-specific functions
93 : ;; do not generally need to be aware of these properties. For example,
94 : ;; `vc-sys-working-revision' should compute the working revision and
95 : ;; return it; it should not look it up in the property, and it needn't
96 : ;; store it there either. However, if a backend-specific function does
97 : ;; store a value in a property, that value takes precedence over any
98 : ;; value that the generic code might want to set (check for uses of
99 : ;; the macro `with-vc-properties' in vc.el).
100 : ;;
101 : ;; In the list of functions below, each identifier needs to be prepended
102 : ;; with `vc-sys-'. Some of the functions are mandatory (marked with a
103 : ;; `*'), others are optional (`-').
104 :
105 : ;; BACKEND PROPERTIES
106 : ;;
107 : ;; * revision-granularity
108 : ;;
109 : ;; Takes no arguments. Returns either 'file or 'repository. Backends
110 : ;; that return 'file have per-file revision numbering; backends
111 : ;; that return 'repository have per-repository revision numbering,
112 : ;; so a revision level implicitly identifies a changeset
113 :
114 : ;; STATE-QUERYING FUNCTIONS
115 : ;;
116 : ;; * registered (file)
117 : ;;
118 : ;; Return non-nil if FILE is registered in this backend. Both this
119 : ;; function as well as `state' should be careful to fail gracefully
120 : ;; in the event that the backend executable is absent. It is
121 : ;; preferable that this function's *body* is autoloaded, that way only
122 : ;; calling vc-registered does not cause the backend to be loaded
123 : ;; (all the vc-FOO-registered functions are called to try to find
124 : ;; the controlling backend for FILE).
125 : ;;
126 : ;; * state (file)
127 : ;;
128 : ;; Return the current version control state of FILE. For a list of
129 : ;; possible values, see `vc-state'. This function should do a full and
130 : ;; reliable state computation; it is usually called immediately after
131 : ;; C-x v v.
132 : ;;
133 : ;; - dir-status-files (dir files update-function)
134 : ;;
135 : ;; Produce RESULT: a list of lists of the form (FILE VC-STATE EXTRA)
136 : ;; for FILES in DIR. If FILES is nil, report on all files in DIR.
137 : ;; (It is OK, though possibly inefficient, to ignore the FILES argument
138 : ;; and always report on all files in DIR.)
139 : ;;
140 : ;; If FILES is non-nil, this function should report on all requested
141 : ;; files, including up-to-date or ignored files.
142 : ;;
143 : ;; EXTRA can be used for backend specific information about FILE.
144 : ;; If a command needs to be run to compute this list, it should be
145 : ;; run asynchronously using (current-buffer) as the buffer for the
146 : ;; command.
147 : ;;
148 : ;; When RESULT is computed, it should be passed back by doing:
149 : ;; (funcall UPDATE-FUNCTION RESULT nil). If the backend uses a
150 : ;; process filter, hence it produces partial results, they can be
151 : ;; passed back by doing: (funcall UPDATE-FUNCTION RESULT t) and then
152 : ;; do a (funcall UPDATE-FUNCTION RESULT nil) when all the results
153 : ;; have been computed.
154 : ;;
155 : ;; To provide more backend specific functionality for `vc-dir'
156 : ;; the following functions might be needed: `dir-extra-headers',
157 : ;; `dir-printer', and `extra-dir-menu'.
158 : ;;
159 : ;; - dir-extra-headers (dir)
160 : ;;
161 : ;; Return a string that will be added to the *vc-dir* buffer header.
162 : ;;
163 : ;; - dir-printer (fileinfo)
164 : ;;
165 : ;; Pretty print the `vc-dir-fileinfo' FILEINFO.
166 : ;; If a backend needs to show more information than the default FILE
167 : ;; and STATE in the vc-dir listing, it can store that extra
168 : ;; information in `vc-dir-fileinfo->extra'. This function can be
169 : ;; used to display that extra information in the *vc-dir* buffer.
170 : ;;
171 : ;; - status-fileinfo-extra (file)
172 : ;;
173 : ;; Compute `vc-dir-fileinfo->extra' for FILE.
174 : ;;
175 : ;; * working-revision (file)
176 : ;;
177 : ;; Return the working revision of FILE. This is the revision fetched
178 : ;; by the last checkout or update, not necessarily the same thing as the
179 : ;; head or tip revision. Should return "0" for a file added but not yet
180 : ;; committed.
181 : ;;
182 : ;; * checkout-model (files)
183 : ;;
184 : ;; Indicate whether FILES need to be "checked out" before they can be
185 : ;; edited. See `vc-checkout-model' for a list of possible values.
186 : ;;
187 : ;; - mode-line-string (file)
188 : ;;
189 : ;; If provided, this function should return the VC-specific mode
190 : ;; line string for FILE. The returned string should have a
191 : ;; `help-echo' property which is the text to be displayed as a
192 : ;; tooltip when the mouse hovers over the VC entry on the mode-line.
193 : ;; The default implementation deals well with all states that
194 : ;; `vc-state' can return.
195 : ;;
196 : ;; STATE-CHANGING FUNCTIONS
197 : ;;
198 : ;; * create-repo (backend)
199 : ;;
200 : ;; Create an empty repository in the current directory and initialize
201 : ;; it so VC mode can add files to it. For file-oriented systems, this
202 : ;; need do no more than create a subdirectory with the right name.
203 : ;;
204 : ;; * register (files &optional comment)
205 : ;;
206 : ;; Register FILES in this backend. Optionally, an initial
207 : ;; description of the file, COMMENT, may be specified, but it is not
208 : ;; guaranteed that the backend will do anything with this. The
209 : ;; implementation should pass the value of vc-register-switches to
210 : ;; the backend command. (Note: in older versions of VC, this
211 : ;; command had an optional revision first argument that was
212 : ;; not used; in still older ones it took a single file argument and
213 : ;; not a list.)
214 : ;;
215 : ;; - responsible-p (file)
216 : ;;
217 : ;; Return non-nil if this backend considers itself "responsible" for
218 : ;; FILE, which can also be a directory. This function is used to find
219 : ;; out what backend to use for registration of new files and for things
220 : ;; like change log generation. The default implementation always
221 : ;; returns nil.
222 : ;;
223 : ;; - receive-file (file rev)
224 : ;;
225 : ;; Let this backend "receive" a file that is already registered under
226 : ;; another backend. The default implementation simply calls `register'
227 : ;; for FILE, but it can be overridden to do something more specific,
228 : ;; e.g. keep revision numbers consistent or choose editing modes for
229 : ;; FILE that resemble those of the other backend.
230 : ;;
231 : ;; - unregister (file)
232 : ;;
233 : ;; Unregister FILE from this backend. This is only needed if this
234 : ;; backend may be used as a "more local" backend for temporary editing.
235 : ;;
236 : ;; * checkin (files comment &optional rev)
237 : ;;
238 : ;; Commit changes in FILES to this backend. COMMENT is used as a
239 : ;; check-in comment. The implementation should pass the value of
240 : ;; vc-checkin-switches to the backend command. The optional REV
241 : ;; revision argument is only supported with some older VCSes, like
242 : ;; RCS and CVS, and is otherwise silently ignored.
243 : ;;
244 : ;; * find-revision (file rev buffer)
245 : ;;
246 : ;; Fetch revision REV of file FILE and put it into BUFFER.
247 : ;; If REV is the empty string, fetch the head of the trunk.
248 : ;; The implementation should pass the value of vc-checkout-switches
249 : ;; to the backend command.
250 : ;;
251 : ;; * checkout (file &optional rev)
252 : ;;
253 : ;; Check out revision REV of FILE into the working area. FILE
254 : ;; should be writable by the user and if locking is used for FILE, a
255 : ;; lock should also be set. If REV is non-nil, that is the revision
256 : ;; to check out (default is the working revision). If REV is t,
257 : ;; that means to check out the head of the current branch; if it is
258 : ;; the empty string, check out the head of the trunk. The
259 : ;; implementation should pass the value of vc-checkout-switches to
260 : ;; the backend command. The 'editable' argument of older VC versions
261 : ;; is gone; all files are checked out editable.
262 : ;;
263 : ;; * revert (file &optional contents-done)
264 : ;;
265 : ;; Revert FILE back to the working revision. If optional
266 : ;; arg CONTENTS-DONE is non-nil, then the contents of FILE have
267 : ;; already been reverted from a version backup, and this function
268 : ;; only needs to update the status of FILE within the backend.
269 : ;; If FILE is in the `added' state it should be returned to the
270 : ;; `unregistered' state.
271 : ;;
272 : ;; - merge-file (file rev1 rev2)
273 : ;;
274 : ;; Merge the changes between REV1 and REV2 into the current working
275 : ;; file (for non-distributed VCS). It is expected that with an
276 : ;; empty first revision this will behave like the merge-news method.
277 : ;;
278 : ;; - merge-branch ()
279 : ;;
280 : ;; Merge another branch into the current one, prompting for a
281 : ;; location to merge from.
282 : ;;
283 : ;; - merge-news (file)
284 : ;;
285 : ;; Merge recent changes from the current branch into FILE.
286 : ;; (for non-distributed VCS).
287 : ;;
288 : ;; - pull (prompt)
289 : ;;
290 : ;; Pull "upstream" changes into the current branch (for distributed
291 : ;; VCS). If PROMPT is non-nil, or if necessary, prompt for a
292 : ;; location to pull from.
293 : ;;
294 : ;; - steal-lock (file &optional revision)
295 : ;;
296 : ;; Steal any lock on the working revision of FILE, or on REVISION if
297 : ;; that is provided. This function is only needed if locking is
298 : ;; used for files under this backend, and if files can indeed be
299 : ;; locked by other users.
300 : ;;
301 : ;; - modify-change-comment (files rev comment)
302 : ;;
303 : ;; Modify the change comments associated with the files at the
304 : ;; given revision. This is optional, many backends do not support it.
305 : ;;
306 : ;; - mark-resolved (files)
307 : ;;
308 : ;; Mark conflicts as resolved. Some VC systems need to run a
309 : ;; command to mark conflicts as resolved.
310 : ;;
311 : ;; - find-admin-dir (file)
312 : ;;
313 : ;; Return the administrative directory of FILE.
314 :
315 : ;; HISTORY FUNCTIONS
316 : ;;
317 : ;; * print-log (files buffer &optional shortlog start-revision limit)
318 : ;;
319 : ;; Insert the revision log for FILES into BUFFER.
320 : ;; If SHORTLOG is true insert a short version of the log.
321 : ;; If LIMIT is true insert only insert LIMIT log entries. If the
322 : ;; backend does not support limiting the number of entries to show
323 : ;; it should return `limit-unsupported'.
324 : ;; If START-REVISION is given, then show the log starting from that
325 : ;; revision ("starting" in the sense of it being the _newest_
326 : ;; revision shown, rather than the working revision, which is normally
327 : ;; the case). Not all backends support this. At present, this is
328 : ;; only ever used with LIMIT = 1 (by vc-annotate-show-log-revision-at-line).
329 : ;;
330 : ;; * log-outgoing (backend remote-location)
331 : ;;
332 : ;; Insert in BUFFER the revision log for the changes that will be
333 : ;; sent when performing a push operation to REMOTE-LOCATION.
334 : ;;
335 : ;; * log-incoming (backend remote-location)
336 : ;;
337 : ;; Insert in BUFFER the revision log for the changes that will be
338 : ;; received when performing a pull operation from REMOTE-LOCATION.
339 : ;;
340 : ;; - log-view-mode ()
341 : ;;
342 : ;; Mode to use for the output of print-log. This defaults to
343 : ;; `log-view-mode' and is expected to be changed (if at all) to a derived
344 : ;; mode of `log-view-mode'.
345 : ;;
346 : ;; - show-log-entry (revision)
347 : ;;
348 : ;; If provided, search the log entry for REVISION in the current buffer,
349 : ;; and make sure it is displayed in the buffer's window. The default
350 : ;; implementation of this function works for RCS-style logs.
351 : ;;
352 : ;; - comment-history (file)
353 : ;;
354 : ;; Return a string containing all log entries that were made for FILE.
355 : ;; This is used for transferring a file from one backend to another,
356 : ;; retaining comment information.
357 : ;;
358 : ;; - update-changelog (files)
359 : ;;
360 : ;; Using recent log entries, create ChangeLog entries for FILES, or for
361 : ;; all files at or below the default-directory if FILES is nil. The
362 : ;; default implementation runs rcs2log, which handles RCS- and
363 : ;; CVS-style logs.
364 : ;;
365 : ;; * diff (files &optional rev1 rev2 buffer async)
366 : ;;
367 : ;; Insert the diff for FILE into BUFFER, or the *vc-diff* buffer if
368 : ;; BUFFER is nil. If ASYNC is non-nil, run asynchronously. If REV1
369 : ;; and REV2 are non-nil, report differences from REV1 to REV2. If
370 : ;; REV1 is nil, use the working revision (as found in the
371 : ;; repository) as the older revision if REV2 is nil as well;
372 : ;; otherwise, diff against an empty tree. If REV2 is nil, use the
373 : ;; current working-copy contents as the newer revision. This
374 : ;; function should pass the value of (vc-switches BACKEND 'diff) to
375 : ;; the backend command. It should return a status of either 0 (no
376 : ;; differences found), or 1 (either non-empty diff or the diff is
377 : ;; run asynchronously).
378 : ;;
379 : ;; - revision-completion-table (files)
380 : ;;
381 : ;; Return a completion table for existing revisions of FILES.
382 : ;; The default is to not use any completion table.
383 : ;;
384 : ;; - annotate-command (file buf &optional rev)
385 : ;;
386 : ;; If this function is provided, it should produce an annotated display
387 : ;; of FILE in BUF, relative to revision REV. Annotation means each line
388 : ;; of FILE displayed is prefixed with version information associated with
389 : ;; its addition (deleted lines leave no history) and that the text of the
390 : ;; file is fontified according to age.
391 : ;;
392 : ;; - annotate-time ()
393 : ;;
394 : ;; Only required if `annotate-command' is defined for the backend.
395 : ;; Return the time of the next line of annotation at or after point,
396 : ;; as a floating point fractional number of days. The helper
397 : ;; function `vc-annotate-convert-time' may be useful for converting
398 : ;; multi-part times as returned by `current-time' and `encode-time'
399 : ;; to this format. Return nil if no more lines of annotation appear
400 : ;; in the buffer. You can safely assume that point is placed at the
401 : ;; beginning of each line, starting at `point-min'. The buffer that
402 : ;; point is placed in is the Annotate output, as defined by the
403 : ;; relevant backend. This function also affects how much of the line
404 : ;; is fontified; where it leaves point is where fontification begins.
405 : ;;
406 : ;; - annotate-current-time ()
407 : ;;
408 : ;; Only required if `annotate-command' is defined for the backend,
409 : ;; AND you'd like the current time considered to be anything besides
410 : ;; (vc-annotate-convert-time (current-time)) -- i.e. the current
411 : ;; time with hours, minutes, and seconds included. Probably safe to
412 : ;; ignore. Return the current-time, in units of fractional days.
413 : ;;
414 : ;; - annotate-extract-revision-at-line ()
415 : ;;
416 : ;; Only required if `annotate-command' is defined for the backend.
417 : ;; Invoked from a buffer in vc-annotate-mode, return the revision
418 : ;; corresponding to the current line, or nil if there is no revision
419 : ;; corresponding to the current line.
420 : ;; If the backend supports annotating through copies and renames,
421 : ;; and displays a file name and a revision, then return a cons
422 : ;; (REVISION . FILENAME).
423 : ;;
424 : ;; - region-history (FILE BUFFER LFROM LTO)
425 : ;;
426 : ;; Insert into BUFFER the history (log comments and diffs) of the content of
427 : ;; FILE between lines LFROM and LTO. This is typically done asynchronously.
428 : ;;
429 : ;; - region-history-mode ()
430 : ;;
431 : ;; Major mode to use for the output of `region-history'.
432 :
433 : ;; TAG SYSTEM
434 : ;;
435 : ;; - create-tag (dir name branchp)
436 : ;;
437 : ;; Attach the tag NAME to the state of the working copy. This
438 : ;; should make sure that files are up-to-date before proceeding with
439 : ;; the action. DIR can also be a file and if BRANCHP is specified,
440 : ;; NAME should be created as a branch and DIR should be checked out
441 : ;; under this new branch. The default implementation does not
442 : ;; support branches but does a sanity check, a tree traversal and
443 : ;; assigns the tag to each file.
444 : ;;
445 : ;; - retrieve-tag (dir name update)
446 : ;;
447 : ;; Retrieve the version tagged by NAME of all registered files at or below DIR.
448 : ;; If UPDATE is non-nil, then update buffers of any files in the
449 : ;; tag that are currently visited. The default implementation
450 : ;; does a sanity check whether there aren't any uncommitted changes at
451 : ;; or below DIR, and then performs a tree walk, using the `checkout'
452 : ;; function to retrieve the corresponding revisions.
453 :
454 : ;; MISCELLANEOUS
455 : ;;
456 : ;; - make-version-backups-p (file)
457 : ;;
458 : ;; Return non-nil if unmodified repository revisions of FILE should be
459 : ;; backed up locally. If this is done, VC can perform `diff' and
460 : ;; `revert' operations itself, without calling the backend system. The
461 : ;; default implementation always returns nil.
462 : ;;
463 : ;; - root (file)
464 : ;;
465 : ;; Return the root of the VC controlled hierarchy for file.
466 : ;;
467 : ;; - ignore (file &optional directory)
468 : ;;
469 : ;; Ignore FILE under the VCS of DIRECTORY (default is `default-directory').
470 : ;; FILE is a file wildcard.
471 : ;; When called interactively and with a prefix argument, remove FILE
472 : ;; from ignored files.
473 : ;; When called from Lisp code, if DIRECTORY is non-nil, the
474 : ;; repository to use will be deduced by DIRECTORY.
475 : ;;
476 : ;; - ignore-completion-table
477 : ;;
478 : ;; Return the completion table for files ignored by the current
479 : ;; version control system, e.g., the entries in `.gitignore' and
480 : ;; `.bzrignore'.
481 : ;;
482 : ;; - previous-revision (file rev)
483 : ;;
484 : ;; Return the revision number that precedes REV for FILE, or nil if no such
485 : ;; revision exists.
486 : ;;
487 : ;; - next-revision (file rev)
488 : ;;
489 : ;; Return the revision number that follows REV for FILE, or nil if no such
490 : ;; revision exists.
491 : ;;
492 : ;; - log-edit-mode ()
493 : ;;
494 : ;; Turn on the mode used for editing the check in log. This
495 : ;; defaults to `log-edit-mode'. If changed, it should use a mode
496 : ;; derived from`log-edit-mode'.
497 : ;;
498 : ;; - check-headers ()
499 : ;;
500 : ;; Return non-nil if the current buffer contains any version headers.
501 : ;;
502 : ;; - delete-file (file)
503 : ;;
504 : ;; Delete FILE and mark it as deleted in the repository. If this
505 : ;; function is not provided, the command `vc-delete-file' will
506 : ;; signal an error.
507 : ;;
508 : ;; - rename-file (old new)
509 : ;;
510 : ;; Rename file OLD to NEW, both in the working area and in the
511 : ;; repository. If this function is not provided, the renaming
512 : ;; will be done by (vc-delete-file old) and (vc-register new).
513 : ;;
514 : ;; - find-file-hook ()
515 : ;;
516 : ;; Operation called in current buffer when opening a file. This can
517 : ;; be used by the backend to setup some local variables it might need.
518 : ;;
519 : ;; - extra-menu ()
520 : ;;
521 : ;; Return a menu keymap, the items in the keymap will appear at the
522 : ;; end of the Version Control menu. The goal is to allow backends
523 : ;; to specify extra menu items that appear in the VC menu. This way
524 : ;; you can provide menu entries for functionality that is specific
525 : ;; to your backend and which does not map to any of the VC generic
526 : ;; concepts.
527 : ;;
528 : ;; - extra-dir-menu ()
529 : ;;
530 : ;; Return a menu keymap, the items in the keymap will appear at the
531 : ;; end of the VC Status menu. The goal is to allow backends to
532 : ;; specify extra menu items that appear in the VC Status menu. This
533 : ;; makes it possible to provide menu entries for functionality that
534 : ;; is specific to a backend and which does not map to any of the VC
535 : ;; generic concepts.
536 : ;;
537 : ;; - conflicted-files (dir)
538 : ;;
539 : ;; Return the list of files where conflict resolution is needed in
540 : ;; the project that contains DIR.
541 : ;; FIXME: what should it do with non-text conflicts?
542 :
543 : ;;; Changes from the pre-25.1 API:
544 : ;;
545 : ;; - INCOMPATIBLE CHANGE: The 'editable' optional argument of
546 : ;; vc-checkout is gone. The upper level assumes that all files are
547 : ;; checked out editable. This moves closer to emulating modern
548 : ;; non-locking behavior even on very old VCSes.
549 : ;;
550 : ;; - INCOMPATIBLE CHANGE: The vc-register function and its backend
551 : ;; implementations no longer take a first optional revision
552 : ;; argument, since on no system since RCS has setting the initial
553 : ;; revision been even possible, let alone sane.
554 : ;;
555 : ;; - INCOMPATIBLE CHANGE: In older versions of the API, vc-diff did
556 : ;; not take an async-mode flag as a fourth optional argument. (This
557 : ;; change eliminated a particularly ugly global.)
558 : ;;
559 : ;; - INCOMPATIBLE CHANGE: The backend operation for non-distributed
560 : ;; VCSes formerly called "merge" is now "merge-file" (to contrast
561 : ;; with merge-branch), and does its own prompting for revisions.
562 : ;; (This fixes a layer violation that produced bad behavior under
563 : ;; SVN.)
564 : ;;
565 : ;; - INCOMPATIBLE CHANGE: The old fourth 'default-state' argument of
566 : ;; dir-status-files is gone; none of the back ends actually used it.
567 : ;;
568 : ;; - dir-status is no longer a public method; it has been replaced by
569 : ;; dir-status-files.
570 : ;;
571 : ;; - state-heuristic is no longer a public method (the CVS backend
572 : ;; retains it as a private one).
573 : ;;
574 : ;; - the vc-mistrust-permissions configuration variable is gone; the
575 : ;; code no longer relies on permissions except in one corner case where
576 : ;; CVS leaves no alternative (which was not gated by this variable). The
577 : ;; only affected back ends were SCCS and RCS.
578 : ;;
579 : ;; - vc-stay-local-p and repository-hostname are no longer part
580 : ;; of the public API. The vc-cvs-stay-local configuration variable
581 : ;; remains and only affects the CVS back end.
582 : ;;
583 : ;; - The init-revision function and the default-initial-revision
584 : ;; variable are gone. These have't made sense on anything shipped
585 : ;; since RCS, and using them was a dumb stunt even on RCS.
586 : ;;
587 : ;; - workfile-unchanged-p is no longer a public back-end method. It
588 : ;; was redundant with vc-state and usually implemented with a trivial
589 : ;; call to it. A few older back ends retain versions for internal use in
590 : ;; their vc-state functions.
591 : ;;
592 : ;; - could-register is no longer a public method. Only vc-cvs ever used it
593 : ;;
594 : ;; The vc-keep-workfiles configuration variable is gone. Used only by
595 : ;; the RCS and SCCS backends, it was an invitation to shoot self in foot
596 : ;; when set to the (non-default) value nil. The original justification
597 : ;; for it (saving disk space) is long obsolete.
598 : ;;
599 : ;; - The rollback method (implemented by RCS and SCCS only) is gone. See
600 : ;; the to-do note on uncommit.
601 : ;;
602 : ;; - latest-on-branch-p is no longer a public method. It was to be used
603 : ;; for implementing rollback. RCS keeps its implementation (the only one)
604 : ;; for internal use.
605 :
606 :
607 : ;;; Todo:
608 :
609 : ;;;; New Primitives:
610 : ;;
611 : ;; - uncommit: undo last checkin, leave changes in place in the workfile,
612 : ;; stash the commit comment for re-use.
613 : ;;
614 : ;; - deal with push operations.
615 : ;;
616 : ;;;; Primitives that need changing:
617 : ;;
618 : ;; - vc-update/vc-merge should deal with VC systems that don't do
619 : ;; update/merge on a file basis, but on a whole repository basis.
620 : ;; vc-update and vc-merge assume the arguments are always files,
621 : ;; they don't deal with directories. Make sure the *vc-dir* buffer
622 : ;; is updated after these operations.
623 : ;; At least bzr, git and hg should benefit from this.
624 : ;;
625 : ;;;; Improved branch and tag handling:
626 : ;;
627 : ;; - Make sure the *vc-dir* buffer is updated after merge-branch operations.
628 : ;;
629 : ;; - add a generic mechanism for remembering the current branch names,
630 : ;; display the branch name in the mode-line. Replace
631 : ;; vc-cvs-sticky-tag with that.
632 : ;;
633 : ;; - Add a primitives for switching to a branch (creating it if required.
634 : ;;
635 : ;; - Add the ability to list tags and branches.
636 : ;;
637 : ;;;; Unify two different versions of the amend capability
638 : ;;
639 : ;; - Some back ends (SCCS/RCS/SVN/SRC), have an amend capability that can
640 : ;; be invoked from log-view.
641 : ;;
642 : ;; - The git backend supports amending, but in a different
643 : ;; way (press `C-c C-e' in log-edit buffer, when making a new commit).
644 : ;;
645 : ;; - Second, `log-view-modify-change-comment' doesn't seem to support
646 : ;; modern backends at all because `log-view-extract-comment'
647 : ;; unconditionally calls `log-view-current-file'. This should be easy to
648 : ;; fix.
649 : ;;
650 : ;; - Third, doing message editing in log-view might be a natural way to go
651 : ;; about it, but editing any but the last commit (and even it, if it's
652 : ;; been pushed) is a dangerous operation in Git, which we shouldn't make
653 : ;; too easy for users to perform.
654 : ;;
655 : ;; There should be a check that the given comment is not reachable
656 : ;; from any of the "remote" refs?
657 : ;;
658 : ;;;; Other
659 : ;;
660 : ;; - asynchronous checkin and commit, so you can keep working in other
661 : ;; buffers while the repo operation happens.
662 : ;;
663 : ;; - Direct support for stash/shelve.
664 : ;;
665 : ;; - when a file is in `conflict' state, turn on smerge-mode.
666 : ;;
667 : ;; - figure out what to do with conflicts that are not caused by the
668 : ;; file contents, but by metadata or other causes. Example: File A
669 : ;; gets renamed to B in one branch and to C in another and you merge
670 : ;; the two branches. Or you locally add file FOO and then pull a
671 : ;; change that also adds a new file FOO, ...
672 : ;;
673 : ;; - make it easier to write logs. Maybe C-x 4 a should add to the log
674 : ;; buffer, if one is present, instead of adding to the ChangeLog.
675 : ;;
676 : ;; - When vc-next-action calls vc-checkin it could pre-fill the
677 : ;; *vc-log* buffer with some obvious items: the list of files that
678 : ;; were added, the list of files that were removed. If the diff is
679 : ;; available, maybe it could even call something like
680 : ;; `diff-add-change-log-entries-other-window' to create a detailed
681 : ;; skeleton for the log...
682 : ;;
683 : ;; - most vc-dir backends need more work. They might need to
684 : ;; provide custom headers, use the `extra' field and deal with all
685 : ;; possible VC states.
686 : ;;
687 : ;; - add a function that calls vc-dir to `find-directory-functions'.
688 : ;;
689 : ;; - vc-diff, vc-annotate, etc. need to deal better with unregistered
690 : ;; files. Now that unregistered and ignored files are shown in
691 : ;; vc-dir, it is possible that these commands are called
692 : ;; for unregistered/ignored files.
693 : ;;
694 : ;; - vc-next-action needs work in order to work with multiple
695 : ;; backends: `vc-state' returns the state for the default backend,
696 : ;; not for the backend in the current *vc-dir* buffer.
697 : ;;
698 : ;; - vc-dir-kill-dir-status-process should not be specific to dir-status,
699 : ;; it should work for other async commands done through vc-do-command
700 : ;; as well,
701 : ;;
702 : ;; - vc-dir toolbar needs more icons.
703 : ;;
704 : ;; - The backends should avoid using `vc-file-setprop' and `vc-file-getprop'.
705 : ;;
706 : ;;; Code:
707 :
708 : (require 'vc-hooks)
709 : (require 'vc-dispatcher)
710 : (require 'cl-lib)
711 :
712 : (declare-function diff-setup-whitespace "diff-mode" ())
713 :
714 : (eval-when-compile
715 : (require 'dired))
716 :
717 : (declare-function dired-get-filename "dired" (&optional localp noerror))
718 : (declare-function dired-move-to-filename "dired" (&optional err eol))
719 : (declare-function dired-marker-regexp "dired" ())
720 :
721 : (unless (assoc 'vc-parent-buffer minor-mode-alist)
722 : (setq minor-mode-alist
723 : (cons '(vc-parent-buffer vc-parent-buffer-name)
724 : minor-mode-alist)))
725 :
726 : ;; General customization
727 :
728 : (defgroup vc nil
729 : "Emacs interface to version control systems."
730 : :group 'tools)
731 :
732 : (defcustom vc-initial-comment nil
733 : "If non-nil, prompt for initial comment when a file is registered."
734 : :type 'boolean
735 : :group 'vc)
736 :
737 : (make-obsolete-variable 'vc-initial-comment "it has no effect." "23.2")
738 :
739 : (defcustom vc-checkin-switches nil
740 : "A string or list of strings specifying extra switches for checkin.
741 : These are passed to the checkin program by \\[vc-checkin]."
742 : :type '(choice (const :tag "None" nil)
743 : (string :tag "Argument String")
744 : (repeat :tag "Argument List"
745 : :value ("")
746 : string))
747 : :group 'vc)
748 :
749 : (defcustom vc-checkout-switches nil
750 : "A string or list of strings specifying extra switches for checkout.
751 : These are passed to the checkout program by \\[vc-checkout]."
752 : :type '(choice (const :tag "None" nil)
753 : (string :tag "Argument String")
754 : (repeat :tag "Argument List"
755 : :value ("")
756 : string))
757 : :group 'vc)
758 :
759 : (defcustom vc-register-switches nil
760 : "A string or list of strings; extra switches for registering a file.
761 : These are passed to the checkin program by \\[vc-register]."
762 : :type '(choice (const :tag "None" nil)
763 : (string :tag "Argument String")
764 : (repeat :tag "Argument List"
765 : :value ("")
766 : string))
767 : :group 'vc)
768 :
769 : (defcustom vc-diff-switches nil
770 : "A string or list of strings specifying switches for diff under VC.
771 : When running diff under a given BACKEND, VC uses the first
772 : non-nil value of `vc-BACKEND-diff-switches', `vc-diff-switches',
773 : and `diff-switches', in that order. Since nil means to check the
774 : next variable in the sequence, either of the first two may use
775 : the value t to mean no switches at all. `vc-diff-switches'
776 : should contain switches that are specific to version control, but
777 : not specific to any particular backend."
778 : :type '(choice (const :tag "Unspecified" nil)
779 : (const :tag "None" t)
780 : (string :tag "Argument String")
781 : (repeat :tag "Argument List" :value ("") string))
782 : :group 'vc
783 : :version "21.1")
784 :
785 : (defcustom vc-annotate-switches nil
786 : "A string or list of strings specifying switches for annotate under VC.
787 : When running annotate under a given BACKEND, VC uses the first
788 : non-nil value of `vc-BACKEND-annotate-switches', `vc-annotate-switches',
789 : and `annotate-switches', in that order. Since nil means to check the
790 : next variable in the sequence, either of the first two may use
791 : the value t to mean no switches at all. `vc-annotate-switches'
792 : should contain switches that are specific to version control, but
793 : not specific to any particular backend.
794 :
795 : As very few switches (if any) are used across different VC tools,
796 : please consider using the specific `vc-BACKEND-annotate-switches'
797 : for the backend you use."
798 : :type '(choice (const :tag "Unspecified" nil)
799 : (const :tag "None" t)
800 : (string :tag "Argument String")
801 : (repeat :tag "Argument List" :value ("") string))
802 : :group 'vc
803 : :version "25.1")
804 :
805 : (defcustom vc-log-show-limit 2000
806 : "Limit the number of items shown by the VC log commands.
807 : Zero means unlimited.
808 : Not all VC backends are able to support this feature."
809 : :type 'integer
810 : :group 'vc)
811 :
812 : (defcustom vc-allow-async-revert nil
813 : "Specifies whether the diff during \\[vc-revert] may be asynchronous.
814 : Enabling this option means that you can confirm a revert operation even
815 : if the local changes in the file have not been found and displayed yet."
816 : :type '(choice (const :tag "No" nil)
817 : (const :tag "Yes" t))
818 : :group 'vc
819 : :version "22.1")
820 :
821 : ;;;###autoload
822 : (defcustom vc-checkout-hook nil
823 : "Normal hook (list of functions) run after checking out a file.
824 : See `run-hooks'."
825 : :type 'hook
826 : :group 'vc
827 : :version "21.1")
828 :
829 : ;;;###autoload
830 : (defcustom vc-checkin-hook nil
831 : "Normal hook (list of functions) run after commit or file checkin.
832 : See also `log-edit-done-hook'."
833 : :type 'hook
834 : :options '(log-edit-comment-to-change-log)
835 : :group 'vc)
836 :
837 : ;;;###autoload
838 : (defcustom vc-before-checkin-hook nil
839 : "Normal hook (list of functions) run before a commit or a file checkin.
840 : See `run-hooks'."
841 : :type 'hook
842 : :group 'vc)
843 :
844 : (defcustom vc-revert-show-diff t
845 : "If non-nil, `vc-revert' shows a `vc-diff' buffer before querying."
846 : :type 'boolean
847 : :group 'vc
848 : :version "24.1")
849 :
850 : ;; Header-insertion hair
851 :
852 : (defcustom vc-static-header-alist
853 : '(("\\.c\\'" .
854 : "\n#ifndef lint\nstatic char vcid[] = \"%s\";\n#endif /* lint */\n"))
855 : "Associate static header string templates with file types.
856 : A %s in the template is replaced with the first string associated with
857 : the file's version control type in `vc-BACKEND-header'."
858 : :type '(repeat (cons :format "%v"
859 : (regexp :tag "File Type")
860 : (string :tag "Header String")))
861 : :group 'vc)
862 :
863 : (defcustom vc-comment-alist
864 : '((nroff-mode ".\\\"" ""))
865 : "Special comment delimiters for generating VC headers.
866 : Add an entry in this list if you need to override the normal `comment-start'
867 : and `comment-end' variables. This will only be necessary if the mode language
868 : is sensitive to blank lines."
869 : :type '(repeat (list :format "%v"
870 : (symbol :tag "Mode")
871 : (string :tag "Comment Start")
872 : (string :tag "Comment End")))
873 : :group 'vc)
874 :
875 :
876 : ;; File property caching
877 :
878 : (defun vc-clear-context ()
879 : "Clear all cached file properties."
880 : (interactive)
881 0 : (fillarray vc-file-prop-obarray 0))
882 :
883 : (defmacro with-vc-properties (files form settings)
884 : "Execute FORM, then maybe set per-file properties for FILES.
885 : If any of FILES is actually a directory, then do the same for all
886 : buffers for files in that directory.
887 : SETTINGS is an association list of property/value pairs. After
888 : executing FORM, set those properties from SETTINGS that have not yet
889 : been updated to their corresponding values."
890 : (declare (debug t))
891 5 : `(let ((vc-touched-properties (list t))
892 : (flist nil))
893 5 : (dolist (file ,files)
894 : (if (file-directory-p file)
895 : (dolist (buffer (buffer-list))
896 : (let ((fname (buffer-file-name buffer)))
897 : (when (and fname (string-prefix-p file fname))
898 : (push fname flist))))
899 : (push file flist)))
900 5 : ,form
901 : (dolist (file flist)
902 5 : (dolist (setting ,settings)
903 : (let ((property (car setting)))
904 : (unless (memq property vc-touched-properties)
905 : (put (intern file vc-file-prop-obarray)
906 5 : property (cdr setting))))))))
907 :
908 : ;;; Code for deducing what fileset and backend to assume
909 :
910 : (defun vc-backend-for-registration (file)
911 : "Return a backend that can be used for registering FILE.
912 :
913 : If no backend declares itself responsible for FILE, then FILE
914 : must not be in a version controlled directory, so try to create a
915 : repository, prompting for the directory and the VC backend to
916 : use."
917 0 : (catch 'found
918 : ;; First try: find a responsible backend, it must be a backend
919 : ;; under which FILE is not yet registered.
920 0 : (dolist (backend vc-handled-backends)
921 0 : (and (not (vc-call-backend backend 'registered file))
922 0 : (vc-call-backend backend 'responsible-p file)
923 0 : (throw 'found backend)))
924 : ;; no responsible backend
925 0 : (let* ((possible-backends
926 0 : (let (pos)
927 0 : (dolist (crt vc-handled-backends)
928 0 : (when (vc-find-backend-function crt 'create-repo)
929 0 : (push crt pos)))
930 0 : pos))
931 : (bk
932 0 : (intern
933 : ;; Read the VC backend from the user, only
934 : ;; complete with the backends that have the
935 : ;; 'create-repo method.
936 0 : (completing-read
937 0 : (format "%s is not in a version controlled directory.\nUse VC backend: " file)
938 0 : (mapcar 'symbol-name possible-backends) nil t)))
939 : (repo-dir
940 0 : (let ((def-dir (file-name-directory file)))
941 : ;; read the directory where to create the
942 : ;; repository, make sure it's a parent of
943 : ;; file.
944 0 : (read-file-name
945 0 : (format "create %s repository in: " bk)
946 0 : default-directory def-dir t nil
947 : (lambda (arg)
948 0 : (message "arg %s" arg)
949 0 : (and (file-directory-p arg)
950 0 : (string-prefix-p (expand-file-name arg) def-dir)))))))
951 0 : (let ((default-directory repo-dir))
952 0 : (vc-call-backend bk 'create-repo))
953 0 : (throw 'found bk))))
954 :
955 : ;;;###autoload
956 : (defun vc-responsible-backend (file)
957 : "Return the name of a backend system that is responsible for FILE.
958 :
959 : If FILE is already registered, return the
960 : backend of FILE. If FILE is not registered, then the
961 : first backend in `vc-handled-backends' that declares itself
962 : responsible for FILE is returned.
963 :
964 : Note that if FILE is a symbolic link, it will not be resolved --
965 : the responsible backend system for the symbolic link itself will
966 : be reported."
967 0 : (or (and (not (file-directory-p file)) (vc-backend file))
968 0 : (catch 'found
969 : ;; First try: find a responsible backend. If this is for registration,
970 : ;; it must be a backend under which FILE is not yet registered.
971 0 : (dolist (backend vc-handled-backends)
972 0 : (and (vc-call-backend backend 'responsible-p file)
973 0 : (throw 'found backend))))
974 0 : (error "No VC backend is responsible for %s" file)))
975 :
976 : (defun vc-expand-dirs (file-or-dir-list backend)
977 : "Expands directories in a file list specification.
978 : Within directories, only files already under version control are noticed."
979 0 : (let ((flattened '()))
980 0 : (dolist (node file-or-dir-list)
981 0 : (when (file-directory-p node)
982 0 : (vc-file-tree-walk
983 0 : node (lambda (f) (when (eq (vc-backend f) backend) (push f flattened)))))
984 0 : (unless (file-directory-p node) (push node flattened)))
985 0 : (nreverse flattened)))
986 :
987 : (defvar vc-dir-backend)
988 : (defvar log-view-vc-backend)
989 : (defvar log-edit-vc-backend)
990 : (defvar diff-vc-backend)
991 :
992 : (defun vc-deduce-backend ()
993 0 : (cond ((derived-mode-p 'vc-dir-mode) vc-dir-backend)
994 0 : ((derived-mode-p 'log-view-mode) log-view-vc-backend)
995 0 : ((derived-mode-p 'log-edit-mode) log-edit-vc-backend)
996 0 : ((derived-mode-p 'diff-mode) diff-vc-backend)
997 : ;; Maybe we could even use comint-mode rather than shell-mode?
998 0 : ((derived-mode-p 'dired-mode 'shell-mode 'compilation-mode)
999 0 : (vc-responsible-backend default-directory))
1000 0 : (vc-mode (vc-backend buffer-file-name))))
1001 :
1002 : (declare-function vc-dir-current-file "vc-dir" ())
1003 : (declare-function vc-dir-deduce-fileset "vc-dir" (&optional state-model-only-files))
1004 :
1005 : (defun vc-deduce-fileset (&optional observer allow-unregistered
1006 : state-model-only-files)
1007 : "Deduce a set of files and a backend to which to apply an operation.
1008 : Return (BACKEND FILESET FILESET-ONLY-FILES STATE CHECKOUT-MODEL).
1009 :
1010 : If we're in VC-dir mode, FILESET is the list of marked files,
1011 : or the directory if no files are marked.
1012 : Otherwise, if in a buffer visiting a version-controlled file,
1013 : FILESET is a single-file fileset containing that file.
1014 : Otherwise, if ALLOW-UNREGISTERED is non-nil and the visited file
1015 : is unregistered, FILESET is a single-file fileset containing it.
1016 : Otherwise, throw an error.
1017 :
1018 : STATE-MODEL-ONLY-FILES if non-nil, means that the caller needs
1019 : the FILESET-ONLY-FILES STATE and MODEL info. Otherwise, that
1020 : part may be skipped.
1021 :
1022 : BEWARE: this function may change the current buffer."
1023 : ;; FIXME: OBSERVER is unused. The name is not intuitive and is not
1024 : ;; documented. It's set to t when called from diff and print-log.
1025 0 : (let (backend)
1026 0 : (cond
1027 0 : ((derived-mode-p 'vc-dir-mode)
1028 0 : (vc-dir-deduce-fileset state-model-only-files))
1029 0 : ((derived-mode-p 'dired-mode)
1030 0 : (if observer
1031 0 : (vc-dired-deduce-fileset)
1032 0 : (error "State changing VC operations not supported in `dired-mode'")))
1033 0 : ((setq backend (vc-backend buffer-file-name))
1034 0 : (if state-model-only-files
1035 0 : (list backend (list buffer-file-name)
1036 0 : (list buffer-file-name)
1037 0 : (vc-state buffer-file-name)
1038 0 : (vc-checkout-model backend buffer-file-name))
1039 0 : (list backend (list buffer-file-name))))
1040 0 : ((and (buffer-live-p vc-parent-buffer)
1041 : ;; FIXME: Why this test? --Stef
1042 0 : (or (buffer-file-name vc-parent-buffer)
1043 0 : (with-current-buffer vc-parent-buffer
1044 0 : (derived-mode-p 'vc-dir-mode))))
1045 0 : (progn ;FIXME: Why not `with-current-buffer'? --Stef.
1046 0 : (set-buffer vc-parent-buffer)
1047 0 : (vc-deduce-fileset observer allow-unregistered state-model-only-files)))
1048 0 : ((and (derived-mode-p 'log-view-mode)
1049 0 : (setq backend (vc-responsible-backend default-directory)))
1050 0 : (list backend nil))
1051 0 : ((not buffer-file-name)
1052 0 : (error "Buffer %s is not associated with a file" (buffer-name)))
1053 0 : ((and allow-unregistered (not (vc-registered buffer-file-name)))
1054 0 : (if state-model-only-files
1055 0 : (list (vc-backend-for-registration (buffer-file-name))
1056 0 : (list buffer-file-name)
1057 0 : (list buffer-file-name)
1058 0 : (when state-model-only-files 'unregistered)
1059 0 : nil)
1060 0 : (list (vc-backend-for-registration (buffer-file-name))
1061 0 : (list buffer-file-name))))
1062 0 : (t (error "File is not under version control")))))
1063 :
1064 : (defun vc-dired-deduce-fileset ()
1065 0 : (let ((backend (vc-responsible-backend default-directory)))
1066 0 : (unless backend (error "Directory not under VC"))
1067 0 : (list backend
1068 0 : (dired-map-over-marks (dired-get-filename nil t) nil))))
1069 :
1070 : (defun vc-ensure-vc-buffer ()
1071 : "Make sure that the current buffer visits a version-controlled file."
1072 0 : (cond
1073 0 : ((derived-mode-p 'vc-dir-mode)
1074 0 : (set-buffer (find-file-noselect (vc-dir-current-file))))
1075 : (t
1076 0 : (while (and vc-parent-buffer
1077 0 : (buffer-live-p vc-parent-buffer)
1078 : ;; Avoid infinite looping when vc-parent-buffer and
1079 : ;; current buffer are the same buffer.
1080 0 : (not (eq vc-parent-buffer (current-buffer))))
1081 0 : (set-buffer vc-parent-buffer))
1082 0 : (if (not buffer-file-name)
1083 0 : (error "Buffer %s is not associated with a file" (buffer-name))
1084 0 : (unless (vc-backend buffer-file-name)
1085 0 : (error "File %s is not under version control" buffer-file-name))))))
1086 :
1087 : ;;; Support for the C-x v v command.
1088 : ;; This is where all the single-file-oriented code from before the fileset
1089 : ;; rewrite lives.
1090 :
1091 : (defsubst vc-editable-p (file)
1092 : "Return non-nil if FILE can be edited."
1093 0 : (let ((backend (vc-backend file)))
1094 0 : (and backend
1095 0 : (or (eq (vc-checkout-model backend (list file)) 'implicit)
1096 0 : (memq (vc-state file) '(edited needs-merge conflict))))))
1097 :
1098 : (defun vc-compatible-state (p q)
1099 : "Controls which states can be in the same commit."
1100 0 : (or
1101 0 : (eq p q)
1102 0 : (and (member p '(edited added removed)) (member q '(edited added removed)))))
1103 :
1104 : (defun vc-read-backend (prompt)
1105 0 : (intern
1106 0 : (completing-read prompt (mapcar 'symbol-name vc-handled-backends)
1107 0 : nil 'require-match)))
1108 :
1109 : ;; Here's the major entry point.
1110 :
1111 : ;;;###autoload
1112 : (defun vc-next-action (verbose)
1113 : "Do the next logical version control operation on the current fileset.
1114 : This requires that all files in the current VC fileset be in the
1115 : same state. If not, signal an error.
1116 :
1117 : For merging-based version control systems:
1118 : If every file in the VC fileset is not registered for version
1119 : control, register the fileset (but don't commit).
1120 : If every work file in the VC fileset is added or changed, pop
1121 : up a *vc-log* buffer to commit the fileset.
1122 : For a centralized version control system, if any work file in
1123 : the VC fileset is out of date, offer to update the fileset.
1124 :
1125 : For old-style locking-based version control systems, like RCS:
1126 : If every file is not registered, register the file(s).
1127 : If every file is registered and unlocked, check out (lock)
1128 : the file(s) for editing.
1129 : If every file is locked by you and has changes, pop up a
1130 : *vc-log* buffer to check in the changes. Leave a
1131 : read-only copy of each changed file after checking in.
1132 : If every file is locked by you and unchanged, unlock them.
1133 : If every file is locked by someone else, offer to steal the lock."
1134 : (interactive "P")
1135 0 : (let* ((vc-fileset (vc-deduce-fileset nil t 'state-model-only-files))
1136 0 : (backend (car vc-fileset))
1137 0 : (files (nth 1 vc-fileset))
1138 : ;; (fileset-only-files (nth 2 vc-fileset))
1139 : ;; FIXME: We used to call `vc-recompute-state' here.
1140 0 : (state (nth 3 vc-fileset))
1141 : ;; The backend should check that the checkout-model is consistent
1142 : ;; among all the `files'.
1143 0 : (model (nth 4 vc-fileset)))
1144 :
1145 : ;; If a buffer has unsaved changes, a checkout would discard those
1146 : ;; changes, so treat the buffer as having unlocked changes.
1147 0 : (when (and (not (eq model 'implicit)) (eq state 'up-to-date))
1148 0 : (dolist (file files)
1149 0 : (let ((buffer (get-file-buffer file)))
1150 0 : (and buffer
1151 0 : (buffer-modified-p buffer)
1152 0 : (setq state 'unlocked-changes)))))
1153 :
1154 : ;; Do the right thing.
1155 0 : (cond
1156 0 : ((eq state 'missing)
1157 0 : (error "Fileset files are missing, so cannot be operated on"))
1158 0 : ((eq state 'ignored)
1159 0 : (error "Fileset files are ignored by the version-control system"))
1160 0 : ((or (null state) (eq state 'unregistered))
1161 0 : (vc-register vc-fileset))
1162 : ;; Files are up-to-date, or need a merge and user specified a revision
1163 0 : ((or (eq state 'up-to-date) (and verbose (eq state 'needs-update)))
1164 0 : (cond
1165 0 : (verbose
1166 : ;; Go to a different revision.
1167 0 : (let* ((revision
1168 : ;; FIXME: Provide completion.
1169 0 : (read-string "Branch, revision, or backend to move to: "))
1170 0 : (revision-downcase (downcase revision)))
1171 0 : (if (member
1172 0 : revision-downcase
1173 0 : (mapcar (lambda (arg) (downcase (symbol-name arg)))
1174 0 : vc-handled-backends))
1175 0 : (let ((vsym (intern-soft revision-downcase)))
1176 0 : (dolist (file files) (vc-transfer-file file vsym)))
1177 0 : (dolist (file files)
1178 0 : (vc-checkout file revision)))))
1179 0 : ((not (eq model 'implicit))
1180 : ;; check the files out
1181 0 : (dolist (file files) (vc-checkout file)))
1182 : (t
1183 : ;; do nothing
1184 0 : (message "Fileset is up-to-date"))))
1185 : ;; Files have local changes
1186 0 : ((vc-compatible-state state 'edited)
1187 0 : (let ((ready-for-commit files))
1188 : ;; CVS, SVN and bzr don't care about read-only (bug#9781).
1189 : ;; RCS does, SCCS might (someone should check...).
1190 0 : (when (memq backend '(RCS SCCS))
1191 : ;; If files are edited but read-only, give user a chance to correct.
1192 0 : (dolist (file files)
1193 : ;; If committing a mix of removed and edited files, the
1194 : ;; fileset has state = 'edited. Rather than checking the
1195 : ;; state of each individual file in the fileset, it seems
1196 : ;; simplest to just check if the file exists. Bug#9781.
1197 0 : (when (and (file-exists-p file) (not (file-writable-p file)))
1198 : ;; Make the file-buffer read-write.
1199 0 : (unless (y-or-n-p (format "%s is edited but read-only; make it writable and continue? " file))
1200 0 : (error "Aborted"))
1201 : ;; Maybe we somehow lost permissions on the directory.
1202 0 : (condition-case nil
1203 0 : (set-file-modes file (logior (file-modes file) 128))
1204 0 : (error (error "Unable to make file writable")))
1205 0 : (let ((visited (get-file-buffer file)))
1206 0 : (when visited
1207 0 : (with-current-buffer visited
1208 0 : (read-only-mode -1)))))))
1209 : ;; Allow user to revert files with no changes
1210 0 : (save-excursion
1211 0 : (dolist (file files)
1212 0 : (let ((visited (get-file-buffer file)))
1213 : ;; For files with locking, if the file does not contain
1214 : ;; any changes, just let go of the lock, i.e. revert.
1215 0 : (when (and (not (eq model 'implicit))
1216 0 : (eq state 'up-to-date)
1217 : ;; If buffer is modified, that means the user just
1218 : ;; said no to saving it; in that case, don't revert,
1219 : ;; because the user might intend to save after
1220 : ;; finishing the log entry and committing.
1221 0 : (not (and visited (buffer-modified-p))))
1222 0 : (vc-revert-file file)
1223 0 : (setq ready-for-commit (delete file ready-for-commit))))))
1224 : ;; Remaining files need to be committed
1225 0 : (if (not ready-for-commit)
1226 0 : (message "No files remain to be committed")
1227 0 : (if (not verbose)
1228 0 : (vc-checkin ready-for-commit backend)
1229 0 : (let* ((revision (read-string "New revision or backend: "))
1230 0 : (revision-downcase (downcase revision)))
1231 0 : (if (member
1232 0 : revision-downcase
1233 0 : (mapcar (lambda (arg) (downcase (symbol-name arg)))
1234 0 : vc-handled-backends))
1235 0 : (let ((vsym (intern revision-downcase)))
1236 0 : (dolist (file files) (vc-transfer-file file vsym)))
1237 0 : (vc-checkin ready-for-commit backend nil nil revision)))))))
1238 : ;; locked by somebody else (locking VCSes only)
1239 0 : ((stringp state)
1240 : ;; In the old days, we computed the revision once and used it on
1241 : ;; the single file. Then, for the 2007-2008 fileset rewrite, we
1242 : ;; computed the revision once (incorrectly, using a free var) and
1243 : ;; used it on all files. To fix the free var bug, we can either
1244 : ;; use `(car files)' or do what we do here: distribute the
1245 : ;; revision computation among `files'. Although this may be
1246 : ;; tedious for those backends where a "revision" is a trans-file
1247 : ;; concept, it is nonetheless correct for both those and (more
1248 : ;; importantly) for those where "revision" is a per-file concept.
1249 : ;; If the intersection of the former group and "locking VCSes" is
1250 : ;; non-empty [I vaguely doubt it --ttn], we can reinstate the
1251 : ;; pre-computation approach of yore.
1252 0 : (dolist (file files)
1253 0 : (vc-steal-lock
1254 0 : file (if verbose
1255 0 : (read-string (format "%s revision to steal: " file))
1256 0 : (vc-working-revision file))
1257 0 : state)))
1258 : ;; conflict
1259 0 : ((eq state 'conflict)
1260 : ;; FIXME: Is it really the UI we want to provide?
1261 : ;; In my experience, the conflicted files should be marked as resolved
1262 : ;; one-by-one when saving the file after resolving the conflicts.
1263 : ;; I.e. stating explicitly that the conflicts are resolved is done
1264 : ;; very rarely.
1265 0 : (vc-mark-resolved backend files))
1266 : ;; needs-update
1267 0 : ((eq state 'needs-update)
1268 0 : (dolist (file files)
1269 0 : (if (yes-or-no-p (format
1270 : "%s is not up-to-date. Get latest revision? "
1271 0 : (file-name-nondirectory file)))
1272 0 : (vc-checkout file t)
1273 0 : (when (and (not (eq model 'implicit))
1274 0 : (yes-or-no-p "Lock this revision? "))
1275 0 : (vc-checkout file)))))
1276 : ;; needs-merge
1277 0 : ((eq state 'needs-merge)
1278 0 : (dolist (file files)
1279 0 : (when (yes-or-no-p (format
1280 : "%s is not up-to-date. Merge in changes now? "
1281 0 : (file-name-nondirectory file)))
1282 0 : (vc-maybe-resolve-conflicts
1283 0 : file (vc-call-backend backend 'merge-news file)))))
1284 :
1285 : ;; unlocked-changes
1286 0 : ((eq state 'unlocked-changes)
1287 0 : (dolist (file files)
1288 0 : (when (not (equal buffer-file-name file))
1289 0 : (find-file-other-window file))
1290 0 : (if (save-window-excursion
1291 0 : (vc-diff-internal nil
1292 0 : (cons (car vc-fileset) (cons (cadr vc-fileset) (list file)))
1293 0 : (vc-working-revision file) nil)
1294 0 : (goto-char (point-min))
1295 0 : (let ((inhibit-read-only t))
1296 0 : (insert
1297 0 : (format "Changes to %s since last lock:\n\n" file)))
1298 0 : (not (beep))
1299 0 : (yes-or-no-p (concat "File has unlocked changes. "
1300 0 : "Claim lock retaining changes? ")))
1301 0 : (progn (vc-call-backend backend 'steal-lock file)
1302 0 : (clear-visited-file-modtime)
1303 0 : (write-file buffer-file-name)
1304 0 : (vc-mode-line file backend))
1305 0 : (if (not (yes-or-no-p
1306 0 : "Revert to checked-in revision, instead? "))
1307 0 : (error "Checkout aborted")
1308 0 : (vc-revert-buffer-internal t t)
1309 0 : (vc-checkout file)))))
1310 : ;; Unknown fileset state
1311 : (t
1312 0 : (error "Fileset is in an unknown state %s" state)))))
1313 :
1314 : (defun vc-create-repo (backend)
1315 : "Create an empty repository in the current directory."
1316 : (interactive
1317 0 : (list
1318 0 : (intern
1319 0 : (upcase
1320 0 : (completing-read
1321 : "Create repository for: "
1322 0 : (mapcar (lambda (b) (list (downcase (symbol-name b)))) vc-handled-backends)
1323 0 : nil t)))))
1324 0 : (vc-call-backend backend 'create-repo))
1325 :
1326 : (declare-function vc-dir-move-to-goal-column "vc-dir" ())
1327 :
1328 : ;;;###autoload
1329 : (defun vc-register (&optional vc-fileset comment)
1330 : "Register into a version control system.
1331 : If VC-FILESET is given, register the files in that fileset.
1332 : Otherwise register the current file.
1333 : If COMMENT is present, use that as an initial comment.
1334 :
1335 : The version control system to use is found by cycling through the list
1336 : `vc-handled-backends'. The first backend in that list which declares
1337 : itself responsible for the file (usually because other files in that
1338 : directory are already registered under that backend) will be used to
1339 : register the file. If no backend declares itself responsible, the
1340 : first backend that could register the file is used."
1341 : (interactive "P")
1342 0 : (let* ((fileset-arg (or vc-fileset (vc-deduce-fileset nil t)))
1343 0 : (backend (car fileset-arg))
1344 0 : (files (nth 1 fileset-arg)))
1345 : ;; We used to operate on `only-files', but VC wants to provide the
1346 : ;; possibility to register directories rather than files only, since
1347 : ;; many VCS allow that as well.
1348 0 : (dolist (fname files)
1349 0 : (let ((bname (get-file-buffer fname)))
1350 0 : (unless fname
1351 0 : (setq fname buffer-file-name))
1352 0 : (when (vc-call-backend backend 'registered fname)
1353 0 : (error "This file is already registered"))
1354 : ;; Watch out for new buffers of size 0: the corresponding file
1355 : ;; does not exist yet, even though buffer-modified-p is nil.
1356 0 : (when bname
1357 0 : (with-current-buffer bname
1358 0 : (when (and (not (buffer-modified-p))
1359 0 : (zerop (buffer-size))
1360 0 : (not (file-exists-p buffer-file-name)))
1361 0 : (set-buffer-modified-p t))
1362 0 : (vc-buffer-sync)))))
1363 0 : (message "Registering %s... " files)
1364 0 : (mapc 'vc-file-clearprops files)
1365 0 : (vc-call-backend backend 'register files comment)
1366 0 : (mapc
1367 : (lambda (file)
1368 0 : (vc-file-setprop file 'vc-backend backend)
1369 : ;; FIXME: This is wrong: it should set `backup-inhibited' in all
1370 : ;; the buffers visiting files affected by this `vc-register', not
1371 : ;; in the current-buffer.
1372 : ;; (unless vc-make-backup-files
1373 : ;; (make-local-variable 'backup-inhibited)
1374 : ;; (setq backup-inhibited t))
1375 :
1376 0 : (vc-resynch-buffer file t t))
1377 0 : files)
1378 0 : (when (derived-mode-p 'vc-dir-mode)
1379 0 : (vc-dir-move-to-goal-column))
1380 0 : (message "Registering %s... done" files)))
1381 :
1382 : (defun vc-register-with (backend)
1383 : "Register the current file with a specified back end."
1384 : (interactive "SBackend: ")
1385 0 : (when (not (member backend vc-handled-backends))
1386 0 : (error "Unknown back end"))
1387 0 : (let ((vc-handled-backends (list backend)))
1388 0 : (call-interactively 'vc-register)))
1389 :
1390 : (defun vc-ignore (file &optional directory remove)
1391 : "Ignore FILE under the VCS of DIRECTORY.
1392 :
1393 : Normally, FILE is a wildcard specification that matches the files
1394 : to be ignored. When REMOVE is non-nil, remove FILE from the list
1395 : of ignored files.
1396 :
1397 : DIRECTORY defaults to `default-directory' and is used to
1398 : determine the responsible VC backend.
1399 :
1400 : When called interactively, prompt for a FILE to ignore, unless a
1401 : prefix argument is given, in which case prompt for a file FILE to
1402 : remove from the list of ignored files."
1403 : (interactive
1404 0 : (list
1405 0 : (if (not current-prefix-arg)
1406 0 : (read-file-name "File to ignore: ")
1407 0 : (completing-read
1408 : "File to remove: "
1409 0 : (vc-call-backend
1410 0 : (or (vc-responsible-backend default-directory)
1411 0 : (error "Unknown backend"))
1412 0 : 'ignore-completion-table default-directory)))
1413 0 : nil current-prefix-arg))
1414 0 : (let* ((directory (or directory default-directory))
1415 0 : (backend (or (vc-responsible-backend default-directory)
1416 0 : (error "Unknown backend"))))
1417 0 : (vc-call-backend backend 'ignore file directory remove)))
1418 :
1419 : (defun vc-default-ignore (backend file &optional directory remove)
1420 : "Ignore FILE under the VCS of DIRECTORY (default is `default-directory').
1421 : FILE is a file wildcard, relative to the root directory of DIRECTORY.
1422 : When called from Lisp code, if DIRECTORY is non-nil, the
1423 : repository to use will be deduced by DIRECTORY; if REMOVE is
1424 : non-nil, remove FILE from ignored files.
1425 : Argument BACKEND is the backend you are using."
1426 0 : (let ((ignore
1427 0 : (vc-call-backend backend 'find-ignore-file (or directory default-directory)))
1428 0 : (pattern (file-relative-name
1429 0 : (expand-file-name file) (file-name-directory file))))
1430 0 : (if remove
1431 0 : (vc--remove-regexp pattern ignore)
1432 0 : (vc--add-line pattern ignore))))
1433 :
1434 : (defun vc-default-ignore-completion-table (backend file)
1435 : "Return the list of ignored files under BACKEND."
1436 0 : (cl-delete-if
1437 : (lambda (str)
1438 : ;; Commented or empty lines.
1439 0 : (string-match-p "\\`\\(?:#\\|[ \t\r\n]*\\'\\)" str))
1440 0 : (let ((file (vc-call-backend backend 'find-ignore-file file)))
1441 0 : (and (file-exists-p file)
1442 0 : (vc--read-lines file)))))
1443 :
1444 : (defun vc--read-lines (file)
1445 : "Return a list of lines of FILE."
1446 0 : (with-temp-buffer
1447 0 : (insert-file-contents file)
1448 0 : (split-string (buffer-string) "\n" t)))
1449 :
1450 : ;; Subroutine for `vc-git-ignore' and `vc-hg-ignore'.
1451 : (defun vc--add-line (string file)
1452 : "Add STRING as a line to FILE."
1453 0 : (with-temp-buffer
1454 0 : (insert-file-contents file)
1455 0 : (unless (re-search-forward (concat "^" (regexp-quote string) "$") nil t)
1456 0 : (goto-char (point-max))
1457 0 : (insert (concat "\n" string))
1458 0 : (write-region (point-min) (point-max) file))))
1459 :
1460 : (defun vc--remove-regexp (regexp file)
1461 : "Remove all matching for REGEXP in FILE."
1462 0 : (with-temp-buffer
1463 0 : (insert-file-contents file)
1464 0 : (while (re-search-forward regexp nil t)
1465 0 : (replace-match ""))
1466 0 : (write-region (point-min) (point-max) file)))
1467 :
1468 : (defun vc-checkout (file &optional rev)
1469 : "Retrieve a copy of the revision REV of FILE.
1470 : REV defaults to the latest revision.
1471 :
1472 : After check-out, runs the normal hook `vc-checkout-hook'."
1473 0 : (and (not rev)
1474 0 : (vc-call make-version-backups-p file)
1475 0 : (vc-up-to-date-p file)
1476 0 : (vc-make-version-backup file))
1477 0 : (let ((backend (vc-backend file)))
1478 0 : (with-vc-properties (list file)
1479 0 : (condition-case err
1480 0 : (vc-call-backend backend 'checkout file rev)
1481 : (file-error
1482 : ;; Maybe the backend is not installed ;-(
1483 0 : (when t
1484 0 : (let ((buf (get-file-buffer file)))
1485 0 : (when buf (with-current-buffer buf (read-only-mode -1)))))
1486 0 : (signal (car err) (cdr err))))
1487 0 : `((vc-state . ,(if (or (eq (vc-checkout-model backend (list file)) 'implicit)
1488 0 : nil)
1489 : 'up-to-date
1490 0 : 'edited))
1491 0 : (vc-checkout-time . ,(nth 5 (file-attributes file))))))
1492 0 : (vc-resynch-buffer file t t)
1493 0 : (run-hooks 'vc-checkout-hook))
1494 :
1495 : (defun vc-mark-resolved (backend files)
1496 0 : (prog1 (with-vc-properties
1497 0 : files
1498 0 : (vc-call-backend backend 'mark-resolved files)
1499 : ;; FIXME: Is this TRTD? Might not be.
1500 0 : `((vc-state . edited)))
1501 0 : (message
1502 0 : (substitute-command-keys
1503 : "Conflicts have been resolved in %s. \
1504 0 : Type \\[vc-next-action] to check in changes.")
1505 0 : (if (> (length files) 1)
1506 0 : (format "%d files" (length files))
1507 0 : "this file"))))
1508 :
1509 : (defun vc-steal-lock (file rev owner)
1510 : "Steal the lock on FILE."
1511 0 : (let (file-description)
1512 0 : (if rev
1513 0 : (setq file-description (format "%s:%s" file rev))
1514 0 : (setq file-description file))
1515 0 : (when (not (yes-or-no-p (format "Steal the lock on %s from %s? "
1516 0 : file-description owner)))
1517 0 : (error "Steal canceled"))
1518 0 : (message "Stealing lock on %s..." file)
1519 0 : (with-vc-properties
1520 0 : (list file)
1521 0 : (vc-call steal-lock file rev)
1522 0 : `((vc-state . edited)))
1523 0 : (vc-resynch-buffer file t t)
1524 0 : (message "Stealing lock on %s...done" file)
1525 : ;; Write mail after actually stealing, because if the stealing
1526 : ;; goes wrong, we don't want to send any mail.
1527 0 : (compose-mail owner (format "Stolen lock on %s" file-description))
1528 0 : (setq default-directory (expand-file-name "~/"))
1529 0 : (goto-char (point-max))
1530 0 : (insert
1531 0 : (format "I stole the lock on %s, " file-description)
1532 0 : (current-time-string)
1533 0 : ".\n")
1534 0 : (message "Please explain why you stole the lock. Type C-c C-c when done.")))
1535 :
1536 : (defun vc-checkin (files backend &optional comment initial-contents rev)
1537 : "Check in FILES. COMMENT is a comment string; if omitted, a
1538 : buffer is popped up to accept a comment. If INITIAL-CONTENTS is
1539 : non-nil, then COMMENT is used as the initial contents of the log
1540 : entry buffer.
1541 : The optional argument REV may be a string specifying the new revision
1542 : level (only supported for some older VCSes, like RCS and CVS).
1543 :
1544 : Runs the normal hooks `vc-before-checkin-hook' and `vc-checkin-hook'."
1545 0 : (when vc-before-checkin-hook
1546 0 : (run-hooks 'vc-before-checkin-hook))
1547 0 : (vc-start-logentry
1548 0 : files comment initial-contents
1549 : "Enter a change comment."
1550 : "*vc-log*"
1551 : (lambda ()
1552 0 : (vc-call-backend backend 'log-edit-mode))
1553 : (lambda (files comment)
1554 0 : (message "Checking in %s..." (vc-delistify files))
1555 : ;; "This log message intentionally left almost blank".
1556 : ;; RCS 5.7 gripes about white-space-only comments too.
1557 0 : (or (and comment (string-match "[^\t\n ]" comment))
1558 0 : (setq comment "*** empty log message ***"))
1559 0 : (with-vc-properties
1560 0 : files
1561 : ;; We used to change buffers to get local value of
1562 : ;; vc-checkin-switches, but 'the' local buffer is
1563 : ;; not a well-defined concept for filesets.
1564 0 : (progn
1565 0 : (vc-call-backend backend 'checkin files comment rev)
1566 0 : (mapc 'vc-delete-automatic-version-backups files))
1567 0 : `((vc-state . up-to-date)
1568 0 : (vc-checkout-time . ,(nth 5 (file-attributes file)))
1569 0 : (vc-working-revision . nil)))
1570 0 : (message "Checking in %s...done" (vc-delistify files)))
1571 : 'vc-checkin-hook
1572 0 : backend))
1573 :
1574 : ;;; Additional entry points for examining version histories
1575 :
1576 : ;; (defun vc-default-diff-tree (backend dir rev1 rev2)
1577 : ;; "List differences for all registered files at and below DIR.
1578 : ;; The meaning of REV1 and REV2 is the same as for `vc-revision-diff'."
1579 : ;; ;; This implementation does an explicit tree walk, and calls
1580 : ;; ;; vc-BACKEND-diff directly for each file. An optimization
1581 : ;; ;; would be to use `vc-diff-internal', so that diffs can be local,
1582 : ;; ;; and to call it only for files that are actually changed.
1583 : ;; ;; However, this is expensive for some backends, and so it is left
1584 : ;; ;; to backend-specific implementations.
1585 : ;; (setq default-directory dir)
1586 : ;; (vc-file-tree-walk
1587 : ;; default-directory
1588 : ;; (lambda (f)
1589 : ;; (vc-run-delayed
1590 : ;; (let ((coding-system-for-read (vc-coding-system-for-diff f)))
1591 : ;; (message "Looking at %s" f)
1592 : ;; (vc-call-backend (vc-backend f)
1593 : ;; 'diff (list f) rev1 rev2))))))
1594 :
1595 : (defvar vc-coding-system-inherit-eol t
1596 : "When non-nil, inherit the EOL format for reading Diff output from the file.
1597 :
1598 : Used in `vc-coding-system-for-diff' to determine the EOL format to use
1599 : for reading Diff output for a file. If non-nil, the EOL format is
1600 : inherited from the file itself.
1601 : Set this variable to nil if your Diff tool might use a different
1602 : EOL. Then Emacs will auto-detect the EOL format in Diff output, which
1603 : gives better results.") ;; Cf. bug#4451.
1604 :
1605 : (defun vc-coding-system-for-diff (file)
1606 : "Return the coding system for reading diff output for FILE."
1607 0 : (or coding-system-for-read
1608 : ;; if we already have this file open,
1609 : ;; use the buffer's coding system
1610 0 : (let ((buf (find-buffer-visiting file)))
1611 0 : (when buf (with-current-buffer buf
1612 0 : (if vc-coding-system-inherit-eol
1613 0 : buffer-file-coding-system
1614 : ;; Don't inherit the EOL part of the coding-system,
1615 : ;; because some Diff tools may choose to use
1616 : ;; a different one. bug#4451.
1617 0 : (coding-system-base buffer-file-coding-system)))))
1618 : ;; otherwise, try to find one based on the file name
1619 0 : (car (find-operation-coding-system 'insert-file-contents file))
1620 : ;; and a final fallback
1621 0 : 'undecided))
1622 :
1623 : (defun vc-switches (backend op)
1624 : "Return a list of vc-BACKEND switches for operation OP.
1625 : BACKEND is a symbol such as `CVS', which will be downcased.
1626 : OP is a symbol such as `diff'.
1627 :
1628 : In decreasing order of preference, return the value of:
1629 : vc-BACKEND-OP-switches (e.g. `vc-cvs-diff-switches');
1630 : vc-OP-switches (e.g. `vc-diff-switches'); or, in the case of
1631 : diff only, `diff-switches'.
1632 :
1633 : If the chosen value is not a string or a list, return nil.
1634 : This is so that you may set, e.g. `vc-svn-diff-switches' to t in order
1635 : to override the value of `vc-diff-switches' and `diff-switches'."
1636 0 : (let ((switches
1637 0 : (or (when backend
1638 0 : (let ((sym (vc-make-backend-sym
1639 0 : backend (intern (concat (symbol-name op)
1640 0 : "-switches")))))
1641 0 : (when (boundp sym) (symbol-value sym))))
1642 0 : (let ((sym (intern (format "vc-%s-switches" (symbol-name op)))))
1643 0 : (when (boundp sym) (symbol-value sym)))
1644 0 : (cond
1645 0 : ((eq op 'diff) diff-switches)))))
1646 0 : (if (stringp switches) (list switches)
1647 : ;; If not a list, return nil.
1648 : ;; This is so we can set vc-diff-switches to t to override
1649 : ;; any switches in diff-switches.
1650 0 : (when (listp switches) switches))))
1651 :
1652 : ;; Old def for compatibility with Emacs-21.[123].
1653 : (defmacro vc-diff-switches-list (backend)
1654 : (declare (obsolete vc-switches "22.1"))
1655 0 : `(vc-switches ',backend 'diff))
1656 :
1657 : (defun vc-diff-finish (buffer messages)
1658 : ;; The empty sync output case has already been handled, so the only
1659 : ;; possibility of an empty output is for an async process.
1660 0 : (when (buffer-live-p buffer)
1661 0 : (let ((window (get-buffer-window buffer t))
1662 0 : (emptyp (zerop (buffer-size buffer))))
1663 0 : (with-current-buffer buffer
1664 0 : (and messages emptyp
1665 0 : (let ((inhibit-read-only t))
1666 0 : (insert (cdr messages) ".\n")
1667 0 : (message "%s" (cdr messages))))
1668 0 : (diff-setup-whitespace)
1669 0 : (goto-char (point-min))
1670 0 : (when window
1671 0 : (shrink-window-if-larger-than-buffer window)))
1672 0 : (when (and messages (not emptyp))
1673 0 : (message "%sdone" (car messages))))))
1674 :
1675 : (defvar vc-diff-added-files nil
1676 : "If non-nil, diff added files by comparing them to /dev/null.")
1677 :
1678 : (defun vc-diff-internal (async vc-fileset rev1 rev2 &optional verbose buffer)
1679 : "Report diffs between two revisions of a fileset.
1680 : Output goes to the buffer BUFFER, which defaults to *vc-diff*.
1681 : BUFFER, if non-nil, should be a buffer or a buffer name.
1682 : Return t if the buffer had changes, nil otherwise."
1683 0 : (unless buffer
1684 0 : (setq buffer "*vc-diff*"))
1685 0 : (let* ((files (cadr vc-fileset))
1686 0 : (messages (cons (format "Finding changes in %s..."
1687 0 : (vc-delistify files))
1688 0 : (format "No changes between %s and %s"
1689 0 : (or rev1 "working revision")
1690 0 : (or rev2 "workfile"))))
1691 : ;; Set coding system based on the first file. It's a kluge,
1692 : ;; but the only way to set it for each file included would
1693 : ;; be to call the back end separately for each file.
1694 : (coding-system-for-read
1695 0 : (if files (vc-coding-system-for-diff (car files)) 'undecided)))
1696 : ;; On MS-Windows and MS-DOS, Diff is likely to produce DOS-style
1697 : ;; EOLs, which will look ugly if (car files) happens to have Unix
1698 : ;; EOLs.
1699 0 : (if (memq system-type '(windows-nt ms-dos))
1700 0 : (setq coding-system-for-read
1701 0 : (coding-system-change-eol-conversion coding-system-for-read
1702 0 : 'dos)))
1703 0 : (vc-setup-buffer buffer)
1704 0 : (message "%s" (car messages))
1705 : ;; Many backends don't handle well the case of a file that has been
1706 : ;; added but not yet committed to the repo (notably CVS and Subversion).
1707 : ;; Do that work here so the backends don't have to futz with it. --ESR
1708 : ;;
1709 : ;; Actually most backends (including CVS) have options to control the
1710 : ;; behavior since which one is better depends on the user and on the
1711 : ;; situation). Worse yet: this code does not handle the case where
1712 : ;; `file' is a directory which contains added files.
1713 : ;; I made it conditional on vc-diff-added-files but it should probably
1714 : ;; just be removed (or copied/moved to specific backends). --Stef.
1715 0 : (when vc-diff-added-files
1716 0 : (let ((filtered '())
1717 : process-file-side-effects)
1718 0 : (dolist (file files)
1719 0 : (if (or (file-directory-p file)
1720 0 : (not (string= (vc-working-revision file) "0")))
1721 0 : (push file filtered)
1722 : ;; This file is added but not yet committed;
1723 : ;; there is no repository version to diff against.
1724 0 : (if (or rev1 rev2)
1725 0 : (error "No revisions of %s exist" file)
1726 : ;; We regard this as "changed".
1727 : ;; Diff it against /dev/null.
1728 0 : (apply 'vc-do-command buffer
1729 0 : (if async 'async 1) "diff" file
1730 0 : (append (vc-switches nil 'diff) '("/dev/null"))))))
1731 0 : (setq files (nreverse filtered))))
1732 0 : (vc-call-backend (car vc-fileset) 'diff files rev1 rev2 buffer async)
1733 0 : (set-buffer buffer)
1734 0 : (diff-mode)
1735 0 : (set (make-local-variable 'diff-vc-backend) (car vc-fileset))
1736 0 : (set (make-local-variable 'revert-buffer-function)
1737 : (lambda (_ignore-auto _noconfirm)
1738 0 : (vc-diff-internal async vc-fileset rev1 rev2 verbose)))
1739 : ;; Make the *vc-diff* buffer read only, the diff-mode key
1740 : ;; bindings are nicer for read only buffers. pcl-cvs does the
1741 : ;; same thing.
1742 0 : (setq buffer-read-only t)
1743 0 : (if (and (zerop (buffer-size))
1744 0 : (not (get-buffer-process (current-buffer))))
1745 : ;; Treat this case specially so as not to pop the buffer.
1746 0 : (progn
1747 0 : (message "%s" (cdr messages))
1748 0 : nil)
1749 : ;; Display the buffer, but at the end because it can change point.
1750 0 : (pop-to-buffer (current-buffer))
1751 : ;; The diff process may finish early, so call `vc-diff-finish'
1752 : ;; after `pop-to-buffer'; the former assumes the diff buffer is
1753 : ;; shown in some window.
1754 0 : (let ((buf (current-buffer)))
1755 0 : (vc-run-delayed (vc-diff-finish buf (when verbose messages))))
1756 : ;; In the async case, we return t even if there are no differences
1757 : ;; because we don't know that yet.
1758 0 : t)))
1759 :
1760 : (defvar vc-revision-history nil
1761 : "History for `vc-read-revision'.")
1762 :
1763 : (defun vc-read-revision (prompt &optional files backend default initial-input)
1764 0 : (cond
1765 0 : ((null files)
1766 0 : (let ((vc-fileset (vc-deduce-fileset t))) ;FIXME: why t? --Stef
1767 0 : (setq files (cadr vc-fileset))
1768 0 : (setq backend (car vc-fileset))))
1769 0 : ((null backend) (setq backend (vc-backend (car files)))))
1770 0 : (let ((completion-table
1771 0 : (vc-call-backend backend 'revision-completion-table files)))
1772 0 : (if completion-table
1773 0 : (completing-read prompt completion-table
1774 0 : nil nil initial-input 'vc-revision-history default)
1775 0 : (read-string prompt initial-input nil default))))
1776 :
1777 : (defun vc-diff-build-argument-list-internal ()
1778 : "Build argument list for calling internal diff functions."
1779 0 : (let* ((vc-fileset (vc-deduce-fileset t)) ;FIXME: why t? --Stef
1780 0 : (files (cadr vc-fileset))
1781 0 : (backend (car vc-fileset))
1782 0 : (first (car files))
1783 : (rev1-default nil)
1784 : (rev2-default nil))
1785 0 : (cond
1786 : ;; someday we may be able to do revision completion on non-singleton
1787 : ;; filesets, but not yet.
1788 0 : ((/= (length files) 1)
1789 : nil)
1790 : ;; if it's a directory, don't supply any revision default
1791 0 : ((file-directory-p first)
1792 : nil)
1793 : ;; if the file is not up-to-date, use working revision as older revision
1794 0 : ((not (vc-up-to-date-p first))
1795 0 : (setq rev1-default (vc-working-revision first)))
1796 : ;; if the file is not locked, use last revision and current source as defaults
1797 : (t
1798 0 : (setq rev1-default (ignore-errors ;If `previous-revision' doesn't work.
1799 0 : (vc-call-backend backend 'previous-revision first
1800 0 : (vc-working-revision first))))
1801 0 : (when (string= rev1-default "") (setq rev1-default nil))))
1802 : ;; construct argument list
1803 0 : (let* ((rev1-prompt (if rev1-default
1804 0 : (concat "Older revision (default "
1805 0 : rev1-default "): ")
1806 0 : "Older revision: "))
1807 0 : (rev2-prompt (concat "Newer revision (default "
1808 0 : (or rev2-default "current source") "): "))
1809 0 : (rev1 (vc-read-revision rev1-prompt files backend rev1-default))
1810 0 : (rev2 (vc-read-revision rev2-prompt files backend rev2-default)))
1811 0 : (when (string= rev1 "") (setq rev1 nil))
1812 0 : (when (string= rev2 "") (setq rev2 nil))
1813 0 : (list files rev1 rev2))))
1814 :
1815 : ;;;###autoload
1816 : (defun vc-version-diff (_files rev1 rev2)
1817 : "Report diffs between revisions of the fileset in the repository history."
1818 0 : (interactive (vc-diff-build-argument-list-internal))
1819 : ;; All that was just so we could do argument completion!
1820 0 : (when (and (not rev1) rev2)
1821 0 : (error "Not a valid revision range"))
1822 : ;; Yes, it's painful to call (vc-deduce-fileset) again. Alas, the
1823 : ;; placement rules for (interactive) don't actually leave us a choice.
1824 0 : (vc-diff-internal t (vc-deduce-fileset t) rev1 rev2
1825 0 : (called-interactively-p 'interactive)))
1826 :
1827 : ;;;###autoload
1828 : (defun vc-diff (&optional historic not-urgent)
1829 : "Display diffs between file revisions.
1830 : Normally this compares the currently selected fileset with their
1831 : working revisions. With a prefix argument HISTORIC, it reads two revision
1832 : designators specifying which revisions to compare.
1833 :
1834 : The optional argument NOT-URGENT non-nil means it is ok to say no to
1835 : saving the buffer."
1836 0 : (interactive (list current-prefix-arg t))
1837 0 : (if historic
1838 0 : (call-interactively 'vc-version-diff)
1839 0 : (when buffer-file-name (vc-buffer-sync not-urgent))
1840 0 : (vc-diff-internal t (vc-deduce-fileset t) nil nil
1841 0 : (called-interactively-p 'interactive))))
1842 :
1843 : (declare-function ediff-load-version-control "ediff" (&optional silent))
1844 : (declare-function ediff-vc-internal "ediff-vers"
1845 : (rev1 rev2 &optional startup-hooks))
1846 :
1847 : ;;;###autoload
1848 : (defun vc-version-ediff (files rev1 rev2)
1849 : "Show differences between revisions of the fileset in the
1850 : repository history using ediff."
1851 0 : (interactive (vc-diff-build-argument-list-internal))
1852 : ;; All that was just so we could do argument completion!
1853 0 : (when (and (not rev1) rev2)
1854 0 : (error "Not a valid revision range"))
1855 :
1856 0 : (message "%s" (format "Finding changes in %s..." (vc-delistify files)))
1857 :
1858 : ;; Functions ediff-(vc|rcs)-internal use "" instead of nil.
1859 0 : (when (null rev1) (setq rev1 ""))
1860 0 : (when (null rev2) (setq rev2 ""))
1861 :
1862 0 : (cond
1863 : ;; FIXME We only support running ediff on one file for now.
1864 : ;; We could spin off an ediff session per file in the file set.
1865 0 : ((= (length files) 1)
1866 0 : (require 'ediff)
1867 0 : (ediff-load-version-control) ; loads ediff-vers
1868 0 : (find-file (car files)) ;FIXME: find-file from Elisp is bad.
1869 0 : (ediff-vc-internal rev1 rev2 nil))
1870 : (t
1871 0 : (error "More than one file is not supported"))))
1872 :
1873 : ;;;###autoload
1874 : (defun vc-ediff (historic &optional not-urgent)
1875 : "Display diffs between file revisions using ediff.
1876 : Normally this compares the currently selected fileset with their
1877 : working revisions. With a prefix argument HISTORIC, it reads two revision
1878 : designators specifying which revisions to compare.
1879 :
1880 : The optional argument NOT-URGENT non-nil means it is ok to say no to
1881 : saving the buffer."
1882 0 : (interactive (list current-prefix-arg t))
1883 0 : (if historic
1884 0 : (call-interactively 'vc-version-ediff)
1885 0 : (when buffer-file-name (vc-buffer-sync not-urgent))
1886 0 : (vc-version-ediff (cadr (vc-deduce-fileset t)) nil nil)))
1887 :
1888 : ;;;###autoload
1889 : (defun vc-root-diff (historic &optional not-urgent)
1890 : "Display diffs between VC-controlled whole tree revisions.
1891 : Normally, this compares the tree corresponding to the current
1892 : fileset with the working revision.
1893 : With a prefix argument HISTORIC, prompt for two revision
1894 : designators specifying which revisions to compare.
1895 :
1896 : The optional argument NOT-URGENT non-nil means it is ok to say no to
1897 : saving the buffer."
1898 0 : (interactive (list current-prefix-arg t))
1899 0 : (if historic
1900 : ;; FIXME: this does not work right, `vc-version-diff' ends up
1901 : ;; calling `vc-deduce-fileset' to find the files to diff, and
1902 : ;; that's not what we want here, we want the diff for the VC root dir.
1903 0 : (call-interactively 'vc-version-diff)
1904 0 : (when buffer-file-name (vc-buffer-sync not-urgent))
1905 0 : (let ((backend (vc-deduce-backend))
1906 0 : (default-directory default-directory)
1907 : rootdir working-revision)
1908 0 : (if backend
1909 0 : (setq rootdir (vc-call-backend backend 'root default-directory))
1910 0 : (setq rootdir (read-directory-name "Directory for VC root-diff: "))
1911 0 : (setq backend (vc-responsible-backend rootdir))
1912 0 : (if backend
1913 0 : (setq default-directory rootdir)
1914 0 : (error "Directory is not version controlled")))
1915 0 : (setq working-revision (vc-working-revision rootdir))
1916 : ;; VC diff for the root directory produces output that is
1917 : ;; relative to it. Bind default-directory to the root directory
1918 : ;; here, this way the *vc-diff* buffer is setup correctly, so
1919 : ;; relative file names work.
1920 0 : (let ((default-directory rootdir))
1921 0 : (vc-diff-internal
1922 0 : t (list backend (list rootdir) working-revision) nil nil
1923 0 : (called-interactively-p 'interactive))))))
1924 :
1925 : ;;;###autoload
1926 : (defun vc-root-dir ()
1927 : "Return the root directory for the current VC tree.
1928 : Return nil if the root directory cannot be identified."
1929 0 : (let ((backend (vc-deduce-backend)))
1930 0 : (if backend
1931 0 : (condition-case err
1932 0 : (vc-call-backend backend 'root default-directory)
1933 : (vc-not-supported
1934 0 : (unless (eq (cadr err) 'root)
1935 0 : (signal (car err) (cdr err)))
1936 0 : nil)))))
1937 :
1938 : ;;;###autoload
1939 : (defun vc-revision-other-window (rev)
1940 : "Visit revision REV of the current file in another window.
1941 : If the current file is named `F', the revision is named `F.~REV~'.
1942 : If `F.~REV~' already exists, use it instead of checking it out again."
1943 : (interactive
1944 0 : (save-current-buffer
1945 0 : (vc-ensure-vc-buffer)
1946 0 : (list
1947 0 : (vc-read-revision "Revision to visit (default is working revision): "
1948 0 : (list buffer-file-name)))))
1949 0 : (vc-ensure-vc-buffer)
1950 0 : (let* ((file buffer-file-name)
1951 0 : (revision (if (string-equal rev "")
1952 0 : (vc-working-revision file)
1953 0 : rev)))
1954 0 : (switch-to-buffer-other-window (vc-find-revision file revision))))
1955 :
1956 : (defun vc-find-revision (file revision &optional backend)
1957 : "Read REVISION of FILE into a buffer and return the buffer.
1958 : Use BACKEND as the VC backend if specified."
1959 0 : (let ((automatic-backup (vc-version-backup-file-name file revision))
1960 0 : (filebuf (or (get-file-buffer file) (current-buffer)))
1961 0 : (filename (vc-version-backup-file-name file revision 'manual)))
1962 0 : (unless (file-exists-p filename)
1963 0 : (if (file-exists-p automatic-backup)
1964 0 : (rename-file automatic-backup filename nil)
1965 0 : (message "Checking out %s..." filename)
1966 0 : (with-current-buffer filebuf
1967 0 : (let ((failed t))
1968 0 : (unwind-protect
1969 0 : (let ((coding-system-for-read 'no-conversion)
1970 : (coding-system-for-write 'no-conversion))
1971 0 : (with-temp-file filename
1972 0 : (let ((outbuf (current-buffer)))
1973 : ;; Change buffer to get local value of
1974 : ;; vc-checkout-switches.
1975 0 : (with-current-buffer filebuf
1976 0 : (if backend
1977 0 : (vc-call-backend backend 'find-revision file revision outbuf)
1978 0 : (vc-call find-revision file revision outbuf)))))
1979 0 : (setq failed nil))
1980 0 : (when (and failed (file-exists-p filename))
1981 0 : (delete-file filename))))
1982 0 : (vc-mode-line file))
1983 0 : (message "Checking out %s...done" filename)))
1984 0 : (let ((result-buf (find-file-noselect filename)))
1985 0 : (with-current-buffer result-buf
1986 : ;; Set the parent buffer so that things like
1987 : ;; C-x v g, C-x v l, ... etc work.
1988 0 : (set (make-local-variable 'vc-parent-buffer) filebuf))
1989 0 : result-buf)))
1990 :
1991 : ;; Header-insertion code
1992 :
1993 : ;;;###autoload
1994 : (defun vc-insert-headers ()
1995 : "Insert headers into a file for use with a version control system.
1996 : Headers desired are inserted at point, and are pulled from
1997 : the variable `vc-BACKEND-header'."
1998 : (interactive)
1999 0 : (vc-ensure-vc-buffer)
2000 0 : (save-excursion
2001 0 : (save-restriction
2002 0 : (widen)
2003 0 : (when (or (not (vc-check-headers))
2004 0 : (y-or-n-p "Version headers already exist. Insert another set? "))
2005 0 : (let* ((delims (cdr (assq major-mode vc-comment-alist)))
2006 0 : (comment-start-vc (or (car delims) comment-start "#"))
2007 0 : (comment-end-vc (or (car (cdr delims)) comment-end ""))
2008 0 : (hdsym (vc-make-backend-sym (vc-backend buffer-file-name)
2009 0 : 'header))
2010 0 : (hdstrings (and (boundp hdsym) (symbol-value hdsym))))
2011 0 : (dolist (s hdstrings)
2012 0 : (insert comment-start-vc "\t" s "\t"
2013 0 : comment-end-vc "\n"))
2014 0 : (when vc-static-header-alist
2015 0 : (dolist (f vc-static-header-alist)
2016 0 : (when (string-match (car f) buffer-file-name)
2017 0 : (insert (format (cdr f) (car hdstrings)))))))))))
2018 :
2019 : (defun vc-modify-change-comment (files rev oldcomment)
2020 : "Edit the comment associated with the given files and revision."
2021 : ;; Less of a kluge than it looks like; log-view mode only passes
2022 : ;; this function a singleton list. Arguments left in this form in
2023 : ;; case the more general operation ever becomes meaningful.
2024 0 : (let ((backend (vc-responsible-backend (car files))))
2025 0 : (vc-start-logentry
2026 0 : files oldcomment t
2027 : "Enter a replacement change comment."
2028 : "*vc-log*"
2029 0 : (lambda () (vc-call-backend backend 'log-edit-mode))
2030 : (lambda (files comment)
2031 0 : (vc-call-backend backend
2032 0 : 'modify-change-comment files rev comment)))))
2033 :
2034 : ;;;###autoload
2035 : (defun vc-merge ()
2036 : "Perform a version control merge operation.
2037 : You must be visiting a version controlled file, or in a `vc-dir' buffer.
2038 : On a distributed version control system, this runs a \"merge\"
2039 : operation to incorporate changes from another branch onto the
2040 : current branch, prompting for an argument list.
2041 :
2042 : On a non-distributed version control system, this merges changes
2043 : between two revisions into the current fileset. This asks for
2044 : two revisions to merge from in the minibuffer. If the first
2045 : revision is a branch number, then merge all changes from that
2046 : branch. If the first revision is empty, merge the most recent
2047 : changes from the current branch."
2048 : (interactive)
2049 0 : (let* ((vc-fileset (vc-deduce-fileset t))
2050 0 : (backend (car vc-fileset))
2051 0 : (files (cadr vc-fileset)))
2052 0 : (cond
2053 : ;; If a branch-merge operation is defined, use it.
2054 0 : ((vc-find-backend-function backend 'merge-branch)
2055 0 : (vc-call-backend backend 'merge-branch))
2056 : ;; Otherwise, do a per-file merge.
2057 0 : ((vc-find-backend-function backend 'merge)
2058 0 : (vc-buffer-sync)
2059 0 : (dolist (file files)
2060 0 : (let* ((state (vc-state file))
2061 : status)
2062 0 : (cond
2063 0 : ((stringp state) ;; Locking VCses only
2064 0 : (error "File %s is locked by %s" file state))
2065 0 : ((not (vc-editable-p file))
2066 0 : (vc-checkout file t)))
2067 0 : (setq status (vc-call-backend backend 'merge-file file))
2068 0 : (vc-maybe-resolve-conflicts file status "WORKFILE" "MERGE SOURCE"))))
2069 : (t
2070 0 : (error "Sorry, merging is not implemented for %s" backend)))))
2071 :
2072 : (defun vc-maybe-resolve-conflicts (file status &optional _name-A _name-B)
2073 0 : (vc-resynch-buffer file t (not (buffer-modified-p)))
2074 0 : (if (zerop status) (message "Merge successful")
2075 0 : (smerge-mode 1)
2076 0 : (message "File contains conflicts.")))
2077 :
2078 : ;;;###autoload
2079 : (defun vc-message-unresolved-conflicts (filename)
2080 : "Display a message indicating unresolved conflicts in FILENAME."
2081 : ;; This enables all VC backends to give a standard, recognizable
2082 : ;; conflict message that indicates which file is conflicted.
2083 0 : (message "There are unresolved conflicts in %s" filename))
2084 :
2085 : ;;;###autoload
2086 : (defalias 'vc-resolve-conflicts 'smerge-ediff)
2087 :
2088 : ;; TODO: This is OK but maybe we could integrate it better.
2089 : ;; E.g. it could be run semi-automatically (via a prompt?) when saving a file
2090 : ;; that was conflicted (i.e. upon mark-resolved).
2091 : ;; FIXME: should we add an "other-window" version? Or maybe we should
2092 : ;; hook it inside find-file so it automatically works for
2093 : ;; find-file-other-window as well. E.g. find-file could use a new
2094 : ;; `default-next-file' variable for its default file (M-n), and
2095 : ;; we could then set it upon mark-resolve, so C-x C-s C-x C-f M-n would
2096 : ;; automatically offer the next conflicted file.
2097 : (defun vc-find-conflicted-file ()
2098 : "Visit the next conflicted file in the current project."
2099 : (interactive)
2100 0 : (let* ((backend (or (if buffer-file-name (vc-backend buffer-file-name))
2101 0 : (vc-responsible-backend default-directory)
2102 0 : (error "No VC backend")))
2103 0 : (root (vc-root-dir))
2104 0 : (files (vc-call-backend backend
2105 0 : 'conflicted-files (or root default-directory))))
2106 : ;; Don't try and visit the current file.
2107 0 : (if (equal (car files) buffer-file-name) (pop files))
2108 0 : (if (null files)
2109 0 : (message "No more conflicted files")
2110 0 : (find-file (pop files))
2111 0 : (message "%s more conflicted files after this one"
2112 0 : (if files (length files) "No")))))
2113 :
2114 : ;; Named-configuration entry points
2115 :
2116 : (defun vc-tag-precondition (dir)
2117 : "Scan the tree below DIR, looking for files not up-to-date.
2118 : If any file is not up-to-date, return the name of the first such file.
2119 : \(This means, neither tag creation nor retrieval is allowed.)
2120 : If one or more of the files are currently visited, return `visited'.
2121 : Otherwise, return nil."
2122 0 : (let ((status nil))
2123 0 : (catch 'vc-locked-example
2124 0 : (vc-file-tree-walk
2125 0 : dir
2126 : (lambda (f)
2127 0 : (if (not (vc-up-to-date-p f)) (throw 'vc-locked-example f)
2128 0 : (when (get-file-buffer f) (setq status 'visited)))))
2129 0 : status)))
2130 :
2131 : ;;;###autoload
2132 : (defun vc-create-tag (dir name branchp)
2133 : "Descending recursively from DIR, make a tag called NAME.
2134 : For each registered file, the working revision becomes part of
2135 : the named configuration. If the prefix argument BRANCHP is
2136 : given, the tag is made as a new branch and the files are
2137 : checked out in that new branch."
2138 : (interactive
2139 0 : (let ((granularity
2140 0 : (vc-call-backend (vc-responsible-backend default-directory)
2141 0 : 'revision-granularity)))
2142 0 : (list
2143 0 : (if (eq granularity 'repository)
2144 : ;; For VC's that do not work at file level, it's pointless
2145 : ;; to ask for a directory, branches are created at repository level.
2146 0 : default-directory
2147 0 : (read-directory-name "Directory: " default-directory default-directory t))
2148 0 : (read-string (if current-prefix-arg "New branch name: " "New tag name: "))
2149 0 : current-prefix-arg)))
2150 0 : (message "Making %s... " (if branchp "branch" "tag"))
2151 0 : (when (file-directory-p dir) (setq dir (file-name-as-directory dir)))
2152 0 : (vc-call-backend (vc-responsible-backend dir)
2153 0 : 'create-tag dir name branchp)
2154 0 : (vc-resynch-buffer dir t t t)
2155 0 : (message "Making %s... done" (if branchp "branch" "tag")))
2156 :
2157 : ;;;###autoload
2158 : (defun vc-retrieve-tag (dir name)
2159 : "For each file in or below DIR, retrieve their tagged version NAME.
2160 : NAME can name a branch, in which case this command will switch to the
2161 : named branch in the directory DIR.
2162 : Interactively, prompt for DIR only for VCS that works at file level;
2163 : otherwise use the repository root of the current buffer.
2164 : If NAME is empty, it refers to the latest revisions of the current branch.
2165 : If locking is used for the files in DIR, then there must not be any
2166 : locked files at or below DIR (but if NAME is empty, locked files are
2167 : allowed and simply skipped)."
2168 : (interactive
2169 0 : (let* ((granularity
2170 0 : (vc-call-backend (vc-responsible-backend default-directory)
2171 0 : 'revision-granularity))
2172 : (dir
2173 0 : (if (eq granularity 'repository)
2174 : ;; For VC's that do not work at file level, it's pointless
2175 : ;; to ask for a directory, branches are created at repository level.
2176 : ;; XXX: Either we call expand-file-name here, or use
2177 : ;; file-in-directory-p inside vc-resynch-buffers-in-directory.
2178 0 : (expand-file-name (vc-root-dir))
2179 0 : (read-directory-name "Directory: " default-directory nil t))))
2180 0 : (list
2181 0 : dir
2182 0 : (vc-read-revision "Tag name to retrieve (default latest revisions): "
2183 0 : (list dir)
2184 0 : (vc-responsible-backend dir)))))
2185 0 : (let ((update (yes-or-no-p "Update any affected buffers? "))
2186 0 : (msg (if (or (not name) (string= name ""))
2187 0 : (format "Updating %s... " (abbreviate-file-name dir))
2188 0 : (format "Retrieving tag into %s... "
2189 0 : (abbreviate-file-name dir)))))
2190 0 : (message "%s" msg)
2191 0 : (vc-call-backend (vc-responsible-backend dir)
2192 0 : 'retrieve-tag dir name update)
2193 0 : (vc-resynch-buffer dir t t t)
2194 0 : (message "%s" (concat msg "done"))))
2195 :
2196 :
2197 : ;; Miscellaneous other entry points
2198 :
2199 : ;; FIXME: this should be a defcustom
2200 : ;; FIXME: maybe add another choice:
2201 : ;; `root-directory' (or somesuch), which would mean show a short log
2202 : ;; for the root directory.
2203 : (defvar vc-log-short-style '(directory)
2204 : "Whether or not to show a short log.
2205 : If it contains `directory' then if the fileset contains a directory show a short log.
2206 : If it contains `file' then show short logs for files.
2207 : Not all VC backends support short logs!")
2208 :
2209 : (defvar log-view-vc-fileset)
2210 :
2211 : (defun vc-print-log-setup-buttons (working-revision is-start-revision limit pl-return)
2212 : "Insert at the end of the current buffer buttons to show more log entries.
2213 : In the new log, leave point at WORKING-REVISION (if non-nil).
2214 : LIMIT is the number of entries currently shown.
2215 : Does nothing if IS-START-REVISION is non-nil, or if LIMIT is nil,
2216 : or if PL-RETURN is `limit-unsupported'."
2217 0 : (when (and limit (not (eq 'limit-unsupported pl-return))
2218 0 : (not is-start-revision))
2219 0 : (goto-char (point-max))
2220 0 : (insert "\n")
2221 0 : (insert-text-button "Show 2X entries"
2222 : 'action (lambda (&rest _ignore)
2223 0 : (vc-print-log-internal
2224 0 : log-view-vc-backend log-view-vc-fileset
2225 0 : working-revision nil (* 2 limit)))
2226 0 : 'help-echo "Show the log again, and double the number of log entries shown")
2227 0 : (insert " ")
2228 0 : (insert-text-button "Show unlimited entries"
2229 : 'action (lambda (&rest _ignore)
2230 0 : (vc-print-log-internal
2231 0 : log-view-vc-backend log-view-vc-fileset
2232 0 : working-revision nil nil))
2233 0 : 'help-echo "Show the log again, including all entries")))
2234 :
2235 : (defun vc-print-log-internal (backend files working-revision
2236 : &optional is-start-revision limit)
2237 : "For specified BACKEND and FILES, show the VC log.
2238 : Leave point at WORKING-REVISION, if it is non-nil.
2239 : If IS-START-REVISION is non-nil, start the log from WORKING-REVISION
2240 : \(not all backends support this); i.e., show only WORKING-REVISION and
2241 : earlier revisions. Show up to LIMIT entries (non-nil means unlimited)."
2242 : ;; As of 2013/04 the only thing that passes IS-START-REVISION non-nil
2243 : ;; is vc-annotate-show-log-revision-at-line, which sets LIMIT = 1.
2244 :
2245 : ;; Don't switch to the output buffer before running the command,
2246 : ;; so that any buffer-local settings in the vc-controlled
2247 : ;; buffer can be accessed by the command.
2248 0 : (let* ((dir-present (cl-some #'file-directory-p files))
2249 0 : (shortlog (not (null (memq (if dir-present 'directory 'file)
2250 0 : vc-log-short-style))))
2251 : (buffer-name "*vc-change-log*")
2252 0 : (type (if shortlog 'short 'long)))
2253 0 : (vc-log-internal-common
2254 0 : backend buffer-name files type
2255 : (lambda (bk buf _type-arg files-arg)
2256 0 : (vc-call-backend bk 'print-log files-arg buf shortlog
2257 0 : (when is-start-revision working-revision) limit))
2258 : (lambda (_bk _files-arg ret)
2259 0 : (vc-print-log-setup-buttons working-revision
2260 0 : is-start-revision limit ret))
2261 : ;; When it's nil, point really shouldn't move (bug#15322).
2262 0 : (when working-revision
2263 : (lambda (bk)
2264 0 : (vc-call-backend bk 'show-log-entry working-revision)))
2265 : (lambda (_ignore-auto _noconfirm)
2266 0 : (vc-print-log-internal backend files working-revision
2267 0 : is-start-revision limit)))))
2268 :
2269 : (defvar vc-log-view-type nil
2270 : "Set this to differentiate the different types of logs.")
2271 : (put 'vc-log-view-type 'permanent-local t)
2272 : (defvar vc-sentinel-movepoint)
2273 :
2274 : (defun vc-log-internal-common (backend
2275 : buffer-name
2276 : files
2277 : type
2278 : backend-func
2279 : setup-buttons-func
2280 : goto-location-func
2281 : rev-buff-func)
2282 0 : (let (retval)
2283 0 : (with-current-buffer (get-buffer-create buffer-name)
2284 0 : (set (make-local-variable 'vc-log-view-type) type))
2285 0 : (setq retval (funcall backend-func backend buffer-name type files))
2286 0 : (with-current-buffer (get-buffer buffer-name)
2287 0 : (let ((inhibit-read-only t))
2288 : ;; log-view-mode used to be called with inhibit-read-only bound
2289 : ;; to t, so let's keep doing it, just in case.
2290 0 : (vc-call-backend backend 'log-view-mode)
2291 0 : (set (make-local-variable 'log-view-vc-backend) backend)
2292 0 : (set (make-local-variable 'log-view-vc-fileset) files)
2293 0 : (set (make-local-variable 'revert-buffer-function)
2294 0 : rev-buff-func)))
2295 : ;; Display after setting up major-mode, so display-buffer-alist can know
2296 : ;; the major-mode.
2297 0 : (pop-to-buffer buffer-name)
2298 0 : (vc-run-delayed
2299 0 : (let ((inhibit-read-only t))
2300 0 : (funcall setup-buttons-func backend files retval)
2301 0 : (shrink-window-if-larger-than-buffer)
2302 0 : (when goto-location-func
2303 0 : (funcall goto-location-func backend)
2304 0 : (setq vc-sentinel-movepoint (point)))
2305 0 : (set-buffer-modified-p nil)))))
2306 :
2307 : (defun vc-incoming-outgoing-internal (backend remote-location buffer-name type)
2308 0 : (vc-log-internal-common
2309 0 : backend buffer-name nil type
2310 : (lambda (bk buf type-arg _files)
2311 0 : (vc-call-backend bk type-arg buf remote-location))
2312 : (lambda (_bk _files-arg _ret) nil)
2313 : nil ;; Don't move point.
2314 : (lambda (_ignore-auto _noconfirm)
2315 0 : (vc-incoming-outgoing-internal backend remote-location buffer-name type))))
2316 :
2317 : ;;;###autoload
2318 : (defun vc-print-log (&optional working-revision limit)
2319 : "List the change log of the current fileset in a window.
2320 : If WORKING-REVISION is non-nil, leave point at that revision.
2321 : If LIMIT is non-nil, it should be a number specifying the maximum
2322 : number of revisions to show; the default is `vc-log-show-limit'.
2323 :
2324 : When called interactively with a prefix argument, prompt for
2325 : WORKING-REVISION and LIMIT."
2326 : (interactive
2327 0 : (cond
2328 0 : (current-prefix-arg
2329 0 : (let ((rev (read-from-minibuffer "Leave point at revision (default: last revision): " nil
2330 0 : nil nil nil))
2331 0 : (lim (string-to-number
2332 0 : (read-from-minibuffer
2333 : "Limit display (unlimited: 0): "
2334 0 : (format "%s" vc-log-show-limit)
2335 0 : nil nil nil))))
2336 0 : (when (string= rev "") (setq rev nil))
2337 0 : (when (<= lim 0) (setq lim nil))
2338 0 : (list rev lim)))
2339 : (t
2340 0 : (list nil (when (> vc-log-show-limit 0) vc-log-show-limit)))))
2341 0 : (let* ((vc-fileset (vc-deduce-fileset t)) ;FIXME: Why t? --Stef
2342 0 : (backend (car vc-fileset))
2343 0 : (files (cadr vc-fileset))
2344 : ;; (working-revision (or working-revision (vc-working-revision (car files))))
2345 : )
2346 0 : (vc-print-log-internal backend files working-revision nil limit)))
2347 :
2348 : ;;;###autoload
2349 : (defun vc-print-root-log (&optional limit)
2350 : "List the change log for the current VC controlled tree in a window.
2351 : If LIMIT is non-nil, it should be a number specifying the maximum
2352 : number of revisions to show; the default is `vc-log-show-limit'.
2353 : When called interactively with a prefix argument, prompt for LIMIT."
2354 : (interactive
2355 0 : (cond
2356 0 : (current-prefix-arg
2357 0 : (let ((lim (string-to-number
2358 0 : (read-from-minibuffer
2359 : "Limit display (unlimited: 0): "
2360 0 : (format "%s" vc-log-show-limit)
2361 0 : nil nil nil))))
2362 0 : (when (<= lim 0) (setq lim nil))
2363 0 : (list lim)))
2364 : (t
2365 0 : (list (when (> vc-log-show-limit 0) vc-log-show-limit)))))
2366 0 : (let ((backend (vc-deduce-backend))
2367 0 : (default-directory default-directory)
2368 : rootdir)
2369 0 : (if backend
2370 0 : (setq rootdir (vc-call-backend backend 'root default-directory))
2371 0 : (setq rootdir (read-directory-name "Directory for VC root-log: "))
2372 0 : (setq backend (vc-responsible-backend rootdir))
2373 0 : (unless backend
2374 0 : (error "Directory is not version controlled")))
2375 0 : (setq default-directory rootdir)
2376 0 : (vc-print-log-internal backend (list rootdir) nil nil limit)))
2377 :
2378 : ;;;###autoload
2379 : (defun vc-print-branch-log (branch)
2380 : (interactive
2381 0 : (list
2382 0 : (vc-read-revision "Branch to log: ")))
2383 0 : (when (equal branch "")
2384 0 : (error "No branch specified"))
2385 0 : (vc-print-log-internal (vc-responsible-backend default-directory)
2386 0 : (list default-directory) branch t
2387 0 : (when (> vc-log-show-limit 0) vc-log-show-limit)))
2388 :
2389 : ;;;###autoload
2390 : (defun vc-log-incoming (&optional remote-location)
2391 : "Show a log of changes that will be received with a pull operation from REMOTE-LOCATION.
2392 : When called interactively with a prefix argument, prompt for REMOTE-LOCATION."
2393 : (interactive
2394 0 : (when current-prefix-arg
2395 0 : (list (read-string "Remote location (empty for default): "))))
2396 0 : (let ((backend (vc-deduce-backend)))
2397 0 : (unless backend
2398 0 : (error "Buffer is not version controlled"))
2399 0 : (vc-incoming-outgoing-internal backend (or remote-location "")
2400 0 : "*vc-incoming*" 'log-incoming)))
2401 :
2402 : ;;;###autoload
2403 : (defun vc-log-outgoing (&optional remote-location)
2404 : "Show a log of changes that will be sent with a push operation to REMOTE-LOCATION.
2405 : When called interactively with a prefix argument, prompt for REMOTE-LOCATION."
2406 : (interactive
2407 0 : (when current-prefix-arg
2408 0 : (list (read-string "Remote location (empty for default): "))))
2409 0 : (let ((backend (vc-deduce-backend)))
2410 0 : (unless backend
2411 0 : (error "Buffer is not version controlled"))
2412 0 : (vc-incoming-outgoing-internal backend (or remote-location "")
2413 0 : "*vc-outgoing*" 'log-outgoing)))
2414 :
2415 : ;;;###autoload
2416 : (defun vc-region-history (from to)
2417 : "Show the history of the region FROM..TO."
2418 : (interactive "r")
2419 0 : (let* ((lfrom (line-number-at-pos from))
2420 0 : (lto (line-number-at-pos (1- to)))
2421 0 : (file buffer-file-name)
2422 0 : (backend (vc-backend file))
2423 0 : (buf (get-buffer-create "*VC-history*")))
2424 0 : (with-current-buffer buf
2425 0 : (setq-local vc-log-view-type 'long))
2426 0 : (vc-call region-history file buf lfrom lto)
2427 0 : (with-current-buffer buf
2428 0 : (vc-call-backend backend 'region-history-mode)
2429 0 : (set (make-local-variable 'log-view-vc-backend) backend)
2430 0 : (set (make-local-variable 'log-view-vc-fileset) file)
2431 0 : (set (make-local-variable 'revert-buffer-function)
2432 : (lambda (_ignore-auto _noconfirm)
2433 0 : (with-current-buffer buf
2434 0 : (let ((inhibit-read-only t)) (erase-buffer)))
2435 0 : (vc-call region-history file buf lfrom lto))))
2436 0 : (display-buffer buf)))
2437 :
2438 : ;;;###autoload
2439 : (defun vc-revert ()
2440 : "Revert working copies of the selected fileset to their repository contents.
2441 : This asks for confirmation if the buffer contents are not identical
2442 : to the working revision (except for keyword expansion)."
2443 : (interactive)
2444 0 : (let* ((vc-fileset (vc-deduce-fileset))
2445 0 : (files (cadr vc-fileset))
2446 : (queried nil)
2447 : diff-buffer)
2448 : ;; If any of the files is visited by the current buffer, make sure
2449 : ;; buffer is saved. If the user says `no', abort since we cannot
2450 : ;; show the changes and ask for confirmation to discard them.
2451 0 : (when (or (not files) (memq (buffer-file-name) files))
2452 0 : (vc-buffer-sync nil))
2453 0 : (dolist (file files)
2454 0 : (let ((buf (get-file-buffer file)))
2455 0 : (when (and buf (buffer-modified-p buf))
2456 0 : (error "Please kill or save all modified buffers before reverting")))
2457 0 : (when (vc-up-to-date-p file)
2458 0 : (if (yes-or-no-p (format "%s seems up-to-date. Revert anyway? " file))
2459 0 : (setq queried t)
2460 0 : (error "Revert canceled"))))
2461 0 : (unwind-protect
2462 0 : (when (if vc-revert-show-diff
2463 0 : (progn
2464 0 : (setq diff-buffer (generate-new-buffer-name "*vc-diff*"))
2465 0 : (vc-diff-internal vc-allow-async-revert vc-fileset
2466 0 : nil nil nil diff-buffer))
2467 : ;; Avoid querying the user again.
2468 0 : (null queried))
2469 0 : (unless (yes-or-no-p
2470 0 : (format "Discard changes in %s? "
2471 0 : (let ((str (vc-delistify files))
2472 0 : (nfiles (length files)))
2473 0 : (if (< (length str) 50)
2474 0 : str
2475 0 : (format "%d file%s" nfiles
2476 0 : (if (= nfiles 1) "" "s"))))))
2477 0 : (error "Revert canceled")))
2478 0 : (when diff-buffer
2479 0 : (quit-windows-on diff-buffer)))
2480 0 : (dolist (file files)
2481 0 : (message "Reverting %s..." (vc-delistify files))
2482 0 : (vc-revert-file file)
2483 0 : (message "Reverting %s...done" (vc-delistify files)))))
2484 :
2485 : ;;;###autoload
2486 : (define-obsolete-function-alias 'vc-revert-buffer 'vc-revert "23.1")
2487 :
2488 : ;;;###autoload
2489 : (defun vc-pull (&optional arg)
2490 : "Update the current fileset or branch.
2491 : You must be visiting a version controlled file, or in a `vc-dir' buffer.
2492 : On a distributed version control system, this runs a \"pull\"
2493 : operation to update the current branch, prompting for an argument
2494 : list if required. Optional prefix ARG forces a prompt for the VCS
2495 : command to run.
2496 :
2497 : On a non-distributed version control system, update the current
2498 : fileset to the tip revisions. For each unchanged and unlocked
2499 : file, this simply replaces the work file with the latest revision
2500 : on its branch. If the file contains changes, any changes in the
2501 : tip revision are merged into the working file."
2502 : (interactive "P")
2503 0 : (let* ((vc-fileset (vc-deduce-fileset t))
2504 0 : (backend (car vc-fileset))
2505 0 : (files (cadr vc-fileset)))
2506 0 : (cond
2507 : ;; If a pull operation is defined, use it.
2508 0 : ((vc-find-backend-function backend 'pull)
2509 0 : (vc-call-backend backend 'pull arg))
2510 : ;; If VCS has `merge-news' functionality (CVS and SVN), use it.
2511 0 : ((vc-find-backend-function backend 'merge-news)
2512 0 : (save-some-buffers ; save buffers visiting files
2513 : nil (lambda ()
2514 0 : (and (buffer-modified-p)
2515 0 : (let ((file (buffer-file-name)))
2516 0 : (and file (member file files))))))
2517 0 : (dolist (file files)
2518 0 : (if (vc-up-to-date-p file)
2519 0 : (vc-checkout file t)
2520 0 : (vc-maybe-resolve-conflicts
2521 0 : file (vc-call-backend backend 'merge-news file)))))
2522 : ;; For a locking VCS, check out each file.
2523 0 : ((eq (vc-checkout-model backend files) 'locking)
2524 0 : (dolist (file files)
2525 0 : (if (vc-up-to-date-p file)
2526 0 : (vc-checkout file t))))
2527 : (t
2528 0 : (error "VC update is unsupported for `%s'" backend)))))
2529 :
2530 : ;;;###autoload
2531 : (defalias 'vc-update 'vc-pull)
2532 :
2533 : ;;;###autoload
2534 : (defun vc-push (&optional arg)
2535 : "Push the current branch.
2536 : You must be visiting a version controlled file, or in a `vc-dir' buffer.
2537 : On a distributed version control system, this runs a \"push\"
2538 : operation on the current branch, prompting for the precise command
2539 : if required. Optional prefix ARG non-nil forces a prompt for the
2540 : VCS command to run.
2541 :
2542 : On a non-distributed version control system, this signals an error.
2543 : It also signals an error in a Bazaar bound branch."
2544 : (interactive "P")
2545 0 : (let* ((vc-fileset (vc-deduce-fileset t))
2546 0 : (backend (car vc-fileset)))
2547 : ;;; (files (cadr vc-fileset)))
2548 0 : (if (vc-find-backend-function backend 'push)
2549 0 : (vc-call-backend backend 'push arg)
2550 0 : (user-error "VC push is unsupported for `%s'" backend))))
2551 :
2552 : (defun vc-version-backup-file (file &optional rev)
2553 : "Return name of backup file for revision REV of FILE.
2554 : If version backups should be used for FILE, and there exists
2555 : such a backup for REV or the working revision of file, return
2556 : its name; otherwise return nil."
2557 0 : (when (vc-call make-version-backups-p file)
2558 0 : (let ((backup-file (vc-version-backup-file-name file rev)))
2559 0 : (if (file-exists-p backup-file)
2560 0 : backup-file
2561 : ;; there is no automatic backup, but maybe the user made one manually
2562 0 : (setq backup-file (vc-version-backup-file-name file rev 'manual))
2563 0 : (when (file-exists-p backup-file)
2564 0 : backup-file)))))
2565 :
2566 : (defun vc-revert-file (file)
2567 : "Revert FILE back to the repository working revision it was based on."
2568 0 : (with-vc-properties
2569 0 : (list file)
2570 0 : (let ((backup-file (vc-version-backup-file file)))
2571 0 : (when backup-file
2572 0 : (copy-file backup-file file 'ok-if-already-exists)
2573 0 : (vc-delete-automatic-version-backups file))
2574 0 : (vc-call revert file backup-file))
2575 0 : `((vc-state . up-to-date)
2576 0 : (vc-checkout-time . ,(nth 5 (file-attributes file)))))
2577 0 : (vc-resynch-buffer file t t))
2578 :
2579 : ;;;###autoload
2580 : (defun vc-switch-backend (file backend)
2581 : "Make BACKEND the current version control system for FILE.
2582 : FILE must already be registered in BACKEND. The change is not
2583 : permanent, only for the current session. This function only changes
2584 : VC's perspective on FILE, it does not register or unregister it.
2585 : By default, this command cycles through the registered backends.
2586 : To get a prompt, use a prefix argument."
2587 : (interactive
2588 0 : (list
2589 0 : (or buffer-file-name
2590 0 : (error "There is no version-controlled file in this buffer"))
2591 0 : (let ((crt-bk (vc-backend buffer-file-name))
2592 : (backends nil))
2593 0 : (unless crt-bk
2594 0 : (error "File %s is not under version control" buffer-file-name))
2595 : ;; Find the registered backends.
2596 0 : (dolist (crt vc-handled-backends)
2597 0 : (when (and (vc-call-backend crt 'registered buffer-file-name)
2598 0 : (not (eq crt-bk crt)))
2599 0 : (push crt backends)))
2600 : ;; Find the next backend.
2601 0 : (let ((def (car backends))
2602 0 : (others backends))
2603 0 : (cond
2604 0 : ((null others) (error "No other backend to switch to"))
2605 0 : (current-prefix-arg
2606 0 : (intern
2607 0 : (upcase
2608 0 : (completing-read
2609 0 : (format "Switch to backend [%s]: " def)
2610 0 : (mapcar (lambda (b) (list (downcase (symbol-name b)))) backends)
2611 0 : nil t nil nil (downcase (symbol-name def))))))
2612 0 : (t def))))))
2613 0 : (unless (eq backend (vc-backend file))
2614 0 : (vc-file-clearprops file)
2615 0 : (vc-file-setprop file 'vc-backend backend)
2616 : ;; Force recomputation of the state
2617 0 : (unless (vc-call-backend backend 'registered file)
2618 0 : (vc-file-clearprops file)
2619 0 : (error "%s is not registered in %s" file backend))
2620 0 : (vc-mode-line file)))
2621 :
2622 : ;;;###autoload
2623 : (defun vc-transfer-file (file new-backend)
2624 : "Transfer FILE to another version control system NEW-BACKEND.
2625 : If NEW-BACKEND has a higher precedence than FILE's current backend
2626 : \(i.e. it comes earlier in `vc-handled-backends'), then register FILE in
2627 : NEW-BACKEND, using the revision number from the current backend as the
2628 : base level. If NEW-BACKEND has a lower precedence than the current
2629 : backend, then commit all changes that were made under the current
2630 : backend to NEW-BACKEND, and unregister FILE from the current backend.
2631 : \(If FILE is not yet registered under NEW-BACKEND, register it.)"
2632 0 : (let* ((old-backend (vc-backend file))
2633 0 : (edited (memq (vc-state file) '(edited needs-merge)))
2634 0 : (registered (vc-call-backend new-backend 'registered file))
2635 : (move
2636 0 : (and registered ; Never move if not registered in new-backend yet.
2637 : ;; move if new-backend comes later in vc-handled-backends
2638 0 : (or (memq new-backend (memq old-backend vc-handled-backends))
2639 0 : (y-or-n-p "Final transfer? "))))
2640 : (comment nil))
2641 0 : (when (eq old-backend new-backend)
2642 0 : (error "%s is the current backend of %s" new-backend file))
2643 0 : (if registered
2644 0 : (set-file-modes file (logior (file-modes file) 128))
2645 : ;; `registered' might have switched under us.
2646 0 : (vc-switch-backend file old-backend)
2647 0 : (let* ((rev (vc-working-revision file))
2648 0 : (modified-file (and edited (make-temp-file file)))
2649 0 : (unmodified-file (and modified-file (vc-version-backup-file file))))
2650 : ;; Go back to the base unmodified file.
2651 0 : (unwind-protect
2652 0 : (progn
2653 0 : (when modified-file
2654 0 : (copy-file file modified-file 'ok-if-already-exists)
2655 : ;; If we have a local copy of the unmodified file, handle that
2656 : ;; here and not in vc-revert-file because we don't want to
2657 : ;; delete that copy -- it is still useful for OLD-BACKEND.
2658 0 : (if unmodified-file
2659 0 : (copy-file unmodified-file file
2660 0 : 'ok-if-already-exists 'keep-date)
2661 0 : (when (y-or-n-p "Get base revision from repository? ")
2662 0 : (vc-revert-file file))))
2663 0 : (vc-call-backend new-backend 'receive-file file rev))
2664 0 : (when modified-file
2665 0 : (vc-switch-backend file new-backend)
2666 0 : (unless (eq (vc-checkout-model new-backend (list file)) 'implicit)
2667 0 : (vc-checkout file))
2668 0 : (rename-file modified-file file 'ok-if-already-exists)
2669 0 : (vc-file-setprop file 'vc-checkout-time nil)))))
2670 0 : (when move
2671 0 : (vc-switch-backend file old-backend)
2672 0 : (setq comment (vc-call-backend old-backend 'comment-history file))
2673 0 : (vc-call-backend old-backend 'unregister file))
2674 0 : (vc-switch-backend file new-backend)
2675 0 : (when (or move edited)
2676 0 : (vc-file-setprop file 'vc-state 'edited)
2677 0 : (vc-mode-line file new-backend)
2678 0 : (vc-checkin file new-backend comment (stringp comment)))))
2679 :
2680 : ;;;###autoload
2681 : (defun vc-delete-file (file)
2682 : "Delete file and mark it as such in the version control system.
2683 : If called interactively, read FILE, defaulting to the current
2684 : buffer's file name if it's under version control."
2685 0 : (interactive (list (read-file-name "VC delete file: " nil
2686 0 : (when (vc-backend buffer-file-name)
2687 0 : buffer-file-name) t)))
2688 0 : (setq file (expand-file-name file))
2689 0 : (let ((buf (get-file-buffer file))
2690 0 : (backend (vc-backend file)))
2691 0 : (unless backend
2692 0 : (error "File %s is not under version control"
2693 0 : (file-name-nondirectory file)))
2694 0 : (unless (vc-find-backend-function backend 'delete-file)
2695 0 : (error "Deleting files under %s is not supported in VC" backend))
2696 0 : (when (and buf (buffer-modified-p buf))
2697 0 : (error "Please save or undo your changes before deleting %s" file))
2698 0 : (let ((state (vc-state file)))
2699 0 : (when (eq state 'edited)
2700 0 : (error "Please commit or undo your changes before deleting %s" file))
2701 0 : (when (eq state 'conflict)
2702 0 : (error "Please resolve the conflicts before deleting %s" file)))
2703 0 : (unless (y-or-n-p (format "Really want to delete %s? "
2704 0 : (file-name-nondirectory file)))
2705 0 : (error "Abort!"))
2706 0 : (unless (or (file-directory-p file) (null make-backup-files)
2707 0 : (not (file-exists-p file)))
2708 0 : (with-current-buffer (or buf (find-file-noselect file))
2709 0 : (let ((backup-inhibited nil))
2710 0 : (backup-buffer))))
2711 : ;; Bind `default-directory' so that the command that the backend
2712 : ;; runs to remove the file is invoked in the correct context.
2713 0 : (let ((default-directory (file-name-directory file)))
2714 0 : (vc-call-backend backend 'delete-file file))
2715 : ;; If the backend hasn't deleted the file itself, let's do it for him.
2716 0 : (when (file-exists-p file) (delete-file file))
2717 : ;; Forget what VC knew about the file.
2718 0 : (vc-file-clearprops file)
2719 : ;; Make sure the buffer is deleted and the *vc-dir* buffers are
2720 : ;; updated after this.
2721 0 : (vc-resynch-buffer file nil t)))
2722 :
2723 : ;;;###autoload
2724 : (defun vc-rename-file (old new)
2725 : "Rename file OLD to NEW in both work area and repository.
2726 : If called interactively, read OLD and NEW, defaulting OLD to the
2727 : current buffer's file name if it's under version control."
2728 0 : (interactive (list (read-file-name "VC rename file: " nil
2729 0 : (when (vc-backend buffer-file-name)
2730 0 : buffer-file-name) t)
2731 0 : (read-file-name "Rename to: ")))
2732 : ;; in CL I would have said (setq new (merge-pathnames new old))
2733 0 : (let ((old-base (file-name-nondirectory old)))
2734 0 : (when (and (not (string= "" old-base))
2735 0 : (string= "" (file-name-nondirectory new)))
2736 0 : (setq new (concat new old-base))))
2737 0 : (let ((oldbuf (get-file-buffer old)))
2738 0 : (when (and oldbuf (buffer-modified-p oldbuf))
2739 0 : (error "Please save files before moving them"))
2740 0 : (when (get-file-buffer new)
2741 0 : (error "Already editing new file name"))
2742 0 : (when (file-exists-p new)
2743 0 : (error "New file already exists"))
2744 0 : (let ((state (vc-state old)))
2745 0 : (unless (memq state '(up-to-date edited))
2746 0 : (error "Please %s files before moving them"
2747 0 : (if (stringp state) "check in" "update"))))
2748 0 : (vc-call rename-file old new)
2749 0 : (vc-file-clearprops old)
2750 : ;; Move the actual file (unless the backend did it already)
2751 0 : (when (file-exists-p old) (rename-file old new))
2752 : ;; ?? Renaming a file might change its contents due to keyword expansion.
2753 : ;; We should really check out a new copy if the old copy was precisely equal
2754 : ;; to some checked-in revision. However, testing for this is tricky....
2755 0 : (when oldbuf
2756 0 : (with-current-buffer oldbuf
2757 0 : (let ((buffer-read-only buffer-read-only))
2758 0 : (set-visited-file-name new))
2759 0 : (vc-mode-line new (vc-backend new))
2760 0 : (set-buffer-modified-p nil)))))
2761 :
2762 : ;;;###autoload
2763 : (defun vc-update-change-log (&rest args)
2764 : "Find change log file and add entries from recent version control logs.
2765 : Normally, find log entries for all registered files in the default
2766 : directory.
2767 :
2768 : With prefix arg of \\[universal-argument], only find log entries for the current buffer's file.
2769 :
2770 : With any numeric prefix arg, find log entries for all currently visited
2771 : files that are under version control. This puts all the entries in the
2772 : log for the default directory, which may not be appropriate.
2773 :
2774 : From a program, any ARGS are assumed to be filenames for which
2775 : log entries should be gathered."
2776 : (interactive
2777 0 : (cond ((consp current-prefix-arg) ;C-u
2778 0 : (list buffer-file-name))
2779 0 : (current-prefix-arg ;Numeric argument.
2780 0 : (let ((files nil))
2781 0 : (dolist (buffer (buffer-list))
2782 0 : (let ((file (buffer-file-name buffer)))
2783 0 : (and file (vc-backend file)
2784 0 : (setq files (cons file files)))))
2785 0 : files))
2786 : (t
2787 : ;; Don't supply any filenames to backend; this means
2788 : ;; it should find all relevant files relative to
2789 : ;; the default-directory.
2790 0 : nil)))
2791 0 : (vc-call-backend (vc-responsible-backend default-directory)
2792 0 : 'update-changelog args))
2793 :
2794 : ;; functions that operate on RCS revision numbers. This code should
2795 : ;; also be moved into the backends. It stays for now, however, since
2796 : ;; it is used in code below.
2797 : (defun vc-branch-p (rev)
2798 : "Return t if REV is a branch revision."
2799 0 : (not (eq nil (string-match "\\`[0-9]+\\(\\.[0-9]+\\.[0-9]+\\)*\\'" rev))))
2800 :
2801 : ;;;###autoload
2802 : (defun vc-branch-part (rev)
2803 : "Return the branch part of a revision number REV."
2804 0 : (let ((index (string-match "\\.[0-9]+\\'" rev)))
2805 0 : (when index
2806 0 : (substring rev 0 index))))
2807 :
2808 : (defun vc-default-responsible-p (_backend _file)
2809 : "Indicate whether BACKEND is responsible for FILE.
2810 : The default is to return nil always."
2811 : nil)
2812 :
2813 : (defun vc-default-find-revision (backend file rev buffer)
2814 : "Provide the new `find-revision' op based on the old `checkout' op.
2815 : This is only for compatibility with old backends. They should be updated
2816 : to provide the `find-revision' operation instead."
2817 0 : (let ((tmpfile (make-temp-file (expand-file-name file))))
2818 0 : (unwind-protect
2819 0 : (progn
2820 0 : (vc-call-backend backend 'checkout file nil rev tmpfile)
2821 0 : (with-current-buffer buffer
2822 0 : (insert-file-contents-literally tmpfile)))
2823 0 : (delete-file tmpfile))))
2824 :
2825 : (defun vc-default-rename-file (_backend old new)
2826 0 : (condition-case nil
2827 0 : (add-name-to-file old new)
2828 0 : (error (rename-file old new)))
2829 0 : (vc-delete-file old)
2830 0 : (with-current-buffer (find-file-noselect new)
2831 0 : (vc-register)))
2832 :
2833 : (defalias 'vc-default-check-headers 'ignore)
2834 :
2835 : (declare-function log-edit-mode "log-edit" ())
2836 :
2837 0 : (defun vc-default-log-edit-mode (_backend) (log-edit-mode))
2838 :
2839 0 : (defun vc-default-log-view-mode (_backend) (log-view-mode))
2840 :
2841 : (defun vc-default-show-log-entry (_backend rev)
2842 0 : (with-no-warnings
2843 0 : (log-view-goto-rev rev)))
2844 :
2845 : (defun vc-default-comment-history (backend file)
2846 : "Return a string with all log entries stored in BACKEND for FILE."
2847 0 : (when (vc-find-backend-function backend 'print-log)
2848 0 : (with-current-buffer "*vc*"
2849 0 : (vc-call-backend backend 'print-log (list file))
2850 0 : (buffer-string))))
2851 :
2852 : (defun vc-default-receive-file (backend file rev)
2853 : "Let BACKEND receive FILE from another version control system."
2854 0 : (vc-call-backend backend 'register (list file) rev ""))
2855 :
2856 : (defun vc-default-retrieve-tag (backend dir name update)
2857 0 : (if (string= name "")
2858 0 : (progn
2859 0 : (vc-file-tree-walk
2860 0 : dir
2861 0 : (lambda (f) (and
2862 0 : (vc-up-to-date-p f)
2863 0 : (vc-error-occurred
2864 : (vc-call-backend backend 'checkout f nil "")
2865 0 : (when update (vc-resynch-buffer f t t)))))))
2866 0 : (let ((result (vc-tag-precondition dir)))
2867 0 : (if (stringp result)
2868 0 : (error "File %s is locked" result)
2869 0 : (setq update (and (eq result 'visited) update))
2870 0 : (vc-file-tree-walk
2871 0 : dir
2872 0 : (lambda (f) (vc-error-occurred
2873 : (vc-call-backend backend 'checkout f nil name)
2874 0 : (when update (vc-resynch-buffer f t t)))))))))
2875 :
2876 : (defun vc-default-revert (backend file contents-done)
2877 0 : (unless contents-done
2878 0 : (let ((rev (vc-working-revision file))
2879 0 : (file-buffer (or (get-file-buffer file) (current-buffer))))
2880 0 : (message "Checking out %s..." file)
2881 0 : (let ((failed t)
2882 0 : (backup-name (car (find-backup-file-name file))))
2883 0 : (when backup-name
2884 0 : (copy-file file backup-name 'ok-if-already-exists 'keep-date)
2885 0 : (unless (file-writable-p file)
2886 0 : (set-file-modes file (logior (file-modes file) 128))))
2887 0 : (unwind-protect
2888 0 : (let ((coding-system-for-read 'no-conversion)
2889 : (coding-system-for-write 'no-conversion))
2890 0 : (with-temp-file file
2891 0 : (let ((outbuf (current-buffer)))
2892 : ;; Change buffer to get local value of vc-checkout-switches.
2893 0 : (with-current-buffer file-buffer
2894 0 : (let ((default-directory (file-name-directory file)))
2895 0 : (vc-call-backend backend 'find-revision
2896 0 : file rev outbuf)))))
2897 0 : (setq failed nil))
2898 0 : (when backup-name
2899 0 : (if failed
2900 0 : (rename-file backup-name file 'ok-if-already-exists)
2901 0 : (and (not vc-make-backup-files) (delete-file backup-name))))))
2902 0 : (message "Checking out %s...done" file))))
2903 :
2904 : (defalias 'vc-default-revision-completion-table 'ignore)
2905 : (defalias 'vc-default-mark-resolved 'ignore)
2906 :
2907 : (defun vc-default-dir-status-files (_backend _dir files update-function)
2908 0 : (funcall update-function
2909 0 : (mapcar (lambda (file) (list file 'up-to-date)) files)))
2910 :
2911 : (defun vc-check-headers ()
2912 : "Check if the current file has any headers in it."
2913 : (interactive)
2914 0 : (vc-call-backend (vc-backend buffer-file-name) 'check-headers))
2915 :
2916 :
2917 :
2918 : ;; These things should probably be generally available
2919 : (define-obsolete-function-alias 'vc-string-prefix-p 'string-prefix-p "24.3")
2920 :
2921 : (defun vc-file-tree-walk (dirname func &rest args)
2922 : "Walk recursively through DIRNAME.
2923 : Invoke FUNC f ARGS on each VC-managed file f underneath it."
2924 0 : (vc-file-tree-walk-internal (expand-file-name dirname) func args)
2925 0 : (message "Traversing directory %s...done" dirname))
2926 :
2927 : (defun vc-file-tree-walk-internal (file func args)
2928 0 : (if (not (file-directory-p file))
2929 0 : (when (vc-backend file) (apply func file args))
2930 0 : (message "Traversing directory %s..." (abbreviate-file-name file))
2931 0 : (let ((dir (file-name-as-directory file)))
2932 0 : (mapcar
2933 0 : (lambda (f) (or
2934 0 : (string-equal f ".")
2935 0 : (string-equal f "..")
2936 0 : (member f vc-directory-exclusion-list)
2937 0 : (let ((dirf (expand-file-name f dir)))
2938 0 : (or
2939 0 : (file-symlink-p dirf) ;; Avoid possible loops.
2940 0 : (vc-file-tree-walk-internal dirf func args)))))
2941 0 : (directory-files dir)))))
2942 :
2943 : (provide 'vc)
2944 :
2945 : ;;; vc.el ends here
|