;; Maintainer: Andre Spiegel <spiegel@gnu.org>
;; 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)
+;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;;; Credits:
;; VC was initially designed and implemented by Eric S. Raymond
-;; <esr@snark.thyrsus.com>. Over the years, many people have
+;; <esr@thyrsus.com> in 1992. Over the years, many other people have
;; contributed substantial amounts of work to VC. These include:
+;;
;; Per Cederqvist <ceder@lysator.liu.se>
;; Paul Eggert <eggert@twinsun.com>
;; Sebastian Kremer <sk@thp.uni-koeln.de>
;; Andre Spiegel <spiegel@gnu.org>
;; Richard Stallman <rms@gnu.org>
;; Thien-Thi Nguyen <ttn@gnu.org>
+;;
+;; In July 2007 ESR returned and redesigned the mode to cope better
+;; with modern version-control systems that do commits by fileset
+;; rather than per individual file.
+;;
+;; Features in the new version:
+;; * Key commands (vc-next-action = C-x v v, vc-print-log = C-x v l, vc-revert
+;; = C-x v u, vc-rollback = C-x v c, vc-diff = C-x v =, vc-update = C-x v +)
+;; now operate on filesets rather than individual files.
+;; * The fileset for a command is either (a) all marked files in VC-dired
+;; mode, (b) the currently visited file if it's under version control,
+;; or (c) the current directory if the visited buffer is not under
+;; version control and a wildcarding-enable flag has been set.
+;;
+;; If you maintain a client of the mode or customize it in your .emacs,
+;; note that some backend functions which formerly took single file arguments
+;; now take a list of files. These include: register, checkin, print-log,
+;; rollback, and diff.
;;; 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).
+;; Supported version-control systems presently include CVS, RCS, GNU
+;; Arch, Subversion, Bzr, Mercurial, 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
;; 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
+;; `vc-sys-workfile-version' should compute the focus 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
;; with `vc-sys-'. Some of the functions are mandatory (marked with a
;; `*'), others are optional (`-').
;;
+;; BACKEND PROPERTIES
+;;
+;; * revision-granularity
+;;
+;; Takes no arguments. Returns either 'file or 'repository. Backends
+;; that return 'file have per-file revision numbering; backends
+;; that return 'repository have per-repository revision numbering,
+;; so a revision level implicitly identifies a changeset
+;;
;; STATE-QUERYING FUNCTIONS
;;
;; * registered (file)
;;
-;; Return non-nil if FILE is registered in this backend.
+;; Return non-nil if FILE is registered in this backend. Both this
+;; function as well as `state' should be careful to fail gracefully
+;; in the event that the backend executable is absent. It is
+;; preferable that this function's body is autoloaded, that way only
+;; calling vc-registered does not cause the backend to be loaded
+;; (all the vc-FOO-registered functions are called to try to find
+;; the controlling backend for FILE.
;;
;; * state (file)
;;
;;
;; * workfile-version (file)
;;
-;; Return the current workfile version of FILE.
+;; Return the current focus version of FILE. This is the version fetched
+;; by the last checkout or upate, not necessarily the same thing as the
+;; head or tip version. Should return "0" for a file added but not yet
+;; committed.
;;
;; - 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.
+;; Return non-nil if the focus version of FILE is the latest version
+;; on its branch (many VCSes call this the 'tip' or 'head' version).
+;; The default implementation always returns t, which means that
+;; working with non-current versions is not supported by default.
;;
;; * checkout-model (file)
;;
;;
;; - 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
+;; Return non-nil if FILE is unchanged from the focus version. This
+;; function should do a brief comparison of FILE's contents with
+;; those of the repository 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'.)
+;; 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.
+;; If provided, this function should return the VC-specific mode
+;; line string for FILE. The returned string should have a
+;; `help-echo' property which is the text to be displayed as a
+;; tooltip when the mouse hovers over the VC entry on the mode-line.
+;; The default implementation deals well with all states that
+;; `vc-state' can return.
;;
;; - dired-state-info (file)
;;
;;
;; STATE-CHANGING FUNCTIONS
;;
-;; * register (file &optional rev comment)
+;; * create-repo (backend)
+;;
+;; Create an empty repository in the current directory and initialize
+;; it so VC mode can add files to it. For file-oriented systems, this
+;; need do no more than create a subdirectory with the right name.
;;
-;; Register FILE in this backend. Optionally, an initial revision REV
-;; and an initial description of the file, COMMENT, may be specified.
+;; * register (files &optional rev comment)
+;;
+;; Register FILES in this backend. Optionally, an initial revision REV
+;; and an initial description of the file, COMMENT, may be specified,
+;; but it is not guaranteed that the backend will do anything with this.
;; The implementation should pass the value of vc-register-switches
-;; to the backend command.
+;; to the backend command. (Note: in older versions of VC, this
+;; command took a single file argument and not a list.)
;;
;; - init-version (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)
+;; * checkin (files 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.
+;; Commit changes in FILES to this backend. If REV is non-nil, that
+;; should become the new revision number (not all backends do
+;; anything with it). COMMENT is used as a check-in comment. The
+;; implementation should pass the value of vc-checkin-switches to
+;; the backend command. (Note: in older versions of VC, this
+;; command took a single file argument and not a list.)
;;
;; * find-version (file rev buffer)
;;
;; 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).
+;; is the revision to check out (default is the focus 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
;;
;; * revert (file &optional contents-done)
;;
-;; Revert FILE back to the current workfile version. If optional
+;; Revert FILE back to the current focus 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)
+;; - rollback (files)
;;
-;; 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.
+;; Remove the tip version of each of FILES from the repository. If
+;; this function is not provided, trying to cancel a version is
+;; caught as an error. (Most backends don't provide it.) (Also
+;; note that older versions of this backend command were called
+;; 'cancel-version' and took a single file arg, not a list of
+;; files.)
;;
;; - merge (file rev1 rev2)
;;
;;
;; - 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.
+;; Steal any lock on the focus 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)
+;; * print-log (files &optional buffer)
+;;
+;; Insert the revision log for FILES into BUFFER, or the *vc* buffer
+;; if BUFFER is nil. (Note: older versions of this function expected
+;; only a single file argument.)
+;;
+;; - log-view-mode ()
;;
-;; Insert the revision log of FILE into BUFFER, or the *vc* buffer
-;; if BUFFER is nil.
+;; Mode to use for the output of print-log. This defaults to
+;; `log-view-mode' and is expected to be changed (if at all) to a derived
+;; mode of `log-view-mode'.
;;
;; - show-log-entry (version)
;;
;;
;; - 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.
+;; Remove all non-comment information from the output of print-log.
;;
;; - logentry-check ()
;;
;;
;; - comment-history (file)
;;
-;; Return a string containing all log entries that were made for FILE.
+;; Return a string containing all log entries that were madoe 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
;;
;; 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).
+;; from REV1 to REV2. If REV1 is nil, use the focus version (as
+;; found in the repository) as the older version; if REV2 is nil,
+;; use the current working-copy 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).
+;;
+;; - revision-completion-table (file)
+;;
+;; Return a completion table for existing revisions of FILE.
+;; The default is to not use any completion table.
;;
;; - diff-tree (dir &optional rev1 rev2)
;;
;;
;; 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
+;; (vc-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.
;;
;;
;; 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.
+;;
+;; - extra-menu ()
+;;
+;; Return a menu keymap, the items in the keymap will appear at the
+;; end of the Version Control menu. The goal is to allow backends
+;; to specify extra menu items that appear in the VC menu. This way
+;; you can provide menu entries for functionality that is specific
+;; to your backend and which does not map to any of the VC generic
+;; concepts.
;;; Code:
:version "20.3")
(defcustom vc-dired-terse-display t
- "If non-nil, show only locked files in VC Dired."
+ "If non-nil, show only locked or locally modified files in VC Dired."
:type 'boolean
:group 'vc
:version "20.3")
-(defcustom vc-directory-exclusion-list '("SCCS" "RCS" "CVS" "MCVS" ".svn" "{arch}")
+(defcustom vc-directory-exclusion-list '("SCCS" "RCS" "CVS" "MCVS" ".svn"
+ ".git" ".hg" ".bzr" "{arch}")
"List of directory names to be ignored when walking directory trees."
:type '(repeat string)
:group 'vc)
:group 'vc)
(defcustom vc-allow-async-revert nil
- "Specifies whether the diff during \\[vc-revert-buffer] may be asynchronous.
+ "Specifies whether the diff during \\[vc-revert] 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)
;;;###autoload
(defcustom vc-checkin-hook nil
- "Normal hook (list of functions) run after a checkin is done.
+ "Normal hook (list of functions) run after commit or file checkin.
See also `log-edit-done-hook'."
:type 'hook
:options '(log-edit-comment-to-change-log)
;;;###autoload
(defcustom vc-before-checkin-hook nil
- "Normal hook (list of functions) run before a file is checked in.
+ "Normal hook (list of functions) run before a commit or a file checkin.
See `run-hooks'."
:type 'hook
:group 'vc)
(define-key m "L" 'vc-annotate-show-log-revision-at-line)
(define-key m "N" 'vc-annotate-next-version)
(define-key m "P" 'vc-annotate-prev-version)
- (define-key m "W" 'vc-annotate-workfile-version)
+ (define-key m "W" 'vc-annotate-focus-version)
m)
"Local keymap used for VC-Annotate mode.")
(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 ()
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
+`save-excursion'. If FILE is not under version control, or you are
+using a locking version-control system and the file is locked by
somebody else, signal error."
(declare (debug t) (indent 2))
(let ((filevar (make-symbol "file")))
,@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
- (set-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)))))
+;; Common command execution logic to be used by backends
(defun vc-process-filter (p s)
"An alternative output filter for async process P.
(inhibit-read-only t))
(erase-buffer))))
+(defvar vc-sentinel-movepoint) ;Dynamically scoped.
+
+(defun vc-process-sentinel (p s)
+ (let ((previous (process-get p 'vc-previous-sentinel)))
+ (if previous (funcall previous p s))
+ (with-current-buffer (process-buffer p)
+ (let (vc-sentinel-movepoint)
+ ;; Normally, we want async code such as sentinels to not move point.
+ (save-excursion
+ (goto-char (process-mark p))
+ (let ((cmds (process-get p 'vc-sentinel-commands)))
+ (process-put p 'vc-postprocess nil)
+ (dolist (cmd cmds)
+ ;; Each sentinel may move point and the next one should be run
+ ;; at that new point. We could get the same result by having
+ ;; each sentinel read&set process-mark, but since `cmd' needs
+ ;; to work both for async and sync processes, this would be
+ ;; difficult to achieve.
+ (vc-exec-after cmd))))
+ ;; But sometimes the sentinels really want to move point.
+ (if vc-sentinel-movepoint
+ (let ((win (get-buffer-window (current-buffer) 0)))
+ (if (not win)
+ (goto-char vc-sentinel-movepoint)
+ (with-selected-window win
+ (goto-char vc-sentinel-movepoint)))))))))
+
(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.
;; lost. Terminated processes get deleted automatically
;; anyway. -- cyd
((or (null proc) (eq (process-status proc) 'exit))
+ ;; Make sure we've read the process's output before going further.
+ (if proc (accept-process-output proc))
(eval 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))))))))
+ (let ((previous (process-sentinel proc)))
+ (unless (eq previous 'vc-process-sentinel)
+ (process-put proc 'vc-previous-sentinel previous))
+ (set-process-sentinel proc 'vc-process-sentinel))
+ (process-put proc 'vc-sentinel-commands
+ (cons code (process-get proc 'vc-sentinel-commands))))
(t (error "Unexpected process state"))))
nil)
and is passed 3 arguments: the COMMAND, the FILE and the FLAGS.")
(defvar w32-quote-process-args)
+
+(defun vc-delistify (filelist)
+ "Smash a FILELIST into a file list string suitable for info messages."
+ ;; FIXME what about file names with spaces?
+ (if (not filelist) "." (mapconcat 'identity filelist " ")))
+
;;;###autoload
-(defun vc-do-command (buffer okstatus command file &rest flags)
+(defun vc-do-command (buffer okstatus command file-or-list &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
considered successful if its exit status does not exceed OKSTATUS (if
OKSTATUS is nil, that means to ignore error status, if it is `async', that
means not to wait for termination of the subprocess; if it is t it means to
-ignore all execution errors). 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,
+ignore all execution errors). FILE-OR-LIST is the name of a working file;
+it may be a list of files or be nil (to execute commands that don't expect
+a file name or set of files). 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))))
- (let ((buffer-undo-list t))
- (setq status (apply 'process-file command nil t nil squeezed)))
- (when (and (not (eq t okstatus))
- (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)))
+ ;; 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.
+ (let* ((files
+ (mapcar (lambda (f) (file-relative-name (expand-file-name f)))
+ (if (listp file-or-list) file-or-list (list file-or-list))))
+ (full-command
+ (concat command " " (vc-delistify flags) " " (vc-delistify files))))
+ (if vc-command-messages
+ (message "Running %s..." full-command))
+ (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 files
+ (setq squeezed (nconc squeezed files)))
+ (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)
+ ;; Run asynchronously
+ (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..." full-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" ',full-command))))
+ (let ((buffer-undo-list t))
+ (setq status (apply 'process-file command nil t nil squeezed)))
+ (when (and (not (eq t okstatus))
+ (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)" full-command
+ (if (integerp status) (format "status %d" status) status))))
+ (if vc-command-messages
+ (message "Running %s...OK" full-command)))
+ (vc-exec-after
+ `(run-hook-with-args 'vc-post-command-functions
+ ',command ',file-or-list ',flags))
+ status))))
(defun vc-position-context (posn)
"Save a bit of the text around POSN in the current buffer.
;; ;; 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
+ ;; ;; if that buffer is a compilation output buffer
;; ;; that contains markers into the current buffer.
;; (save-current-buffer
;; (mapcar (lambda (buffer)
(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)
+(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-expand-dirs (file-or-dir-list)
+ "Expands directories in a file list specification.
+Only files already under version control are noticed."
+ ;; FIXME: Kill this function.
+ (let ((flattened '()))
+ (dolist (node file-or-dir-list)
+ (vc-file-tree-walk
+ node (lambda (f) (if (vc-backend f) (push f flattened)))))
+ (nreverse flattened)))
+
+(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
+ (set-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)))))
+
+;;; Support for the C-x v v command. This is where all the single-file-oriented
+;;; code from before the fileset rewrite lives.
+
+(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))))
+
+(defun vc-revert-buffer-internal (&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.
(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."
(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)
+(defvar vc-dired-window-configuration)
+
+;; 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
(defun vc-next-action-on-file (file verbose &optional comment)
"Do The Right Thing for a given FILE under version control.
;; 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)))
+ (vc-revert)))
(t ;; normal action
(if (not verbose)
(vc-checkin file nil comment)
(yes-or-no-p (concat "File has unlocked changes. "
"Claim lock retaining changes? ")))
(progn (vc-call steal-lock file)
- (clear-visited-file-modtime)
+ (clear-visited-file-modtime)
;; Must clear any headers here because they wouldn't
;; show that the file is locked now.
(vc-clear-headers file)
(if (not (yes-or-no-p
"Revert to checked-in version, instead? "))
(error "Checkout aborted")
- (vc-revert-buffer1 t t)
+ (vc-revert-buffer-internal 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."
nil t))
(dired-move-to-filename))
-;; Here's the major entry point.
+(defun vc-create-repo (backend)
+ "Create an empty repository in the current directory."
+ (interactive
+ (list
+ (intern
+ (upcase
+ (completing-read
+ "Create repository for: "
+ (mapcar (lambda (b) (list (downcase (symbol-name b)))) vc-handled-backends)
+ nil t)))))
+ (vc-call-backend backend 'create-repo))
;;;###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
-
-(defun vc-default-init-version (backend) vc-default-init-version)
-
-;;;###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.
+(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
(message "Registering %s... " file)
(let ((backend (vc-responsible-backend file t)))
(vc-file-clearprops file)
- (vc-call-backend backend 'register file rev comment)
+ (vc-call-backend backend 'register (list file) rev comment)
(vc-file-setprop file 'vc-backend backend)
(unless vc-make-backup-files
(make-local-variable 'backup-inhibited)
(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
(and (string= buffer-file-name file)
(if keep
(progn
- (vc-revert-buffer1 t noquery)
+ (vc-revert-buffer-internal 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.
;; 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-call checkin (list file) rev comment)
(vc-delete-automatic-version-backups file)))
`((vc-state . up-to-date)
(vc-checkout-time . ,(nth 5 (file-attributes file)))
(message "Checking in %s...done" file))
'vc-checkin-hook))
+;; Code for access to the comment ring
+
(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
(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
+
+(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 (list ',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))
+
+(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-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.
-;; Additional entry points for examining version histories
+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)
+ (let ((status
+ (if (eq vc-diff-knows-L 'no)
+ (apply 'vc-do-command "*vc-diff*" 1 "diff" nil
+ (append (vc-switches nil 'diff)
+ (list (file-relative-name file-rev1)
+ (file-relative-name file-rev2))))
+ (apply 'vc-do-command "*vc-diff*" 2 "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)))))))
+ (if (eq status 2)
+ (if (not vc-diff-knows-L)
+ (setq vc-diff-knows-L 'no
+ status (apply 'vc-do-command "*vc-diff*" 1 "diff" nil
+ (append
+ (vc-switches nil 'diff)
+ (list (file-relative-name file-rev1)
+ (file-relative-name file-rev2)))))
+ (error "diff failed"))
+ (if (not vc-diff-knows-L) (setq vc-diff-knows-L 'yes)))
+ status)
+ (vc-call diff (list file) rev1 rev2 "*vc-diff*"))))
;;;###autoload
(defun vc-diff (historic &optional not-urgent)
(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
+If REV1 is empty or nil it means to use the focus version;
+REV2 empty or nil means the working-copy 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))
+ (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)
+ (completion-table (vc-call revision-completion-table file)))
;; compute default versions based on the file state
(cond
;; if it's a directory, don't supply any version default
;; 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)))
+ (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))))
+ (let* ((rev1-prompt (if rev1-default
+ (concat "Older version (default "
+ rev1-default "): ")
+ "Older version: "))
+ (rev2-prompt (concat "Newer version (default "
+ (or rev2-default "current source") "): "))
+ (rev1 (if completion-table
+ (completing-read rev1-prompt completion-table
+ nil nil nil nil rev1-default)
+ (read-string rev1-prompt nil nil rev1-default)))
+ (rev2 (if completion-table
+ (completing-read rev2-prompt completion-table
+ nil nil nil nil rev2-default)
+ (read-string rev2-prompt nil nil rev2-default))))
+ (list file rev1 rev2))))
(if (file-directory-p file)
;; recursive directory diff
(progn
(insert "Diffs between "
(or rev1 "last version checked in")
" and "
- (or rev2 "current workfile(s)")
+ (or rev2 "working copy")
":\n\n"))
(let ((dir (file-name-as-directory file)))
(vc-call-backend (vc-responsible-backend dir)
(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)
- (let ((status
- (if (eq vc-diff-knows-L 'no)
- (apply 'vc-do-command "*vc-diff*" 1 "diff" nil
- (append (vc-switches nil 'diff)
- (list (file-relative-name file-rev1)
- (file-relative-name file-rev2))))
- (apply 'vc-do-command "*vc-diff*" 2 "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)))))))
- (if (eq status 2)
- (if (not vc-diff-knows-L)
- (setq vc-diff-knows-L 'no
- status (apply 'vc-do-command "*vc-diff*" 1 "diff" nil
- (append
- (vc-switches nil 'diff)
- (list (file-relative-name file-rev1)
- (file-relative-name file-rev2)))))
- (error "diff failed"))
- (if (not vc-diff-knows-L) (setq vc-diff-knows-L 'yes)))
- status)
- (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): ")
+ (interactive
+ (save-current-buffer
+ (vc-ensure-vc-buffer)
+ (let ((completion-table
+ (vc-call revision-completion-table buffer-file-name))
+ (prompt "Version to visit (default is focus version): "))
+ (list
+ (if completion-table
+ (completing-read prompt completion-table)
+ (read-string prompt))))))
(vc-ensure-vc-buffer)
(let* ((file buffer-file-name)
(version (if (string-equal rev "")
(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
(state (vc-state file))
first-version second-version status)
(cond
- ((stringp state)
+ ((stringp state) ;; Locking VCses only
(error "File is locked by %s" state))
((not (vc-editable-p file))
(if (y-or-n-p
(define-key vmap "t" 'vc-dired-toggle-terse-mode)
map))
-(define-derived-mode vc-dired-mode dired-mode "Dired under VC"
+(define-derived-mode vc-dired-mode dired-mode "Dired under "
"The major mode used in VC directory buffers.
It works like Dired, but lists only files under version control, with
(set (make-local-variable 'dired-actual-switches)
vc-dired-switches))
(set (make-local-variable 'vc-dired-terse-mode) vc-dired-terse-display)
+ (let ((backend-name (symbol-name (vc-responsible-backend
+ default-directory))))
+ (setq mode-name (concat mode-name backend-name))
+ ;; Add menu after `vc-dired-mode-map' has `dired-mode-map' as the parent.
+ (let ((vc-dire-menu-map (copy-keymap vc-menu-map)))
+ (define-key-after (lookup-key vc-dired-mode-map [menu-bar]) [vc]
+ (cons backend-name vc-dire-menu-map) 'subdir)))
(setq vc-dired-mode t))
(defun vc-dired-toggle-terse-mode ()
(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 file) ")"))
- ((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.
"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))
+ (let (subdir filename (inhibit-read-only t))
(goto-char (point-min))
(while (not (eobp))
(cond
;; 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)
+ ;; check `backend' can really handle `subdir'.
+ (if (and (vc-call-backend backend 'responsible-p subdir)
+ (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
(let (result)
;; Check whether dired is loaded.
(when (fboundp 'dired-buffers-for-dir)
- (mapcar (lambda (buffer)
+ (mapc (lambda (buffer)
(with-current-buffer buffer
(if vc-dired-mode
(setq result (append result (list buffer))))))
'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.
'retrieve-snapshot dir name update)
(message "%s" (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
;; buffer can be accessed by the command.
(condition-case err
(progn
- (vc-call print-log file "*vc-change-log*")
+ (vc-call print-log (list 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
(not (eq (caddr err) 2)))
(signal (car err) (cdr err))
;; for backward compatibility
- (vc-call print-log file)
+ (vc-call print-log (list file))
(set-buffer "*vc*"))))
(pop-to-buffer (current-buffer))
(vc-exec-after
`(let ((inhibit-read-only t))
- (log-view-mode)
+ (vc-call-backend ',(vc-backend file) 'log-view-mode)
(goto-char (point-max)) (forward-line -1)
(while (looking-at "=*\n")
(delete-char (- (match-end 0) (match-beginning 0)))
(vc-call-backend ',(vc-backend file)
'show-log-entry
',focus-rev)
+ (setq vc-sentinel-movepoint (point))
(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 ()
+(defun vc-revert ()
"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
(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-default-revert (backend file contents-done)
- (unless contents-done
- (let ((rev (vc-workfile-version file))
- (file-buffer (or (get-file-buffer file) (current-buffer))))
- (message "Checking out %s..." file)
- (let ((failed t)
- (backup-name (car (find-backup-file-name file))))
- (when backup-name
- (copy-file file backup-name 'ok-if-already-exists 'keep-date)
- (unless (file-writable-p file)
- (set-file-modes file (logior (file-modes file) 128))))
- (unwind-protect
- (let ((coding-system-for-read 'no-conversion)
- (coding-system-for-write 'no-conversion))
- (with-temp-file file
- (let ((outbuf (current-buffer)))
- ;; Change buffer to get local value of vc-checkout-switches.
- (with-current-buffer file-buffer
- (let ((default-directory (file-name-directory file)))
- (vc-call find-version file rev outbuf)))))
- (setq failed nil))
- (when backup-name
- (if failed
- (rename-file backup-name file 'ok-if-already-exists)
- (and (not vc-make-backup-files) (delete-file backup-name))))))
- (message "Checking out %s...done" 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)
+(defun vc-rollback (&optional 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")
(backend (vc-backend file))
(target (vc-workfile-version file)))
(cond
- ((not (vc-find-backend-function backend 'cancel-version))
+ ((not (vc-find-backend-function backend 'rollback))
(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"))))
+ (error "%s" (substitute-command-keys "File is not up to date; use \\[vc-revert] to discard changes"))))
(if (null (yes-or-no-p (format "Remove version %s from master? " target)))
(error "Aborted")
(setq norevert (or norevert (not
(message "Removing last change from %s..." file)
(with-vc-properties
file
- (vc-call cancel-version file norevert)
+ (vc-call rollback (list file))
`((vc-state . ,(if norevert 'edited 'up-to-date))
(vc-checkout-time . ,(if norevert
0
(vc-resynch-buffer file t t)))
(message "Version %s has been removed from the master" target))))
+;;;###autoload
+(define-obsolete-function-alias 'vc-revert-buffer 'vc-revert "23.1")
+
+;;;###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] 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 focus 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 repository 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-switch-backend (file backend)
"Make BACKEND the current version control system for FILE.
(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)))
;; 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."
(vc-call-backend (vc-responsible-backend default-directory)
'update-changelog args))
-(defun vc-default-update-changelog (backend files)
+;;; The default back end. Assumes RCS-like version numbering.
+
+(defun vc-default-revision-granularity ()
+ (error "Your backend will not work with this version of VC 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))))))
+
+(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-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-default-init-version (backend) vc-default-init-version)
+
+(defalias 'vc-cvs-update-changelog 'vc-update-changelog-rcs2log)
+(defalias 'vc-rcs-update-changelog 'vc-update-changelog-rcs2log)
+;; FIXME: This should probably be moved to vc-rcs.el and replaced in
+;; vc-cvs.el by code using cvs2cl.
+(defun vc-update-changelog-rcs2log (files)
"Default implementation of update-changelog.
Uses `rcs2log' which only works for RCS and CVS."
;; FIXME: We (c|sh)ould add support for cvs2cl
(mapcar
(lambda (f)
(file-relative-name
- (if (file-name-absolute-p f)
- f
- (concat odefault f))))
+ (expand-file-name f odefault)))
files)))
"done"
(pop-to-buffer (get-buffer-create "*vc*"))
(setq default-directory (file-name-directory changelog))
(delete-file tempfile)))))
-;; Annotate functionality
+(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))))
+
+(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 file) ")"))
+ ((eq state 'needs-merge) "(merge)")
+ ((eq state 'needs-patch) "(patch)")
+ ((eq state 'unlocked-changes) "(stale)"))))
+
+(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)))
+
+(defalias 'vc-default-logentry-check 'ignore)
+
+(defun vc-default-check-headers (backend)
+ "Default implementation of check-headers; always returns nil."
+ nil)
+
+(defun vc-default-log-view-mode (backend) (log-view-mode))
+
+(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 (list file))
+ (vc-call wash-log file)
+ (buffer-string))))
+
+(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-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))))))
+
+(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)))))))))
+
+(defun vc-default-revert (backend file contents-done)
+ (unless contents-done
+ (let ((rev (vc-workfile-version file))
+ (file-buffer (or (get-file-buffer file) (current-buffer))))
+ (message "Checking out %s..." file)
+ (let ((failed t)
+ (backup-name (car (find-backup-file-name file))))
+ (when backup-name
+ (copy-file file backup-name 'ok-if-already-exists 'keep-date)
+ (unless (file-writable-p file)
+ (set-file-modes file (logior (file-modes file) 128))))
+ (unwind-protect
+ (let ((coding-system-for-read 'no-conversion)
+ (coding-system-for-write 'no-conversion))
+ (with-temp-file file
+ (let ((outbuf (current-buffer)))
+ ;; Change buffer to get local value of vc-checkout-switches.
+ (with-current-buffer file-buffer
+ (let ((default-directory (file-name-directory file)))
+ (vc-call find-version file rev outbuf)))))
+ (setq failed nil))
+ (when backup-name
+ (if failed
+ (rename-file backup-name file 'ok-if-already-exists)
+ (and (not vc-make-backup-files) (delete-file backup-name))))))
+ (message "Checking out %s...done" file))))
+
+(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)))))
+
+(defun vc-default-revision-completion-table (backend file) nil)
+
+(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))
+
+;;; Annotate functionality
;; Declare globally instead of additional parameter to
;; temp-buffer-show-function (not possible to pass more than one
;; 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))))
+ (while (not (eobp))
+ (when (setq date (vc-call-backend vc-annotate-backend 'annotate-time))
+ (if (> date newest)
+ (setq newest date))
+ (if (< date oldest)
+ (setq oldest date)))
+ (forward-line 1)))
(vc-annotate-display
(/ (- (if full newest current) oldest)
(vc-annotate-oldest-in-map vc-annotate-color-map))
["Annotate next revision" vc-annotate-next-version]
["Annotate revision at line" vc-annotate-revision-at-line]
["Annotate revision previous to line" vc-annotate-revision-previous-to-line]
- ["Annotate latest revision" vc-annotate-workfile-version]
+ ["Annotate latest revision" vc-annotate-focus-version]
["Show log of revision at line" vc-annotate-show-log-revision-at-line]
["Show diff of revision at line" vc-annotate-show-diff-revision-at-line]))
(vc-annotate-display-default (or vc-annotate-ratio 1.0)))
;; One of the auto-scaling modes
((eq vc-annotate-display-mode 'scale)
- (vc-annotate-display-autoscale))
+ (vc-exec-after `(vc-annotate-display-autoscale)))
((eq vc-annotate-display-mode 'fullscale)
- (vc-annotate-display-autoscale t))
+ (vc-exec-after `(vc-annotate-display-autoscale t)))
((numberp vc-annotate-display-mode) ; A fixed number of days lookback
(vc-annotate-display-default
(/ vc-annotate-display-mode
(set (make-local-variable 'vc-annotate-parent-rev) rev)
(set (make-local-variable 'vc-annotate-parent-display-mode)
display-mode)))
- (when current-line
- (goto-line current-line temp-buffer-name))
- (message "Annotating... done")))
+
+ (with-current-buffer temp-buffer-name
+ (vc-exec-after
+ `(progn
+ ;; Ideally, we'd rather not move point if the user has already
+ ;; moved it elsewhere, but really point here is not the position
+ ;; of the user's cursor :-(
+ (when ,current-line ;(and (bobp))
+ (goto-line ,current-line)
+ (setq vc-sentinel-movepoint))
+ (unless (active-minibuffer-window)
+ (message "Annotating... done")))))))
(defun vc-annotate-prev-version (prefix)
"Visit the annotation of the version previous to this one.
(interactive "p")
(vc-annotate-warp-version prefix))
-(defun vc-annotate-workfile-version ()
- "Visit the annotation of the workfile version of this file."
+(defun vc-annotate-focus-version ()
+ "Visit the annotation of the focus version of this file."
(interactive)
(if (not (equal major-mode 'vc-annotate-mode))
(message "Cannot be invoked outside of a vc annotate buffer")
vc-annotate-parent-display-mode
buf)
(goto-line (min oldline (progn (goto-char (point-max))
- (previous-line)
+ (forward-line -1)
(line-number-at-pos))) buf)))))
(defun vc-annotate-compcar (threshold a-list)
(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-"
- (if (string-equal
- (substring (cdr color) 0 1) "#")
- (substring (cdr color) 1)
- (cdr color))))
- ;; 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))
-\f
-;; 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."
+ (while (< (point) limit)
+ (let ((difference (vc-annotate-difference vc-annotate-offset))
+ (start (point))
+ (end (progn (forward-line 1) (point))))
+ (when difference
+ (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-"
+ (if (string-equal
+ (substring (cdr color) 0 1) "#")
+ (substring (cdr color) 1)
+ (cdr color))))
+ ;; 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
+ (put-text-property start end 'face face)))))
+ ;; Pretend to font-lock there were no matches.
nil)
-
-;; Back-end-dependent stuff ends here.
+\f
;; Set up key bindings for use while editing log messages
(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)))))
+ (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)
HCoop / bpt / emacs.git / blobdiff