view lisp/vc.el @ 63163:ee270e098ec6

*** empty log message ***

+
鐃緒申;;; vc.el --- drive a version-control system from within Emacs
+
鐃緒申
+
鐃緒申;; Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998,
+
鐃緒申;;   2000, 2001, 2003, 2004, 2005  Free Software Foundation, Inc.
+
鐃緒申
+
鐃緒申;; Author:     FSF (see below for full credits)
+
鐃緒申;; Maintainer: Andre Spiegel <[e-mail]>
+
鐃緒申;; Keywords: tools
+
鐃緒申
+
鐃緒申;; $Id$
+
鐃緒申
+
鐃緒申;; This file is part of GNU Emacs.
+
鐃緒申
+
鐃緒申;; GNU Emacs is free software; you can redistribute it and/or modify
+
鐃緒申;; it under the terms of the GNU General Public License as published by
+
鐃緒申;; the Free Software Foundation; either version 2, or (at your option)
+
鐃緒申;; any later version.
+
鐃緒申
+
鐃緒申;; GNU Emacs is distributed in the hope that it will be useful,
+
鐃緒申;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+
鐃緒申;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+
鐃緒申;; GNU General Public License for more details.
+
鐃緒申
+
鐃緒申;; You should have received a copy of the GNU General Public License
+
鐃緒申;; along with GNU Emacs; see the file COPYING.  If not, write to the
+
鐃緒申;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+
鐃緒申;; Boston, MA 02111-1307, USA.
+
鐃緒申
+
鐃緒申;;; Credits:
+
鐃緒申
+
鐃緒申;; VC was initially designed and implemented by Eric S. Raymond
+
鐃緒申;; <[e-mail]>.  Over the years, many people have
+
鐃緒申;; contributed substantial amounts of work to VC.  These include:
+
鐃緒申;;   Per Cederqvist <[e-mail]>
+
鐃緒申;;   Paul Eggert <[e-mail]>
+
鐃緒申;;   Sebastian Kremer <[e-mail]>
+
鐃緒申;;   Martin Lorentzson <[e-mail]>
+
鐃緒申;;   Dave Love <[e-mail]>
+
鐃緒申;;   Stefan Monnier <[e-mail]>
+
鐃緒申;;   J.D. Smith <[e-mail]>
+
鐃緒申;;   Andre Spiegel <[e-mail]>
+
鐃緒申;;   Richard Stallman <[e-mail]>
+
鐃緒申;;   Thien-Thi Nguyen <[e-mail]>
+
鐃緒申
+
鐃緒申;;; Commentary:
+
鐃緒申
+
鐃緒申;; This mode is fully documented in the Emacs user's manual.
+
鐃緒申;;
+
鐃緒申;; Supported version-control systems presently include CVS, RCS, GNU Arch,
+
鐃緒申;; Subversion, Meta-CVS, and SCCS (or its free replacement, CSSC).
+
鐃緒申;;
+
鐃緒申;; Some features will not work with old RCS versions.  Where
+
鐃緒申;; appropriate, VC finds out which version you have, and allows or
+
鐃緒申;; disallows those features (stealing locks, for example, works only
+
鐃緒申;; from 5.6.2 onwards).
+
鐃緒申;; Even initial checkins will fail if your RCS version is so old that ci
+
鐃緒申;; doesn't understand -t-; this has been known to happen to people running
+
鐃緒申;; NExTSTEP 3.0.
+
鐃緒申;;
+
鐃緒申;; You can support the RCS -x option by customizing vc-rcs-master-templates.
+
鐃緒申;;
+
鐃緒申;; Proper function of the SCCS diff commands requires the shellscript vcdiff
+
鐃緒申;; to be installed somewhere on Emacs's path for executables.
+
鐃緒申;;
+
鐃緒申;; If your site uses the ChangeLog convention supported by Emacs, the
+
鐃緒申;; function log-edit-comment-to-change-log could prove a useful checkin hook,
+
鐃緒申;; although you might prefer to use C-c C-a (i.e. log-edit-insert-changelog)
+
鐃緒申;; from the commit buffer instead or to set `log-edit-setup-invert'.
+
鐃緒申;;
+
鐃緒申;; The vc code maintains some internal state in order to reduce expensive
+
鐃緒申;; version-control operations to a minimum.  Some names are only computed
+
鐃緒申;; once.  If you perform version control operations with the backend while
+
鐃緒申;; vc's back is turned, or move/rename master files while vc is running,
+
鐃緒申;; vc may get seriously confused.  Don't do these things!
+
鐃緒申;;
+
鐃緒申;; Developer's notes on some concurrency issues are included at the end of
+
鐃緒申;; the file.
+
鐃緒申;;
+
鐃緒申;; ADDING SUPPORT FOR OTHER BACKENDS
+
鐃緒申;;
+
鐃緒申;; VC can use arbitrary version control systems as a backend.  To add
+
鐃緒申;; support for a new backend named SYS, write a library vc-sys.el that
+
鐃緒申;; contains functions of the form `vc-sys-...' (note that SYS is in lower
+
鐃緒申;; case for the function and library names).  VC will use that library if
+
鐃緒申;; you put the symbol SYS somewhere into the list of
+
鐃緒申;; `vc-handled-backends'.  Then, for example, if `vc-sys-registered'
+
鐃緒申;; returns non-nil for a file, all SYS-specific versions of VC commands
+
鐃緒申;; will be available for that file.
+
鐃緒申;;
+
鐃緒申;; VC keeps some per-file information in the form of properties (see
+
鐃緒申;; vc-file-set/getprop in vc-hooks.el).  The backend-specific functions
+
鐃緒申;; do not generally need to be aware of these properties.  For example,
+
鐃緒申;; `vc-sys-workfile-version' should compute the workfile version and
+
鐃緒申;; return it; it should not look it up in the property, and it needn't
+
鐃緒申;; store it there either.  However, if a backend-specific function does
+
鐃緒申;; store a value in a property, that value takes precedence over any
+
鐃緒申;; value that the generic code might want to set (check for uses of
+
鐃緒申;; the macro `with-vc-properties' in vc.el).
+
鐃緒申;;
+
鐃緒申;; In the list of functions below, each identifier needs to be prepended
+
鐃緒申;; with `vc-sys-'.  Some of the functions are mandatory (marked with a
+
鐃緒申;; `*'), others are optional (`-').
+
鐃緒申;;
+
鐃緒申;; STATE-QUERYING FUNCTIONS
+
鐃緒申;;
+
鐃緒申;; * registered (file)
+
鐃緒申;;
+
鐃緒申;;   Return non-nil if FILE is registered in this backend.
+
鐃緒申;;
+
鐃緒申;; * state (file)
+
鐃緒申;;
+
鐃緒申;;   Return the current version control state of FILE.  For a list of
+
鐃緒申;;   possible values, see `vc-state'.  This function should do a full and
+
鐃緒申;;   reliable state computation; it is usually called immediately after
+
鐃緒申;;   C-x v v.  If you want to use a faster heuristic when visiting a
+
鐃緒申;;   file, put that into `state-heuristic' below.
+
鐃緒申;;
+
鐃緒申;; - state-heuristic (file)
+
鐃緒申;;
+
鐃緒申;;   If provided, this function is used to estimate the version control
+
鐃緒申;;   state of FILE at visiting time.  It should be considerably faster
+
鐃緒申;;   than the implementation of `state'.  For a list of possible values,
+
鐃緒申;;   see the doc string of `vc-state'.
+
鐃緒申;;
+
鐃緒申;; - dir-state (dir)
+
鐃緒申;;
+
鐃緒申;;   If provided, this function is used to find the version control state
+
鐃緒申;;   of all files in DIR in a fast way.  The function should not return
+
鐃緒申;;   anything, but rather store the files' states into the corresponding
+
鐃緒申;;   `vc-state' properties.
+
鐃緒申;;
+
鐃緒申;; * workfile-version (file)
+
鐃緒申;;
+
鐃緒申;;   Return the current workfile version of FILE.
+
鐃緒申;;
+
鐃緒申;; - latest-on-branch-p (file)
+
鐃緒申;;
+
鐃緒申;;   Return non-nil if the current workfile version of FILE is the latest
+
鐃緒申;;   on its branch.  The default implementation always returns t, which
+
鐃緒申;;   means that working with non-current versions is not supported by
+
鐃緒申;;   default.
+
鐃緒申;;
+
鐃緒申;; * checkout-model (file)
+
鐃緒申;;
+
鐃緒申;;   Indicate whether FILE needs to be "checked out" before it can be
+
鐃緒申;;   edited.  See `vc-checkout-model' for a list of possible values.
+
鐃緒申;;
+
鐃緒申;; - workfile-unchanged-p (file)
+
鐃緒申;;
+
鐃緒申;;   Return non-nil if FILE is unchanged from its current workfile
+
鐃緒申;;   version.  This function should do a brief comparison of FILE's
+
鐃緒申;;   contents with those of the master version.  If the backend does not
+
鐃緒申;;   have such a brief-comparison feature, the default implementation of
+
鐃緒申;;   this function can be used, which delegates to a full
+
鐃緒申;;   vc-BACKEND-diff.  (Note that vc-BACKEND-diff must not run
+
鐃緒申;;   asynchronously in this case, see variable `vc-disable-async-diff'.)
+
鐃緒申;;
+
鐃緒申;; - mode-line-string (file)
+
鐃緒申;;
+
鐃緒申;;   If provided, this function should return the VC-specific mode line
+
鐃緒申;;   string for FILE.  The default implementation deals well with all
+
鐃緒申;;   states that `vc-state' can return.
+
鐃緒申;;
+
鐃緒申;; - dired-state-info (file)
+
鐃緒申;;
+
鐃緒申;;   Translate the `vc-state' property of FILE into a string that can be
+
鐃緒申;;   used in a vc-dired buffer.  The default implementation deals well
+
鐃緒申;;   with all states that `vc-state' can return.
+
鐃緒申;;
+
鐃緒申;; STATE-CHANGING FUNCTIONS
+
鐃緒申;;
+
鐃緒申;; * register (file &optional rev comment)
+
鐃緒申;;
+
鐃緒申;;   Register FILE in this backend.  Optionally, an initial revision REV
+
鐃緒申;;   and an initial description of the file, COMMENT, may be specified.
+
鐃緒申;;   The implementation should pass the value of vc-register-switches
+
鐃緒申;;   to the backend command.
+
鐃緒申;;
+
鐃緒申;; - init-version (file)
+
鐃緒申;;
+
鐃緒申;;   The initial version to use when registering FILE if one is not
+
鐃緒申;;   specified by the user.  If not provided, the variable
+
鐃緒申;;   vc-default-init-version is used instead.
+
鐃緒申;;
+
鐃緒申;; - responsible-p (file)
+
鐃緒申;;
+
鐃緒申;;   Return non-nil if this backend considers itself "responsible" for
+
鐃緒申;;   FILE, which can also be a directory.  This function is used to find
+
鐃緒申;;   out what backend to use for registration of new files and for things
+
鐃緒申;;   like change log generation.  The default implementation always
+
鐃緒申;;   returns nil.
+
鐃緒申;;
+
鐃緒申;; - could-register (file)
+
鐃緒申;;
+
鐃緒申;;   Return non-nil if FILE could be registered under this backend.  The
+
鐃緒申;;   default implementation always returns t.
+
鐃緒申;;
+
鐃緒申;; - receive-file (file rev)
+
鐃緒申;;
+
鐃緒申;;   Let this backend "receive" a file that is already registered under
+
鐃緒申;;   another backend.  The default implementation simply calls `register'
+
鐃緒申;;   for FILE, but it can be overridden to do something more specific,
+
鐃緒申;;   e.g. keep revision numbers consistent or choose editing modes for
+
鐃緒申;;   FILE that resemble those of the other backend.
+
鐃緒申;;
+
鐃緒申;; - unregister (file)
+
鐃緒申;;
+
鐃緒申;;   Unregister FILE from this backend.  This is only needed if this
+
鐃緒申;;   backend may be used as a "more local" backend for temporary editing.
+
鐃緒申;;
+
鐃緒申;; * checkin (file rev comment)
+
鐃緒申;;
+
鐃緒申;;   Commit changes in FILE to this backend.  If REV is non-nil, that
+
鐃緒申;;   should become the new revision number.  COMMENT is used as a
+
鐃緒申;;   check-in comment.  The implementation should pass the value of
+
鐃緒申;;   vc-checkin-switches to the backend command.
+
鐃緒申;;
+
鐃緒申;; * find-version (file rev buffer)
+
鐃緒申;;
+
鐃緒申;;   Fetch revision REV of file FILE and put it into BUFFER.
+
鐃緒申;;   If REV is the empty string, fetch the head of the trunk.
+
鐃緒申;;   The implementation should pass the value of vc-checkout-switches
+
鐃緒申;;   to the backend command.
+
鐃緒申;;
+
鐃緒申;; * checkout (file &optional editable rev)
+
鐃緒申;;
+
鐃緒申;;   Check out revision REV of FILE into the working area.  If EDITABLE
+
鐃緒申;;   is non-nil, FILE should be writable by the user and if locking is
+
鐃緒申;;   used for FILE, a lock should also be set.  If REV is non-nil, that
+
鐃緒申;;   is the revision to check out (default is current workfile version).
+
鐃緒申;;   If REV is t, that means to check out the head of the current branch;
+
鐃緒申;;   if it is the empty string, check out the head of the trunk.
+
鐃緒申;;   The implementation should pass the value of vc-checkout-switches
+
鐃緒申;;   to the backend command.
+
鐃緒申;;
+
鐃緒申;; * revert (file &optional contents-done)
+
鐃緒申;;
+
鐃緒申;;   Revert FILE back to the current workfile version.  If optional
+
鐃緒申;;   arg CONTENTS-DONE is non-nil, then the contents of FILE have
+
鐃緒申;;   already been reverted from a version backup, and this function
+
鐃緒申;;   only needs to update the status of FILE within the backend.
+
鐃緒申;;
+
鐃緒申;; - cancel-version (file editable)
+
鐃緒申;;
+
鐃緒申;;   Cancel the current workfile version of FILE, i.e. remove it from the
+
鐃緒申;;   master.  EDITABLE non-nil means that FILE should be writable
+
鐃緒申;;   afterwards, and if locking is used for FILE, then a lock should also
+
鐃緒申;;   be set.  If this function is not provided, trying to cancel a
+
鐃緒申;;   version is caught as an error.
+
鐃緒申;;
+
鐃緒申;; - merge (file rev1 rev2)
+
鐃緒申;;
+
鐃緒申;;   Merge the changes between REV1 and REV2 into the current working file.
+
鐃緒申;;
+
鐃緒申;; - merge-news (file)
+
鐃緒申;;
+
鐃緒申;;   Merge recent changes from the current branch into FILE.
+
鐃緒申;;
+
鐃緒申;; - steal-lock (file &optional version)
+
鐃緒申;;
+
鐃緒申;;   Steal any lock on the current workfile version of FILE, or on
+
鐃緒申;;   VERSION if that is provided.  This function is only needed if
+
鐃緒申;;   locking is used for files under this backend, and if files can
+
鐃緒申;;   indeed be locked by other users.
+
鐃緒申;;
+
鐃緒申;; HISTORY FUNCTIONS
+
鐃緒申;;
+
鐃緒申;; * print-log (file &optional buffer)
+
鐃緒申;;
+
鐃緒申;;   Insert the revision log of FILE into BUFFER, or the *vc* buffer
+
鐃緒申;;   if BUFFER is nil.
+
鐃緒申;;
+
鐃緒申;; - show-log-entry (version)
+
鐃緒申;;
+
鐃緒申;;   If provided, search the log entry for VERSION in the current buffer,
+
鐃緒申;;   and make sure it is displayed in the buffer's window.  The default
+
鐃緒申;;   implementation of this function works for RCS-style logs.
+
鐃緒申;;
+
鐃緒申;; - wash-log (file)
+
鐃緒申;;
+
鐃緒申;;   Remove all non-comment information from the output of print-log.  The
+
鐃緒申;;   default implementation of this function works for RCS-style logs.
+
鐃緒申;;
+
鐃緒申;; - logentry-check ()
+
鐃緒申;;
+
鐃緒申;;   If defined, this function is run to find out whether the user
+
鐃緒申;;   entered a valid log entry for check-in.  The log entry is in the
+
鐃緒申;;   current buffer, and if it is not a valid one, the function should
+
鐃緒申;;   throw an error.
+
鐃緒申;;
+
鐃緒申;; - comment-history (file)
+
鐃緒申;;
+
鐃緒申;;   Return a string containing all log entries that were made for FILE.
+
鐃緒申;;   This is used for transferring a file from one backend to another,
+
鐃緒申;;   retaining comment information.  The default implementation of this
+
鐃緒申;;   function does this by calling print-log and then wash-log, and
+
鐃緒申;;   returning the resulting buffer contents as a string.
+
鐃緒申;;
+
鐃緒申;; - update-changelog (files)
+
鐃緒申;;
+
鐃緒申;;   Using recent log entries, create ChangeLog entries for FILES, or for
+
鐃緒申;;   all files at or below the default-directory if FILES is nil.  The
+
鐃緒申;;   default implementation runs rcs2log, which handles RCS- and
+
鐃緒申;;   CVS-style logs.
+
鐃緒申;;
+
鐃緒申;; * diff (file &optional rev1 rev2 buffer)
+
鐃緒申;;
+
鐃緒申;;   Insert the diff for FILE into BUFFER, or the *vc-diff* buffer if
+
鐃緒申;;   BUFFER is nil.  If REV1 and REV2 are non-nil, report differences
+
鐃緒申;;   from REV1 to REV2.  If REV1 is nil, use the current workfile
+
鐃緒申;;   version (as found in the repository) as the older version; if
+
鐃緒申;;   REV2 is nil, use the current workfile contents as the newer
+
鐃緒申;;   version.  This function should pass the value of (vc-switches
+
鐃緒申;;   BACKEND 'diff) to the backend command.  It should return a status
+
鐃緒申;;   of either 0 (no differences found), or 1 (either non-empty diff
+
鐃緒申;;   or the diff is run asynchronously).
+
鐃緒申;;
+
鐃緒申;; - diff-tree (dir &optional rev1 rev2)
+
鐃緒申;;
+
鐃緒申;;   Insert the diff for all files at and below DIR into the *vc-diff*
+
鐃緒申;;   buffer.  The meaning of REV1 and REV2 is the same as for
+
鐃緒申;;   vc-BACKEND-diff.  The default implementation does an explicit tree
+
鐃緒申;;   walk, calling vc-BACKEND-diff for each individual file.
+
鐃緒申;;
+
鐃緒申;; - annotate-command (file buf &optional rev)
+
鐃緒申;;
+
鐃緒申;;   If this function is provided, it should produce an annotated display
+
鐃緒申;;   of FILE in BUF, relative to version REV.  Annotation means each line
+
鐃緒申;;   of FILE displayed is prefixed with version information associated with
+
鐃緒申;;   its addition (deleted lines leave no history) and that the text of the
+
鐃緒申;;   file is fontified according to age.
+
鐃緒申;;
+
鐃緒申;; - annotate-time ()
+
鐃緒申;;
+
鐃緒申;;   Only required if `annotate-command' is defined for the backend.
+
鐃緒申;;   Return the time of the next line of annotation at or after point,
+
鐃緒申;;   as a floating point fractional number of days.  The helper
+
鐃緒申;;   function `vc-annotate-convert-time' may be useful for converting
+
鐃緒申;;   multi-part times as returned by `current-time' and `encode-time'
+
鐃緒申;;   to this format.  Return nil if no more lines of annotation appear
+
鐃緒申;;   in the buffer.  You can safely assume that point is placed at the
+
鐃緒申;;   beginning of each line, starting at `point-min'.  The buffer that
+
鐃緒申;;   point is placed in is the Annotate output, as defined by the
+
鐃緒申;;   relevant backend.  This function also affects how much of the line
+
鐃緒申;;   is fontified; where it leaves point is where fontification begins.
+
鐃緒申;;
+
鐃緒申;; - annotate-current-time ()
+
鐃緒申;;
+
鐃緒申;;   Only required if `annotate-command' is defined for the backend,
+
鐃緒申;;   AND you'd like the current time considered to be anything besides
+
鐃緒申;;   (vs-annotate-convert-time (current-time)) -- i.e. the current
+
鐃緒申;;   time with hours, minutes, and seconds included.  Probably safe to
+
鐃緒申;;   ignore.  Return the current-time, in units of fractional days.
+
鐃緒申;;
+
鐃緒申;; - annotate-extract-revision-at-line ()
+
鐃緒申;;
+
鐃緒申;;   Only required if `annotate-command' is defined for the backend.
+
鐃緒申;;   Invoked from a buffer in vc-annotate-mode, return the revision
+
鐃緒申;;   corresponding to the current line, or nil if there is no revision
+
鐃緒申;;   corresponding to the current line.
+
鐃緒申;;
+
鐃緒申;; SNAPSHOT SYSTEM
+
鐃緒申;;
+
鐃緒申;; - create-snapshot (dir name branchp)
+
鐃緒申;;
+
鐃緒申;;   Take a snapshot of the current state of files under DIR and name it
+
鐃緒申;;   NAME.  This should make sure that files are up-to-date before
+
鐃緒申;;   proceeding with the action.  DIR can also be a file and if BRANCHP
+
鐃緒申;;   is specified, NAME should be created as a branch and DIR should be
+
鐃緒申;;   checked out under this new branch.  The default implementation does
+
鐃緒申;;   not support branches but does a sanity check, a tree traversal and
+
鐃緒申;;   for each file calls `assign-name'.
+
鐃緒申;;
+
鐃緒申;; - assign-name (file name)
+
鐃緒申;;
+
鐃緒申;;   Give name NAME to the current version of FILE, assuming it is
+
鐃緒申;;   up-to-date.  Only used by the default version of `create-snapshot'.
+
鐃緒申;;
+
鐃緒申;; - retrieve-snapshot (dir name update)
+
鐃緒申;;
+
鐃緒申;;   Retrieve a named snapshot of all registered files at or below DIR.
+
鐃緒申;;   If UPDATE is non-nil, then update buffers of any files in the
+
鐃緒申;;   snapshot that are currently visited.  The default implementation
+
鐃緒申;;   does a sanity check whether there aren't any uncommitted changes at
+
鐃緒申;;   or below DIR, and then performs a tree walk, using the `checkout'
+
鐃緒申;;   function to retrieve the corresponding versions.
+
鐃緒申;;
+
鐃緒申;; MISCELLANEOUS
+
鐃緒申;;
+
鐃緒申;; - make-version-backups-p (file)
+
鐃緒申;;
+
鐃緒申;;   Return non-nil if unmodified repository versions of FILE should be
+
鐃緒申;;   backed up locally.  If this is done, VC can perform `diff' and
+
鐃緒申;;   `revert' operations itself, without calling the backend system.  The
+
鐃緒申;;   default implementation always returns nil.
+
鐃緒申;;
+
鐃緒申;; - repository-hostname (dirname)
+
鐃緒申;;
+
鐃緒申;;   Return the hostname that the backend will have to contact
+
鐃緒申;;   in order to operate on a file in DIRNAME.  If the return value
+
鐃緒申;;   is nil, it means that the repository is local.
+
鐃緒申;;   This function is used in `vc-stay-local-p' which backends can use
+
鐃緒申;;   for their convenience.
+
鐃緒申;;
+
鐃緒申;; - previous-version (file rev)
+
鐃緒申;;
+
鐃緒申;;   Return the version number that precedes REV for FILE, or nil if no such
+
鐃緒申;;   version exists.
+
鐃緒申;;
+
鐃緒申;; - next-version (file rev)
+
鐃緒申;;
+
鐃緒申;;   Return the version number that follows REV for FILE, or nil if no such
+
鐃緒申;;   version exists.
+
鐃緒申;;
+
鐃緒申;; - check-headers ()
+
鐃緒申;;
+
鐃緒申;;   Return non-nil if the current buffer contains any version headers.
+
鐃緒申;;
+
鐃緒申;; - clear-headers ()
+
鐃緒申;;
+
鐃緒申;;   In the current buffer, reset all version headers to their unexpanded
+
鐃緒申;;   form.  This function should be provided if the state-querying code
+
鐃緒申;;   for this backend uses the version headers to determine the state of
+
鐃緒申;;   a file.  This function will then be called whenever VC changes the
+
鐃緒申;;   version control state in such a way that the headers would give
+
鐃緒申;;   wrong information.
+
鐃緒申;;
+
鐃緒申;; - delete-file (file)
+
鐃緒申;;
+
鐃緒申;;   Delete FILE and mark it as deleted in the repository.  If this
+
鐃緒申;;   function is not provided, the command `vc-delete-file' will
+
鐃緒申;;   signal an error.
+
鐃緒申;;
+
鐃緒申;; - rename-file (old new)
+
鐃緒申;;
+
鐃緒申;;   Rename file OLD to NEW, both in the working area and in the
+
鐃緒申;;   repository.  If this function is not provided, the renaming
+
鐃緒申;;   will be done by (vc-delete-file old) and (vc-register new).
+
鐃緒申;;
+
鐃緒申;; - find-file-hook ()
+
鐃緒申;;
+
鐃緒申;;   Operation called in current buffer when opening a file.  This can
+
鐃緒申;;   be used by the backend to setup some local variables it might need.
+
鐃緒申;
+
鐃緒申;; - find-file-not-found-hook ()
+
鐃緒申;;
+
鐃緒申;;   Operation called in current buffer when opening a non-existing file.
+
鐃緒申;;   By default, this asks the user if she wants to check out the file.
+
鐃緒申
+
鐃緒申;;; Code:
+
鐃緒申
+
鐃緒申(require 'vc-hooks)
+
鐃緒申(require 'ring)
+
鐃緒申(eval-when-compile
+
鐃緒申  (require 'cl)
+
鐃緒申  (require 'compile)
+
鐃緒申  (require 'dired)      ; for dired-map-over-marks macro
+
鐃緒申  (require 'dired-aux))	; for dired-kill-{line,tree}
+
鐃緒申
+
鐃緒申(if (not (assoc 'vc-parent-buffer minor-mode-alist))
+
鐃緒申    (setq minor-mode-alist
+
鐃緒申	  (cons '(vc-parent-buffer vc-parent-buffer-name)
+
鐃緒申		minor-mode-alist)))
+
鐃緒申
+
鐃緒申;; General customization
+
鐃緒申
+
鐃緒申(defgroup vc nil
+
鐃緒申  "Version-control system in Emacs."
+
鐃緒申  :group 'tools)
+
鐃緒申
+
鐃緒申(defcustom vc-suppress-confirm nil
+
鐃緒申  "*If non-nil, treat user as expert; suppress yes-no prompts on some things."
+
鐃緒申  :type 'boolean
+
鐃緒申  :group 'vc)
+
鐃緒申
+
鐃緒申(defcustom vc-delete-logbuf-window t
+
鐃緒申  "*If non-nil, delete the *VC-log* buffer and window after each logical action.
+
鐃緒申If nil, bury that buffer instead.
+
鐃緒申This is most useful if you have multiple windows on a frame and would like to
+
鐃緒申preserve the setting."
+
鐃緒申  :type 'boolean
+
鐃緒申  :group 'vc)
+
鐃緒申
+
鐃緒申(defcustom vc-initial-comment nil
+
鐃緒申  "*If non-nil, prompt for initial comment when a file is registered."
+
鐃緒申  :type 'boolean
+
鐃緒申  :group 'vc)
+
鐃緒申
+
鐃緒申(defcustom vc-default-init-version "1.1"
+
鐃緒申  "*A string used as the default version number when a new file is registered.
+
鐃緒申This can be overridden by giving a prefix argument to \\[vc-register].  This
+
鐃緒申can also be overridden by a particular VC backend."
+
鐃緒申  :type 'string
+
鐃緒申  :group 'vc
+
鐃緒申  :version "20.3")
+
鐃緒申
+
鐃緒申(defcustom vc-command-messages nil
+
鐃緒申  "*If non-nil, display run messages from back-end commands."
+
鐃緒申  :type 'boolean
+
鐃緒申  :group 'vc)
+
鐃緒申
+
鐃緒申(defcustom vc-checkin-switches nil
+
鐃緒申  "*A string or list of strings specifying extra switches for checkin.
+
鐃緒申These are passed to the checkin program by \\[vc-checkin]."
+
鐃緒申  :type '(choice (const :tag "None" nil)
+
鐃緒申		 (string :tag "Argument String")
+
鐃緒申		 (repeat :tag "Argument List"
+
鐃緒申			 :value ("")
+
鐃緒申			 string))
+
鐃緒申  :group 'vc)
+
鐃緒申
+
鐃緒申(defcustom vc-checkout-switches nil
+
鐃緒申  "*A string or list of strings specifying extra switches for checkout.
+
鐃緒申These are passed to the checkout program by \\[vc-checkout]."
+
鐃緒申  :type '(choice (const :tag "None" nil)
+
鐃緒申		 (string :tag "Argument String")
+
鐃緒申		 (repeat :tag "Argument List"
+
鐃緒申			 :value ("")
+
鐃緒申			 string))
+
鐃緒申  :group 'vc)
+
鐃緒申
+
鐃緒申(defcustom vc-register-switches nil
+
鐃緒申  "*A string or list of strings; extra switches for registering a file.
+
鐃緒申These are passed to the checkin program by \\[vc-register]."
+
鐃緒申  :type '(choice (const :tag "None" nil)
+
鐃緒申		 (string :tag "Argument String")
+
鐃緒申		 (repeat :tag "Argument List"
+
鐃緒申			 :value ("")
+
鐃緒申			 string))
+
鐃緒申  :group 'vc)
+
鐃緒申
+
鐃緒申(defcustom vc-dired-listing-switches "-al"
+
鐃緒申  "*Switches passed to `ls' for vc-dired.  MUST contain the `l' option."
+
鐃緒申  :type 'string
+
鐃緒申  :group 'vc
+
鐃緒申  :version "21.1")
+
鐃緒申
+
鐃緒申(defcustom vc-dired-recurse t
+
鐃緒申  "*If non-nil, show directory trees recursively in VC Dired."
+
鐃緒申  :type 'boolean
+
鐃緒申  :group 'vc
+
鐃緒申  :version "20.3")
+
鐃緒申
+
鐃緒申(defcustom vc-dired-terse-display t
+
鐃緒申  "*If non-nil, show only locked files in VC Dired."
+
鐃緒申  :type 'boolean
+
鐃緒申  :group 'vc
+
鐃緒申  :version "20.3")
+
鐃緒申
+
鐃緒申(defcustom vc-directory-exclusion-list '("SCCS" "RCS" "CVS" "MCVS" ".svn")
+
鐃緒申  "*List of directory names to be ignored when walking directory trees."
+
鐃緒申  :type '(repeat string)
+
鐃緒申  :group 'vc)
+
鐃緒申
+
鐃緒申(defcustom vc-diff-switches nil
+
鐃緒申  "*A string or list of strings specifying switches for diff under VC.
+
鐃緒申When running diff under a given BACKEND, VC concatenates the values of
+
鐃緒申`diff-switches', `vc-diff-switches', and `vc-BACKEND-diff-switches' to
+
鐃緒申get the switches for that command.  Thus, `vc-diff-switches' should
+
鐃緒申contain switches that are specific to version control, but not
+
鐃緒申specific to any particular backend."
+
鐃緒申  :type '(choice (const :tag "None" nil)
+
鐃緒申		 (string :tag "Argument String")
+
鐃緒申		 (repeat :tag "Argument List"
+
鐃緒申			 :value ("")
+
鐃緒申			 string))
+
鐃緒申  :group 'vc
+
鐃緒申  :version "21.1")
+
鐃緒申
+
鐃緒申(defcustom vc-allow-async-revert nil
+
鐃緒申  "*Specifies whether the diff during \\[vc-revert-buffer] may be asynchronous.
+
鐃緒申Enabling this option means that you can confirm a revert operation even
+
鐃緒申if the local changes in the file have not been found and displayed yet."
+
鐃緒申  :type '(choice (const :tag "No" nil)
+
鐃緒申                 (const :tag "Yes" t))
+
鐃緒申  :group 'vc
+
鐃緒申  :version "22.1")
+
鐃緒申
+
鐃緒申;;;###autoload
+
鐃緒申(defcustom vc-checkout-hook nil
+
鐃緒申  "*Normal hook (list of functions) run after checking out a file.
+
鐃緒申See `run-hooks'."
+
鐃緒申  :type 'hook
+
鐃緒申  :group 'vc
+
鐃緒申  :version "21.1")
+
鐃緒申
+
鐃緒申(defcustom vc-annotate-display-mode nil
+
鐃緒申  "Which mode to color the output of \\[vc-annotate] with by default."
+
鐃緒申  :type '(choice (const :tag "Default" nil)
+
鐃緒申		 (const :tag "Scale to Oldest" scale)
+
鐃緒申		 (const :tag "Scale Oldest->Newest" fullscale)
+
鐃緒申		 (number :tag "Specify Fractional Number of Days"
+
鐃緒申			 :value "20.5"))
+
鐃緒申  :group 'vc)
+
鐃緒申
+
鐃緒申;;;###autoload
+
鐃緒申(defcustom vc-checkin-hook nil
+
鐃緒申  "*Normal hook (list of functions) run after a checkin is done.
+
鐃緒申See also `log-edit-done-hook'."
+
鐃緒申  :type 'hook
+
鐃緒申  :options '(log-edit-comment-to-change-log)
+
鐃緒申  :group 'vc)
+
鐃緒申
+
鐃緒申;;;###autoload
+
鐃緒申(defcustom vc-before-checkin-hook nil
+
鐃緒申  "*Normal hook (list of functions) run before a file is checked in.
+
鐃緒申See `run-hooks'."
+
鐃緒申  :type 'hook
+
鐃緒申  :group 'vc)
+
鐃緒申
+
鐃緒申(defcustom vc-logentry-check-hook nil
+
鐃緒申  "*Normal hook run by `vc-backend-logentry-check'.
+
鐃緒申Use this to impose your own rules on the entry in addition to any the
+
鐃緒申version control backend imposes itself."
+
鐃緒申  :type 'hook
+
鐃緒申  :group 'vc)
+
鐃緒申
+
鐃緒申;; Annotate customization
+
鐃緒申(defcustom vc-annotate-color-map
+
鐃緒申  '(( 20. . "#FFCC00")
+
鐃緒申    ( 40. . "#FF6666")
+
鐃緒申    ( 60. . "#FF6600")
+
鐃緒申    ( 80. . "#FF3300")
+
鐃緒申    (100. . "#FF00FF")
+
鐃緒申    (120. . "#FF0000")
+
鐃緒申    (140. . "#CCCC00")
+
鐃緒申    (160. . "#CC00CC")
+
鐃緒申    (180. . "#BC8F8F")
+
鐃緒申    (200. . "#99CC00")
+
鐃緒申    (220. . "#999900")
+
鐃緒申    (240. . "#7AC5CD")
+
鐃緒申    (260. . "#66CC00")
+
鐃緒申    (280. . "#33CC33")
+
鐃緒申    (300. . "#00CCFF")
+
鐃緒申    (320. . "#00CC99")
+
鐃緒申    (340. . "#0099FF"))
+
鐃緒申  "*Association list of age versus color, for \\[vc-annotate].
+
鐃緒申Ages are given in units of fractional days.  Default is eighteen steps
+
鐃緒申using a twenty day increment."
+
鐃緒申  :type 'alist
+
鐃緒申  :group 'vc)
+
鐃緒申
+
鐃緒申(defcustom vc-annotate-very-old-color "#0046FF"
+
鐃緒申  "*Color for lines older than the current color range in \\[vc-annotate]]."
+
鐃緒申  :type 'string
+
鐃緒申  :group 'vc)
+
鐃緒申
+
鐃緒申(defcustom vc-annotate-background "black"
+
鐃緒申  "*Background color for \\[vc-annotate].
+
鐃緒申Default color is used if nil."
+
鐃緒申  :type 'string
+
鐃緒申  :group 'vc)
+
鐃緒申
+
鐃緒申(defcustom vc-annotate-menu-elements '(2 0.5 0.1 0.01)
+
鐃緒申  "*Menu elements for the mode-specific menu of VC-Annotate mode.
+
鐃緒申List of factors, used to expand/compress the time scale.  See `vc-annotate'."
+
鐃緒申  :type '(repeat number)
+
鐃緒申  :group 'vc)
+
鐃緒申
+
鐃緒申(defvar vc-annotate-mode-map
+
鐃緒申  (let ((m (make-sparse-keymap)))
+
鐃緒申    (define-key m [menu-bar] (make-sparse-keymap "VC-Annotate"))
+
鐃緒申    m)
+
鐃緒申  "Local keymap used for VC-Annotate mode.")
+
鐃緒申
+
鐃緒申(define-key vc-annotate-mode-map "A" 'vc-annotate-revision-previous-to-line)
+
鐃緒申(define-key vc-annotate-mode-map "D" 'vc-annotate-show-diff-revision-at-line)
+
鐃緒申(define-key vc-annotate-mode-map "J" 'vc-annotate-revision-at-line)
+
鐃緒申(define-key vc-annotate-mode-map "L" 'vc-annotate-show-log-revision-at-line)
+
鐃緒申(define-key vc-annotate-mode-map "N" 'vc-annotate-next-version)
+
鐃緒申(define-key vc-annotate-mode-map "P" 'vc-annotate-prev-version)
+
鐃緒申(define-key vc-annotate-mode-map "W" 'vc-annotate-workfile-version)
+
鐃緒申
+
鐃緒申(defvar vc-annotate-mode-menu nil
+
鐃緒申  "Local keymap used for VC-Annotate mode's menu bar menu.")
+
鐃緒申
+
鐃緒申;; Header-insertion hair
+
鐃緒申
+
鐃緒申(defcustom vc-static-header-alist
+
鐃緒申  '(("\\.c$" .
+
鐃緒申     "\n#ifndef lint\nstatic char vcid[] = \"\%s\";\n#endif /* lint */\n"))
+
鐃緒申  "*Associate static header string templates with file types.
+
鐃緒申A \%s in the template is replaced with the first string associated with
+
鐃緒申the file's version control type in `vc-header-alist'."
+
鐃緒申  :type '(repeat (cons :format "%v"
+
鐃緒申		       (regexp :tag "File Type")
+
鐃緒申		       (string :tag "Header String")))
+
鐃緒申  :group 'vc)
+
鐃緒申
+
鐃緒申(defcustom vc-comment-alist
+
鐃緒申  '((nroff-mode ".\\\"" ""))
+
鐃緒申  "*Special comment delimiters for generating VC headers.
+
鐃緒申Add an entry in this list if you need to override the normal `comment-start'
+
鐃緒申and `comment-end' variables.  This will only be necessary if the mode language
+
鐃緒申is sensitive to blank lines."
+
鐃緒申  :type '(repeat (list :format "%v"
+
鐃緒申		       (symbol :tag "Mode")
+
鐃緒申		       (string :tag "Comment Start")
+
鐃緒申		       (string :tag "Comment End")))
+
鐃緒申  :group 'vc)
+
鐃緒申
+
鐃緒申(defcustom vc-checkout-carefully (= (user-uid) 0)
+
鐃緒申  "*Non-nil means be extra-careful in checkout.
+
鐃緒申Verify that the file really is not locked
+
鐃緒申and that its contents match what the master file says."
+
鐃緒申  :type 'boolean
+
鐃緒申  :group 'vc)
+
鐃緒申(make-obsolete-variable 'vc-checkout-carefully
+
鐃緒申                        "the corresponding checks are always done now."
+
鐃緒申                        "21.1")
+
鐃緒申
+
鐃緒申
+
鐃緒申;; Variables the user doesn't need to know about.
+
鐃緒申(defvar vc-log-operation nil)
+
鐃緒申(defvar vc-log-after-operation-hook nil)
+
鐃緒申(defvar vc-annotate-buffers nil
+
鐃緒申  "Alist of current \"Annotate\" buffers and their corresponding backends.
+
鐃緒申The keys are \(BUFFER . BACKEND\).  See also `vc-annotate-get-backend'.")
+
鐃緒申;; In a log entry buffer, this is a local variable
+
鐃緒申;; that points to the buffer for which it was made
+
鐃緒申;; (either a file, or a VC dired buffer).
+
鐃緒申(defvar vc-parent-buffer nil)
+
鐃緒申(put 'vc-parent-buffer 'permanent-local t)
+
鐃緒申(defvar vc-parent-buffer-name nil)
+
鐃緒申(put 'vc-parent-buffer-name 'permanent-local t)
+
鐃緒申
+
鐃緒申(defvar vc-disable-async-diff nil
+
鐃緒申  "VC sets this to t locally to disable some async diff operations.
+
鐃緒申Backends that offer asynchronous diffs should respect this variable
+
鐃緒申in their implementation of vc-BACKEND-diff.")
+
鐃緒申
+
鐃緒申(defvar vc-log-file)
+
鐃緒申(defvar vc-log-version)
+
鐃緒申
+
鐃緒申(defvar vc-dired-mode nil)
+
鐃緒申(make-variable-buffer-local 'vc-dired-mode)
+
鐃緒申
+
鐃緒申;; functions that operate on RCS revision numbers.  This code should
+
鐃緒申;; also be moved into the backends.  It stays for now, however, since
+
鐃緒申;; it is used in code below.
+
鐃緒申;;;###autoload
+
鐃緒申(defun vc-trunk-p (rev)
+
鐃緒申  "Return t if REV is a revision on the trunk."
+
鐃緒申  (not (eq nil (string-match "\\`[0-9]+\\.[0-9]+\\'" rev))))
+
鐃緒申
+
鐃緒申(defun vc-branch-p (rev)
+
鐃緒申  "Return t if REV is a branch revision."
+
鐃緒申  (not (eq nil (string-match "\\`[0-9]+\\(\\.[0-9]+\\.[0-9]+\\)*\\'" rev))))
+
鐃緒申
+
鐃緒申;;;###autoload
+
鐃緒申(defun vc-branch-part (rev)
+
鐃緒申  "Return the branch part of a revision number REV."
+
鐃緒申  (let ((index (string-match "\\.[0-9]+\\'" rev)))
+
鐃緒申    (if index
+
鐃緒申        (substring rev 0 index))))
+
鐃緒申
+
鐃緒申(defun vc-minor-part (rev)
+
鐃緒申  "Return the minor version number of a revision number REV."
+
鐃緒申  (string-match "[0-9]+\\'" rev)
+
鐃緒申  (substring rev (match-beginning 0) (match-end 0)))
+
鐃緒申
+
鐃緒申(defun vc-default-previous-version (backend file rev)
+
鐃緒申  "Return the version number immediately preceding REV for FILE,
+
鐃緒申or nil if there is no previous version.  This default
+
鐃緒申implementation works for <major>.<minor>-style version numbers as
+
鐃緒申used by RCS and CVS."
+
鐃緒申  (let ((branch (vc-branch-part rev))
+
鐃緒申        (minor-num (string-to-number (vc-minor-part rev))))
+
鐃緒申    (when branch
+
鐃緒申      (if (> minor-num 1)
+
鐃緒申          ;; version does probably not start a branch or release
+
鐃緒申          (concat branch "." (number-to-string (1- minor-num)))
+
鐃緒申        (if (vc-trunk-p rev)
+
鐃緒申            ;; we are at the beginning of the trunk --
+
鐃緒申            ;; don't know anything to return here
+
鐃緒申            nil
+
鐃緒申          ;; we are at the beginning of a branch --
+
鐃緒申          ;; return version of starting point
+
鐃緒申          (vc-branch-part branch))))))
+
鐃緒申
+
鐃緒申(defun vc-default-next-version (backend file rev)
+
鐃緒申  "Return the version number immediately following REV for FILE,
+
鐃緒申or nil if there is no next version.  This default implementation
+
鐃緒申works for <major>.<minor>-style version numbers as used by RCS
+
鐃緒申and CVS."
+
鐃緒申  (when (not (string= rev (vc-workfile-version file)))
+
鐃緒申    (let ((branch (vc-branch-part rev))
+
鐃緒申	  (minor-num (string-to-number (vc-minor-part rev))))
+
鐃緒申      (concat branch "." (number-to-string (1+ minor-num))))))
+
鐃緒申
+
鐃緒申;; File property caching
+
鐃緒申
+
鐃緒申(defun vc-clear-context ()
+
鐃緒申  "Clear all cached file properties."
+
鐃緒申  (interactive)
+
鐃緒申  (fillarray vc-file-prop-obarray 0))
+
鐃緒申
+
鐃緒申(defmacro with-vc-properties (file form settings)
+
鐃緒申  "Execute FORM, then maybe set per-file properties for FILE.
+
鐃緒申SETTINGS is an association list of property/value pairs.  After
+
鐃緒申executing FORM, set those properties from SETTINGS that have not yet
+
鐃緒申been updated to their corresponding values."
+
鐃緒申  (declare (debug t))
+
鐃緒申  `(let ((vc-touched-properties (list t)))
+
鐃緒申     ,form
+
鐃緒申     (mapcar (lambda (setting)
+
鐃緒申	       (let ((property (car setting)))
+
鐃緒申		 (unless (memq property vc-touched-properties)
+
鐃緒申		   (put (intern ,file vc-file-prop-obarray)
+
鐃緒申			property (cdr setting)))))
+
鐃緒申	     ,settings)))
+
鐃緒申
+
鐃緒申;; Random helper functions
+
鐃緒申
+
鐃緒申(defsubst vc-editable-p (file)
+
鐃緒申  "Return non-nil if FILE can be edited."
+
鐃緒申  (or (eq (vc-checkout-model file) 'implicit)
+
鐃緒申      (memq (vc-state file) '(edited needs-merge))))
+
鐃緒申
+
鐃緒申;; Two macros for elisp programming
+
鐃緒申;;;###autoload
+
鐃緒申(defmacro with-vc-file (file comment &rest body)
+
鐃緒申  "Check out a writable copy of FILE if necessary, then execute BODY.
+
鐃緒申Check in FILE with COMMENT (a string) after BODY has been executed.
+
鐃緒申FILE is passed through `expand-file-name'; BODY executed within
+
鐃緒申`save-excursion'.  If FILE is not under version control, or locked by
+
鐃緒申somebody else, signal error."
+
鐃緒申  (declare (debug t) (indent 2))
+
鐃緒申  (let ((filevar (make-symbol "file")))
+
鐃緒申    `(let ((,filevar (expand-file-name ,file)))
+
鐃緒申       (or (vc-backend ,filevar)
+
鐃緒申           (error "File not under version control: `%s'" file))
+
鐃緒申       (unless (vc-editable-p ,filevar)
+
鐃緒申         (let ((state (vc-state ,filevar)))
+
鐃緒申           (if (stringp state)
+
鐃緒申               (error "`%s' is locking `%s'" state ,filevar)
+
鐃緒申             (vc-checkout ,filevar t))))
+
鐃緒申       (save-excursion
+
鐃緒申         ,@body)
+
鐃緒申       (vc-checkin ,filevar nil ,comment))))
+
鐃緒申
+
鐃緒申;;;###autoload
+
鐃緒申(defmacro edit-vc-file (file comment &rest body)
+
鐃緒申  "Edit FILE under version control, executing body.
+
鐃緒申Checkin with COMMENT after executing BODY.
+
鐃緒申This macro uses `with-vc-file', passing args to it.
+
鐃緒申However, before executing BODY, find FILE, and after BODY, save buffer."
+
鐃緒申  (declare (debug t) (indent 2))
+
鐃緒申  (let ((filevar (make-symbol "file")))
+
鐃緒申    `(let ((,filevar (expand-file-name ,file)))
+
鐃緒申       (with-vc-file
+
鐃緒申        ,filevar ,comment
+
鐃緒申        (set-buffer (find-file-noselect ,filevar))
+
鐃緒申        ,@body
+
鐃緒申        (save-buffer)))))
+
鐃緒申
+
鐃緒申(defun vc-ensure-vc-buffer ()
+
鐃緒申  "Make sure that the current buffer visits a version-controlled file."
+
鐃緒申  (if vc-dired-mode
+
鐃緒申      (set-buffer (find-file-noselect (dired-get-filename)))
+
鐃緒申    (while vc-parent-buffer
+
鐃緒申      (pop-to-buffer vc-parent-buffer))
+
鐃緒申    (if (not buffer-file-name)
+
鐃緒申	(error "Buffer %s is not associated with a file" (buffer-name))
+
鐃緒申      (if (not (vc-backend buffer-file-name))
+
鐃緒申	  (error "File %s is not under version control" buffer-file-name)))))
+
鐃緒申
+
鐃緒申(defun vc-process-filter (p s)
+
鐃緒申  "An alternative output filter for async process P.
+
鐃緒申The only difference with the default filter is to insert S after markers."
+
鐃緒申  (with-current-buffer (process-buffer p)
+
鐃緒申    (save-excursion
+
鐃緒申      (let ((inhibit-read-only t))
+
鐃緒申	(goto-char (process-mark p))
+
鐃緒申	(insert s)
+
鐃緒申	(set-marker (process-mark p) (point))))))
+
鐃緒申
+
鐃緒申(defun vc-setup-buffer (&optional buf)
+
鐃緒申  "Prepare BUF for executing a VC command and make it current.
+
鐃緒申BUF defaults to \"*vc*\", can be a string and will be created if necessary."
+
鐃緒申  (unless buf (setq buf "*vc*"))
+
鐃緒申  (let ((camefrom (current-buffer))
+
鐃緒申	(olddir default-directory))
+
鐃緒申    (set-buffer (get-buffer-create buf))
+
鐃緒申    (kill-all-local-variables)
+
鐃緒申    (set (make-local-variable 'vc-parent-buffer) camefrom)
+
鐃緒申    (set (make-local-variable 'vc-parent-buffer-name)
+
鐃緒申	 (concat " from " (buffer-name camefrom)))
+
鐃緒申    (setq default-directory olddir)
+
鐃緒申    (let ((inhibit-read-only t))
+
鐃緒申      (erase-buffer))))
+
鐃緒申
+
鐃緒申(defun vc-exec-after (code)
+
鐃緒申  "Eval CODE when the current buffer's process is done.
+
鐃緒申If the current buffer has no process, just evaluate CODE.
+
鐃緒申Else, add CODE to the process' sentinel."
+
鐃緒申  (let ((proc (get-buffer-process (current-buffer))))
+
鐃緒申    (cond
+
鐃緒申     ;; If there's no background process, just execute the code.
+
鐃緒申     ((null proc) (eval code))
+
鐃緒申     ;; If the background process has exited, reap it and try again
+
鐃緒申     ((eq (process-status proc) 'exit)
+
鐃緒申      (delete-process proc)
+
鐃緒申      (vc-exec-after code))
+
鐃緒申     ;; If a process is running, add CODE to the sentinel
+
鐃緒申     ((eq (process-status proc) 'run)
+
鐃緒申      (let ((sentinel (process-sentinel proc)))
+
鐃緒申	(set-process-sentinel proc
+
鐃緒申	  `(lambda (p s)
+
鐃緒申	     (with-current-buffer ',(current-buffer)
+
鐃緒申	       (goto-char (process-mark p))
+
鐃緒申	       ,@(append (cdr (cdr (cdr ;strip off `with-current-buffer buf
+
鐃緒申                                        ;             (goto-char...)'
+
鐃緒申			   (car (cdr (cdr ;strip off `lambda (p s)'
+
鐃緒申			    sentinel))))))
+
鐃緒申			 (list `(vc-exec-after ',code))))))))
+
鐃緒申     (t (error "Unexpected process state"))))
+
鐃緒申  nil)
+
鐃緒申
+
鐃緒申(defvar vc-post-command-functions nil
+
鐃緒申  "Hook run at the end of `vc-do-command'.
+
鐃緒申Each function is called inside the buffer in which the command was run
+
鐃緒申and is passed 3 arguments: the COMMAND, the FILE and the FLAGS.")
+
鐃緒申
+
鐃緒申(defvar w32-quote-process-args)
+
鐃緒申;;;###autoload
+
鐃緒申(defun vc-do-command (buffer okstatus command file &rest flags)
+
鐃緒申  "Execute a VC command, notifying user and checking for errors.
+
鐃緒申Output from COMMAND goes to BUFFER, or *vc* if BUFFER is nil or the
+
鐃緒申current buffer if BUFFER is t.  If the destination buffer is not
+
鐃緒申already current, set it up properly and erase it.  The command is
+
鐃緒申considered successful if its exit status does not exceed OKSTATUS (if
+
鐃緒申OKSTATUS is nil, that means to ignore errors, if it is 'async, that
+
鐃緒申means not to wait for termination of the subprocess).  FILE is the
+
鐃緒申name of the working file (may also be nil, to execute commands that
+
鐃緒申don't expect a file name).  If an optional list of FLAGS is present,
+
鐃緒申that is inserted into the command line before the filename."
+
鐃緒申  (and file (setq file (expand-file-name file)))
+
鐃緒申  (if vc-command-messages
+
鐃緒申      (message "Running %s on %s..." command file))
+
鐃緒申  (save-current-buffer
+
鐃緒申    (unless (or (eq buffer t)
+
鐃緒申                (and (stringp buffer)
+
鐃緒申                     (string= (buffer-name) buffer))
+
鐃緒申                (eq buffer (current-buffer)))
+
鐃緒申      (vc-setup-buffer buffer))
+
鐃緒申    (let ((squeezed (remq nil flags))
+
鐃緒申	  (inhibit-read-only t)
+
鐃緒申	  (status 0))
+
鐃緒申      (when file
+
鐃緒申	;; FIXME: file-relative-name can return a bogus result because
+
鐃緒申	;; it doesn't look at the actual file-system to see if symlinks
+
鐃緒申	;; come into play.
+
鐃緒申	(setq squeezed (append squeezed (list (file-relative-name file)))))
+
鐃緒申      (let ((exec-path (append vc-path exec-path))
+
鐃緒申	    ;; Add vc-path to PATH for the execution of this command.
+
鐃緒申	    (process-environment
+
鐃緒申	     (cons (concat "PATH=" (getenv "PATH")
+
鐃緒申			   path-separator
+
鐃緒申			   (mapconcat 'identity vc-path path-separator))
+
鐃緒申		   process-environment))
+
鐃緒申	    (w32-quote-process-args t))
+
鐃緒申	(if (and (eq okstatus 'async) (file-remote-p default-directory))
+
鐃緒申	    ;; start-process does not support remote execution
+
鐃緒申	    (setq okstatus nil))
+
鐃緒申	(if (eq okstatus 'async)
+
鐃緒申	    (let ((proc
+
鐃緒申		   (let ((process-connection-type nil))
+
鐃緒申		     (apply 'start-process command (current-buffer) command
+
鐃緒申			    squeezed))))
+
鐃緒申              (unless (active-minibuffer-window)
+
鐃緒申                (message "Running %s in the background..." command))
+
鐃緒申	      ;;(set-process-sentinel proc (lambda (p msg) (delete-process p)))
+
鐃緒申	      (set-process-filter proc 'vc-process-filter)
+
鐃緒申	      (vc-exec-after
+
鐃緒申	       `(unless (active-minibuffer-window)
+
鐃緒申                  (message "Running %s in the background... done" ',command))))
+
鐃緒申	  (setq status (apply 'process-file command nil t nil squeezed))
+
鐃緒申	  (when (or (not (integerp status)) (and okstatus (< okstatus status)))
+
鐃緒申	    (pop-to-buffer (current-buffer))
+
鐃緒申	    (goto-char (point-min))
+
鐃緒申	    (shrink-window-if-larger-than-buffer)
+
鐃緒申	    (error "Running %s...FAILED (%s)" command
+
鐃緒申		   (if (integerp status) (format "status %d" status) status))))
+
鐃緒申	(if vc-command-messages
+
鐃緒申	    (message "Running %s...OK" command)))
+
鐃緒申      (vc-exec-after
+
鐃緒申       `(run-hook-with-args 'vc-post-command-functions ',command ',file ',flags))
+
鐃緒申      status)))
+
鐃緒申
+
鐃緒申(defun vc-position-context (posn)
+
鐃緒申  "Save a bit of the text around POSN in the current buffer.
+
鐃緒申Used to help us find the corresponding position again later
+
鐃緒申if markers are destroyed or corrupted."
+
鐃緒申  ;; A lot of this was shamelessly lifted from Sebastian Kremer's
+
鐃緒申  ;; rcs.el mode.
+
鐃緒申  (list posn
+
鐃緒申	(buffer-size)
+
鐃緒申	(buffer-substring posn
+
鐃緒申			  (min (point-max) (+ posn 100)))))
+
鐃緒申
+
鐃緒申(defun vc-find-position-by-context (context)
+
鐃緒申  "Return the position of CONTEXT in the current buffer.
+
鐃緒申If CONTEXT cannot be found, return nil."
+
鐃緒申  (let ((context-string (nth 2 context)))
+
鐃緒申    (if (equal "" context-string)
+
鐃緒申	(point-max)
+
鐃緒申      (save-excursion
+
鐃緒申	(let ((diff (- (nth 1 context) (buffer-size))))
+
鐃緒申	  (if (< diff 0) (setq diff (- diff)))
+
鐃緒申	  (goto-char (nth 0 context))
+
鐃緒申	  (if (or (search-forward context-string nil t)
+
鐃緒申		  ;; Can't use search-backward since the match may continue
+
鐃緒申		  ;; after point.
+
鐃緒申		  (progn (goto-char (- (point) diff (length context-string)))
+
鐃緒申			 ;; goto-char doesn't signal an error at
+
鐃緒申			 ;; beginning of buffer like backward-char would
+
鐃緒申			 (search-forward context-string nil t)))
+
鐃緒申	      ;; to beginning of OSTRING
+
鐃緒申	      (- (point) (length context-string))))))))
+
鐃緒申
+
鐃緒申(defun vc-context-matches-p (posn context)
+
鐃緒申  "Return t if POSN matches CONTEXT, nil otherwise."
+
鐃緒申  (let* ((context-string (nth 2 context))
+
鐃緒申	 (len (length context-string))
+
鐃緒申	 (end (+ posn len)))
+
鐃緒申    (if (> end (1+ (buffer-size)))
+
鐃緒申	nil
+
鐃緒申      (string= context-string (buffer-substring posn end)))))
+
鐃緒申
+
鐃緒申(defun vc-buffer-context ()
+
鐃緒申  "Return a list (POINT-CONTEXT MARK-CONTEXT REPARSE).
+
鐃緒申Used by `vc-restore-buffer-context' to later restore the context."
+
鐃緒申  (let ((point-context (vc-position-context (point)))
+
鐃緒申	;; Use mark-marker to avoid confusion in transient-mark-mode.
+
鐃緒申	(mark-context  (if (eq (marker-buffer (mark-marker)) (current-buffer))
+
鐃緒申			   (vc-position-context (mark-marker))))
+
鐃緒申	;; Make the right thing happen in transient-mark-mode.
+
鐃緒申	(mark-active nil)
+
鐃緒申	;; The new compilation code does not use compilation-error-list any
+
鐃緒申	;; more, so the code below is now ineffective and might as well
+
鐃緒申	;; be disabled.  -- Stef
+
鐃緒申	;; ;; We may want to reparse the compilation buffer after revert
+
鐃緒申	;; (reparse (and (boundp 'compilation-error-list) ;compile loaded
+
鐃緒申	;; 	      ;; Construct a list; each elt is nil or a buffer
+
鐃緒申	;; 	      ;; iff that buffer is a compilation output buffer
+
鐃緒申	;; 	      ;; that contains markers into the current buffer.
+
鐃緒申	;; 	      (save-current-buffer
+
鐃緒申	;; 		(mapcar (lambda (buffer)
+
鐃緒申	;; 			  (set-buffer buffer)
+
鐃緒申	;; 			  (let ((errors (or
+
鐃緒申	;; 					 compilation-old-error-list
+
鐃緒申	;; 					 compilation-error-list))
+
鐃緒申	;; 				(buffer-error-marked-p nil))
+
鐃緒申	;; 			    (while (and (consp errors)
+
鐃緒申	;; 					(not buffer-error-marked-p))
+
鐃緒申	;; 			      (and (markerp (cdr (car errors)))
+
鐃緒申	;; 				   (eq buffer
+
鐃緒申	;; 				       (marker-buffer
+
鐃緒申	;; 					(cdr (car errors))))
+
鐃緒申	;; 				   (setq buffer-error-marked-p t))
+
鐃緒申	;; 			      (setq errors (cdr errors)))
+
鐃緒申	;; 			    (if buffer-error-marked-p buffer)))
+
鐃緒申	;; 			(buffer-list)))))
+
鐃緒申	(reparse nil))
+
鐃緒申    (list point-context mark-context reparse)))
+
鐃緒申
+
鐃緒申(defun vc-restore-buffer-context (context)
+
鐃緒申  "Restore point/mark, and reparse any affected compilation buffers.
+
鐃緒申CONTEXT is that which `vc-buffer-context' returns."
+
鐃緒申  (let ((point-context (nth 0 context))
+
鐃緒申	(mark-context (nth 1 context))
+
鐃緒申	(reparse (nth 2 context)))
+
鐃緒申    ;; The new compilation code does not use compilation-error-list any
+
鐃緒申    ;; more, so the code below is now ineffective and might as well
+
鐃緒申    ;; be disabled.  -- Stef
+
鐃緒申    ;; ;; Reparse affected compilation buffers.
+
鐃緒申    ;; (while reparse
+
鐃緒申    ;;   (if (car reparse)
+
鐃緒申    ;; 	  (with-current-buffer (car reparse)
+
鐃緒申    ;; 	    (let ((compilation-last-buffer (current-buffer)) ;select buffer
+
鐃緒申    ;; 		  ;; Record the position in the compilation buffer of
+
鐃緒申    ;; 		  ;; the last error next-error went to.
+
鐃緒申    ;; 		  (error-pos (marker-position
+
鐃緒申    ;; 			      (car (car-safe compilation-error-list)))))
+
鐃緒申    ;; 	      ;; Reparse the error messages as far as they were parsed before.
+
鐃緒申    ;; 	      (compile-reinitialize-errors '(4) compilation-parsing-end)
+
鐃緒申    ;; 	      ;; Move the pointer up to find the error we were at before
+
鐃緒申    ;; 	      ;; reparsing.  Now next-error should properly go to the next one.
+
鐃緒申    ;; 	      (while (and compilation-error-list
+
鐃緒申    ;; 			  (/= error-pos (car (car compilation-error-list))))
+
鐃緒申    ;; 		(setq compilation-error-list (cdr compilation-error-list))))))
+
鐃緒申    ;;   (setq reparse (cdr reparse)))
+
鐃緒申
+
鐃緒申    ;; if necessary, restore point and mark
+
鐃緒申    (if (not (vc-context-matches-p (point) point-context))
+
鐃緒申	(let ((new-point (vc-find-position-by-context point-context)))
+
鐃緒申	  (if new-point (goto-char new-point))))
+
鐃緒申    (and mark-active
+
鐃緒申         mark-context
+
鐃緒申         (not (vc-context-matches-p (mark) mark-context))
+
鐃緒申         (let ((new-mark (vc-find-position-by-context mark-context)))
+
鐃緒申           (if new-mark (set-mark new-mark))))))
+
鐃緒申
+
鐃緒申(defun vc-revert-buffer1 (&optional arg no-confirm)
+
鐃緒申  "Revert buffer, keeping point and mark where user expects them.
+
鐃緒申Try to be clever in the face of changes due to expanded version control
+
鐃緒申key words.  This is important for typeahead to work as expected.
+
鐃緒申ARG and NO-CONFIRM are passed on to `revert-buffer'."
+
鐃緒申  (interactive "P")
+
鐃緒申  (widen)
+
鐃緒申  (let ((context (vc-buffer-context)))
+
鐃緒申    ;; Use save-excursion here, because it may be able to restore point
+
鐃緒申    ;; and mark properly even in cases where vc-restore-buffer-context
+
鐃緒申    ;; would fail.  However, save-excursion might also get it wrong --
+
鐃緒申    ;; in this case, vc-restore-buffer-context gives it a second try.
+
鐃緒申    (save-excursion
+
鐃緒申      ;; t means don't call normal-mode;
+
鐃緒申      ;; that's to preserve various minor modes.
+
鐃緒申      (revert-buffer arg no-confirm t))
+
鐃緒申    (vc-restore-buffer-context context)))
+
鐃緒申
+
鐃緒申
+
鐃緒申(defun vc-buffer-sync (&optional not-urgent)
+
鐃緒申  "Make sure the current buffer and its working file are in sync.
+
鐃緒申NOT-URGENT means it is ok to continue if the user says not to save."
+
鐃緒申  (if (buffer-modified-p)
+
鐃緒申      (if (or vc-suppress-confirm
+
鐃緒申	      (y-or-n-p (format "Buffer %s modified; save it? " (buffer-name))))
+
鐃緒申	  (save-buffer)
+
鐃緒申	(unless not-urgent
+
鐃緒申	  (error "Aborted")))))
+
鐃緒申
+
鐃緒申(defun vc-default-latest-on-branch-p (backend file)
+
鐃緒申  "Return non-nil if FILE is the latest on its branch.
+
鐃緒申This default implementation always returns non-nil, which means that
+
鐃緒申editing non-current versions is not supported by default."
+
鐃緒申  t)
+
鐃緒申
+
鐃緒申(defun vc-next-action-on-file (file verbose &optional comment)
+
鐃緒申  "Do The Right Thing for a given FILE under version control.
+
鐃緒申If COMMENT is specified, it will be used as an admin or checkin comment.
+
鐃緒申If VERBOSE is non-nil, query the user rather than using default parameters."
+
鐃緒申  (let ((visited (get-file-buffer file))
+
鐃緒申	state version)
+
鐃緒申    (when visited
+
鐃緒申      (if vc-dired-mode
+
鐃緒申          (switch-to-buffer-other-window visited)
+
鐃緒申        (set-buffer visited))
+
鐃緒申      ;; Check relation of buffer and file, and make sure
+
鐃緒申      ;; user knows what he's doing.  First, finding the file
+
鐃緒申      ;; will check whether the file on disk is newer.
+
鐃緒申      ;; Ignore buffer-read-only during this test, and
+
鐃緒申      ;; preserve find-file-literally.
+
鐃緒申      (let ((buffer-read-only (not (file-writable-p file))))
+
鐃緒申        (find-file-noselect file nil find-file-literally))
+
鐃緒申      (if (not (verify-visited-file-modtime (current-buffer)))
+
鐃緒申	  (if (yes-or-no-p "Replace file on disk with buffer contents? ")
+
鐃緒申	      (write-file buffer-file-name)
+
鐃緒申	    (error "Aborted"))
+
鐃緒申	;; Now, check if we have unsaved changes.
+
鐃緒申	(vc-buffer-sync t)
+
鐃緒申	(if (buffer-modified-p)
+
鐃緒申	    (or (y-or-n-p "Operate on disk file, keeping modified buffer? ")
+
鐃緒申		(error "Aborted")))))
+
鐃緒申
+
鐃緒申    ;; Do the right thing
+
鐃緒申    (if (not (vc-registered file))
+
鐃緒申	(vc-register verbose comment)
+
鐃緒申      (vc-recompute-state file)
+
鐃緒申      (if visited (vc-mode-line file))
+
鐃緒申      (setq state (vc-state file))
+
鐃緒申      (cond
+
鐃緒申       ;; up-to-date
+
鐃緒申       ((or (eq state 'up-to-date)
+
鐃緒申	    (and verbose (eq state 'needs-patch)))
+
鐃緒申	(cond
+
鐃緒申	 (verbose
+
鐃緒申	  ;; go to a different version
+
鐃緒申	  (setq version
+
鐃緒申		(read-string "Branch, version, or backend to move to: "))
+
鐃緒申	  (let ((vsym (intern-soft (upcase version))))
+
鐃緒申	    (if (member vsym vc-handled-backends)
+
鐃緒申		(vc-transfer-file file vsym)
+
鐃緒申	      (vc-checkout file (eq (vc-checkout-model file) 'implicit)
+
鐃緒申			   version))))
+
鐃緒申	 ((not (eq (vc-checkout-model file) 'implicit))
+
鐃緒申	  ;; check the file out
+
鐃緒申	  (vc-checkout file t))
+
鐃緒申	 (t
+
鐃緒申	  ;; do nothing
+
鐃緒申	  (message "%s is up-to-date" file))))
+
鐃緒申
+
鐃緒申       ;; Abnormal: edited but read-only
+
鐃緒申       ((and visited (eq state 'edited)
+
鐃緒申	     buffer-read-only (not (file-writable-p file)))
+
鐃緒申	;; Make the file+buffer read-write.  If the user really wanted to
+
鐃緒申	;; commit, he'll get a chance to do that next time around, anyway.
+
鐃緒申	(message "File is edited but read-only; making it writable")
+
鐃緒申	(set-file-modes buffer-file-name
+
鐃緒申			(logior (file-modes buffer-file-name) 128))
+
鐃緒申	(toggle-read-only -1))
+
鐃緒申
+
鐃緒申       ;; edited
+
鐃緒申       ((eq state 'edited)
+
鐃緒申	(cond
+
鐃緒申	 ;; For files with locking, if the file does not contain
+
鐃緒申	 ;; any changes, just let go of the lock, i.e. revert.
+
鐃緒申	 ((and (not (eq (vc-checkout-model file) 'implicit))
+
鐃緒申	       (vc-workfile-unchanged-p file)
+
鐃緒申	       ;; If buffer is modified, that means the user just
+
鐃緒申	       ;; said no to saving it; in that case, don't revert,
+
鐃緒申	       ;; because the user might intend to save after
+
鐃緒申	       ;; finishing the log entry.
+
鐃緒申	       (not (and visited (buffer-modified-p))))
+
鐃緒申	  ;; DO NOT revert the file without asking the user!
+
鐃緒申	  (if (not visited) (find-file-other-window file))
+
鐃緒申	  (if (yes-or-no-p "Revert to master version? ")
+
鐃緒申	      (vc-revert-buffer)))
+
鐃緒申	 (t ;; normal action
+
鐃緒申	  (if (not verbose)
+
鐃緒申	      (vc-checkin file nil comment)
+
鐃緒申	    (setq version (read-string "New version or backend: "))
+
鐃緒申	    (let ((vsym (intern (upcase version))))
+
鐃緒申	      (if (member vsym vc-handled-backends)
+
鐃緒申		  (vc-transfer-file file vsym)
+
鐃緒申		(vc-checkin file version comment)))))))
+
鐃緒申
+
鐃緒申       ;; locked by somebody else
+
鐃緒申       ((stringp state)
+
鐃緒申	(if comment
+
鐃緒申	    (error "Sorry, you can't steal the lock on %s this way"
+
鐃緒申		   (file-name-nondirectory file)))
+
鐃緒申	(vc-steal-lock file
+
鐃緒申                       (if verbose (read-string "Version to steal: ")
+
鐃緒申                         (vc-workfile-version file))
+
鐃緒申		       state))
+
鐃緒申
+
鐃緒申       ;; needs-patch
+
鐃緒申       ((eq state 'needs-patch)
+
鐃緒申	(if (yes-or-no-p (format
+
鐃緒申			  "%s is not up-to-date.  Get latest version? "
+
鐃緒申			  (file-name-nondirectory file)))
+
鐃緒申	    (vc-checkout file (eq (vc-checkout-model file) 'implicit) t)
+
鐃緒申	  (if (and (not (eq (vc-checkout-model file) 'implicit))
+
鐃緒申		   (yes-or-no-p "Lock this version? "))
+
鐃緒申	      (vc-checkout file t)
+
鐃緒申	    (error "Aborted"))))
+
鐃緒申
+
鐃緒申       ;; needs-merge
+
鐃緒申       ((eq state 'needs-merge)
+
鐃緒申	(if (yes-or-no-p (format
+
鐃緒申			  "%s is not up-to-date.  Merge in changes now? "
+
鐃緒申			  (file-name-nondirectory file)))
+
鐃緒申	    (vc-maybe-resolve-conflicts file (vc-call merge-news file))
+
鐃緒申	  (error "Aborted")))
+
鐃緒申
+
鐃緒申       ;; unlocked-changes
+
鐃緒申       ((eq state 'unlocked-changes)
+
鐃緒申	(if (not visited) (find-file-other-window file))
+
鐃緒申	(if (save-window-excursion
+
鐃緒申	      (vc-version-diff file (vc-workfile-version file) nil)
+
鐃緒申	      (goto-char (point-min))
+
鐃緒申	      (let ((inhibit-read-only t))
+
鐃緒申		(insert
+
鐃緒申		 (format "Changes to %s since last lock:\n\n" file)))
+
鐃緒申	      (not (beep))
+
鐃緒申	      (yes-or-no-p (concat "File has unlocked changes.  "
+
鐃緒申				   "Claim lock retaining changes? ")))
+
鐃緒申	    (progn (vc-call steal-lock file)
+
鐃緒申                   (clear-visited-file-modtime)
+
鐃緒申		   ;; Must clear any headers here because they wouldn't
+
鐃緒申		   ;; show that the file is locked now.
+
鐃緒申		   (vc-clear-headers file)
+
鐃緒申		   (write-file buffer-file-name)
+
鐃緒申		   (vc-mode-line file))
+
鐃緒申	  (if (not (yes-or-no-p
+
鐃緒申		    "Revert to checked-in version, instead? "))
+
鐃緒申	      (error "Checkout aborted")
+
鐃緒申	    (vc-revert-buffer1 t t)
+
鐃緒申	    (vc-checkout file t))))))))
+
鐃緒申
+
鐃緒申(defvar vc-dired-window-configuration)
+
鐃緒申
+
鐃緒申(defun vc-next-action-dired (file rev comment)
+
鐃緒申  "Call `vc-next-action-on-file' on all the marked files.
+
鐃緒申Ignores FILE and REV, but passes on COMMENT."
+
鐃緒申  (let ((dired-buffer (current-buffer)))
+
鐃緒申    (dired-map-over-marks
+
鐃緒申     (let ((file (dired-get-filename)))
+
鐃緒申       (message "Processing %s..." file)
+
鐃緒申       (vc-next-action-on-file file nil comment)
+
鐃緒申       (set-buffer dired-buffer)
+
鐃緒申       (set-window-configuration vc-dired-window-configuration)
+
鐃緒申       (message "Processing %s...done" file))
+
鐃緒申    nil t))
+
鐃緒申  (dired-move-to-filename))
+
鐃緒申
+
鐃緒申;; Here's the major entry point.
+
鐃緒申
+
鐃緒申;;;###autoload
+
鐃緒申(defun vc-next-action (verbose)
+
鐃緒申  "Do the next logical version control operation on the current file.
+
鐃緒申
+
鐃緒申If you call this from within a VC dired buffer with no files marked,
+
鐃緒申it will operate on the file in the current line.
+
鐃緒申
+
鐃緒申If you call this from within a VC dired buffer, and one or more
+
鐃緒申files are marked, it will accept a log message and then operate on
+
鐃緒申each one.  The log message will be used as a comment for any register
+
鐃緒申or checkin operations, but ignored when doing checkouts.  Attempted
+
鐃緒申lock steals will raise an error.
+
鐃緒申
+
鐃緒申A prefix argument lets you specify the version number to use.
+
鐃緒申
+
鐃緒申For RCS and SCCS files:
+
鐃緒申   If the file is not already registered, this registers it for version
+
鐃緒申control.
+
鐃緒申   If the file is registered and not locked by anyone, this checks out
+
鐃緒申a writable and locked file ready for editing.
+
鐃緒申   If the file is checked out and locked by the calling user, this
+
鐃緒申first checks to see if the file has changed since checkout.  If not,
+
鐃緒申it performs a revert.
+
鐃緒申   If the file has been changed, this pops up a buffer for entry
+
鐃緒申of a log message; when the message has been entered, it checks in the
+
鐃緒申resulting changes along with the log message as change commentary.  If
+
鐃緒申the variable `vc-keep-workfiles' is non-nil (which is its default), a
+
鐃緒申read-only copy of the changed file is left in place afterwards.
+
鐃緒申   If the file is registered and locked by someone else, you are given
+
鐃緒申the option to steal the lock.
+
鐃緒申
+
鐃緒申For CVS files:
+
鐃緒申   If the file is not already registered, this registers it for version
+
鐃緒申control.  This does a \"cvs add\", but no \"cvs commit\".
+
鐃緒申   If the file is added but not committed, it is committed.
+
鐃緒申   If your working file is changed, but the repository file is
+
鐃緒申unchanged, this pops up a buffer for entry of a log message; when the
+
鐃緒申message has been entered, it checks in the resulting changes along
+
鐃緒申with the logmessage as change commentary.  A writable file is retained.
+
鐃緒申   If the repository file is changed, you are asked if you want to
+
鐃緒申merge in the changes into your working copy."
+
鐃緒申
+
鐃緒申  (interactive "P")
+
鐃緒申  (catch 'nogo
+
鐃緒申    (if vc-dired-mode
+
鐃緒申	(let ((files (dired-get-marked-files)))
+
鐃緒申          (set (make-local-variable 'vc-dired-window-configuration)
+
鐃緒申               (current-window-configuration))
+
鐃緒申	  (if (string= ""
+
鐃緒申		 (mapconcat
+
鐃緒申	             (lambda (f)
+
鐃緒申		       (if (not (vc-up-to-date-p f)) "@" ""))
+
鐃緒申		     files ""))
+
鐃緒申		(vc-next-action-dired nil nil "dummy")
+
鐃緒申	      (vc-start-entry nil nil nil nil
+
鐃緒申			      "Enter a change comment for the marked files."
+
鐃緒申			      'vc-next-action-dired))
+
鐃緒申	    (throw 'nogo nil)))
+
鐃緒申    (while vc-parent-buffer
+
鐃緒申      (pop-to-buffer vc-parent-buffer))
+
鐃緒申    (if buffer-file-name
+
鐃緒申        (vc-next-action-on-file buffer-file-name verbose)
+
鐃緒申      (error "Buffer %s is not associated with a file" (buffer-name)))))
+
鐃緒申
+
鐃緒申;; These functions help the vc-next-action entry point
+
鐃緒申
+
鐃緒申;;;###autoload
+
鐃緒申(defun vc-register (&optional set-version comment)
+
鐃緒申  "Register the current file into a version control system.
+
鐃緒申With prefix argument SET-VERSION, allow user to specify initial version
+
鐃緒申level.  If COMMENT is present, use that as an initial comment.
+
鐃緒申
+
鐃緒申The version control system to use is found by cycling through the list
+
鐃緒申`vc-handled-backends'.  The first backend in that list which declares
+
鐃緒申itself responsible for the file (usually because other files in that
+
鐃緒申directory are already registered under that backend) will be used to
+
鐃緒申register the file.  If no backend declares itself responsible, the
+
鐃緒申first backend that could register the file is used."
+
鐃緒申  (interactive "P")
+
鐃緒申  (unless buffer-file-name (error "No visited file"))
+
鐃緒申  (when (vc-backend buffer-file-name)
+
鐃緒申    (if (vc-registered buffer-file-name)
+
鐃緒申	(error "This file is already registered")
+
鐃緒申      (unless (y-or-n-p "Previous master file has vanished.  Make a new one? ")
+
鐃緒申	(error "Aborted"))))
+
鐃緒申  ;; Watch out for new buffers of size 0: the corresponding file
+
鐃緒申  ;; does not exist yet, even though buffer-modified-p is nil.
+
鐃緒申  (if (and (not (buffer-modified-p))
+
鐃緒申	   (zerop (buffer-size))
+
鐃緒申	   (not (file-exists-p buffer-file-name)))
+
鐃緒申      (set-buffer-modified-p t))
+
鐃緒申  (vc-buffer-sync)
+
鐃緒申
+
鐃緒申  (vc-start-entry buffer-file-name
+
鐃緒申                  (if set-version
+
鐃緒申                      (read-string (format "Initial version level for %s: "
+
鐃緒申					   (buffer-name)))
+
鐃緒申		    (let ((backend (vc-responsible-backend buffer-file-name)))
+
鐃緒申		      (if (vc-find-backend-function backend 'init-version)
+
鐃緒申			  (vc-call-backend backend 'init-version)
+
鐃緒申			vc-default-init-version)))
+
鐃緒申                  (or comment (not vc-initial-comment))
+
鐃緒申		  nil
+
鐃緒申                  "Enter initial comment."
+
鐃緒申		  (lambda (file rev comment)
+
鐃緒申		    (message "Registering %s... " file)
+
鐃緒申		    (let ((backend (vc-responsible-backend file t)))
+
鐃緒申		      (vc-file-clearprops file)
+
鐃緒申		      (vc-call-backend backend 'register file rev comment)
+
鐃緒申		      (vc-file-setprop file 'vc-backend backend)
+
鐃緒申		      (unless vc-make-backup-files
+
鐃緒申			(make-local-variable 'backup-inhibited)
+
鐃緒申			(setq backup-inhibited t)))
+
鐃緒申		    (message "Registering %s... done" file))))
+
鐃緒申
+
鐃緒申
+
鐃緒申(defun vc-responsible-backend (file &optional register)
+
鐃緒申  "Return the name of a backend system that is responsible for FILE.
+
鐃緒申The optional argument REGISTER means that a backend suitable for
+
鐃緒申registration should be found.
+
鐃緒申
+
鐃緒申If REGISTER is nil, then if FILE is already registered, return the
+
鐃緒申backend of FILE.  If FILE is not registered, or a directory, then the
+
鐃緒申first backend in `vc-handled-backends' that declares itself
+
鐃緒申responsible for FILE is returned.  If no backend declares itself
+
鐃緒申responsible, return the first backend.
+
鐃緒申
+
鐃緒申If REGISTER is non-nil, return the first responsible backend under
+
鐃緒申which FILE is not yet registered.  If there is no such backend, return
+
鐃緒申the first backend under which FILE is not yet registered, but could
+
鐃緒申be registered."
+
鐃緒申  (if (not vc-handled-backends)
+
鐃緒申      (error "No handled backends"))
+
鐃緒申  (or (and (not (file-directory-p file)) (not register) (vc-backend file))
+
鐃緒申      (catch 'found
+
鐃緒申	;; First try: find a responsible backend.  If this is for registration,
+
鐃緒申	;; it must be a backend under which FILE is not yet registered.
+
鐃緒申	(dolist (backend vc-handled-backends)
+
鐃緒申	  (and (or (not register)
+
鐃緒申		   (not (vc-call-backend backend 'registered file)))
+
鐃緒申	       (vc-call-backend backend 'responsible-p file)
+
鐃緒申	       (throw 'found backend)))
+
鐃緒申	;; no responsible backend
+
鐃緒申	(if (not register)
+
鐃緒申	    ;; if this is not for registration, the first backend must do
+
鐃緒申	    (car vc-handled-backends)
+
鐃緒申	  ;; for registration, we need to find a new backend that
+
鐃緒申	  ;; could register FILE
+
鐃緒申	  (dolist (backend vc-handled-backends)
+
鐃緒申	    (and (not (vc-call-backend backend 'registered file))
+
鐃緒申		 (vc-call-backend backend 'could-register file)
+
鐃緒申		 (throw 'found backend)))
+
鐃緒申	  (error "No backend that could register")))))
+
鐃緒申
+
鐃緒申(defun vc-default-responsible-p (backend file)
+
鐃緒申  "Indicate whether BACKEND is reponsible for FILE.
+
鐃緒申The default is to return nil always."
+
鐃緒申  nil)
+
鐃緒申
+
鐃緒申(defun vc-default-could-register (backend file)
+
鐃緒申  "Return non-nil if BACKEND could be used to register FILE.
+
鐃緒申The default implementation returns t for all files."
+
鐃緒申  t)
+
鐃緒申
+
鐃緒申(defun vc-resynch-window (file &optional keep noquery)
+
鐃緒申  "If FILE is in the current buffer, either revert or unvisit it.
+
鐃緒申The choice between revert (to see expanded keywords) and unvisit depends on
+
鐃緒申`vc-keep-workfiles'.  NOQUERY if non-nil inhibits confirmation for
+
鐃緒申reverting.  NOQUERY should be t *only* if it is known the only
+
鐃緒申difference between the buffer and the file is due to version control
+
鐃緒申rather than user editing!"
+
鐃緒申  (and (string= buffer-file-name file)
+
鐃緒申       (if keep
+
鐃緒申	   (progn
+
鐃緒申	     (vc-revert-buffer1 t noquery)
+
鐃緒申             ;; TODO: Adjusting view mode might no longer be necessary
+
鐃緒申             ;; after RMS change to files.el of 1999-08-08.  Investigate
+
鐃緒申             ;; this when we install the new VC.
+
鐃緒申             (and view-read-only
+
鐃緒申                  (if (file-writable-p file)
+
鐃緒申                      (and view-mode
+
鐃緒申                           (let ((view-old-buffer-read-only nil))
+
鐃緒申                             (view-mode-exit)))
+
鐃緒申                    (and (not view-mode)
+
鐃緒申                         (not (eq (get major-mode 'mode-class) 'special))
+
鐃緒申                         (view-mode-enter))))
+
鐃緒申	     (vc-mode-line buffer-file-name))
+
鐃緒申	 (kill-buffer (current-buffer)))))
+
鐃緒申
+
鐃緒申(defun vc-resynch-buffer (file &optional keep noquery)
+
鐃緒申  "If FILE is currently visited, resynch its buffer."
+
鐃緒申  (if (string= buffer-file-name file)
+
鐃緒申      (vc-resynch-window file keep noquery)
+
鐃緒申    (let ((buffer (get-file-buffer file)))
+
鐃緒申      (if buffer
+
鐃緒申	  (with-current-buffer buffer
+
鐃緒申	    (vc-resynch-window file keep noquery)))))
+
鐃緒申  (vc-dired-resynch-file file))
+
鐃緒申
+
鐃緒申(defun vc-start-entry (file rev comment initial-contents msg action &optional after-hook)
+
鐃緒申  "Accept a comment for an operation on FILE revision REV.
+
鐃緒申If COMMENT is nil, pop up a VC-log buffer, emit MSG, and set the
+
鐃緒申action on close to ACTION.  If COMMENT is a string and
+
鐃緒申INITIAL-CONTENTS is non-nil, then COMMENT is used as the initial
+
鐃緒申contents of the log entry buffer.  If COMMENT is a string and
+
鐃緒申INITIAL-CONTENTS is nil, do action immediately as if the user had
+
鐃緒申entered COMMENT.  If COMMENT is t, also do action immediately with an
+
鐃緒申empty comment.  Remember the file's buffer in `vc-parent-buffer'
+
鐃緒申\(current one if no file).  AFTER-HOOK specifies the local value
+
鐃緒申for vc-log-operation-hook."
+
鐃緒申  (let ((parent (or (and file (get-file-buffer file)) (current-buffer))))
+
鐃緒申    (if vc-before-checkin-hook
+
鐃緒申        (if file
+
鐃緒申            (with-current-buffer parent
+
鐃緒申              (run-hooks 'vc-before-checkin-hook))
+
鐃緒申          (run-hooks 'vc-before-checkin-hook)))
+
鐃緒申    (if (and comment (not initial-contents))
+
鐃緒申	(set-buffer (get-buffer-create "*VC-log*"))
+
鐃緒申      (pop-to-buffer (get-buffer-create "*VC-log*")))
+
鐃緒申    (set (make-local-variable 'vc-parent-buffer) parent)
+
鐃緒申    (set (make-local-variable 'vc-parent-buffer-name)
+
鐃緒申	 (concat " from " (buffer-name vc-parent-buffer)))
+
鐃緒申    (if file (vc-mode-line file))
+
鐃緒申    (vc-log-edit file)
+
鐃緒申    (make-local-variable 'vc-log-after-operation-hook)
+
鐃緒申    (if after-hook
+
鐃緒申	(setq vc-log-after-operation-hook after-hook))
+
鐃緒申    (setq vc-log-operation action)
+
鐃緒申    (setq vc-log-version rev)
+
鐃緒申    (when comment
+
鐃緒申      (erase-buffer)
+
鐃緒申      (when (stringp comment) (insert comment)))
+
鐃緒申    (if (or (not comment) initial-contents)
+
鐃緒申	(message "%s  Type C-c C-c when done" msg)
+
鐃緒申      (vc-finish-logentry (eq comment t)))))
+
鐃緒申
+
鐃緒申(defun vc-checkout (file &optional writable rev)
+
鐃緒申  "Retrieve a copy of the revision REV of FILE.
+
鐃緒申If WRITABLE is non-nil, make sure the retrieved file is writable.
+
鐃緒申REV defaults to the latest revision.
+
鐃緒申
+
鐃緒申After check-out, runs the normal hook `vc-checkout-hook'."
+
鐃緒申  (and writable
+
鐃緒申       (not rev)
+
鐃緒申       (vc-call make-version-backups-p file)
+
鐃緒申       (vc-up-to-date-p file)
+
鐃緒申       (vc-make-version-backup file))
+
鐃緒申  (with-vc-properties
+
鐃緒申   file
+
鐃緒申   (condition-case err
+
鐃緒申       (vc-call checkout file writable rev)
+
鐃緒申     (file-error
+
鐃緒申      ;; Maybe the backend is not installed ;-(
+
鐃緒申      (when writable
+
鐃緒申	(let ((buf (get-file-buffer file)))
+
鐃緒申	  (when buf (with-current-buffer buf (toggle-read-only -1)))))
+
鐃緒申      (signal (car err) (cdr err))))
+
鐃緒申   `((vc-state . ,(if (or (eq (vc-checkout-model file) 'implicit)
+
鐃緒申			  (not writable))
+
鐃緒申		      (if (vc-call latest-on-branch-p file)
+
鐃緒申			  'up-to-date
+
鐃緒申			'needs-patch)
+
鐃緒申		    'edited))
+
鐃緒申     (vc-checkout-time . ,(nth 5 (file-attributes file)))))
+
鐃緒申  (vc-resynch-buffer file t t)
+
鐃緒申  (run-hooks 'vc-checkout-hook))
+
鐃緒申
+
鐃緒申(defun vc-steal-lock (file rev owner)
+
鐃緒申  "Steal the lock on FILE."
+
鐃緒申  (let (file-description)
+
鐃緒申    (if rev
+
鐃緒申	(setq file-description (format "%s:%s" file rev))
+
鐃緒申      (setq file-description file))
+
鐃緒申    (if (not (yes-or-no-p (format "Steal the lock on %s from %s? "
+
鐃緒申				  file-description owner)))
+
鐃緒申	(error "Steal canceled"))
+
鐃緒申    (message "Stealing lock on %s..." file)
+
鐃緒申    (with-vc-properties
+
鐃緒申     file
+
鐃緒申     (vc-call steal-lock file rev)
+
鐃緒申     `((vc-state . edited)))
+
鐃緒申    (vc-resynch-buffer file t t)
+
鐃緒申    (message "Stealing lock on %s...done" file)
+
鐃緒申    ;; Write mail after actually stealing, because if the stealing
+
鐃緒申    ;; goes wrong, we don't want to send any mail.
+
鐃緒申    (compose-mail owner (format "Stolen lock on %s" file-description))
+
鐃緒申    (setq default-directory (expand-file-name "~/"))
+
鐃緒申    (goto-char (point-max))
+
鐃緒申    (insert
+
鐃緒申     (format "I stole the lock on %s, " file-description)
+
鐃緒申     (current-time-string)
+
鐃緒申     ".\n")
+
鐃緒申    (message "Please explain why you stole the lock.  Type C-c C-c when done.")))
+
鐃緒申
+
鐃緒申(defun vc-checkin (file &optional rev comment initial-contents)
+
鐃緒申  "Check in FILE.
+
鐃緒申The optional argument REV may be a string specifying the new version
+
鐃緒申level (if nil increment the current level).  COMMENT is a comment
+
鐃緒申string; if omitted, a buffer is popped up to accept a comment.  If
+
鐃緒申INITIAL-CONTENTS is non-nil, then COMMENT is used as the initial contents
+
鐃緒申of the log entry buffer.
+
鐃緒申
+
鐃緒申If `vc-keep-workfiles' is nil, FILE is deleted afterwards, provided
+
鐃緒申that the version control system supports this mode of operation.
+
鐃緒申
+
鐃緒申Runs the normal hook `vc-checkin-hook'."
+
鐃緒申  (vc-start-entry
+
鐃緒申   file rev comment initial-contents
+
鐃緒申   "Enter a change comment."
+
鐃緒申   (lambda (file rev comment)
+
鐃緒申     (message "Checking in %s..." file)
+
鐃緒申     ;; "This log message intentionally left almost blank".
+
鐃緒申     ;; RCS 5.7 gripes about white-space-only comments too.
+
鐃緒申     (or (and comment (string-match "[^\t\n ]" comment))
+
鐃緒申	 (setq comment "*** empty log message ***"))
+
鐃緒申     (with-vc-properties
+
鐃緒申      file
+
鐃緒申      ;; Change buffers to get local value of vc-checkin-switches.
+
鐃緒申      (with-current-buffer (or (get-file-buffer file) (current-buffer))
+
鐃緒申	(progn
+
鐃緒申	  (vc-call checkin file rev comment)
+
鐃緒申	  (vc-delete-automatic-version-backups file)))
+
鐃緒申      `((vc-state . up-to-date)
+
鐃緒申	(vc-checkout-time . ,(nth 5 (file-attributes file)))
+
鐃緒申	(vc-workfile-version . nil)))
+
鐃緒申     (message "Checking in %s...done" file))
+
鐃緒申   'vc-checkin-hook))
+
鐃緒申
+
鐃緒申(defun vc-finish-logentry (&optional nocomment)
+
鐃緒申  "Complete the operation implied by the current log entry.
+
鐃緒申Use the contents of the current buffer as a check-in or registration
+
鐃緒申comment.  If the optional arg NOCOMMENT is non-nil, then don't check
+
鐃緒申the buffer contents as a comment."
+
鐃緒申  (interactive)
+
鐃緒申  ;; Check and record the comment, if any.
+
鐃緒申  (unless nocomment
+
鐃緒申    ;; Comment too long?
+
鐃緒申    (vc-call-backend (or (and vc-log-file (vc-backend vc-log-file))
+
鐃緒申			 (vc-responsible-backend default-directory))
+
鐃緒申		     'logentry-check)
+
鐃緒申    (run-hooks 'vc-logentry-check-hook))
+
鐃緒申  ;; Sync parent buffer in case the user modified it while editing the comment.
+
鐃緒申  ;; But not if it is a vc-dired buffer.
+
鐃緒申  (with-current-buffer vc-parent-buffer
+
鐃緒申    (or vc-dired-mode (vc-buffer-sync)))
+
鐃緒申  (if (not vc-log-operation) (error "No log operation is pending"))
+
鐃緒申  ;; save the parameters held in buffer-local variables
+
鐃緒申  (let ((log-operation vc-log-operation)
+
鐃緒申	(log-file vc-log-file)
+
鐃緒申	(log-version vc-log-version)
+
鐃緒申	(log-entry (buffer-string))
+
鐃緒申	(after-hook vc-log-after-operation-hook)
+
鐃緒申	(tmp-vc-parent-buffer vc-parent-buffer))
+
鐃緒申    (pop-to-buffer vc-parent-buffer)
+
鐃緒申    ;; OK, do it to it
+
鐃緒申    (save-excursion
+
鐃緒申      (funcall log-operation
+
鐃緒申	       log-file
+
鐃緒申	       log-version
+
鐃緒申	       log-entry))
+
鐃緒申    ;; Remove checkin window (after the checkin so that if that fails
+
鐃緒申    ;; we don't zap the *VC-log* buffer and the typing therein).
+
鐃緒申    (let ((logbuf (get-buffer "*VC-log*")))
+
鐃緒申      (cond ((and logbuf vc-delete-logbuf-window)
+
鐃緒申	     (delete-windows-on logbuf (selected-frame))
+
鐃緒申	     ;; Kill buffer and delete any other dedicated windows/frames.
+
鐃緒申	     (kill-buffer logbuf))
+
鐃緒申	    (logbuf (pop-to-buffer "*VC-log*")
+
鐃緒申		    (bury-buffer)
+
鐃緒申		    (pop-to-buffer tmp-vc-parent-buffer))))
+
鐃緒申    ;; Now make sure we see the expanded headers
+
鐃緒申    (if log-file
+
鐃緒申	(vc-resynch-buffer log-file vc-keep-workfiles t))
+
鐃緒申    (if vc-dired-mode
+
鐃緒申      (dired-move-to-filename))
+
鐃緒申    (run-hooks after-hook 'vc-finish-logentry-hook)))
+
鐃緒申
+
鐃緒申;; Code for access to the comment ring
+
鐃緒申
+
鐃緒申;; Additional entry points for examining version histories
+
鐃緒申
+
鐃緒申;;;###autoload
+
鐃緒申(defun vc-diff (historic &optional not-urgent)
+
鐃緒申  "Display diffs between file versions.
+
鐃緒申Normally this compares the current file and buffer with the most
+
鐃緒申recent checked in version of that file.  This uses no arguments.  With
+
鐃緒申a prefix argument HISTORIC, it reads the file name to use and two
+
鐃緒申version designators specifying which versions to compare.  The
+
鐃緒申optional argument NOT-URGENT non-nil means it is ok to say no to
+
鐃緒申saving the buffer."
+
鐃緒申  (interactive (list current-prefix-arg t))
+
鐃緒申  (if historic
+
鐃緒申      (call-interactively 'vc-version-diff)
+
鐃緒申    (vc-ensure-vc-buffer)
+
鐃緒申    (let ((file buffer-file-name))
+
鐃緒申      (vc-buffer-sync not-urgent)
+
鐃緒申      (if (vc-workfile-unchanged-p buffer-file-name)
+
鐃緒申	  (message "No changes to %s since latest version" file)
+
鐃緒申	(vc-version-diff file nil nil)))))
+
鐃緒申
+
鐃緒申(defun vc-version-diff (file rev1 rev2)
+
鐃緒申  "List the differences between FILE's versions REV1 and REV2.
+
鐃緒申If REV1 is empty or nil it means to use the current workfile version;
+
鐃緒申REV2 empty or nil means the current file contents.  FILE may also be
+
鐃緒申a directory, in that case, generate diffs between the correponding
+
鐃緒申versions of all registered files in or below it."
+
鐃緒申  (interactive
+
鐃緒申   (let ((file (expand-file-name
+
鐃緒申                (read-file-name (if buffer-file-name
+
鐃緒申                                    "File or dir to diff: (default visited file) "
+
鐃緒申                                  "File or dir to diff: ")
+
鐃緒申                                default-directory buffer-file-name t)))
+
鐃緒申         (rev1-default nil) (rev2-default nil))
+
鐃緒申     ;; compute default versions based on the file state
+
鐃緒申     (cond
+
鐃緒申      ;; if it's a directory, don't supply any version default
+
鐃緒申      ((file-directory-p file)
+
鐃緒申       nil)
+
鐃緒申      ;; if the file is not up-to-date, use current version as older version
+
鐃緒申      ((not (vc-up-to-date-p file))
+
鐃緒申       (setq rev1-default (vc-workfile-version file)))
+
鐃緒申      ;; if the file is not locked, use last and previous version as default
+
鐃緒申      (t
+
鐃緒申       (setq rev1-default (vc-call previous-version file
+
鐃緒申                                   (vc-workfile-version file)))
+
鐃緒申       (if (string= rev1-default "") (setq rev1-default nil))
+
鐃緒申       (setq rev2-default (vc-workfile-version file))))
+
鐃緒申     ;; construct argument list
+
鐃緒申     (list file
+
鐃緒申           (read-string (if rev1-default
+
鐃緒申			    (concat "Older version: (default "
+
鐃緒申				    rev1-default ") ")
+
鐃緒申			  "Older version: ")
+
鐃緒申			nil nil rev1-default)
+
鐃緒申           (read-string (if rev2-default
+
鐃緒申			    (concat "Newer version: (default "
+
鐃緒申				    rev2-default ") ")
+
鐃緒申			  "Newer version (default: current source): ")
+
鐃緒申			nil nil rev2-default))))
+
鐃緒申  (if (file-directory-p file)
+
鐃緒申      ;; recursive directory diff
+
鐃緒申      (progn
+
鐃緒申        (vc-setup-buffer "*vc-diff*")
+
鐃緒申	(if (string-equal rev1 "") (setq rev1 nil))
+
鐃緒申	(if (string-equal rev2 "") (setq rev2 nil))
+
鐃緒申        (let ((inhibit-read-only t))
+
鐃緒申          (insert "Diffs between "
+
鐃緒申                  (or rev1 "last version checked in")
+
鐃緒申                  " and "
+
鐃緒申                  (or rev2 "current workfile(s)")
+
鐃緒申                  ":\n\n"))
+
鐃緒申        (let ((dir (file-name-as-directory file)))
+
鐃緒申          (vc-call-backend (vc-responsible-backend dir)
+
鐃緒申                           'diff-tree dir rev1 rev2))
+
鐃緒申	(vc-exec-after `(let ((inhibit-read-only t))
+
鐃緒申			  (insert "\nEnd of diffs.\n"))))
+
鐃緒申    ;; Single file diff.  It is important that the vc-controlled buffer
+
鐃緒申    ;; is still current at this time, because any local settings in that
+
鐃緒申    ;; buffer should affect the diff command.
+
鐃緒申    (vc-diff-internal file rev1 rev2))
+
鐃緒申  (set-buffer "*vc-diff*")
+
鐃緒申  (if (and (zerop (buffer-size))
+
鐃緒申	   (not (get-buffer-process (current-buffer))))
+
鐃緒申      (progn
+
鐃緒申	(if rev1
+
鐃緒申	    (if rev2
+
鐃緒申		(message "No changes to %s between %s and %s" file rev1 rev2)
+
鐃緒申	      (message "No changes to %s since %s" file rev1))
+
鐃緒申	  (message "No changes to %s since latest version" file))
+
鐃緒申	nil)
+
鐃緒申    (pop-to-buffer (current-buffer))
+
鐃緒申    ;; Gnus-5.8.5 sets up an autoload for diff-mode, even if it's
+
鐃緒申    ;; not available.  Work around that.
+
鐃緒申    (if (require 'diff-mode nil t) (diff-mode))
+
鐃緒申    (vc-exec-after '(let ((inhibit-read-only t))
+
鐃緒申		      (if (eq (buffer-size) 0)
+
鐃緒申			  (insert "No differences found.\n"))
+
鐃緒申		      (goto-char (point-min))
+
鐃緒申		      (shrink-window-if-larger-than-buffer)))
+
鐃緒申    t))
+
鐃緒申
+
鐃緒申(defun vc-diff-label (file file-rev rev)
+
鐃緒申  (concat (file-relative-name file)
+
鐃緒申	  (format-time-string "\t%d %b %Y %T %z\t"
+
鐃緒申			      (nth 5 (file-attributes file-rev)))
+
鐃緒申	  rev))
+
鐃緒申
+
鐃緒申(defun vc-diff-internal (file rev1 rev2)
+
鐃緒申  "Run diff to compare FILE's revisions REV1 and REV2.
+
鐃緒申Diff output goes to the *vc-diff* buffer.  The exit status of the diff
+
鐃緒申command is returned.
+
鐃緒申
+
鐃緒申This function takes care to set up a proper coding system for diff output.
+
鐃緒申If both revisions are available as local files, then it also does not
+
鐃緒申actually call the backend, but performs a local diff."
+
鐃緒申  (if (or (not rev1) (string-equal rev1 ""))
+
鐃緒申      (setq rev1 (vc-workfile-version file)))
+
鐃緒申  (if (string-equal rev2 "")
+
鐃緒申      (setq rev2 nil))
+
鐃緒申  (let ((file-rev1 (vc-version-backup-file file rev1))
+
鐃緒申        (file-rev2 (if (not rev2)
+
鐃緒申                       file
+
鐃緒申                     (vc-version-backup-file file rev2)))
+
鐃緒申        (coding-system-for-read (vc-coding-system-for-diff file)))
+
鐃緒申    (if (and file-rev1 file-rev2)
+
鐃緒申        (apply 'vc-do-command "*vc-diff*" 1 "diff" nil
+
鐃緒申	       (append (vc-switches nil 'diff)
+
鐃緒申		       ;; Provide explicit labels like RCS or CVS would do
+
鐃緒申		       ;; so diff-mode refers to `file' rather than to
+
鐃緒申		       ;; `file-rev1' when trying to find/apply/undo hunks.
+
鐃緒申		       (list "-L" (vc-diff-label file file-rev1 rev1)
+
鐃緒申			     "-L" (vc-diff-label file file-rev2 rev2)
+
鐃緒申			     (file-relative-name file-rev1)
+
鐃緒申			     (file-relative-name file-rev2))))
+
鐃緒申      (vc-call diff file rev1 rev2))))
+
鐃緒申
+
鐃緒申
+
鐃緒申(defun vc-switches (backend op)
+
鐃緒申  (let ((switches
+
鐃緒申	 (or (if backend
+
鐃緒申		 (let ((sym (vc-make-backend-sym
+
鐃緒申			     backend (intern (concat (symbol-name op)
+
鐃緒申						     "-switches")))))
+
鐃緒申		   (if (boundp sym) (symbol-value sym))))
+
鐃緒申	     (let ((sym (intern (format "vc-%s-switches" (symbol-name op)))))
+
鐃緒申	       (if (boundp sym) (symbol-value sym)))
+
鐃緒申	     (cond
+
鐃緒申	      ((eq op 'diff) diff-switches)))))
+
鐃緒申    (if (stringp switches) (list switches)
+
鐃緒申      ;; If not a list, return nil.
+
鐃緒申      ;; This is so we can set vc-diff-switches to t to override
+
鐃緒申      ;; any switches in diff-switches.
+
鐃緒申      (if (listp switches) switches))))
+
鐃緒申
+
鐃緒申;; Old def for compatibility with Emacs-21.[123].
+
鐃緒申(defmacro vc-diff-switches-list (backend) `(vc-switches ',backend 'diff))
+
鐃緒申(make-obsolete 'vc-diff-switches-list 'vc-switches "22.1")
+
鐃緒申
+
鐃緒申(defun vc-default-diff-tree (backend dir rev1 rev2)
+
鐃緒申  "List differences for all registered files at and below DIR.
+
鐃緒申The meaning of REV1 and REV2 is the same as for `vc-version-diff'."
+
鐃緒申  ;; This implementation does an explicit tree walk, and calls
+
鐃緒申  ;; vc-BACKEND-diff directly for each file.  An optimization
+
鐃緒申  ;; would be to use `vc-diff-internal', so that diffs can be local,
+
鐃緒申  ;; and to call it only for files that are actually changed.
+
鐃緒申  ;; However, this is expensive for some backends, and so it is left
+
鐃緒申  ;; to backend-specific implementations.
+
鐃緒申  (setq default-directory dir)
+
鐃緒申  (vc-file-tree-walk
+
鐃緒申   default-directory
+
鐃緒申   (lambda (f)
+
鐃緒申     (vc-exec-after
+
鐃緒申      `(let ((coding-system-for-read (vc-coding-system-for-diff ',f)))
+
鐃緒申         (message "Looking at %s" ',f)
+
鐃緒申         (vc-call-backend ',(vc-backend f)
+
鐃緒申                          'diff ',f ',rev1 ',rev2))))))
+
鐃緒申
+
鐃緒申(defun vc-coding-system-for-diff (file)
+
鐃緒申  "Return the coding system for reading diff output for FILE."
+
鐃緒申  (or coding-system-for-read
+
鐃緒申      ;; if we already have this file open,
+
鐃緒申      ;; use the buffer's coding system
+
鐃緒申      (let ((buf (find-buffer-visiting file)))
+
鐃緒申        (if buf (with-current-buffer buf
+
鐃緒申                  buffer-file-coding-system)))
+
鐃緒申      ;; otherwise, try to find one based on the file name
+
鐃緒申      (car (find-operation-coding-system 'insert-file-contents file))
+
鐃緒申      ;; and a final fallback
+
鐃緒申      'undecided))
+
鐃緒申
+
鐃緒申;;;###autoload
+
鐃緒申(defun vc-version-other-window (rev)
+
鐃緒申  "Visit version REV of the current file in another window.
+
鐃緒申If the current file is named `F', the version is named `F.~REV~'.
+
鐃緒申If `F.~REV~' already exists, use it instead of checking it out again."
+
鐃緒申  (interactive "sVersion to visit (default is workfile version): ")
+
鐃緒申  (vc-ensure-vc-buffer)
+
鐃緒申  (let* ((file buffer-file-name)
+
鐃緒申	 (version (if (string-equal rev "")
+
鐃緒申		      (vc-workfile-version file)
+
鐃緒申		    rev)))
+
鐃緒申    (switch-to-buffer-other-window (vc-find-version file version))))
+
鐃緒申
+
鐃緒申(defun vc-find-version (file version)
+
鐃緒申  "Read VERSION of FILE into a buffer and return the buffer."
+
鐃緒申  (let ((automatic-backup (vc-version-backup-file-name file version))
+
鐃緒申	(filebuf (or (get-file-buffer file) (current-buffer)))
+
鐃緒申        (filename (vc-version-backup-file-name file version 'manual)))
+
鐃緒申    (unless (file-exists-p filename)
+
鐃緒申      (if (file-exists-p automatic-backup)
+
鐃緒申          (rename-file automatic-backup filename nil)
+
鐃緒申	(message "Checking out %s..." filename)
+
鐃緒申	(with-current-buffer filebuf
+
鐃緒申	  (let ((failed t))
+
鐃緒申	    (unwind-protect
+
鐃緒申		(let ((coding-system-for-read 'no-conversion)
+
鐃緒申		      (coding-system-for-write 'no-conversion))
+
鐃緒申		  (with-temp-file filename
+
鐃緒申		    (let ((outbuf (current-buffer)))
+
鐃緒申		      ;; Change buffer to get local value of
+
鐃緒申		      ;; vc-checkout-switches.
+
鐃緒申		      (with-current-buffer filebuf
+
鐃緒申			(vc-call find-version file version outbuf))))
+
鐃緒申		  (setq failed nil))
+
鐃緒申	      (if (and failed (file-exists-p filename))
+
鐃緒申		  (delete-file filename))))
+
鐃緒申	  (vc-mode-line file))
+
鐃緒申	(message "Checking out %s...done" filename)))
+
鐃緒申    (find-file-noselect filename)))
+
鐃緒申
+
鐃緒申(defun vc-default-find-version (backend file rev buffer)
+
鐃緒申  "Provide the new `find-version' op based on the old `checkout' op.
+
鐃緒申This is only for compatibility with old backends.  They should be updated
+
鐃緒申to provide the `find-version' operation instead."
+
鐃緒申  (let ((tmpfile (make-temp-file (expand-file-name file))))
+
鐃緒申    (unwind-protect
+
鐃緒申	(progn
+
鐃緒申	  (vc-call-backend backend 'checkout file nil rev tmpfile)
+
鐃緒申	  (with-current-buffer buffer
+
鐃緒申	    (insert-file-contents-literally tmpfile)))
+
鐃緒申      (delete-file tmpfile))))
+
鐃緒申
+
鐃緒申;; Header-insertion code
+
鐃緒申
+
鐃緒申;;;###autoload
+
鐃緒申(defun vc-insert-headers ()
+
鐃緒申  "Insert headers into a file for use with a version control system.
+
鐃緒申Headers desired are inserted at point, and are pulled from
+
鐃緒申the variable `vc-BACKEND-header'."
+
鐃緒申  (interactive)
+
鐃緒申  (vc-ensure-vc-buffer)
+
鐃緒申  (save-excursion
+
鐃緒申    (save-restriction
+
鐃緒申      (widen)
+
鐃緒申      (if (or (not (vc-check-headers))
+
鐃緒申	      (y-or-n-p "Version headers already exist.  Insert another set? "))
+
鐃緒申	  (progn
+
鐃緒申	    (let* ((delims (cdr (assq major-mode vc-comment-alist)))
+
鐃緒申		   (comment-start-vc (or (car delims) comment-start "#"))
+
鐃緒申		   (comment-end-vc (or (car (cdr delims)) comment-end ""))
+
鐃緒申		   (hdsym (vc-make-backend-sym (vc-backend buffer-file-name)
+
鐃緒申					       'header))
+
鐃緒申		   (hdstrings (and (boundp hdsym) (symbol-value hdsym))))
+
鐃緒申	      (mapcar (lambda (s)
+
鐃緒申			(insert comment-start-vc "\t" s "\t"
+
鐃緒申				comment-end-vc "\n"))
+
鐃緒申		      hdstrings)
+
鐃緒申	      (if vc-static-header-alist
+
鐃緒申		  (mapcar (lambda (f)
+
鐃緒申			    (if (string-match (car f) buffer-file-name)
+
鐃緒申				(insert (format (cdr f) (car hdstrings)))))
+
鐃緒申			  vc-static-header-alist))
+
鐃緒申	      )
+
鐃緒申	    )))))
+
鐃緒申
+
鐃緒申(defun vc-clear-headers (&optional file)
+
鐃緒申  "Clear all version headers in the current buffer (or FILE).
+
鐃緒申The headers are reset to their non-expanded form."
+
鐃緒申  (let* ((filename (or file buffer-file-name))
+
鐃緒申	 (visited (find-buffer-visiting filename))
+
鐃緒申	 (backend (vc-backend filename)))
+
鐃緒申    (when (vc-find-backend-function backend 'clear-headers)
+
鐃緒申	(if visited
+
鐃緒申	    (let ((context (vc-buffer-context)))
+
鐃緒申	      ;; save-excursion may be able to relocate point and mark
+
鐃緒申	      ;; properly.  If it fails, vc-restore-buffer-context
+
鐃緒申	      ;; will give it a second try.
+
鐃緒申	      (save-excursion
+
鐃緒申		(vc-call-backend backend 'clear-headers))
+
鐃緒申	      (vc-restore-buffer-context context))
+
鐃緒申	  (set-buffer (find-file-noselect filename))
+
鐃緒申	  (vc-call-backend backend 'clear-headers)
+
鐃緒申	  (kill-buffer filename)))))
+
鐃緒申
+
鐃緒申;;;###autoload
+
鐃緒申(defun vc-merge ()
+
鐃緒申  "Merge changes between two versions into the current buffer's file.
+
鐃緒申This asks for two versions to merge from in the minibuffer.  If the
+
鐃緒申first version is a branch number, then merge all changes from that
+
鐃緒申branch.  If the first version is empty, merge news, i.e. recent changes
+
鐃緒申from the current branch.
+
鐃緒申
+
鐃緒申See Info node `Merging'."
+
鐃緒申  (interactive)
+
鐃緒申  (vc-ensure-vc-buffer)
+
鐃緒申  (vc-buffer-sync)
+
鐃緒申  (let* ((file buffer-file-name)
+
鐃緒申	 (backend (vc-backend file))
+
鐃緒申	 (state (vc-state file))
+
鐃緒申	 first-version second-version status)
+
鐃緒申    (cond
+
鐃緒申     ((stringp state)
+
鐃緒申      (error "File is locked by %s" state))
+
鐃緒申     ((not (vc-editable-p file))
+
鐃緒申      (if (y-or-n-p
+
鐃緒申	   "File must be checked out for merging.  Check out now? ")
+
鐃緒申	  (vc-checkout file t)
+
鐃緒申	(error "Merge aborted"))))
+
鐃緒申    (setq first-version
+
鐃緒申	  (read-string (concat "Branch or version to merge from "
+
鐃緒申			       "(default: news on current branch): ")))
+
鐃緒申    (if (string= first-version "")
+
鐃緒申	(if (not (vc-find-backend-function backend 'merge-news))
+
鐃緒申	    (error "Sorry, merging news is not implemented for %s" backend)
+
鐃緒申	  (setq status (vc-call merge-news file)))
+
鐃緒申      (if (not (vc-find-backend-function backend 'merge))
+
鐃緒申	  (error "Sorry, merging is not implemented for %s" backend)
+
鐃緒申	(if (not (vc-branch-p first-version))
+
鐃緒申	    (setq second-version
+
鐃緒申		  (read-string "Second version: "
+
鐃緒申			       (concat (vc-branch-part first-version) ".")))
+
鐃緒申	  ;; We want to merge an entire branch.  Set versions
+
鐃緒申	  ;; accordingly, so that vc-BACKEND-merge understands us.
+
鐃緒申	  (setq second-version first-version)
+
鐃緒申	  ;; first-version must be the starting point of the branch
+
鐃緒申	  (setq first-version (vc-branch-part first-version)))
+
鐃緒申	(setq status (vc-call merge file first-version second-version))))
+
鐃緒申    (vc-maybe-resolve-conflicts file status "WORKFILE" "MERGE SOURCE")))
+
鐃緒申
+
鐃緒申(defun vc-maybe-resolve-conflicts (file status &optional name-A name-B)
+
鐃緒申  (vc-resynch-buffer file t (not (buffer-modified-p)))
+
鐃緒申  (if (zerop status) (message "Merge successful")
+
鐃緒申    (smerge-mode 1)
+
鐃緒申    (message "File contains conflicts.")))
+
鐃緒申
+
鐃緒申;;;###autoload
+
鐃緒申(defalias 'vc-resolve-conflicts 'smerge-ediff)
+
鐃緒申
+
鐃緒申;; The VC directory major mode.  Coopt Dired for this.
+
鐃緒申;; All VC commands get mapped into logical equivalents.
+
鐃緒申
+
鐃緒申(defvar vc-dired-switches)
+
鐃緒申(defvar vc-dired-terse-mode)
+
鐃緒申
+
鐃緒申(defvar vc-dired-mode-map
+
鐃緒申  (let ((map (make-sparse-keymap))
+
鐃緒申	(vmap (make-sparse-keymap)))
+
鐃緒申    (define-key map "\C-xv" vmap)
+
鐃緒申    (define-key map "v" vmap)
+
鐃緒申    (set-keymap-parent vmap vc-prefix-map)
+
鐃緒申    (define-key vmap "t" 'vc-dired-toggle-terse-mode)
+
鐃緒申    map))
+
鐃緒申
+
鐃緒申(define-derived-mode vc-dired-mode dired-mode "Dired under VC"
+
鐃緒申  "The major mode used in VC directory buffers.
+
鐃緒申
+
鐃緒申It works like Dired, but lists only files under version control, with
+
鐃緒申the current VC state of each file being indicated in the place of the
+
鐃緒申file's link count, owner, group and size.  Subdirectories are also
+
鐃緒申listed, and you may insert them into the buffer as desired, like in
+
鐃緒申Dired.
+
鐃緒申
+
鐃緒申All Dired commands operate normally, with the exception of `v', which
+
鐃緒申is redefined as the version control prefix, so that you can type
+
鐃緒申`vl', `v=' etc. to invoke `vc-print-log', `vc-diff', and the like on
+
鐃緒申the file named in the current Dired buffer line.  `vv' invokes
+
鐃緒申`vc-next-action' on this file, or on all files currently marked.
+
鐃緒申There is a special command, `*l', to mark all files currently locked."
+
鐃緒申  ;; define-derived-mode does it for us in Emacs-21, but not in Emacs-20.
+
鐃緒申  ;; We do it here because dired might not be loaded yet
+
鐃緒申  ;; when vc-dired-mode-map is initialized.
+
鐃緒申  (set-keymap-parent vc-dired-mode-map dired-mode-map)
+
鐃緒申  (add-hook 'dired-after-readin-hook 'vc-dired-hook nil t)
+
鐃緒申  ;; The following is slightly modified from dired.el,
+
鐃緒申  ;; because file lines look a bit different in vc-dired-mode
+
鐃緒申  ;; (the column before the date does not end in a digit).
+
鐃緒申  (set (make-local-variable 'dired-move-to-filename-regexp)
+
鐃緒申  (let* ((l "\\([A-Za-z]\\|[^\0-\177]\\)")
+
鐃緒申         ;; In some locales, month abbreviations are as short as 2 letters,
+
鐃緒申         ;; and they can be followed by ".".
+
鐃緒申         (month (concat l l "+\\.?"))
+
鐃緒申         (s " ")
+
鐃緒申         (yyyy "[0-9][0-9][0-9][0-9]")
+
鐃緒申         (dd "[ 0-3][0-9]")
+
鐃緒申         (HH:MM "[ 0-2][0-9]:[0-5][0-9]")
+
鐃緒申         (seconds "[0-6][0-9]\\([.,][0-9]+\\)?")
+
鐃緒申         (zone "[-+][0-2][0-9][0-5][0-9]")
+
鐃緒申         (iso-mm-dd "[01][0-9]-[0-3][0-9]")
+
鐃緒申         (iso-time (concat HH:MM "\\(:" seconds "\\( ?" zone "\\)?\\)?"))
+
鐃緒申         (iso (concat "\\(\\(" yyyy "-\\)?" iso-mm-dd "[ T]" iso-time
+
鐃緒申                      "\\|" yyyy "-" iso-mm-dd "\\)"))
+
鐃緒申         (western (concat "\\(" month s "+" dd "\\|" dd "\\.?" s month "\\)"
+
鐃緒申                          s "+"
+
鐃緒申                          "\\(" HH:MM "\\|" yyyy "\\)"))
+
鐃緒申         (western-comma (concat month s "+" dd "," s "+" yyyy))
+
鐃緒申         ;; Japanese MS-Windows ls-lisp has one-digit months, and
+
鐃緒申         ;; omits the Kanji characters after month and day-of-month.
+
鐃緒申         (mm "[ 0-1]?[0-9]")
+
鐃緒申         (japanese
+
鐃緒申          (concat mm l "?" s dd l "?" s "+"
+
鐃緒申                  "\\(" HH:MM "\\|" yyyy l "?" "\\)")))
+
鐃緒申    ;; the .* below ensures that we find the last match on a line
+
鐃緒申    (concat ".*" s
+
鐃緒申            "\\(" western "\\|" western-comma "\\|" japanese "\\|" iso "\\)"
+
鐃緒申            s "+")))
+
鐃緒申  (and (boundp 'vc-dired-switches)
+
鐃緒申       vc-dired-switches
+
鐃緒申       (set (make-local-variable 'dired-actual-switches)
+
鐃緒申            vc-dired-switches))
+
鐃緒申  (set (make-local-variable 'vc-dired-terse-mode) vc-dired-terse-display)
+
鐃緒申  (setq vc-dired-mode t))
+
鐃緒申
+
鐃緒申(defun vc-dired-toggle-terse-mode ()
+
鐃緒申  "Toggle terse display in VC Dired."
+
鐃緒申  (interactive)
+
鐃緒申  (if (not vc-dired-mode)
+
鐃緒申      nil
+
鐃緒申    (setq vc-dired-terse-mode (not vc-dired-terse-mode))
+
鐃緒申    (if vc-dired-terse-mode
+
鐃緒申        (vc-dired-hook)
+
鐃緒申      (revert-buffer))))
+
鐃緒申
+
鐃緒申(defun vc-dired-mark-locked ()
+
鐃緒申  "Mark all files currently locked."
+
鐃緒申  (interactive)
+
鐃緒申  (dired-mark-if (let ((f (dired-get-filename nil t)))
+
鐃緒申		   (and f
+
鐃緒申			(not (file-directory-p f))
+
鐃緒申			(not (vc-up-to-date-p f))))
+
鐃緒申		 "locked file"))
+
鐃緒申
+
鐃緒申(define-key vc-dired-mode-map "*l" 'vc-dired-mark-locked)
+
鐃緒申
+
鐃緒申(defun vc-default-dired-state-info (backend file)
+
鐃緒申  (let ((state (vc-state file)))
+
鐃緒申    (cond
+
鐃緒申     ((stringp state) (concat "(" state ")"))
+
鐃緒申     ((eq state 'edited) (concat "(" (vc-user-login-name) ")"))
+
鐃緒申     ((eq state 'needs-merge) "(merge)")
+
鐃緒申     ((eq state 'needs-patch) "(patch)")
+
鐃緒申     ((eq state 'unlocked-changes) "(stale)"))))
+
鐃緒申
+
鐃緒申(defun vc-dired-reformat-line (vc-info)
+
鐃緒申  "Reformat a directory-listing line.
+
鐃緒申Replace various columns with version control information, VC-INFO.
+
鐃緒申This code, like dired, assumes UNIX -l format."
+
鐃緒申  (beginning-of-line)
+
鐃緒申  (when (re-search-forward
+
鐃緒申         ;; Match link count, owner, group, size.  Group may be missing,
+
鐃緒申         ;; and only the size is present in OS/2 -l format.
+
鐃緒申         "^..[drwxlts-]+ \\( *[0-9]+\\( [^ ]+ +\\([^ ]+ +\\)?[0-9]+\\)?\\) "
+
鐃緒申         (line-end-position) t)
+
鐃緒申      (replace-match (substring (concat vc-info "          ") 0 10)
+
鐃緒申                     t t nil 1)))
+
鐃緒申
+
鐃緒申(defun vc-dired-hook ()
+
鐃緒申  "Reformat the listing according to version control.
+
鐃緒申Called by dired after any portion of a vc-dired buffer has been read in."
+
鐃緒申  (message "Getting version information... ")
+
鐃緒申  (let (subdir filename (buffer-read-only nil))
+
鐃緒申    (goto-char (point-min))
+
鐃緒申    (while (not (eobp))
+
鐃緒申      (cond
+
鐃緒申       ;; subdir header line
+
鐃緒申       ((setq subdir (dired-get-subdir))
+
鐃緒申	;; if the backend supports it, get the state
+
鐃緒申	;; of all files in this directory at once
+
鐃緒申	(let ((backend (vc-responsible-backend subdir)))
+
鐃緒申	  (if (vc-find-backend-function backend 'dir-state)
+
鐃緒申	      (vc-call-backend backend 'dir-state subdir)))
+
鐃緒申        (forward-line 1)
+
鐃緒申        ;; erase (but don't remove) the "total" line
+
鐃緒申	(delete-region (point) (line-end-position))
+
鐃緒申	(beginning-of-line)
+
鐃緒申	(forward-line 1))
+
鐃緒申       ;; file line
+
鐃緒申       ((setq filename (dired-get-filename nil t))
+
鐃緒申        (cond
+
鐃緒申         ;; subdir
+
鐃緒申         ((file-directory-p filename)
+
鐃緒申          (cond
+
鐃緒申           ((member (file-name-nondirectory filename)
+
鐃緒申                    vc-directory-exclusion-list)
+
鐃緒申            (let ((pos (point)))
+
鐃緒申              (dired-kill-tree filename)
+
鐃緒申              (goto-char pos)
+
鐃緒申              (dired-kill-line)))
+
鐃緒申           (vc-dired-terse-mode
+
鐃緒申            ;; Don't show directories in terse mode.  Don't use
+
鐃緒申            ;; dired-kill-line to remove it, because in recursive listings,
+
鐃緒申            ;; that would remove the directory contents as well.
+
鐃緒申            (delete-region (line-beginning-position)
+
鐃緒申                           (progn (forward-line 1) (point))))
+
鐃緒申           ((string-match "\\`\\.\\.?\\'" (file-name-nondirectory filename))
+
鐃緒申            (dired-kill-line))
+
鐃緒申           (t
+
鐃緒申            (vc-dired-reformat-line nil)
+
鐃緒申            (forward-line 1))))
+
鐃緒申         ;; ordinary file
+
鐃緒申         ((and (vc-backend filename)
+
鐃緒申	       (not (and vc-dired-terse-mode
+
鐃緒申			 (vc-up-to-date-p filename))))
+
鐃緒申          (vc-dired-reformat-line (vc-call dired-state-info filename))
+
鐃緒申          (forward-line 1))
+
鐃緒申         (t
+
鐃緒申          (dired-kill-line))))
+
鐃緒申       ;; any other line
+
鐃緒申       (t (forward-line 1))))
+
鐃緒申    (vc-dired-purge))
+
鐃緒申  (message "Getting version information... done")
+
鐃緒申  (save-restriction
+
鐃緒申    (widen)
+
鐃緒申    (cond ((eq (count-lines (point-min) (point-max)) 1)
+
鐃緒申           (goto-char (point-min))
+
鐃緒申           (message "No files locked under %s" default-directory)))))
+
鐃緒申
+
鐃緒申(defun vc-dired-purge ()
+
鐃緒申  "Remove empty subdirs."
+
鐃緒申  (goto-char (point-min))
+
鐃緒申  (while (dired-get-subdir)
+
鐃緒申    (forward-line 2)
+
鐃緒申    (if (dired-get-filename nil t)
+
鐃緒申	(if (not (dired-next-subdir 1 t))
+
鐃緒申	    (goto-char (point-max)))
+
鐃緒申      (forward-line -2)
+
鐃緒申      (if (not (string= (dired-current-directory) default-directory))
+
鐃緒申	  (dired-do-kill-lines t "")
+
鐃緒申	;; We cannot remove the top level directory.
+
鐃緒申	;; Just make it look a little nicer.
+
鐃緒申	(forward-line 1)
+
鐃緒申	(or (eobp) (kill-line))
+
鐃緒申	(if (not (dired-next-subdir 1 t))
+
鐃緒申	    (goto-char (point-max))))))
+
鐃緒申  (goto-char (point-min)))
+
鐃緒申
+
鐃緒申(defun vc-dired-buffers-for-dir (dir)
+
鐃緒申  "Return a list of all vc-dired buffers that currently display DIR."
+
鐃緒申  (let (result)
+
鐃緒申    ;; Check whether dired is loaded.
+
鐃緒申    (when (fboundp 'dired-buffers-for-dir)
+
鐃緒申      (mapcar (lambda (buffer)
+
鐃緒申		(with-current-buffer buffer
+
鐃緒申		  (if vc-dired-mode
+
鐃緒申		      (setq result (append result (list buffer))))))
+
鐃緒申	      (dired-buffers-for-dir dir)))
+
鐃緒申    result))
+
鐃緒申
+
鐃緒申(defun vc-dired-resynch-file (file)
+
鐃緒申  "Update the entries for FILE in any VC Dired buffers that list it."
+
鐃緒申  (let ((buffers (vc-dired-buffers-for-dir (file-name-directory file))))
+
鐃緒申    (when buffers
+
鐃緒申      (mapcar (lambda (buffer)
+
鐃緒申		(with-current-buffer buffer
+
鐃緒申		  (if (dired-goto-file file)
+
鐃緒申		      ;; bind vc-dired-terse-mode to nil so that
+
鐃緒申		      ;; files won't vanish when they are checked in
+
鐃緒申		      (let ((vc-dired-terse-mode nil))
+
鐃緒申			(dired-do-redisplay 1)))))
+
鐃緒申	      buffers))))
+
鐃緒申
+
鐃緒申;;;###autoload
+
鐃緒申(defun vc-directory (dir read-switches)
+
鐃緒申  "Create a buffer in VC Dired Mode for directory DIR.
+
鐃緒申
+
鐃緒申See Info node `VC Dired Mode'.
+
鐃緒申
+
鐃緒申With prefix arg READ-SWITCHES, specify a value to override
+
鐃緒申`dired-listing-switches' when generating the listing."
+
鐃緒申  (interactive "DDired under VC (directory): \nP")
+
鐃緒申  (let ((vc-dired-switches (concat vc-dired-listing-switches
+
鐃緒申                                   (if vc-dired-recurse "R" ""))))
+
鐃緒申    (if read-switches
+
鐃緒申        (setq vc-dired-switches
+
鐃緒申              (read-string "Dired listing switches: "
+
鐃緒申                           vc-dired-switches)))
+
鐃緒申    (require 'dired)
+
鐃緒申    (require 'dired-aux)
+
鐃緒申    (switch-to-buffer
+
鐃緒申     (dired-internal-noselect (expand-file-name (file-name-as-directory dir))
+
鐃緒申                              vc-dired-switches
+
鐃緒申                              'vc-dired-mode))))
+
鐃緒申
+
鐃緒申
+
鐃緒申;; Named-configuration entry points
+
鐃緒申
+
鐃緒申(defun vc-snapshot-precondition (dir)
+
鐃緒申  "Scan the tree below DIR, looking for files not up-to-date.
+
鐃緒申If any file is not up-to-date, return the name of the first such file.
+
鐃緒申\(This means, neither snapshot creation nor retrieval is allowed.\)
+
鐃緒申If one or more of the files are currently visited, return `visited'.
+
鐃緒申Otherwise, return nil."
+
鐃緒申  (let ((status nil))
+
鐃緒申    (catch 'vc-locked-example
+
鐃緒申      (vc-file-tree-walk
+
鐃緒申       dir
+
鐃緒申       (lambda (f)
+
鐃緒申	 (if (not (vc-up-to-date-p f)) (throw 'vc-locked-example f)
+
鐃緒申	   (if (get-file-buffer f) (setq status 'visited)))))
+
鐃緒申      status)))
+
鐃緒申
+
鐃緒申;;;###autoload
+
鐃緒申(defun vc-create-snapshot (dir name branchp)
+
鐃緒申  "Descending recursively from DIR, make a snapshot called NAME.
+
鐃緒申For each registered file, the version level of its latest version
+
鐃緒申becomes part of the named configuration.  If the prefix argument
+
鐃緒申BRANCHP is given, the snapshot is made as a new branch and the files
+
鐃緒申are checked out in that new branch."
+
鐃緒申  (interactive
+
鐃緒申   (list (read-file-name "Directory: " default-directory default-directory t)
+
鐃緒申         (read-string "New snapshot name: ")
+
鐃緒申	 current-prefix-arg))
+
鐃緒申  (message "Making %s... " (if branchp "branch" "snapshot"))
+
鐃緒申  (if (file-directory-p dir) (setq dir (file-name-as-directory dir)))
+
鐃緒申  (vc-call-backend (vc-responsible-backend dir)
+
鐃緒申		   'create-snapshot dir name branchp)
+
鐃緒申  (message "Making %s... done" (if branchp "branch" "snapshot")))
+
鐃緒申
+
鐃緒申(defun vc-default-create-snapshot (backend dir name branchp)
+
鐃緒申  (when branchp
+
鐃緒申    (error "VC backend %s does not support module branches" backend))
+
鐃緒申  (let ((result (vc-snapshot-precondition dir)))
+
鐃緒申    (if (stringp result)
+
鐃緒申	(error "File %s is not up-to-date" result)
+
鐃緒申      (vc-file-tree-walk
+
鐃緒申       dir
+
鐃緒申       (lambda (f)
+
鐃緒申	 (vc-call assign-name f name))))))
+
鐃緒申
+
鐃緒申;;;###autoload
+
鐃緒申(defun vc-retrieve-snapshot (dir name)
+
鐃緒申  "Descending recursively from DIR, retrieve the snapshot called NAME.
+
鐃緒申If NAME is empty, it refers to the latest versions.
+
鐃緒申If locking is used for the files in DIR, then there must not be any
+
鐃緒申locked files at or below DIR (but if NAME is empty, locked files are
+
鐃緒申allowed and simply skipped)."
+
鐃緒申  (interactive
+
鐃緒申   (list (read-file-name "Directory: " default-directory default-directory t)
+
鐃緒申         (read-string "Snapshot name to retrieve (default latest versions): ")))
+
鐃緒申  (let ((update (yes-or-no-p "Update any affected buffers? "))
+
鐃緒申	(msg (if (or (not name) (string= name ""))
+
鐃緒申		 (format "Updating %s... " (abbreviate-file-name dir))
+
鐃緒申	       (format "Retrieving snapshot into %s... "
+
鐃緒申		       (abbreviate-file-name dir)))))
+
鐃緒申    (message msg)
+
鐃緒申    (vc-call-backend (vc-responsible-backend dir)
+
鐃緒申		     'retrieve-snapshot dir name update)
+
鐃緒申    (message (concat msg "done"))))
+
鐃緒申
+
鐃緒申(defun vc-default-retrieve-snapshot (backend dir name update)
+
鐃緒申  (if (string= name "")
+
鐃緒申      (progn
+
鐃緒申        (vc-file-tree-walk
+
鐃緒申         dir
+
鐃緒申         (lambda (f) (and
+
鐃緒申		 (vc-up-to-date-p f)
+
鐃緒申		 (vc-error-occurred
+
鐃緒申		  (vc-call checkout f nil "")
+
鐃緒申		  (if update (vc-resynch-buffer f t t)))))))
+
鐃緒申    (let ((result (vc-snapshot-precondition dir)))
+
鐃緒申      (if (stringp result)
+
鐃緒申          (error "File %s is locked" result)
+
鐃緒申        (setq update (and (eq result 'visited) update))
+
鐃緒申        (vc-file-tree-walk
+
鐃緒申         dir
+
鐃緒申         (lambda (f) (vc-error-occurred
+
鐃緒申		 (vc-call checkout f nil name)
+
鐃緒申		 (if update (vc-resynch-buffer f t t)))))))))
+
鐃緒申
+
鐃緒申;; Miscellaneous other entry points
+
鐃緒申
+
鐃緒申;;;###autoload
+
鐃緒申(defun vc-print-log (&optional focus-rev)
+
鐃緒申  "List the change log of the current buffer in a window.
+
鐃緒申If FOCUS-REV is non-nil, leave the point at that revision."
+
鐃緒申  (interactive)
+
鐃緒申  (vc-ensure-vc-buffer)
+
鐃緒申  (let ((file buffer-file-name))
+
鐃緒申    (or focus-rev (setq focus-rev (vc-workfile-version file)))
+
鐃緒申    ;; Don't switch to the output buffer before running the command,
+
鐃緒申    ;; so that any buffer-local settings in the vc-controlled
+
鐃緒申    ;; buffer can be accessed by the command.
+
鐃緒申    (condition-case err
+
鐃緒申        (progn
+
鐃緒申          (vc-call print-log file "*vc-change-log*")
+
鐃緒申          (set-buffer "*vc-change-log*"))
+
鐃緒申      (wrong-number-of-arguments
+
鐃緒申       ;; If this error came from the above call to print-log, try again
+
鐃緒申       ;; without the optional buffer argument (for backward compatibility).
+
鐃緒申       ;; Otherwise, resignal.
+
鐃緒申       (if (or (not (eq (cadr err)
+
鐃緒申                        (indirect-function
+
鐃緒申                         (vc-find-backend-function (vc-backend file)
+
鐃緒申                                                   'print-log))))
+
鐃緒申               (not (eq (caddr err) 2)))
+
鐃緒申           (signal (car err) (cdr err))
+
鐃緒申         ;; for backward compatibility
+
鐃緒申         (vc-call print-log file)
+
鐃緒申         (set-buffer "*vc*"))))
+
鐃緒申    (pop-to-buffer (current-buffer))
+
鐃緒申    (log-view-mode)
+
鐃緒申    (vc-exec-after
+
鐃緒申     `(let ((inhibit-read-only t))
+
鐃緒申	(goto-char (point-max)) (forward-line -1)
+
鐃緒申	(while (looking-at "=*\n")
+
鐃緒申	  (delete-char (- (match-end 0) (match-beginning 0)))
+
鐃緒申	  (forward-line -1))
+
鐃緒申	(goto-char (point-min))
+
鐃緒申	(if (looking-at "[\b\t\n\v\f\r ]+")
+
鐃緒申	    (delete-char (- (match-end 0) (match-beginning 0))))
+
鐃緒申	(shrink-window-if-larger-than-buffer)
+
鐃緒申	;; move point to the log entry for the current version
+
鐃緒申	(vc-call-backend ',(vc-backend file)
+
鐃緒申			 'show-log-entry
+
鐃緒申			 ',focus-rev)
+
鐃緒申        (set-buffer-modified-p nil)))))
+
鐃緒申
+
鐃緒申(defun vc-default-show-log-entry (backend rev)
+
鐃緒申  (with-no-warnings
+
鐃緒申   (log-view-goto-rev rev)))
+
鐃緒申
+
鐃緒申(defun vc-default-comment-history (backend file)
+
鐃緒申  "Return a string with all log entries stored in BACKEND for FILE."
+
鐃緒申  (if (vc-find-backend-function backend 'print-log)
+
鐃緒申      (with-current-buffer "*vc*"
+
鐃緒申	(vc-call print-log file)
+
鐃緒申	(vc-call wash-log file)
+
鐃緒申	(buffer-string))))
+
鐃緒申
+
鐃緒申(defun vc-default-wash-log (backend file)
+
鐃緒申  "Remove all non-comment information from log output.
+
鐃緒申This default implementation works for RCS logs; backends should override
+
鐃緒申it if their logs are not in RCS format."
+
鐃緒申  (let ((separator (concat "^-+\nrevision [0-9.]+\ndate: .*\n"
+
鐃緒申			   "\\(branches: .*;\n\\)?"
+
鐃緒申			   "\\(\\*\\*\\* empty log message \\*\\*\\*\n\\)?")))
+
鐃緒申    (goto-char (point-max)) (forward-line -1)
+
鐃緒申    (while (looking-at "=*\n")
+
鐃緒申      (delete-char (- (match-end 0) (match-beginning 0)))
+
鐃緒申      (forward-line -1))
+
鐃緒申    (goto-char (point-min))
+
鐃緒申    (if (looking-at "[\b\t\n\v\f\r ]+")
+
鐃緒申	(delete-char (- (match-end 0) (match-beginning 0))))
+
鐃緒申    (goto-char (point-min))
+
鐃緒申    (re-search-forward separator nil t)
+
鐃緒申    (delete-region (point-min) (point))
+
鐃緒申    (while (re-search-forward separator nil t)
+
鐃緒申      (delete-region (match-beginning 0) (match-end 0)))))
+
鐃緒申
+
鐃緒申;;;###autoload
+
鐃緒申(defun vc-revert-buffer ()
+
鐃緒申  "Revert the current buffer's file to the version it was based on.
+
鐃緒申This asks for confirmation if the buffer contents are not identical
+
鐃緒申to that version.  This function does not automatically pick up newer
+
鐃緒申changes found in the master file; use \\[universal-argument] \\[vc-next-action] to do so."
+
鐃緒申  (interactive)
+
鐃緒申  (vc-ensure-vc-buffer)
+
鐃緒申  ;; Make sure buffer is saved.  If the user says `no', abort since
+
鐃緒申  ;; we cannot show the changes and ask for confirmation to discard them.
+
鐃緒申  (vc-buffer-sync nil)
+
鐃緒申  (let ((file buffer-file-name)
+
鐃緒申	;; This operation should always ask for confirmation.
+
鐃緒申	(vc-suppress-confirm nil)
+
鐃緒申	(obuf (current-buffer))
+
鐃緒申	status)
+
鐃緒申    (if (vc-up-to-date-p file)
+
鐃緒申        (unless (yes-or-no-p "File seems up-to-date.  Revert anyway? ")
+
鐃緒申          (error "Revert canceled")))
+
鐃緒申    (unless (vc-workfile-unchanged-p file)
+
鐃緒申      (message "Finding changes...")
+
鐃緒申      ;; vc-diff selects the new window, which is not what we want:
+
鐃緒申      ;; if the new window is on another frame, that'd require the user
+
鐃緒申      ;; moving her mouse to answer the yes-or-no-p question.
+
鐃緒申      (let* ((vc-disable-async-diff (not vc-allow-async-revert))
+
鐃緒申             (win (save-selected-window
+
鐃緒申                    (setq status (vc-diff nil t)) (selected-window))))
+
鐃緒申	(vc-exec-after `(message nil))
+
鐃緒申	(when status
+
鐃緒申	  (unwind-protect
+
鐃緒申	      (unless (yes-or-no-p "Discard changes? ")
+
鐃緒申		(error "Revert canceled"))
+
鐃緒申	    (select-window win)
+
鐃緒申	    (if (one-window-p t)
+
鐃緒申		(if (window-dedicated-p (selected-window))
+
鐃緒申		    (make-frame-invisible))
+
鐃緒申	      (delete-window))))))
+
鐃緒申    (set-buffer obuf)
+
鐃緒申    ;; Do the reverting
+
鐃緒申    (message "Reverting %s..." file)
+
鐃緒申    (vc-revert-file file)
+
鐃緒申    (message "Reverting %s...done" file)))
+
鐃緒申
+
鐃緒申;;;###autoload
+
鐃緒申(defun vc-update ()
+
鐃緒申  "Update the current buffer's file to the latest version on its branch.
+
鐃緒申If the file contains no changes, and is not locked, then this simply replaces
+
鐃緒申the working file with the latest version on its branch.  If the file contains
+
鐃緒申changes, and the backend supports merging news, then any recent changes from
+
鐃緒申the current branch are merged into the working file."
+
鐃緒申  (interactive)
+
鐃緒申  (vc-ensure-vc-buffer)
+
鐃緒申  (vc-buffer-sync nil)
+
鐃緒申  (let ((file buffer-file-name))
+
鐃緒申    (if (vc-up-to-date-p file)
+
鐃緒申        (vc-checkout file nil "")
+
鐃緒申      (if (eq (vc-checkout-model file) 'locking)
+
鐃緒申          (if (eq (vc-state file) 'edited)
+
鐃緒申              (error
+
鐃緒申               (substitute-command-keys
+
鐃緒申           "File is locked--type \\[vc-revert-buffer] to discard changes"))
+
鐃緒申            (error
+
鐃緒申             (substitute-command-keys
+
鐃緒申           "Unexpected file state (%s)--type \\[vc-next-action] to correct")
+
鐃緒申                   (vc-state file)))
+
鐃緒申        (if (not (vc-find-backend-function (vc-backend file) 'merge-news))
+
鐃緒申            (error "Sorry, merging news is not implemented for %s"
+
鐃緒申                   (vc-backend file))
+
鐃緒申          (vc-call merge-news file)
+
鐃緒申          (vc-resynch-window file t t))))))
+
鐃緒申
+
鐃緒申(defun vc-version-backup-file (file &optional rev)
+
鐃緒申  "Return name of backup file for revision REV of FILE.
+
鐃緒申If version backups should be used for FILE, and there exists
+
鐃緒申such a backup for REV or the current workfile version of file,
+
鐃緒申return its name; otherwise return nil."
+
鐃緒申  (when (vc-call make-version-backups-p file)
+
鐃緒申    (let ((backup-file (vc-version-backup-file-name file rev)))
+
鐃緒申      (if (file-exists-p backup-file)
+
鐃緒申          backup-file
+
鐃緒申        ;; there is no automatic backup, but maybe the user made one manually
+
鐃緒申        (setq backup-file (vc-version-backup-file-name file rev 'manual))
+
鐃緒申        (if (file-exists-p backup-file)
+
鐃緒申            backup-file)))))
+
鐃緒申
+
鐃緒申(defun vc-revert-file (file)
+
鐃緒申  "Revert FILE back to the version it was based on."
+
鐃緒申  (with-vc-properties
+
鐃緒申   file
+
鐃緒申   (let ((backup-file (vc-version-backup-file file)))
+
鐃緒申     (when backup-file
+
鐃緒申       (copy-file backup-file file 'ok-if-already-exists 'keep-date)
+
鐃緒申       (vc-delete-automatic-version-backups file))
+
鐃緒申     (vc-call revert file backup-file))
+
鐃緒申   `((vc-state . up-to-date)
+
鐃緒申     (vc-checkout-time . ,(nth 5 (file-attributes file)))))
+
鐃緒申  (vc-resynch-buffer file t t))
+
鐃緒申
+
鐃緒申;;;###autoload
+
鐃緒申(defun vc-cancel-version (norevert)
+
鐃緒申  "Get rid of most recently checked in version of this file.
+
鐃緒申A prefix argument NOREVERT means do not revert the buffer afterwards."
+
鐃緒申  (interactive "P")
+
鐃緒申  (vc-ensure-vc-buffer)
+
鐃緒申  (let* ((file buffer-file-name)
+
鐃緒申	 (backend (vc-backend file))
+
鐃緒申         (target (vc-workfile-version file)))
+
鐃緒申    (cond
+
鐃緒申     ((not (vc-find-backend-function backend 'cancel-version))
+
鐃緒申      (error "Sorry, canceling versions is not supported under %s" backend))
+
鐃緒申     ((not (vc-call latest-on-branch-p file))
+
鐃緒申      (error "This is not the latest version; VC cannot cancel it"))
+
鐃緒申     ((not (vc-up-to-date-p file))
+
鐃緒申      (error "%s" (substitute-command-keys "File is not up to date; use \\[vc-revert-buffer] to discard changes"))))
+
鐃緒申    (if (null (yes-or-no-p (format "Remove version %s from master? " target)))
+
鐃緒申	(error "Aborted")
+
鐃緒申      (setq norevert (or norevert (not
+
鐃緒申          (yes-or-no-p "Revert buffer to most recent remaining version? "))))
+
鐃緒申
+
鐃緒申      (message "Removing last change from %s..." file)
+
鐃緒申      (with-vc-properties
+
鐃緒申       file
+
鐃緒申       (vc-call cancel-version file norevert)
+
鐃緒申       `((vc-state . ,(if norevert 'edited 'up-to-date))
+
鐃緒申	 (vc-checkout-time . ,(if norevert
+
鐃緒申				0
+
鐃緒申			      (nth 5 (file-attributes file))))
+
鐃緒申	 (vc-workfile-version . nil)))
+
鐃緒申      (message "Removing last change from %s...done" file)
+
鐃緒申
+
鐃緒申      (cond
+
鐃緒申       (norevert ;; clear version headers and mark the buffer modified
+
鐃緒申	(set-visited-file-name file)
+
鐃緒申	(when (not vc-make-backup-files)
+
鐃緒申	  ;; inhibit backup for this buffer
+
鐃緒申	  (make-local-variable 'backup-inhibited)
+
鐃緒申	  (setq backup-inhibited t))
+
鐃緒申	(setq buffer-read-only nil)
+
鐃緒申	(vc-clear-headers)
+
鐃緒申	(vc-mode-line file)
+
鐃緒申	(vc-dired-resynch-file file))
+
鐃緒申       (t ;; revert buffer to file on disk
+
鐃緒申	(vc-resynch-buffer file t t)))
+
鐃緒申      (message "Version %s has been removed from the master" target))))
+
鐃緒申
+
鐃緒申;;;###autoload
+
鐃緒申(defun vc-switch-backend (file backend)
+
鐃緒申  "Make BACKEND the current version control system for FILE.
+
鐃緒申FILE must already be registered in BACKEND.  The change is not
+
鐃緒申permanent, only for the current session.  This function only changes
+
鐃緒申VC's perspective on FILE, it does not register or unregister it.
+
鐃緒申By default, this command cycles through the registered backends.
+
鐃緒申To get a prompt, use a prefix argument."
+
鐃緒申  (interactive
+
鐃緒申   (list
+
鐃緒申    buffer-file-name
+
鐃緒申    (let ((backend (vc-backend buffer-file-name))
+
鐃緒申	  (backends nil))
+
鐃緒申      ;; Find the registered backends.
+
鐃緒申      (dolist (backend vc-handled-backends)
+
鐃緒申	(when (vc-call-backend backend 'registered buffer-file-name)
+
鐃緒申	  (push backend backends)))
+
鐃緒申      ;; Find the next backend.
+
鐃緒申      (let ((def (car (delq backend (append (memq backend backends) backends))))
+
鐃緒申	    (others (delete backend backends)))
+
鐃緒申	(cond
+
鐃緒申	 ((null others) (error "No other backend to switch to"))
+
鐃緒申	 (current-prefix-arg
+
鐃緒申	  (intern
+
鐃緒申	   (upcase
+
鐃緒申	    (completing-read
+
鐃緒申	     (format "Switch to backend [%s]: " def)
+
鐃緒申	     (mapcar (lambda (b) (list (downcase (symbol-name b)))) backends)
+
鐃緒申	     nil t nil nil (downcase (symbol-name def))))))
+
鐃緒申       (t def))))))
+
鐃緒申  (unless (eq backend (vc-backend file))
+
鐃緒申    (vc-file-clearprops file)
+
鐃緒申    (vc-file-setprop file 'vc-backend backend)
+
鐃緒申    ;; Force recomputation of the state
+
鐃緒申    (unless (vc-call-backend backend 'registered file)
+
鐃緒申      (vc-file-clearprops file)
+
鐃緒申      (error "%s is not registered in %s" file backend))
+
鐃緒申    (vc-mode-line file)))
+
鐃緒申
+
鐃緒申;;;###autoload
+
鐃緒申(defun vc-transfer-file (file new-backend)
+
鐃緒申  "Transfer FILE to another version control system NEW-BACKEND.
+
鐃緒申If NEW-BACKEND has a higher precedence than FILE's current backend
+
鐃緒申\(i.e.  it comes earlier in `vc-handled-backends'), then register FILE in
+
鐃緒申NEW-BACKEND, using the version number from the current backend as the
+
鐃緒申base level.  If NEW-BACKEND has a lower precedence than the current
+
鐃緒申backend, then commit all changes that were made under the current
+
鐃緒申backend to NEW-BACKEND, and unregister FILE from the current backend.
+
鐃緒申\(If FILE is not yet registered under NEW-BACKEND, register it.)"
+
鐃緒申  (let* ((old-backend (vc-backend file))
+
鐃緒申	 (edited (memq (vc-state file) '(edited needs-merge)))
+
鐃緒申	 (registered (vc-call-backend new-backend 'registered file))
+
鐃緒申	 (move
+
鐃緒申	  (and registered    ; Never move if not registered in new-backend yet.
+
鐃緒申	       ;; move if new-backend comes later in vc-handled-backends
+
鐃緒申	       (or (memq new-backend (memq old-backend vc-handled-backends))
+
鐃緒申		   (y-or-n-p "Final transfer? "))))
+
鐃緒申	 (comment nil))
+
鐃緒申    (if (eq old-backend new-backend)
+
鐃緒申	(error "%s is the current backend of %s" new-backend file))
+
鐃緒申    (if registered
+
鐃緒申	(set-file-modes file (logior (file-modes file) 128))
+
鐃緒申      ;; `registered' might have switched under us.
+
鐃緒申      (vc-switch-backend file old-backend)
+
鐃緒申      (let* ((rev (vc-workfile-version file))
+
鐃緒申	     (modified-file (and edited (make-temp-file file)))
+
鐃緒申	     (unmodified-file (and modified-file (vc-version-backup-file file))))
+
鐃緒申	;; Go back to the base unmodified file.
+
鐃緒申	(unwind-protect
+
鐃緒申	    (progn
+
鐃緒申	      (when modified-file
+
鐃緒申		(copy-file file modified-file 'ok-if-already-exists)
+
鐃緒申		;; If we have a local copy of the unmodified file, handle that
+
鐃緒申		;; here and not in vc-revert-file because we don't want to
+
鐃緒申		;; delete that copy -- it is still useful for OLD-BACKEND.
+
鐃緒申		(if unmodified-file
+
鐃緒申		    (copy-file unmodified-file file
+
鐃緒申			       'ok-if-already-exists 'keep-date)
+
鐃緒申		  (if (y-or-n-p "Get base version from master? ")
+
鐃緒申		      (vc-revert-file file))))
+
鐃緒申	      (vc-call-backend new-backend 'receive-file file rev))
+
鐃緒申	  (when modified-file
+
鐃緒申	    (vc-switch-backend file new-backend)
+
鐃緒申	    (unless (eq (vc-checkout-model file) 'implicit)
+
鐃緒申	      (vc-checkout file t nil))
+
鐃緒申	    (rename-file modified-file file 'ok-if-already-exists)
+
鐃緒申	    (vc-file-setprop file 'vc-checkout-time nil)))))
+
鐃緒申    (when move
+
鐃緒申      (vc-switch-backend file old-backend)
+
鐃緒申      (setq comment (vc-call comment-history file))
+
鐃緒申      (vc-call unregister file))
+
鐃緒申    (vc-switch-backend file new-backend)
+
鐃緒申    (when (or move edited)
+
鐃緒申      (vc-file-setprop file 'vc-state 'edited)
+
鐃緒申      (vc-mode-line file)
+
鐃緒申      (vc-checkin file nil comment (stringp comment)))))
+
鐃緒申
+
鐃緒申(defun vc-default-unregister (backend file)
+
鐃緒申  "Default implementation of `vc-unregister', signals an error."
+
鐃緒申  (error "Unregistering files is not supported for %s" backend))
+
鐃緒申
+
鐃緒申(defun vc-default-receive-file (backend file rev)
+
鐃緒申  "Let BACKEND receive FILE from another version control system."
+
鐃緒申  (vc-call-backend backend 'register file rev ""))
+
鐃緒申
+
鐃緒申(defun vc-rename-master (oldmaster newfile templates)
+
鐃緒申  "Rename OLDMASTER to be the master file for NEWFILE based on TEMPLATES."
+
鐃緒申  (let* ((dir (file-name-directory (expand-file-name oldmaster)))
+
鐃緒申	 (newdir (or (file-name-directory newfile) ""))
+
鐃緒申	 (newbase (file-name-nondirectory newfile))
+
鐃緒申	 (masters
+
鐃緒申	  ;; List of potential master files for `newfile'
+
鐃緒申	  (mapcar
+
鐃緒申	   (lambda (s) (vc-possible-master s newdir newbase))
+
鐃緒申	   templates)))
+
鐃緒申    (if (or (file-symlink-p oldmaster)
+
鐃緒申	    (file-symlink-p (file-name-directory oldmaster)))
+
鐃緒申	(error "This is unsafe in the presence of symbolic links"))
+
鐃緒申    (rename-file
+
鐃緒申     oldmaster
+
鐃緒申     (catch 'found
+
鐃緒申       ;; If possible, keep the master file in the same directory.
+
鐃緒申       (dolist (f masters)
+
鐃緒申	 (if (and f (string= (file-name-directory (expand-file-name f)) dir))
+
鐃緒申	     (throw 'found f)))
+
鐃緒申       ;; If not, just use the first possible place.
+
鐃緒申       (dolist (f masters)
+
鐃緒申	 (and f (or (not (setq dir (file-name-directory f)))
+
鐃緒申		    (file-directory-p dir))
+
鐃緒申	      (throw 'found f)))
+
鐃緒申       (error "New file lacks a version control directory")))))
+
鐃緒申
+
鐃緒申(defun vc-delete-file (file)
+
鐃緒申  "Delete file and mark it as such in the version control system."
+
鐃緒申  (interactive "fVC delete file: ")
+
鐃緒申  (let ((buf (get-file-buffer file))
+
鐃緒申        (backend (vc-backend file)))
+
鐃緒申    (unless backend
+
鐃緒申      (error "File %s is not under version control"
+
鐃緒申             (file-name-nondirectory file)))
+
鐃緒申    (unless (vc-find-backend-function backend 'delete-file)
+
鐃緒申      (error "Deleting files under %s is not supported in VC" backend))
+
鐃緒申    (if (and buf (buffer-modified-p buf))
+
鐃緒申	(error "Please save files before deleting them"))
+
鐃緒申    (unless (y-or-n-p (format "Really want to delete %s ? "
+
鐃緒申			      (file-name-nondirectory file)))
+
鐃緒申      (error "Abort!"))
+
鐃緒申    (unless (or (file-directory-p file) (null make-backup-files))
+
鐃緒申      (with-current-buffer (or buf (find-file-noselect file))
+
鐃緒申	(let ((backup-inhibited nil))
+
鐃緒申	  (backup-buffer))))
+
鐃緒申    (vc-call delete-file file)
+
鐃緒申    ;; If the backend hasn't deleted the file itself, let's do it for him.
+
鐃緒申    (if (file-exists-p file) (delete-file file))))
+
鐃緒申
+
鐃緒申(defun vc-default-rename-file (backend old new)
+
鐃緒申  (condition-case nil
+
鐃緒申      (add-name-to-file old new)
+
鐃緒申    (error (rename-file old new)))
+
鐃緒申  (vc-delete-file old)
+
鐃緒申  (with-current-buffer (find-file-noselect new)
+
鐃緒申    (vc-register)))
+
鐃緒申
+
鐃緒申;;;###autoload
+
鐃緒申(defun vc-rename-file (old new)
+
鐃緒申  "Rename file OLD to NEW, and rename its master file likewise."
+
鐃緒申  (interactive "fVC rename file: \nFRename to: ")
+
鐃緒申  (let ((oldbuf (get-file-buffer old)))
+
鐃緒申    (if (and oldbuf (buffer-modified-p oldbuf))
+
鐃緒申	(error "Please save files before moving them"))
+
鐃緒申    (if (get-file-buffer new)
+
鐃緒申	(error "Already editing new file name"))
+
鐃緒申    (if (file-exists-p new)
+
鐃緒申	(error "New file already exists"))
+
鐃緒申    (let ((state (vc-state old)))
+
鐃緒申      (unless (memq state '(up-to-date edited))
+
鐃緒申	(error "Please %s files before moving them"
+
鐃緒申	       (if (stringp state) "check in" "update"))))
+
鐃緒申    (vc-call rename-file old new)
+
鐃緒申    (vc-file-clearprops old)
+
鐃緒申    ;; Move the actual file (unless the backend did it already)
+
鐃緒申    (if (file-exists-p old) (rename-file old new))
+
鐃緒申    ;; ?? Renaming a file might change its contents due to keyword expansion.
+
鐃緒申    ;; We should really check out a new copy if the old copy was precisely equal
+
鐃緒申    ;; to some checked in version.  However, testing for this is tricky....
+
鐃緒申    (if oldbuf
+
鐃緒申	(with-current-buffer oldbuf
+
鐃緒申	  (let ((buffer-read-only buffer-read-only))
+
鐃緒申	    (set-visited-file-name new))
+
鐃緒申	  (vc-backend new)
+
鐃緒申	  (vc-mode-line new)
+
鐃緒申	  (set-buffer-modified-p nil)))))
+
鐃緒申
+
鐃緒申;; Only defined in very recent Emacsen
+
鐃緒申(defvar small-temporary-file-directory nil)
+
鐃緒申
+
鐃緒申;;;###autoload
+
鐃緒申(defun vc-update-change-log (&rest args)
+
鐃緒申  "Find change log file and add entries from recent version control logs.
+
鐃緒申Normally, find log entries for all registered files in the default
+
鐃緒申directory.
+
鐃緒申
+
鐃緒申With prefix arg of \\[universal-argument], only find log entries for the current buffer's file.
+
鐃緒申
+
鐃緒申With any numeric prefix arg, find log entries for all currently visited
+
鐃緒申files that are under version control.  This puts all the entries in the
+
鐃緒申log for the default directory, which may not be appropriate.
+
鐃緒申
+
鐃緒申From a program, any ARGS are assumed to be filenames for which
+
鐃緒申log entries should be gathered."
+
鐃緒申  (interactive
+
鐃緒申   (cond ((consp current-prefix-arg)	;C-u
+
鐃緒申	  (list buffer-file-name))
+
鐃緒申	 (current-prefix-arg		;Numeric argument.
+
鐃緒申	  (let ((files nil)
+
鐃緒申		(buffers (buffer-list))
+
鐃緒申		file)
+
鐃緒申	    (while buffers
+
鐃緒申	      (setq file (buffer-file-name (car buffers)))
+
鐃緒申	      (and file (vc-backend file)
+
鐃緒申		   (setq files (cons file files)))
+
鐃緒申	      (setq buffers (cdr buffers)))
+
鐃緒申	    files))
+
鐃緒申	 (t
+
鐃緒申          ;; Don't supply any filenames to backend; this means
+
鐃緒申          ;; it should find all relevant files relative to
+
鐃緒申          ;; the default-directory.
+
鐃緒申	  nil)))
+
鐃緒申  (vc-call-backend (vc-responsible-backend default-directory)
+
鐃緒申                   'update-changelog args))
+
鐃緒申
+
鐃緒申(defun vc-default-update-changelog (backend files)
+
鐃緒申  "Default implementation of update-changelog.
+
鐃緒申Uses `rcs2log' which only works for RCS and CVS."
+
鐃緒申  ;; FIXME: We (c|sh)ould add support for cvs2cl
+
鐃緒申  (let ((odefault default-directory)
+
鐃緒申	(changelog (find-change-log))
+
鐃緒申	;; Presumably not portable to non-Unixy systems, along with rcs2log:
+
鐃緒申	(tempfile (make-temp-file
+
鐃緒申		   (expand-file-name "vc"
+
鐃緒申				     (or small-temporary-file-directory
+
鐃緒申					 temporary-file-directory))))
+
鐃緒申	(full-name (or add-log-full-name
+
鐃緒申		       (user-full-name)
+
鐃緒申		       (user-login-name)
+
鐃緒申		       (format "uid%d" (number-to-string (user-uid)))))
+
鐃緒申	(mailing-address (or add-log-mailing-address
+
鐃緒申			     user-mail-address)))
+
鐃緒申    (find-file-other-window changelog)
+
鐃緒申    (barf-if-buffer-read-only)
+
鐃緒申    (vc-buffer-sync)
+
鐃緒申    (undo-boundary)
+
鐃緒申    (goto-char (point-min))
+
鐃緒申    (push-mark)
+
鐃緒申    (message "Computing change log entries...")
+
鐃緒申    (message "Computing change log entries... %s"
+
鐃緒申	     (unwind-protect
+
鐃緒申		 (progn
+
鐃緒申		   (setq default-directory odefault)
+
鐃緒申		   (if (eq 0 (apply 'call-process
+
鐃緒申                                    (expand-file-name "rcs2log"
+
鐃緒申                                                      exec-directory)
+
鐃緒申                                    nil (list t tempfile) nil
+
鐃緒申                                    "-c" changelog
+
鐃緒申                                    "-u" (concat (vc-user-login-name)
+
鐃緒申                                                 "\t" full-name
+
鐃緒申                                                 "\t" mailing-address)
+
鐃緒申                                    (mapcar
+
鐃緒申                                     (lambda (f)
+
鐃緒申                                       (file-relative-name
+
鐃緒申                                        (if (file-name-absolute-p f)
+
鐃緒申                                            f
+
鐃緒申                                          (concat odefault f))))
+
鐃緒申                                     files)))
+
鐃緒申                       "done"
+
鐃緒申		     (pop-to-buffer
+
鐃緒申		      (set-buffer (get-buffer-create "*vc*")))
+
鐃緒申		     (erase-buffer)
+
鐃緒申		     (insert-file-contents tempfile)
+
鐃緒申		     "failed"))
+
鐃緒申	       (setq default-directory (file-name-directory changelog))
+
鐃緒申	       (delete-file tempfile)))))
+
鐃緒申
+
鐃緒申;; Annotate functionality
+
鐃緒申
+
鐃緒申;; Declare globally instead of additional parameter to
+
鐃緒申;; temp-buffer-show-function (not possible to pass more than one
+
鐃緒申;; parameter).  The use of annotate-ratio is deprecated in favor of
+
鐃緒申;; annotate-mode, which replaces it with the more sensible "span-to
+
鐃緒申;; days", along with autoscaling support.
+
鐃緒申(defvar vc-annotate-ratio nil "Global variable.")
+
鐃緒申(defvar vc-annotate-backend nil "Global variable.")
+
鐃緒申
+
鐃緒申;; internal buffer-local variables
+
鐃緒申(defvar vc-annotate-parent-file nil)
+
鐃緒申(defvar vc-annotate-parent-rev nil)
+
鐃緒申(defvar vc-annotate-parent-display-mode nil)
+
鐃緒申
+
鐃緒申(defconst vc-annotate-font-lock-keywords
+
鐃緒申  ;; The fontification is done by vc-annotate-lines instead of font-lock.
+
鐃緒申  '((vc-annotate-lines)))
+
鐃緒申
+
鐃緒申(defun vc-annotate-get-backend (buffer)
+
鐃緒申  "Return the backend matching \"Annotate\" buffer BUFFER.
+
鐃緒申Return nil if no match made.  Associations are made based on
+
鐃緒申`vc-annotate-buffers'."
+
鐃緒申  (cdr (assoc buffer vc-annotate-buffers)))
+
鐃緒申
+
鐃緒申(define-derived-mode vc-annotate-mode fundamental-mode "Annotate"
+
鐃緒申  "Major mode for output buffers of the `vc-annotate' command.
+
鐃緒申
+
鐃緒申You can use the mode-specific menu to alter the time-span of the used
+
鐃緒申colors.  See variable `vc-annotate-menu-elements' for customizing the
+
鐃緒申menu items."
+
鐃緒申  (set (make-local-variable 'truncate-lines) t)
+
鐃緒申  (set (make-local-variable 'font-lock-defaults)
+
鐃緒申       '(vc-annotate-font-lock-keywords t))
+
鐃緒申  (view-mode 1)
+
鐃緒申  (vc-annotate-add-menu))
+
鐃緒申
+
鐃緒申(defun vc-annotate-display-default (&optional ratio)
+
鐃緒申  "Display the output of \\[vc-annotate] using the default color range.
+
鐃緒申The color range is given by `vc-annotate-color-map', scaled by RATIO
+
鐃緒申if present.  The current time is used as the offset."
+
鐃緒申  (interactive "e")
+
鐃緒申  (message "Redisplaying annotation...")
+
鐃緒申  (vc-annotate-display
+
鐃緒申   (if ratio (vc-annotate-time-span vc-annotate-color-map ratio)))
+
鐃緒申  (message "Redisplaying annotation...done"))
+
鐃緒申
+
鐃緒申(defun vc-annotate-display-autoscale (&optional full)
+
鐃緒申  "Highlight the output of \\[vc-annotate] using an autoscaled color map.
+
鐃緒申Autoscaling means that the map is scaled from the current time to the
+
鐃緒申oldest annotation in the buffer, or, with prefix argument FULL, to
+
鐃緒申cover the range from the oldest annotation to the newest."
+
鐃緒申  (interactive "P")
+
鐃緒申  (let ((newest 0.0)
+
鐃緒申	(oldest 999999.)		;Any CVS users at the founding of Rome?
+
鐃緒申	(current (vc-annotate-convert-time (current-time)))
+
鐃緒申	date)
+
鐃緒申    (message "Redisplaying annotation...")
+
鐃緒申    ;; Run through this file and find the oldest and newest dates annotated.
+
鐃緒申    (save-excursion
+
鐃緒申      (goto-char (point-min))
+
鐃緒申      (while (setq date (prog1 (vc-call-backend vc-annotate-backend
+
鐃緒申                                                'annotate-time)
+
鐃緒申                          (forward-line 1)))
+
鐃緒申	(if (> date newest)
+
鐃緒申	    (setq newest date))
+
鐃緒申	(if (< date oldest)
+
鐃緒申	    (setq oldest date))))
+
鐃緒申    (vc-annotate-display
+
鐃緒申     (vc-annotate-time-span		;return the scaled colormap.
+
鐃緒申      vc-annotate-color-map
+
鐃緒申      (/ (-  (if full newest current) oldest)
+
鐃緒申	 (vc-annotate-car-last-cons vc-annotate-color-map)))
+
鐃緒申     (if full newest))
+
鐃緒申    (message "Redisplaying annotation...done \(%s\)"
+
鐃緒申	     (if full
+
鐃緒申		 (format "Spanned from %.1f to %.1f days old"
+
鐃緒申			 (- current oldest)
+
鐃緒申			 (- current newest))
+
鐃緒申	       (format "Spanned to %.1f days old" (- current oldest))))))
+
鐃緒申
+
鐃緒申;; Menu -- Using easymenu.el
+
鐃緒申(defun vc-annotate-add-menu ()
+
鐃緒申  "Add the menu 'Annotate' to the menu bar in VC-Annotate mode."
+
鐃緒申  (let ((menu-elements vc-annotate-menu-elements)
+
鐃緒申	(menu-def
+
鐃緒申	 '("VC-Annotate"
+
鐃緒申	   ["Default" (unless (null vc-annotate-display-mode)
+
鐃緒申			(setq vc-annotate-display-mode nil)
+
鐃緒申			(vc-annotate-display-select))
+
鐃緒申	    :style toggle :selected (null vc-annotate-display-mode)]))
+
鐃緒申	(oldest-in-map (vc-annotate-car-last-cons vc-annotate-color-map)))
+
鐃緒申    (while menu-elements
+
鐃緒申      (let* ((element (car menu-elements))
+
鐃緒申	     (days (* element oldest-in-map)))
+
鐃緒申	(setq menu-elements (cdr menu-elements))
+
鐃緒申	(setq menu-def
+
鐃緒申	      (append menu-def
+
鐃緒申		      `([,(format "Span %.1f days" days)
+
鐃緒申			 (unless (and (numberp vc-annotate-display-mode)
+
鐃緒申				      (= vc-annotate-display-mode ,days))
+
鐃緒申			   (vc-annotate-display-select nil ,days))
+
鐃緒申			 :style toggle :selected
+
鐃緒申			 (and (numberp vc-annotate-display-mode)
+
鐃緒申			      (= vc-annotate-display-mode ,days)) ])))))
+
鐃緒申    (setq menu-def
+
鐃緒申	  (append menu-def
+
鐃緒申		  (list
+
鐃緒申		   ["Span ..."
+
鐃緒申		    (let ((days
+
鐃緒申			   (float (string-to-number
+
鐃緒申				   (read-string "Span how many days? ")))))
+
鐃緒申		      (vc-annotate-display-select nil days)) t])
+
鐃緒申		  (list "--")
+
鐃緒申		  (list
+
鐃緒申		   ["Span to Oldest"
+
鐃緒申		    (unless (eq vc-annotate-display-mode 'scale)
+
鐃緒申		      (vc-annotate-display-select nil 'scale))
+
鐃緒申		    :style toggle :selected
+
鐃緒申		    (eq vc-annotate-display-mode 'scale)])
+
鐃緒申		  (list
+
鐃緒申		   ["Span Oldest->Newest"
+
鐃緒申		    (unless (eq vc-annotate-display-mode 'fullscale)
+
鐃緒申		      (vc-annotate-display-select nil 'fullscale))
+
鐃緒申		    :style toggle :selected
+
鐃緒申		    (eq vc-annotate-display-mode 'fullscale)])
+
鐃緒申		  (list "--")
+
鐃緒申		  (list ["Annotate previous revision"
+
鐃緒申			 (call-interactively 'vc-annotate-prev-version)])
+
鐃緒申		  (list ["Annotate next revision"
+
鐃緒申			 (call-interactively 'vc-annotate-next-version)])
+
鐃緒申		  (list ["Annotate revision at line"
+
鐃緒申			 (vc-annotate-revision-at-line)])
+
鐃緒申		  (list ["Annotate revision previous to line"
+
鐃緒申			 (vc-annotate-revision-previous-to-line)])
+
鐃緒申		  (list ["Annotate latest revision"
+
鐃緒申			 (vc-annotate-workfile-version)])
+
鐃緒申		  (list ["Show log of revision at line"
+
鐃緒申			 (vc-annotate-show-log-revision-at-line)])
+
鐃緒申		  (list ["Show diff of revision at line"
+
鐃緒申			 (vc-annotate-show-diff-revision-at-line)])))
+
鐃緒申
+
鐃緒申    ;; Define the menu
+
鐃緒申    (if (or (featurep 'easymenu) (load "easymenu" t))
+
鐃緒申	(easy-menu-define vc-annotate-mode-menu vc-annotate-mode-map
+
鐃緒申			  "VC Annotate Display Menu" menu-def))))
+
鐃緒申
+
鐃緒申(defun vc-annotate-display-select (&optional buffer mode)
+
鐃緒申  "Highlight the output of \\[vc-annotate].
+
鐃緒申By default, the current buffer is highlighted, unless overridden by
+
鐃緒申BUFFER.  `vc-annotate-display-mode' specifies the highlighting mode to
+
鐃緒申use; you may override this using the second optional arg MODE."
+
鐃緒申  (interactive)
+
鐃緒申  (if mode (setq vc-annotate-display-mode mode))
+
鐃緒申  (when buffer
+
鐃緒申    (set-buffer buffer)
+
鐃緒申    (display-buffer buffer))
+
鐃緒申  (if (not vc-annotate-parent-rev)
+
鐃緒申      (vc-annotate-mode))
+
鐃緒申  (cond ((null vc-annotate-display-mode)
+
鐃緒申	 (vc-annotate-display-default vc-annotate-ratio))
+
鐃緒申	;; One of the auto-scaling modes
+
鐃緒申	((eq vc-annotate-display-mode 'scale)
+
鐃緒申	 (vc-annotate-display-autoscale))
+
鐃緒申	((eq vc-annotate-display-mode 'fullscale)
+
鐃緒申	 (vc-annotate-display-autoscale t))
+
鐃緒申	((numberp vc-annotate-display-mode) ; A fixed number of days lookback
+
鐃緒申	 (vc-annotate-display-default
+
鐃緒申	  (/ vc-annotate-display-mode (vc-annotate-car-last-cons
+
鐃緒申				       vc-annotate-color-map))))
+
鐃緒申	(t (error "No such display mode: %s"
+
鐃緒申		  vc-annotate-display-mode))))
+
鐃緒申
+
鐃緒申;;;; (defun vc-BACKEND-annotate-command (file buffer) ...)
+
鐃緒申;;;;  Execute "annotate" on FILE by using `call-process' and insert
+
鐃緒申;;;;  the contents in BUFFER.
+
鐃緒申
+
鐃緒申;;;###autoload
+
鐃緒申(defun vc-annotate (prefix &optional revision display-mode)
+
鐃緒申  "Display the edit history of the current file using colours.
+
鐃緒申
+
鐃緒申This command creates a buffer that shows, for each line of the current
+
鐃緒申file, when it was last edited and by whom.  Additionally, colours are
+
鐃緒申used to show the age of each line--blue means oldest, red means
+
鐃緒申youngest, and intermediate colours indicate intermediate ages.  By
+
鐃緒申default, the time scale stretches back one year into the past;
+
鐃緒申everything that is older than that is shown in blue.
+
鐃緒申
+
鐃緒申With a prefix argument, this command asks two questions in the
+
鐃緒申minibuffer.  First, you may enter a version number; then the buffer
+
鐃緒申displays and annotates that version instead of the current version
+
鐃緒申\(type RET in the minibuffer to leave that default unchanged).  Then,
+
鐃緒申you are prompted for the time span in days which the color range
+
鐃緒申should cover.  For example, a time span of 20 days means that changes
+
鐃緒申over the past 20 days are shown in red to blue, according to their
+
鐃緒申age, and everything that is older than that is shown in blue.
+
鐃緒申
+
鐃緒申Customization variables:
+
鐃緒申
+
鐃緒申`vc-annotate-menu-elements' customizes the menu elements of the
+
鐃緒申mode-specific menu. `vc-annotate-color-map' and
+
鐃緒申`vc-annotate-very-old-color' defines the mapping of time to
+
鐃緒申colors. `vc-annotate-background' specifies the background color."
+
鐃緒申  (interactive "P")
+
鐃緒申  (vc-ensure-vc-buffer)
+
鐃緒申  (let* ((temp-buffer-name nil)
+
鐃緒申         (temp-buffer-show-function 'vc-annotate-display-select)
+
鐃緒申	 (rev (or revision (vc-workfile-version buffer-file-name)))
+
鐃緒申	 (bfn buffer-file-name)
+
鐃緒申         (vc-annotate-version
+
鐃緒申	  (if prefix (read-string
+
鐃緒申		      (format "Annotate from version: (default %s) " rev)
+
鐃緒申		      nil nil rev)
+
鐃緒申	    rev)))
+
鐃緒申    (if display-mode
+
鐃緒申	(setq vc-annotate-display-mode display-mode)
+
鐃緒申      (if prefix
+
鐃緒申	  (setq vc-annotate-display-mode
+
鐃緒申		(float (string-to-number
+
鐃緒申			(read-string "Annotate span days: (default 20) "
+
鐃緒申				     nil nil "20"))))))
+
鐃緒申    (setq temp-buffer-name (format "*Annotate %s (rev %s)*"
+
鐃緒申				   (buffer-name) vc-annotate-version))
+
鐃緒申    (setq vc-annotate-backend (vc-backend buffer-file-name))
+
鐃緒申    (message "Annotating...")
+
鐃緒申    (if (not (vc-find-backend-function vc-annotate-backend 'annotate-command))
+
鐃緒申	(error "Sorry, annotating is not implemented for %s"
+
鐃緒申	       vc-annotate-backend))
+
鐃緒申    (with-output-to-temp-buffer temp-buffer-name
+
鐃緒申      (vc-call-backend vc-annotate-backend 'annotate-command
+
鐃緒申		       buffer-file-name
+
鐃緒申		       (get-buffer temp-buffer-name)
+
鐃緒申                       vc-annotate-version))
+
鐃緒申    (save-excursion
+
鐃緒申      (set-buffer temp-buffer-name)
+
鐃緒申      (set (make-local-variable 'vc-annotate-parent-file) bfn)
+
鐃緒申      (set (make-local-variable 'vc-annotate-parent-rev) vc-annotate-version)
+
鐃緒申      (set (make-local-variable 'vc-annotate-parent-display-mode)
+
鐃緒申	   vc-annotate-display-mode))
+
鐃緒申
+
鐃緒申    ;; Don't use the temp-buffer-name until the buffer is created
+
鐃緒申    ;; (only after `with-output-to-temp-buffer'.)
+
鐃緒申    (setq vc-annotate-buffers
+
鐃緒申	  (append vc-annotate-buffers
+
鐃緒申		  (list (cons (get-buffer temp-buffer-name) vc-annotate-backend))))
+
鐃緒申  (message "Annotating... done")))
+
鐃緒申
+
鐃緒申(defun vc-annotate-prev-version (prefix)
+
鐃緒申  "Visit the annotation of the version previous to this one.
+
鐃緒申
+
鐃緒申With a numeric prefix argument, annotate the version that many
+
鐃緒申versions previous."
+
鐃緒申  (interactive "p")
+
鐃緒申  (vc-annotate-warp-version (- 0 prefix)))
+
鐃緒申
+
鐃緒申(defun vc-annotate-next-version (prefix)
+
鐃緒申  "Visit the annotation of the version after this one.
+
鐃緒申
+
鐃緒申With a numeric prefix argument, annotate the version that many
+
鐃緒申versions after."
+
鐃緒申  (interactive "p")
+
鐃緒申  (vc-annotate-warp-version prefix))
+
鐃緒申
+
鐃緒申(defun vc-annotate-workfile-version ()
+
鐃緒申  "Visit the annotation of the workfile version of this file."
+
鐃緒申  (interactive)
+
鐃緒申  (if (not (equal major-mode 'vc-annotate-mode))
+
鐃緒申      (message "Cannot be invoked outside of a vc annotate buffer")
+
鐃緒申    (let ((warp-rev (vc-workfile-version vc-annotate-parent-file)))
+
鐃緒申      (if (equal warp-rev vc-annotate-parent-rev)
+
鐃緒申	  (message "Already at version %s" warp-rev)
+
鐃緒申	(vc-annotate-warp-version warp-rev)))))
+
鐃緒申
+
鐃緒申(defun vc-annotate-extract-revision-at-line ()
+
鐃緒申  "Extract the revision number of the current line."
+
鐃緒申  ;; This function must be invoked from a buffer in vc-annotate-mode
+
鐃緒申  (save-window-excursion
+
鐃緒申    (vc-ensure-vc-buffer)
+
鐃緒申    (setq vc-annotate-backend (vc-backend buffer-file-name)))
+
鐃緒申  (vc-call-backend vc-annotate-backend 'annotate-extract-revision-at-line))
+
鐃緒申
+
鐃緒申(defun vc-annotate-revision-at-line ()
+
鐃緒申  "Visit the annotation of the version identified in the current line."
+
鐃緒申  (interactive)
+
鐃緒申  (if (not (equal major-mode 'vc-annotate-mode))
+
鐃緒申      (message "Cannot be invoked outside of a vc annotate buffer")
+
鐃緒申    (let ((rev-at-line (vc-annotate-extract-revision-at-line)))
+
鐃緒申      (if (not rev-at-line)
+
鐃緒申	  (message "Cannot extract revision number from the current line")
+
鐃緒申	(if (equal rev-at-line vc-annotate-parent-rev)
+
鐃緒申	    (message "Already at version %s" rev-at-line)
+
鐃緒申	  (vc-annotate-warp-version rev-at-line))))))
+
鐃緒申
+
鐃緒申(defun vc-annotate-revision-previous-to-line ()
+
鐃緒申  "Visit the annotation of the version before the version at line."
+
鐃緒申  (interactive)
+
鐃緒申  (if (not (equal major-mode 'vc-annotate-mode))
+
鐃緒申      (message "Cannot be invoked outside of a vc annotate buffer")
+
鐃緒申    (let ((rev-at-line (vc-annotate-extract-revision-at-line))
+
鐃緒申	  (prev-rev nil))
+
鐃緒申      (if (not rev-at-line)
+
鐃緒申	  (message "Cannot extract revision number from the current line")
+
鐃緒申	(setq prev-rev
+
鐃緒申	      (vc-call previous-version vc-annotate-parent-file rev-at-line))
+
鐃緒申	(vc-annotate-warp-version prev-rev)))))
+
鐃緒申
+
鐃緒申(defun vc-annotate-show-log-revision-at-line ()
+
鐃緒申  "Visit the log of the version at line."
+
鐃緒申  (interactive)
+
鐃緒申  (if (not (equal major-mode 'vc-annotate-mode))
+
鐃緒申      (message "Cannot be invoked outside of a vc annotate buffer")
+
鐃緒申    (let ((rev-at-line (vc-annotate-extract-revision-at-line)))
+
鐃緒申      (if (not rev-at-line)
+
鐃緒申	  (message "Cannot extract revision number from the current line")
+
鐃緒申	(vc-print-log rev-at-line)))))
+
鐃緒申
+
鐃緒申(defun vc-annotate-show-diff-revision-at-line ()
+
鐃緒申  "Visit the diff of the version at line from its previous version."
+
鐃緒申  (interactive)
+
鐃緒申  (if (not (equal major-mode 'vc-annotate-mode))
+
鐃緒申      (message "Cannot be invoked outside of a vc annotate buffer")
+
鐃緒申    (let ((rev-at-line (vc-annotate-extract-revision-at-line))
+
鐃緒申	  (prev-rev nil))
+
鐃緒申      (if (not rev-at-line)
+
鐃緒申	  (message "Cannot extract revision number from the current line")
+
鐃緒申	(setq prev-rev
+
鐃緒申	      (vc-call previous-version vc-annotate-parent-file rev-at-line))
+
鐃緒申	(if (not prev-rev)
+
鐃緒申	    (message "Cannot diff from any version prior to %s" rev-at-line)
+
鐃緒申	  (save-window-excursion
+
鐃緒申	    (vc-version-diff vc-annotate-parent-file prev-rev rev-at-line))
+
鐃緒申	  (switch-to-buffer "*vc-diff*"))))))
+
鐃緒申
+
鐃緒申(defun vc-annotate-warp-version (revspec)
+
鐃緒申  "Annotate the version described by REVSPEC.
+
鐃緒申
+
鐃緒申If REVSPEC is a positive integer, warp that many versions
+
鐃緒申forward, if possible, otherwise echo a warning message.  If
+
鐃緒申REVSPEC is a negative integer, warp that many versions backward,
+
鐃緒申if possible, otherwise echo a warning message.  If REVSPEC is a
+
鐃緒申string, then it describes a revision number, so warp to that
+
鐃緒申revision."
+
鐃緒申  (if (not (equal major-mode 'vc-annotate-mode))
+
鐃緒申      (message "Cannot be invoked outside of a vc annotate buffer")
+
鐃緒申    (let* ((oldline (line-number-at-pos))
+
鐃緒申	   (revspeccopy revspec)
+
鐃緒申	   (newrev nil))
+
鐃緒申      (cond
+
鐃緒申       ((and (integerp revspec) (> revspec 0))
+
鐃緒申	(setq newrev vc-annotate-parent-rev)
+
鐃緒申	(while (and (> revspec 0) newrev)
+
鐃緒申	       (setq newrev (vc-call next-version
+
鐃緒申				     vc-annotate-parent-file newrev))
+
鐃緒申	       (setq revspec (1- revspec)))
+
鐃緒申	(if (not newrev)
+
鐃緒申	    (message "Cannot increment %d versions from version %s"
+
鐃緒申		     revspeccopy vc-annotate-parent-rev)))
+
鐃緒申       ((and (integerp revspec) (< revspec 0))
+
鐃緒申	(setq newrev vc-annotate-parent-rev)
+
鐃緒申	(while (and (< revspec 0) newrev)
+
鐃緒申	       (setq newrev (vc-call previous-version
+
鐃緒申				     vc-annotate-parent-file newrev))
+
鐃緒申	       (setq revspec (1+ revspec)))
+
鐃緒申	(if (not newrev)
+
鐃緒申	    (message "Cannot decrement %d versions from version %s"
+
鐃緒申		     (- 0 revspeccopy) vc-annotate-parent-rev)))
+
鐃緒申       ((stringp revspec) (setq newrev revspec))
+
鐃緒申       (t (error "Invalid argument to vc-annotate-warp-version")))
+
鐃緒申      (when newrev
+
鐃緒申	(save-window-excursion
+
鐃緒申	  (find-file vc-annotate-parent-file)
+
鐃緒申	  (vc-annotate nil newrev vc-annotate-parent-display-mode))
+
鐃緒申	(kill-buffer (current-buffer)) ;; kill the buffer we started from
+
鐃緒申	(switch-to-buffer (car (car (last vc-annotate-buffers))))
+
鐃緒申	(goto-line (min oldline (progn (goto-char (point-max))
+
鐃緒申				       (previous-line)
+
鐃緒申				       (line-number-at-pos))))))))
+
鐃緒申
+
鐃緒申(defun vc-annotate-car-last-cons (a-list)
+
鐃緒申  "Return car of last cons in association list A-LIST."
+
鐃緒申  (if (not (eq nil (cdr a-list)))
+
鐃緒申      (vc-annotate-car-last-cons (cdr a-list))
+
鐃緒申    (car (car a-list))))
+
鐃緒申
+
鐃緒申(defun vc-annotate-time-span (a-list span &optional quantize)
+
鐃緒申  "Apply factor SPAN to the time-span of association list A-LIST.
+
鐃緒申Return the new alist.
+
鐃緒申Optionally quantize to the factor of QUANTIZE."
+
鐃緒申  ;; Apply span to each car of every cons
+
鐃緒申  (if (not (eq nil a-list))
+
鐃緒申      (append (list (cons (* (car (car a-list)) span)
+
鐃緒申			  (cdr (car a-list))))
+
鐃緒申	      (vc-annotate-time-span (nthcdr (or quantize ; optional
+
鐃緒申						 1) ; Default to cdr
+
鐃緒申					     a-list) span quantize))))
+
鐃緒申
+
鐃緒申(defun vc-annotate-compcar (threshold a-list)
+
鐃緒申  "Test successive cons cells of A-LIST against THRESHOLD.
+
鐃緒申Return the first cons cell with a car that is not less than THRESHOLD,
+
鐃緒申nil if no such cell exists."
+
鐃緒申 (let ((i 1)
+
鐃緒申       (tmp-cons (car a-list)))
+
鐃緒申   (while (and tmp-cons (< (car tmp-cons) threshold))
+
鐃緒申     (setq tmp-cons (car (nthcdr i a-list)))
+
鐃緒申     (setq i (+ i 1)))
+
鐃緒申   tmp-cons))				; Return the appropriate value
+
鐃緒申
+
鐃緒申(defun vc-annotate-convert-time (time)
+
鐃緒申  "Convert a time value to a floating-point number of days.
+
鐃緒申The argument TIME is a list as returned by `current-time' or
+
鐃緒申`encode-time', only the first two elements of that list are considered."
+
鐃緒申  (/ (+ (* (float (car time)) (lsh 1 16)) (cadr time)) 24 3600))
+
鐃緒申
+
鐃緒申(defun vc-annotate-difference (&optional offset)
+
鐃緒申  "Return the time span in days to the next annotation.
+
鐃緒申This calls the backend function annotate-time, and returns the
+
鐃緒申difference in days between the time returned and the current time,
+
鐃緒申or OFFSET if present."
+
鐃緒申   (let ((next-time (vc-call-backend vc-annotate-backend 'annotate-time)))
+
鐃緒申     (if next-time
+
鐃緒申	 (- (or offset
+
鐃緒申		(vc-call-backend vc-annotate-backend 'annotate-current-time))
+
鐃緒申	    next-time))))
+
鐃緒申
+
鐃緒申(defun vc-default-annotate-current-time (backend)
+
鐃緒申  "Return the current time, encoded as fractional days."
+
鐃緒申  (vc-annotate-convert-time (current-time)))
+
鐃緒申
+
鐃緒申(defvar vc-annotate-offset nil)
+
鐃緒申
+
鐃緒申(defun vc-annotate-display (&optional color-map offset)
+
鐃緒申  "Highlight `vc-annotate' output in the current buffer.
+
鐃緒申COLOR-MAP, if present, overrides `vc-annotate-color-map'.
+
鐃緒申The annotations are relative to the current time, unless overridden by OFFSET."
+
鐃緒申  (if (and color-map (not (eq color-map vc-annotate-color-map)))
+
鐃緒申      (set (make-local-variable 'vc-annotate-color-map) color-map))
+
鐃緒申  (set (make-local-variable 'vc-annotate-offset) offset)
+
鐃緒申  (font-lock-mode 1))
+
鐃緒申
+
鐃緒申(defun vc-annotate-lines (limit)
+
鐃緒申  (let (difference)
+
鐃緒申    (while (and (< (point) limit)
+
鐃緒申		(setq difference (vc-annotate-difference vc-annotate-offset)))
+
鐃緒申      (let* ((color (or (vc-annotate-compcar difference vc-annotate-color-map)
+
鐃緒申			(cons nil vc-annotate-very-old-color)))
+
鐃緒申	     ;; substring from index 1 to remove any leading `#' in the name
+
鐃緒申	     (face-name (concat "vc-annotate-face-" (substring (cdr color) 1)))
+
鐃緒申	     ;; Make the face if not done.
+
鐃緒申	     (face (or (intern-soft face-name)
+
鐃緒申		       (let ((tmp-face (make-face (intern face-name))))
+
鐃緒申			 (set-face-foreground tmp-face (cdr color))
+
鐃緒申			 (if vc-annotate-background
+
鐃緒申			     (set-face-background tmp-face
+
鐃緒申						  vc-annotate-background))
+
鐃緒申			 tmp-face)))	; Return the face
+
鐃緒申	     (point (point)))
+
鐃緒申	(forward-line 1)
+
鐃緒申	(put-text-property point (point) 'face face)))
+
鐃緒申    ;; Pretend to font-lock there were no matches.
+
鐃緒申    nil))
+
鐃緒申
+
鐃緒申;; Collect back-end-dependent stuff here
+
鐃緒申
+
鐃緒申(defalias 'vc-default-logentry-check 'ignore)
+
鐃緒申
+
鐃緒申(defun vc-check-headers ()
+
鐃緒申  "Check if the current file has any headers in it."
+
鐃緒申  (interactive)
+
鐃緒申  (vc-call-backend (vc-backend buffer-file-name) 'check-headers))
+
鐃緒申
+
鐃緒申(defun vc-default-check-headers (backend)
+
鐃緒申  "Default implementation of check-headers; always returns nil."
+
鐃緒申  nil)
+
鐃緒申
+
鐃緒申;; Back-end-dependent stuff ends here.
+
鐃緒申
+
鐃緒申;; Set up key bindings for use while editing log messages
+
鐃緒申
+
鐃緒申(defun vc-log-edit (file)
+
鐃緒申  "Set up `log-edit' for use with VC on FILE."
+
鐃緒申  (setq default-directory
+
鐃緒申	(if file (file-name-directory file)
+
鐃緒申	  (with-current-buffer vc-parent-buffer default-directory)))
+
鐃緒申  (log-edit 'vc-finish-logentry nil
+
鐃緒申	    (if file `(lambda () ',(list (file-name-nondirectory file)))
+
鐃緒申	      ;; If FILE is nil, we were called from vc-dired.
+
鐃緒申	      (lambda ()
+
鐃緒申		(with-current-buffer vc-parent-buffer
+
鐃緒申		  (dired-get-marked-files t)))))
+
鐃緒申  (set (make-local-variable 'vc-log-file) file)
+
鐃緒申  (make-local-variable 'vc-log-version)
+
鐃緒申  (set-buffer-modified-p nil)
+
鐃緒申  (setq buffer-file-name nil))
+
鐃緒申
+
鐃緒申;; These things should probably be generally available
+
鐃緒申
+
鐃緒申(defun vc-file-tree-walk (dirname func &rest args)
+
鐃緒申  "Walk recursively through DIRNAME.
+
鐃緒申Invoke FUNC f ARGS on each VC-managed file f underneath it."
+
鐃緒申  (vc-file-tree-walk-internal (expand-file-name dirname) func args)
+
鐃緒申  (message "Traversing directory %s...done" dirname))
+
鐃緒申
+
鐃緒申(defun vc-file-tree-walk-internal (file func args)
+
鐃緒申  (if (not (file-directory-p file))
+
鐃緒申      (if (vc-backend file) (apply func file args))
+
鐃緒申    (message "Traversing directory %s..." (abbreviate-file-name file))
+
鐃緒申    (let ((dir (file-name-as-directory file)))
+
鐃緒申      (mapcar
+
鐃緒申       (lambda (f) (or
+
鐃緒申		    (string-equal f ".")
+
鐃緒申		    (string-equal f "..")
+
鐃緒申		    (member f vc-directory-exclusion-list)
+
鐃緒申		    (let ((dirf (expand-file-name f dir)))
+
鐃緒申		      (or
+
鐃緒申		       (file-symlink-p dirf);; Avoid possible loops
+
鐃緒申		       (vc-file-tree-walk-internal dirf func args)))))
+
鐃緒申       (directory-files dir)))))
+
鐃緒申
+
鐃緒申(provide 'vc)
+
鐃緒申
+
鐃緒申;; DEVELOPER'S NOTES ON CONCURRENCY PROBLEMS IN THIS CODE
+
鐃緒申;;
+
鐃緒申;; These may be useful to anyone who has to debug or extend the package.
+
鐃緒申;; (Note that this information corresponds to versions 5.x. Some of it
+
鐃緒申;; might have been invalidated by the additions to support branching
+
鐃緒申;; and RCS keyword lookup. AS, 1995/03/24)
+
鐃緒申;;
+
鐃緒申;; A fundamental problem in VC is that there are time windows between
+
鐃緒申;; vc-next-action's computations of the file's version-control state and
+
鐃緒申;; the actions that change it.  This is a window open to lossage in a
+
鐃緒申;; multi-user environment; someone else could nip in and change the state
+
鐃緒申;; of the master during it.
+
鐃緒申;;
+
鐃緒申;; The performance problem is that rlog/prs calls are very expensive; we want
+
鐃緒申;; to avoid them as much as possible.
+
鐃緒申;;
+
鐃緒申;; ANALYSIS:
+
鐃緒申;;
+
鐃緒申;; The performance problem, it turns out, simplifies in practice to the
+
鐃緒申;; problem of making vc-state fast.  The two other functions that call
+
鐃緒申;; prs/rlog will not be so commonly used that the slowdown is a problem; one
+
鐃緒申;; makes snapshots, the other deletes the calling user's last change in the
+
鐃緒申;; master.
+
鐃緒申;;
+
鐃緒申;; The race condition implies that we have to either (a) lock the master
+
鐃緒申;; during the entire execution of vc-next-action, or (b) detect and
+
鐃緒申;; recover from errors resulting from dispatch on an out-of-date state.
+
鐃緒申;;
+
鐃緒申;; Alternative (a) appears to be infeasible.  The problem is that we can't
+
鐃緒申;; guarantee that the lock will ever be removed.  Suppose a user starts a
+
鐃緒申;; checkin, the change message buffer pops up, and the user, having wandered
+
鐃緒申;; off to do something else, simply forgets about it?
+
鐃緒申;;
+
鐃緒申;; Alternative (b), on the other hand, works well with a cheap way to speed up
+
鐃緒申;; vc-state.  Usually, if a file is registered, we can read its locked/
+
鐃緒申;; unlocked state and its current owner from its permissions.
+
鐃緒申;;
+
鐃緒申;; This shortcut will fail if someone has manually changed the workfile's
+
鐃緒申;; permissions; also if developers are munging the workfile in several
+
鐃緒申;; directories, with symlinks to a master (in this latter case, the
+
鐃緒申;; permissions shortcut will fail to detect a lock asserted from another
+
鐃緒申;; directory).
+
鐃緒申;;
+
鐃緒申;; Note that these cases correspond exactly to the errors which could happen
+
鐃緒申;; because of a competing checkin/checkout race in between two instances of
+
鐃緒申;; vc-next-action.
+
鐃緒申;;
+
鐃緒申;; For VC's purposes, a workfile/master pair may have the following states:
+
鐃緒申;;
+
鐃緒申;; A. Unregistered.  There is a workfile, there is no master.
+
鐃緒申;;
+
鐃緒申;; B. Registered and not locked by anyone.
+
鐃緒申;;
+
鐃緒申;; C. Locked by calling user and unchanged.
+
鐃緒申;;
+
鐃緒申;; D. Locked by the calling user and changed.
+
鐃緒申;;
+
鐃緒申;; E. Locked by someone other than the calling user.
+
鐃緒申;;
+
鐃緒申;; This makes for 25 states and 20 error conditions.  Here's the matrix:
+
鐃緒申;;
+
鐃緒申;; VC's idea of state
+
鐃緒申;;  |
+
鐃緒申;;  V  Actual state   RCS action              SCCS action          Effect
+
鐃緒申;;    A  B  C  D  E
+
鐃緒申;;  A .  1  2  3  4   ci -u -t-          admin -fb -i<file>      initial admin
+
鐃緒申;;  B 5  .  6  7  8   co -l              get -e                  checkout
+
鐃緒申;;  C 9  10 .  11 12  co -u              unget; get              revert
+
鐃緒申;;  D 13 14 15 .  16  ci -u -m<comment>  delta -y<comment>; get  checkin
+
鐃緒申;;  E 17 18 19 20 .   rcs -u -M -l       unget -n ; get -g       steal lock
+
鐃緒申;;
+
鐃緒申;; All commands take the master file name as a last argument (not shown).
+
鐃緒申;;
+
鐃緒申;; In the discussion below, a "self-race" is a pathological situation in
+
鐃緒申;; which VC operations are being attempted simultaneously by two or more
+
鐃緒申;; Emacsen running under the same username.
+
鐃緒申;;
+
鐃緒申;; The vc-next-action code has the following windows:
+
鐃緒申;;
+
鐃緒申;; Window P:
+
鐃緒申;;    Between the check for existence of a master file and the call to
+
鐃緒申;; admin/checkin in vc-buffer-admin (apparent state A).  This window may
+
鐃緒申;; never close if the initial-comment feature is on.
+
鐃緒申;;
+
鐃緒申;; Window Q:
+
鐃緒申;;    Between the call to vc-workfile-unchanged-p in and the immediately
+
鐃緒申;; following revert (apparent state C).
+
鐃緒申;;
+
鐃緒申;; Window R:
+
鐃緒申;;    Between the call to vc-workfile-unchanged-p in and the following
+
鐃緒申;; checkin (apparent state D).  This window may never close.
+
鐃緒申;;
+
鐃緒申;; Window S:
+
鐃緒申;;    Between the unlock and the immediately following checkout during a
+
鐃緒申;; revert operation (apparent state C).  Included in window Q.
+
鐃緒申;;
+
鐃緒申;; Window T:
+
鐃緒申;;    Between vc-state and the following checkout (apparent state B).
+
鐃緒申;;
+
鐃緒申;; Window U:
+
鐃緒申;;    Between vc-state and the following revert (apparent state C).
+
鐃緒申;; Includes windows Q and S.
+
鐃緒申;;
+
鐃緒申;; Window V:
+
鐃緒申;;    Between vc-state and the following checkin (apparent state
+
鐃緒申;; D).  This window may never be closed if the user fails to complete the
+
鐃緒申;; checkin message.  Includes window R.
+
鐃緒申;;
+
鐃緒申;; Window W:
+
鐃緒申;;    Between vc-state and the following steal-lock (apparent
+
鐃緒申;; state E).  This window may never close if the user fails to complete
+
鐃緒申;; the steal-lock message.  Includes window X.
+
鐃緒申;;
+
鐃緒申;; Window X:
+
鐃緒申;;    Between the unlock and the immediately following re-lock during a
+
鐃緒申;; steal-lock operation (apparent state E).  This window may never close
+
鐃緒申;; if the user fails to complete the steal-lock message.
+
鐃緒申;;
+
鐃緒申;; Errors:
+
鐃緒申;;
+
鐃緒申;; Apparent state A ---
+
鐃緒申;;
+
鐃緒申;; 1. File looked unregistered but is actually registered and not locked.
+
鐃緒申;;
+
鐃緒申;;    Potential cause: someone else's admin during window P, with
+
鐃緒申;; caller's admin happening before their checkout.
+
鐃緒申;;
+
鐃緒申;;    RCS: Prior to version 5.6.4, ci fails with message
+
鐃緒申;;         "no lock set by <user>".  From 5.6.4 onwards, VC uses the new
+
鐃緒申;;         ci -i option and the message is "<file>,v: already exists".
+
鐃緒申;;    SCCS: admin will fail with error (ad19).
+
鐃緒申;;
+
鐃緒申;;    We can let these errors be passed up to the user.
+
鐃緒申;;
+
鐃緒申;; 2. File looked unregistered but is actually locked by caller, unchanged.
+
鐃緒申;;
+
鐃緒申;;    Potential cause: self-race during window P.
+
鐃緒申;;
+
鐃緒申;;    RCS: Prior to version 5.6.4, reverts the file to the last saved
+
鐃緒申;;         version and unlocks it.  From 5.6.4 onwards, VC uses the new
+
鐃緒申;;         ci -i option, failing with message "<file>,v: already exists".
+
鐃緒申;;    SCCS: will fail with error (ad19).
+
鐃緒申;;
+
鐃緒申;;    Either of these consequences is acceptable.
+
鐃緒申;;
+
鐃緒申;; 3. File looked unregistered but is actually locked by caller, changed.
+
鐃緒申;;
+
鐃緒申;;    Potential cause: self-race during window P.
+
鐃緒申;;
+
鐃緒申;;    RCS: Prior to version 5.6.4, VC registers the caller's workfile as
+
鐃緒申;;         a delta with a null change comment (the -t- switch will be
+
鐃緒申;;         ignored). From 5.6.4 onwards, VC uses the new ci -i option,
+
鐃緒申;;         failing with message "<file>,v: already exists".
+
鐃緒申;;    SCCS: will fail with error (ad19).
+
鐃緒申;;
+
鐃緒申;; 4. File looked unregistered but is locked by someone else.
+
鐃緒申;;;
+
鐃緒申;;    Potential cause: someone else's admin during window P, with
+
鐃緒申;; caller's admin happening *after* their checkout.
+
鐃緒申;;
+
鐃緒申;;    RCS: Prior to version 5.6.4, ci fails with a
+
鐃緒申;;         "no lock set by <user>" message.  From 5.6.4 onwards,
+
鐃緒申;;         VC uses the new ci -i option, failing with message
+
鐃緒申;;         "<file>,v: already exists".
+
鐃緒申;;    SCCS: will fail with error (ad19).
+
鐃緒申;;
+
鐃緒申;;    We can let these errors be passed up to the user.
+
鐃緒申;;
+
鐃緒申;; Apparent state B ---
+
鐃緒申;;
+
鐃緒申;; 5. File looked registered and not locked, but is actually unregistered.
+
鐃緒申;;
+
鐃緒申;;    Potential cause: master file got nuked during window P.
+
鐃緒申;;
+
鐃緒申;;    RCS: will fail with "RCS/<file>: No such file or directory"
+
鐃緒申;;    SCCS: will fail with error ut4.
+
鐃緒申;;
+
鐃緒申;;    We can let these errors be passed up to the user.
+
鐃緒申;;
+
鐃緒申;; 6. File looked registered and not locked, but is actually locked by the
+
鐃緒申;; calling user and unchanged.
+
鐃緒申;;
+
鐃緒申;;    Potential cause: self-race during window T.
+
鐃緒申;;
+
鐃緒申;;    RCS: in the same directory as the previous workfile, co -l will fail
+
鐃緒申;; with "co error: writable foo exists; checkout aborted".  In any other
+
鐃緒申;; directory, checkout will succeed.
+
鐃緒申;;    SCCS: will fail with ge17.
+
鐃緒申;;
+
鐃緒申;;    Either of these consequences is acceptable.
+
鐃緒申;;
+
鐃緒申;; 7. File looked registered and not locked, but is actually locked by the
+
鐃緒申;; calling user and changed.
+
鐃緒申;;
+
鐃緒申;;    As case 6.
+
鐃緒申;;
+
鐃緒申;; 8. File looked registered and not locked, but is actually locked by another
+
鐃緒申;; user.
+
鐃緒申;;
+
鐃緒申;;    Potential cause: someone else checks it out during window T.
+
鐃緒申;;
+
鐃緒申;;    RCS: co error: revision 1.3 already locked by <user>
+
鐃緒申;;    SCCS: fails with ge4 (in directory) or ut7 (outside it).
+
鐃緒申;;
+
鐃緒申;;    We can let these errors be passed up to the user.
+
鐃緒申;;
+
鐃緒申;; Apparent state C ---
+
鐃緒申;;
+
鐃緒申;; 9. File looks locked by calling user and unchanged, but is unregistered.
+
鐃緒申;;
+
鐃緒申;;    As case 5.
+
鐃緒申;;
+
鐃緒申;; 10. File looks locked by calling user and unchanged, but is actually not
+
鐃緒申;; locked.
+
鐃緒申;;
+
鐃緒申;;    Potential cause: a self-race in window U, or by the revert's
+
鐃緒申;; landing during window X of some other user's steal-lock or window S
+
鐃緒申;; of another user's revert.
+
鐃緒申;;
+
鐃緒申;;    RCS: succeeds, refreshing the file from the identical version in
+
鐃緒申;; the master.
+
鐃緒申;;    SCCS: fails with error ut4 (p file nonexistent).
+
鐃緒申;;
+
鐃緒申;;    Either of these consequences is acceptable.
+
鐃緒申;;
+
鐃緒申;; 11. File is locked by calling user.  It looks unchanged, but is actually
+
鐃緒申;; changed.
+
鐃緒申;;
+
鐃緒申;;    Potential cause: the file would have to be touched by a self-race
+
鐃緒申;; during window Q.
+
鐃緒申;;
+
鐃緒申;;    The revert will succeed, removing whatever changes came with
+
鐃緒申;; the touch.  It is theoretically possible that work could be lost.
+
鐃緒申;;
+
鐃緒申;; 12. File looks like it's locked by the calling user and unchanged, but
+
鐃緒申;; it's actually locked by someone else.
+
鐃緒申;;
+
鐃緒申;;    Potential cause: a steal-lock in window V.
+
鐃緒申;;
+
鐃緒申;;    RCS: co error: revision <rev> locked by <user>; use co -r or rcs -u
+
鐃緒申;;    SCCS: fails with error un2
+
鐃緒申;;
+
鐃緒申;;    We can pass these errors up to the user.
+
鐃緒申;;
+
鐃緒申;; Apparent state D ---
+
鐃緒申;;
+
鐃緒申;; 13. File looks like it's locked by the calling user and changed, but it's
+
鐃緒申;; actually unregistered.
+
鐃緒申;;
+
鐃緒申;;    Potential cause: master file got nuked during window P.
+
鐃緒申;;
+
鐃緒申;;    RCS: Prior to version 5.6.4, checks in the user's version as an
+
鐃緒申;;         initial delta.  From 5.6.4 onwards, VC uses the new ci -j
+
鐃緒申;;         option, failing with message "no such file or directory".
+
鐃緒申;;    SCCS: will fail with error ut4.
+
鐃緒申;;
+
鐃緒申;;    This case is kind of nasty.  Under RCS prior to version 5.6.4,
+
鐃緒申;; VC may fail to detect the loss of previous version information.
+
鐃緒申;;
+
鐃緒申;; 14. File looks like it's locked by the calling user and changed, but it's
+
鐃緒申;; actually unlocked.
+
鐃緒申;;
+
鐃緒申;;    Potential cause: self-race in window V, or the checkin happening
+
鐃緒申;; during the window X of someone else's steal-lock or window S of
+
鐃緒申;; someone else's revert.
+
鐃緒申;;
+
鐃緒申;;    RCS: ci will fail with "no lock set by <user>".
+
鐃緒申;;    SCCS: delta will fail with error ut4.
+
鐃緒申;;
+
鐃緒申;; 15. File looks like it's locked by the calling user and changed, but it's
+
鐃緒申;; actually locked by the calling user and unchanged.
+
鐃緒申;;
+
鐃緒申;;    Potential cause: another self-race --- a whole checkin/checkout
+
鐃緒申;; sequence by the calling user would have to land in window R.
+
鐃緒申;;
+
鐃緒申;;    SCCS: checks in a redundant delta and leaves the file unlocked as usual.
+
鐃緒申;;    RCS: reverts to the file state as of the second user's checkin, leaving
+
鐃緒申;; the file unlocked.
+
鐃緒申;;
+
鐃緒申;;    It is theoretically possible that work could be lost under RCS.
+
鐃緒申;;
+
鐃緒申;; 16. File looks like it's locked by the calling user and changed, but it's
+
鐃緒申;; actually locked by a different user.
+
鐃緒申;;
+
鐃緒申;;    RCS: ci error: no lock set by <user>
+
鐃緒申;;    SCCS: unget will fail with error un2
+
鐃緒申;;
+
鐃緒申;;    We can pass these errors up to the user.
+
鐃緒申;;
+
鐃緒申;; Apparent state E ---
+
鐃緒申;;
+
鐃緒申;; 17. File looks like it's locked by some other user, but it's actually
+
鐃緒申;; unregistered.
+
鐃緒申;;
+
鐃緒申;;    As case 13.
+
鐃緒申;;
+
鐃緒申;; 18. File looks like it's locked by some other user, but it's actually
+
鐃緒申;; unlocked.
+
鐃緒申;;
+
鐃緒申;;    Potential cause: someone released a lock during window W.
+
鐃緒申;;
+
鐃緒申;;    RCS: The calling user will get the lock on the file.
+
鐃緒申;;    SCCS: unget -n will fail with cm4.
+
鐃緒申;;
+
鐃緒申;;    Either of these consequences will be OK.
+
鐃緒申;;
+
鐃緒申;; 19. File looks like it's locked by some other user, but it's actually
+
鐃緒申;; locked by the calling user and unchanged.
+
鐃緒申;;
+
鐃緒申;;    Potential cause: the other user relinquishing a lock followed by
+
鐃緒申;; a self-race, both in window W.
+
鐃緒申;;
+
鐃緒申;;     Under both RCS and SCCS, both unlock and lock will succeed, making
+
鐃緒申;; the sequence a no-op.
+
鐃緒申;;
+
鐃緒申;; 20. File looks like it's locked by some other user, but it's actually
+
鐃緒申;; locked by the calling user and changed.
+
鐃緒申;;
+
鐃緒申;;     As case 19.
+
鐃緒申;;
+
鐃緒申;; PROBLEM CASES:
+
鐃緒申;;
+
鐃緒申;;    In order of decreasing severity:
+
鐃緒申;;
+
鐃緒申;;    Cases 11 and 15 are the only ones that potentially lose work.
+
鐃緒申;; They would require a self-race for this to happen.
+
鐃緒申;;
+
鐃緒申;;    Case 13 in RCS loses information about previous deltas, retaining
+
鐃緒申;; only the information in the current workfile.  This can only happen
+
鐃緒申;; if the master file gets nuked in window P.
+
鐃緒申;;
+
鐃緒申;;    Case 3 in RCS and case 15 under SCCS insert a redundant delta with
+
鐃緒申;; no change comment in the master.  This would require a self-race in
+
鐃緒申;; window P or R respectively.
+
鐃緒申;;
+
鐃緒申;;    Cases 2, 10, 19 and 20 do extra work, but make no changes.
+
鐃緒申;;
+
鐃緒申;;    Unfortunately, it appears to me that no recovery is possible in these
+
鐃緒申;; cases.  They don't yield error messages, so there's no way to tell that
+
鐃緒申;; a race condition has occurred.
+
鐃緒申;;
+
鐃緒申;;    All other cases don't change either the workfile or the master, and
+
鐃緒申;; trigger command errors which the user will see.
+
鐃緒申;;
+
鐃緒申;;    Thus, there is no explicit recovery code.
+
鐃緒申
+
鐃緒申;; arch-tag: ca82c1de-3091-4e26-af92-460abc6213a6
+
鐃緒申;;; vc.el ends here