LCOV - code coverage report
Current view: top level - lisp/vc - vc.el (source / functions) Hit Total Coverage
Test: tramp-tests.info Lines: 5 1110 0.5 %
Date: 2017-08-27 09:44:50 Functions: 1 115 0.9 %

          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

Generated by: LCOV version 1.12