;;; vc.el --- drive a version-control system from within Emacs
-;; Copyright (C) 1992,93,94,95,96,97,98,2000 Free Software Foundation, Inc.
+;; Copyright (C) 1992,93,94,95,96,97,98,2000,2001 Free Software Foundation, Inc.
;; Author: FSF (see below for full credits)
;; Maintainer: Andre Spiegel <spiegel@gnu.org>
+;; $Id: vc.el,v 1.298 2001/03/10 10:44:35 spiegel Exp $
+
;; This file is part of GNU Emacs.
;; GNU Emacs is free software; you can redistribute it and/or modify
;; Paul Eggert <eggert@twinsun.com>
;; Sebastian Kremer <sk@thp.uni-koeln.de>
;; Martin Lorentzson <martinl@gnu.org>
-;; Dave Love <d.love@dl.ac.uk>
+;; Dave Love <fx@gnu.org>
;; Stefan Monnier <monnier@cs.yale.edu>
;; Andre Spiegel <spiegel@gnu.org>
;; Richard Stallman <rms@gnu.org>
;;
;; Developer's notes on some concurrency issues are included at the end of
;; the file.
-
-;;; Code:
-
-;;;;;;;;;;;;;;;;; Backend-specific functions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
-;; for each operation FUN, the backend should provide a function vc-BACKEND-FUN.
-;; Operations marked with a `-' instead of a `*' have a sensible default
-;; behavior.
-
+;; 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)
-;; * state (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)
-;; The default behavior delegates to `state'.
+;;
+;; 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.
+;;
;; - mode-line-string (file)
-;; * workfile-version (file)
-;; * revert (file)
-;; - merge-news (file)
-;; Only needed if state `needs-merge' is possible.
-;; - merge (file rev1 rev2)
-;; - steal-lock (file &optional version)
-;; Only required if files can be locked by somebody else.
-;; * register (file rev comment)
+;;
+;; 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.
+;;
;; - responsible-p (file)
-;; Should also work if FILE is a directory (ends with a slash).
+;;
+;; 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)
-;; * checkout (file writable &optional rev destfile)
-;; Checkout revision REV of FILE into DESTFILE.
-;; DESTFILE defaults to FILE.
-;; The file should be made writable if WRITABLE is non-nil.
-;; REV can be nil (BASE) or "" (HEAD) or any other revision.
+;;
+;; 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.
+;;
+;; * checkout (file &optional editable rev destfile)
+;;
+;; 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 the empty string, that means to check out the head of the
+;; trunk. If optional arg DESTFILE is given, it is an alternate
+;; filename to write the contents to.
+;;
+;; * revert (file)
+;;
+;; Revert FILE back to the current workfile version.
+;;
+;; - 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)
+;;
+;; Insert the revision log of FILE into the *vc* buffer.
+;;
+;; - 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)
-;; Insert the diff for FILE into the current buffer.
-;; REV1 should default to workfile-version.
-;; REV2 should default to the current workfile
-;; Return a status of either 0 (i.e. no diff) or 1 (i.e. either non-empty
-;; diff or the diff is run asynchronously).
-;; - 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.
-;; - clear-headers ()
-;; * check-headers ()
-;; - dired-state-info (file)
+;;
+;; Insert the diff for FILE into the *vc-diff* buffer. 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 return a status of either 0
+;; (no differences found), or 1 (either non-empty diff or the diff is
+;; run asynchronously).
+;;
+;; - annotate-command (file buf rev)
+;;
+;; If this function is provided, it should produce an annotated version
+;; of FILE in BUF, relative to version REV. This is currently only
+;; implemented for CVS, using the `cvs annotate' command.
+;;
+;; - annotate-difference (point)
+;;
+;; Only required if `annotate-command' is defined for the backend.
+;; Return the difference between the age of the line at point and the
+;; current time. Return NIL if there is no more comparison to be made
+;; in the buffer. Return value as defined for `current-time'. 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.
+;;
+;; 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 behavior 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'.
+;;
+;; 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.
-;; * print-log (file)
-;; Insert the revision log of FILE into the current buffer.
-;; - show-log-entry (version)
-;; - update-changelog (files)
-;; Find changelog entries for FILES, or for all files at or below
-;; the default-directory if FILES is nil.
-;; * latest-on-branch-p (file)
-;; - cancel-version (file writable)
+;;
+;; 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.
+;;
+;; - 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.
+;;
;; - rename-file (old new)
-;; - annotate-command (file buf)
-;; - annotate-difference (pos)
-;; Only required if `annotate-command' is defined for the backend.
+;;
+;; Rename file OLD to NEW, both in the working area and in the
+;; repository. If this function is not provided, the command
+;; `vc-rename-file' will signal an error.
+
+;;; 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}
"*Switches passed to `ls' for vc-dired. MUST contain the `l' option."
:type 'string
:group 'vc
- :version "21.0")
+ :version "21.1")
(defcustom vc-dired-recurse t
"*If non-nil, show directory trees recursively in VC Dired."
(defvar diff-switches "-c"
"*A string or list of strings specifying switches to be passed to diff.")
+(defcustom vc-diff-switches nil
+ "*A string or list of strings specifying switches for diff under VC.
+There is also an option vc-BACKEND-diff-switches for each BACKEND that
+VC can handle."
+ :type '(choice (const :tag "None" nil)
+ (string :tag "Argument String")
+ (repeat :tag "Argument List"
+ :value ("")
+ string))
+ :group 'vc
+ :version "21.1")
+
;;;###autoload
(defcustom vc-checkin-hook nil
"*Normal hook (list of functions) run after a checkin is done.
:group 'vc)
;; Default is to be extra careful for super-user.
-;; TODO: This variable is no longer used; the corresponding checks
-;; are always done now. If that turns out to be fast enough,
+;; TODO: This variable is no longer used; the corresponding checks
+;; are always done now. If that turns out to be fast enough,
;; the variable can be obsoleted.
(defcustom vc-checkout-carefully (= (user-uid) 0)
"*Non-nil means be extra-careful in checkout.
(defvar vc-prefix-map
(let ((map (make-sparse-keymap)))
(define-key map "a" 'vc-update-change-log)
+ (define-key map "b" 'vc-switch-backend)
(define-key map "c" 'vc-cancel-version)
(define-key map "d" 'vc-directory)
(define-key map "g" 'vc-annotate)
(setq vc-comment-ring (make-ring vc-maximum-comment-ring-size)))
(defmacro with-vc-properties (file form settings)
- "Execute FORM, then set per-file properties for FILE, but only those
-that have not been set during the execution of FORM. SETTINGS is a list
-of two-element lists, each of which has the form (PROPERTY VALUE)."
+ "Execute FORM, then set per-file properties for FILE,
+but only those that have not been set during the execution of FORM.
+SETTINGS is a list of two-element lists, each of which has the
+ form (PROPERTY . VALUE)."
`(let ((vc-touched-properties (list t))
(filename ,file))
,form
(mapcar (lambda (setting)
- (let ((property (nth 0 setting))
- (value (nth 1 setting)))
+ (let ((property (car setting)))
(unless (memq property vc-touched-properties)
- (put (intern filename vc-file-prop-obarray)
- property value))))
+ (put (intern filename vc-file-prop-obarray)
+ property (cdr setting)))))
,settings)))
;; Random helper functions
(defsubst vc-editable-p (file)
(or (eq (vc-checkout-model file) 'implicit)
- (eq (vc-state file) 'edited)
- (eq (vc-state file) 'needs-merge)))
+ (memq (vc-state file) '(edited needs-merge))))
;;; Two macros for elisp programming
;;;###autoload
`save-excursion'. If FILE is not under version control, or locked by
somebody else, signal error."
`(let ((file (expand-file-name ,file)))
- (or (vc-registered file)
+ (or (vc-backend file)
(error (format "File not under version control: `%s'" file)))
(unless (vc-editable-p file)
(let ((state (vc-state file)))
(save-excursion
,@body)
(vc-checkin file nil ,comment)))
+(put 'with-vc-file 'indent-function 1)
;;;###autoload
(defmacro edit-vc-file (file comment &rest body)
However, before executing BODY, find FILE, and after BODY, save buffer."
`(with-vc-file
,file ,comment
- (find-file ,file)
+ (set-buffer (find-file-noselect ,file))
,@body
(save-buffer)))
+(put 'edit-vc-file 'indent-function 1)
(defun vc-ensure-vc-buffer ()
"Make sure that the current buffer visits a version-controlled file."
`(lambda (p s)
(with-current-buffer ',(current-buffer)
(goto-char (process-mark p))
- ,@(append (cdr (cdr (cdr ;strip off `with-current-buffer buf
+ ,@(append (cdr (cdr (cdr ;strip off `with-current-buffer buf
; (goto-char...)'
(car (cdr (cdr ;strip off `lambda (p s)'
sentinel))))))
(defun vc-do-command (buffer okstatus command file &rest flags)
"Execute a version control command, notifying user and checking for errors.
-Output from COMMAND goes to BUFFER, or *vc* if BUFFER is nil or the current
-buffer (which is assumed to be properly setup) if BUFFER is t. 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,
+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 (eq buffer t) (vc-setup-buffer buffer))
+ (unless (or (eq buffer t)
+ (and (stringp buffer)
+ (string= (buffer-name) buffer))
+ (eq buffer (current-buffer)))
+ (vc-setup-buffer buffer))
(let ((squeezed nil)
(inhibit-read-only t)
(status 0))
(if (eq okstatus 'async)
(let ((proc (apply 'start-process command (current-buffer) command
squeezed)))
- (message "Running %s in the background..." command)
+ (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
- `(message "Running %s in the background... done" ',command)))
+ `(unless (active-minibuffer-window)
+ (message "Running %s in the background... done" ',command))))
(setq status (apply 'call-process command nil t nil squeezed))
(when (or (not (integerp status)) (and okstatus (< okstatus status)))
(pop-to-buffer (current-buffer))
(let ((unchanged (vc-call workfile-unchanged-p file)))
(vc-file-setprop file 'vc-checkout-time (if unchanged lastmod 0))
unchanged))))
-
-(defun vc-default-workfile-unchanged-p (file)
+
+(defun vc-default-workfile-unchanged-p (backend file)
"Default check whether FILE is unchanged: diff against master version."
(zerop (vc-call diff file (vc-workfile-version file))))
+(defun vc-default-latest-on-branch-p (backend file)
+ "Default check whether the current workfile version of FILE is the
+latest on its branch."
+ t)
+
(defun vc-recompute-state (file)
"Force a recomputation of the version control state of FILE.
The state is computed using the exact, and possibly expensive
;; will check whether the file on disk is newer.
(if vc-dired-mode
(find-file-other-window file)
- (find-file file))
+ (set-buffer (find-file-noselect file)))
(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))
(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
(cond
(verbose
;; go to a different version
- (setq version (read-string "Branch or version to move to: "))
- (vc-checkout file (eq (vc-checkout-model file) 'implicit) 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)
+ ((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
+ (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))
(if (yes-or-no-p "Revert to master version? ")
(vc-revert-buffer)))
(t ;; normal action
- (if verbose (setq version (read-string "New version: ")))
- (vc-checkin file version comment))))
-
+ (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
(if verbose (read-string "Version to steal: ")
(vc-workfile-version file))
state))
-
+
;; needs-patch
((eq state 'needs-patch)
- (if (yes-or-no-p (format
+ (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) "")
(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
+ (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))
- (insert-string (format "Changes to %s since last lock:\n\n"
- file))
+ (let ((inhibit-read-only t))
+ (insert-string
+ (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? ")))
(if (not (vc-up-to-date-p f)) "@" ""))
files ""))
(vc-next-action-dired nil nil "dummy")
- (vc-start-entry nil nil nil
+ (vc-start-entry nil nil nil nil
"Enter a change comment for the marked files."
'vc-next-action-dired))
(throw 'nogo nil)))
;;;###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
+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
+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
(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 "Initial version level for %s: "
- (buffer-name))
+ (read-string (format "Initial version level for %s: "
+ (buffer-name)))
;; TODO: Use backend-specific 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)))
+ (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
(setq backup-inhibited t)))
(message "Registering %s... done" file))))
+
(defun vc-responsible-backend (file &optional register)
- "Return the name of the backend system that is responsible for FILE.
-If no backend in variable `vc-handled-backends' declares itself
-responsible, the first backend in that list will be returned (if optional
-arg REGISTER is non-nil, return the first backend that could register the
-file).
-FILE can also be a directory name (ending with a slash)."
- (if (null vc-handled-backends)
- (error "Cannot register, no backends in `vc-handled-backends'"))
- (or (and (not (file-directory-p file)) (vc-backend file))
+ "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
- (mapcar (lambda (backend)
- (if (vc-call-backend backend 'responsible-p file)
- (throw 'found backend)))
- vc-handled-backends)
- (if register
- (mapcar (lambda (backend)
- (if (vc-call-backend backend 'could-register file)
- (throw 'found backend)))
- vc-handled-backends)
- (car vc-handled-backends)))))
+ ;; 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.
+ "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.
+ "Return non-nil if BACKEND could be used to register FILE.
The default implementation returns t for all files."
t)
(vc-resynch-window file keep noquery)))))
(vc-dired-resynch-file file))
-(defun vc-start-entry (file rev comment msg action &optional after-hook)
+(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; otherwise, do action immediately. 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 (if file (find-file-noselect file) (current-buffer))))
+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 comment
+ (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)
(setq vc-log-after-operation-hook after-hook))
(setq vc-log-operation action)
(setq vc-log-version rev)
- (if comment
- (progn
- (erase-buffer)
- (if (eq comment t)
- (vc-finish-logentry t)
- (insert comment)
- (vc-finish-logentry nil)))
- (message "%s Type C-c C-c when done" msg))))
+ (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."
+ (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
(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-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))
(defun vc-steal-lock (file rev owner)
(defun vc-finish-steal (file version)
;; This is called when the notification has been sent.
(message "Stealing lock on %s..." file)
- (with-vc-properties
+ (with-vc-properties
file
(vc-call steal-lock file version)
- `((vc-state edited)))
+ `((vc-state . edited)))
(vc-resynch-buffer file t t)
(message "Stealing lock on %s...done" file))
-(defun vc-checkin (file &optional rev comment)
- "Check in FILE.
+(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.
+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
- "Enter a change comment."
+ (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
+ (with-vc-properties
file
;; Change buffers to get local value of vc-checkin-switches.
(with-current-buffer (or (get-file-buffer file) (current-buffer))
- (vc-call checkin file rev comment))
- `((vc-state up-to-date)
- (vc-checkout-time ,(nth 5 (file-attributes file)))
- (vc-workfile-version nil)))
+ (let ((backup-file (vc-version-backup-file file)))
+ (vc-call checkin file rev comment)
+ (if backup-file (delete-file backup-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))
(delete-windows-on logbuf (selected-frame))
;; Kill buffer and delete any other dedicated windows/frames.
(kill-buffer logbuf))
- (t (pop-to-buffer "*VC-log*")
- (bury-buffer)
- (pop-to-buffer tmp-vc-parent-buffer))))
+ (logbuf (pop-to-buffer "*VC-log*")
+ (bury-buffer)
+ (pop-to-buffer tmp-vc-parent-buffer))))
;; Now make sure we see the expanded headers
- (if buffer-file-name
- (vc-resynch-buffer buffer-file-name vc-keep-workfiles t))
+ (if log-file
+ (vc-resynch-buffer log-file vc-keep-workfiles t))
(if vc-dired-mode
- (dired-move-to-filename))
+ (dired-move-to-filename))
(run-hooks after-hook 'vc-finish-logentry-hook)))
;; Code for access to the comment ring
(vc-previous-comment (- arg)))
(defun vc-comment-search-reverse (str &optional stride)
- "Searches backwards through comment history for substring match."
+ "Search backwards through comment history for substring match."
;; Why substring rather than regexp ? -sm
(interactive
(list (read-string "Comment substring: " nil nil vc-last-comment-match)))
(vc-previous-comment 0)))
(defun vc-comment-search-forward (str)
- "Searches forwards through comment history for substring match."
+ "Search forwards through comment history for substring match."
(interactive
(list (read-string "Comment substring: " nil nil vc-last-comment-match)))
(vc-comment-search-reverse str -1))
rel2-default ") ")
"Newer version (default: current source): ")
nil nil rel2-default))))
- (if (string-equal rel1 "") (setq rel1 nil))
- (if (string-equal rel2 "") (setq rel2 nil))
- (vc-setup-buffer "*vc-diff*")
(if (file-directory-p file)
- (let ((inhibit-read-only t))
- (insert "Diffs between "
- (or rel1 "last version checked in")
- " and "
- (or rel2 "current workfile(s)")
- ":\n\n")
+ ;; recursive directory diff
+ (progn
+ (vc-setup-buffer "*vc-diff*")
+ (if (string-equal rel1 "") (setq rel1 nil))
+ (if (string-equal rel2 "") (setq rel2 nil))
+ (let ((inhibit-read-only t))
+ (insert "Diffs between "
+ (or rel1 "last version checked in")
+ " and "
+ (or rel2 "current workfile(s)")
+ ":\n\n"))
(setq default-directory (file-name-as-directory file))
;; FIXME: this should do a single exec in CVS.
(vc-file-tree-walk
(vc-call-backend ',(vc-backend file) 'diff ',f ',rel1 ',rel2)))))
(vc-exec-after `(let ((inhibit-read-only t))
(insert "\nEnd of diffs.\n"))))
-
- (cd (file-name-directory file))
- (vc-call diff file rel1 rel2))
+ ;; single file diff
+ (if (or (not rel1) (string-equal rel1 ""))
+ (setq rel1 (vc-workfile-version file)))
+ (if (string-equal rel2 "")
+ (setq rel2 nil))
+ (let ((file-rel1 (vc-version-backup-file file rel1))
+ (file-rel2 (if (not rel2)
+ file
+ (vc-version-backup-file file rel2))))
+ (if (and file-rel1 file-rel2)
+ (apply 'vc-do-command "*vc-diff*" 1 "diff" nil
+ (append (if (listp diff-switches)
+ diff-switches
+ (list diff-switches))
+ (if (listp vc-diff-switches)
+ vc-diff-switches
+ (list vc-diff-switches))
+ (list (file-relative-name file-rel1)
+ (file-relative-name file-rel2))))
+ (vc-call diff file rel1 rel2))))
+ (set-buffer "*vc-diff*")
(if (and (zerop (buffer-size))
(not (get-buffer-process (current-buffer))))
(progn
;; 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 '(progn (goto-char (point-min))
- (shrink-window-if-larger-than-buffer)))
+ (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))
+(defmacro vc-diff-switches-list (backend)
+ "Make a list of `diff-switches', `vc-diff-switches',
+and `vc-BACKEND-diff-switches'."
+ `(append
+ (if (listp diff-switches) diff-switches (list diff-switches))
+ (if (listp vc-diff-switches) vc-diff-switches (list vc-diff-switches))
+ (let ((backend-switches
+ (eval (intern (concat "vc-" (symbol-name ',backend)
+ "-diff-switches")))))
+ (if (listp backend-switches) backend-switches (list backend-switches)))))
+
;;;###autoload
(defun vc-version-other-window (rev)
"Visit version REV of the current buffer in another window.
If `F.~REV~' already exists, it is used instead of being re-created."
(interactive "sVersion to visit (default is workfile version): ")
(vc-ensure-vc-buffer)
- (let* ((version (if (string-equal rev "")
- (vc-workfile-version buffer-file-name)
+ (let* ((file buffer-file-name)
+ (version (if (string-equal rev "")
+ (vc-workfile-version file)
rev))
- (filename (concat buffer-file-name ".~" version "~")))
- (or (file-exists-p filename)
- (vc-call checkout buffer-file-name nil version filename))
- (find-file-other-window filename)))
+ (automatic-backup (vc-version-backup-file-name file version))
+ (manual-backup (vc-version-backup-file-name file version 'manual)))
+ (unless (file-exists-p manual-backup)
+ (if (file-exists-p automatic-backup)
+ (rename-file automatic-backup manual-backup nil)
+ (vc-call checkout file nil version manual-backup)))
+ (find-file-other-window manual-backup)))
;; Header-insertion code
(visited (find-buffer-visiting filename))
(backend (vc-backend filename)))
(when (vc-find-backend-function backend 'clear-headers)
- (if visited
+ (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
(save-excursion
(vc-call-backend backend 'clear-headers))
(vc-restore-buffer-context context))
- (find-file filename)
+ (set-buffer (find-file-noselect filename))
(vc-call-backend backend 'clear-headers)
(kill-buffer filename)))))
"File must be checked out for merging. Check out now? ")
(vc-checkout file t)
(error "Merge aborted"))))
- (setq first-version
+ (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))
(error "Sorry, merging is not implemented for %s" backend)
(if (not (vc-branch-p first-version))
- (setq second-version
- (read-string "Second 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.
(make-local-variable 'vc-ediff-result)
(setq vc-ediff-result result-buffer)
(make-local-variable 'ediff-quit-hook)
- (setq ediff-quit-hook
+ (setq ediff-quit-hook
(lambda ()
(let ((buffer-A ediff-buffer-A)
(buffer-B ediff-buffer-B)
;;;###autoload
(defun vc-create-snapshot (dir name branchp)
- "Descending recursively from DIR, make a snapshot called NAME.
+ "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
(message "Making %s... done" (if branchp "branch" "snapshot")))
(defun vc-default-create-snapshot (backend dir name branchp)
- (when branchp
+ (when branchp
(error "VC backend %s does not support module branches" backend))
(let ((result (vc-snapshot-precondition dir)))
(if (stringp result)
(setq update (and (eq result 'visited) update))
(vc-file-tree-walk
dir
- (lambda (f) (and
- (vc-error-occurred
- (vc-call checkout f nil name)
- (if update (vc-resynch-buffer f t t))))))))))
+ (lambda (f) (vc-error-occurred
+ (vc-call checkout f nil name)
+ (if update (vc-resynch-buffer f t t)))))))))
;; Miscellaneous other entry points
(interactive)
(vc-ensure-vc-buffer)
(let ((file buffer-file-name))
- (vc-setup-buffer nil)
- (setq default-directory (file-name-directory file))
(vc-call print-log file)
+ (set-buffer "*vc*")
(pop-to-buffer (current-buffer))
(if (fboundp 'log-view-mode) (log-view-mode))
(vc-exec-after
(if (fboundp 'log-view-goto-rev)
(log-view-goto-rev ',(vc-workfile-version file))
(if (vc-find-backend-function ',(vc-backend file) 'show-log-entry)
- (vc-call-backend ',(vc-backend file)
- 'show-log-entry
+ (vc-call-backend ',(vc-backend file)
+ 'show-log-entry
',(vc-workfile-version file))))))))
+(defun vc-default-comment-history (backend file)
+ "Return a string with all log entries that were made under BACKEND for FILE."
+ (if (vc-find-backend-function backend 'print-log)
+ (with-temp-buffer
+ (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 back to the version it was based on.
This asks for confirmation if the buffer contents are not identical
-to that version. Note that for RCS and CVS, this function does not
-automatically pick up newer changes found in the master file;
-use \\[universal-argument] \\[vc-next-action] to do so."
+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)
(let ((file buffer-file-name)
;; This operation should always ask for confirmation.
(vc-suppress-confirm nil)
- (obuf (current-buffer)))
+ (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)
- (vc-diff nil t)
- (vc-exec-after `(message nil))
- (unwind-protect
- (if (not (yes-or-no-p "Discard changes? "))
- (error "Revert canceled"))
- (if (or (window-dedicated-p (selected-window))
- (one-window-p t 'selected-frame))
- (make-frame-invisible (selected-frame))
- (delete-window))))
+ ;; 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 ((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)
- (with-vc-properties
- file
- (vc-call revert file)
- `((vc-state up-to-date)
- (vc-checkout-time (nth 5 (file-attributes file)))))
- (vc-resynch-buffer file t t)
+ (vc-revert-file file)
(message "Reverting %s...done" file)))
+(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)))
+ (if (not backup-file)
+ (vc-call revert file)
+ (copy-file backup-file file 'ok-if-already-exists 'keep-date)
+ (vc-delete-automatic-version-backups 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.
(with-vc-properties
file
(vc-call cancel-version file norevert)
- `((vc-state ,(if norevert 'edited 'up-to-date))
- (vc-checkout-time ,(if norevert
- 0
+ `((vc-state . ,(if norevert 'edited 'up-to-date))
+ (vc-checkout-time . ,(if norevert
+ 0
(nth 5 (file-attributes file))))
- (vc-workfile-version nil)))
+ (vc-workfile-version . nil)))
(message "Removing last change from %s...done" file)
(cond
(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-name 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)
+ ;; 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)
+ (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)))
(defun vc-rename-file (old new)
"Rename file OLD to NEW, and rename its master file likewise."
(interactive "fVC rename file: \nFRename to: ")
- ;; There are several ways of renaming files under CVS 1.3, but they all
- ;; have serious disadvantages. See the FAQ (available from think.com in
- ;; pub/cvs/). I'd rather send the user an error, than do something he might
- ;; consider to be wrong. When the famous, long-awaited rename database is
- ;; implemented things might change for the better. This is unlikely to occur
- ;; until CVS 2.0 is released. --ceder 1994-01-23 21:27:51
(let ((oldbuf (get-file-buffer old))
(backend (vc-backend old)))
(unless (or (null backend) (vc-find-backend-function backend 'rename-file))
(unwind-protect
(progn
(setq default-directory odefault)
- (if (eq 0 (apply 'call-process
- (expand-file-name "rcs2log"
- exec-directory)
+ (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)
(interactive "e")
(message "Redisplaying annotation...")
(vc-annotate-display (current-buffer)
- nil
+ nil
(vc-annotate-get-backend (current-buffer)))
(message "Redisplaying annotation...done"))
;;;; the contents in BUFFER.
;;;###autoload
-(defun vc-annotate (ratio)
+(defun vc-annotate (prefix)
"Display the result of the \"Annotate\" command using colors.
\"Annotate\" is defined by `vc-BACKEND-annotate-command'. New lines
-are displayed in red, old in blue. A prefix argument specifies a
-factor for stretching the time scale.
+are displayed in red, old in blue. When given a prefix argument, asks
+for a version to annotate from, and a factor for stretching the time
+scale.
`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")
+ (interactive "P")
(vc-ensure-vc-buffer)
- (message "Annotating...")
(let ((temp-buffer-name (concat "*Annotate " (buffer-name) "*"))
- (temp-buffer-show-function 'vc-annotate-display)
- (vc-annotate-ratio ratio)
- (vc-annotate-backend (vc-backend (buffer-file-name))))
+ (temp-buffer-show-function 'vc-annotate-display)
+ (vc-annotate-version
+ (if prefix (read-string
+ (format "Annotate from version: (default %s) "
+ (vc-workfile-version (buffer-file-name)))
+ nil nil (vc-workfile-version (buffer-file-name)))))
+ (vc-annotate-ratio
+ (if prefix (string-to-number
+ (read-string "Annotate ratio: (default 1.0) "
+ nil nil "1.0"))))
+ (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
+ (with-output-to-temp-buffer temp-buffer-name
(vc-call-backend vc-annotate-backend 'annotate-command
(file-name-nondirectory (buffer-file-name))
- (get-buffer temp-buffer-name)))
+ (get-buffer temp-buffer-name)
+ vc-annotate-version))
;; Don't use the temp-buffer-name until the buffer is created
;; (only after `with-output-to-temp-buffer'.)
- (setq vc-annotate-buffers
+ (setq vc-annotate-buffers
(append vc-annotate-buffers
(list (cons (get-buffer temp-buffer-name) vc-annotate-backend)))))
(message "Annotating... done"))
(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.
+ "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
tmp-cons)) ; Return the appropriate value
-;;;; (defun vc-BACKEND-annotate-difference (point) ...)
-;;;;
-;;;; Return the difference between the age of the line at point and
-;;;; the current time. Return NIL if there is no more comparison to
-;;;; be made in the buffer. Return value as defined for
-;;;; `current-time'. 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.
-
(defun vc-annotate-display (buffer &optional color-map backend)
"Do the VC-Annotate display in BUFFER using COLOR-MAP.
The original annotating file is supposed to be handled by BACKEND.
(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
`vc-keep-workfiles' Non-nil value prevents workfiles from being
deleted when changes are checked in
- `vc-suppress-confirm' Suppresses some confirmation prompts,
- notably for reversions.
+ `vc-suppress-confirm' Suppresses some confirmation prompts.
vc-BACKEND-header Which keywords to insert when adding headers
with \\[vc-insert-headers]. Defaults to
HCoop / bpt / emacs.git / blobdiff