;;; vc.el --- drive a version-control system from within Emacs
;; Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 2000,
-;; 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008
+;; 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010
;; Free Software Foundation, Inc.
;; Author: FSF (see below for full credits)
;; Arch, Subversion, Bzr, Git, Mercurial, Monotone and SCCS
;; (or its free replacement, CSSC).
;;
-;; Some features will not work with old RCS versions. Where
-;; appropriate, VC finds out which version you have, and allows or
-;; disallows those features (stealing locks, for example, works only
-;; from 5.6.2 onwards).
-;; Even initial checkins will fail if your RCS version is so old that ci
-;; doesn't understand -t-; this has been known to happen to people running
-;; NExTSTEP 3.0.
-;;
-;; You can support the RCS -x option by customizing vc-rcs-master-templates.
-;;
-;; Proper function of the SCCS diff commands requires the shellscript vcdiff
-;; to be installed somewhere on Emacs's path for executables.
-;;
;; If your site uses the ChangeLog convention supported by Emacs, the
;; function `log-edit-comment-to-change-log' could prove a useful checkin hook,
;; although you might prefer to use C-c C-a (i.e. `log-edit-insert-changelog')
;; vc's back is turned, or move/rename master files while vc is running,
;; vc may get seriously confused. Don't do these things!
;;
-;; Developer's notes on some concurrency issues are included at the end of
-;; the file.
-;;
;; ADDING SUPPORT FOR OTHER BACKENDS
;;
;; VC can use arbitrary version control systems as a backend. To add
;; and then do a (funcall UPDATE-FUNCTION RESULT nil)
;; when all the results have been computed.
;; To provide more backend specific functionality for `vc-dir'
-;; the following functions might be needed: `status-extra-headers',
-;; `status-printer', `extra-status-menu' and `dir-status-files'.
+;; the following functions might be needed: `dir-extra-headers',
+;; `dir-printer', `extra-dir-menu' and `dir-status-files'.
;;
;; - dir-status-files (dir files default-state update-function)
;;
;; files. If not provided, the default is to consider that the files
;; are in DEFAULT-STATE.
;;
-;; - status-extra-headers (dir)
+;; - dir-extra-headers (dir)
;;
;; Return a string that will be added to the *vc-dir* buffer header.
;;
-;; - status-printer (fileinfo)
+;; - dir-printer (fileinfo)
;;
;; Pretty print the `vc-dir-fileinfo' FILEINFO.
;; If a backend needs to show more information than the default FILE
;; The default implementation deals well with all states that
;; `vc-state' can return.
;;
-;; - prettify-state-info (file)
-;;
-;; Translate the `vc-state' property of FILE into a string that can be
-;; used in a human-readable buffer. The default implementation deals well
-;; with all states that `vc-state' can return.
-;;
;; STATE-CHANGING FUNCTIONS
;;
;; * create-repo (backend)
;; 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.
+;; If FILE is in the `added' state it should be returned to the
+;; `unregistered' state.
;;
;; - rollback (files)
;;
;;
;; HISTORY FUNCTIONS
;;
-;; * print-log (files &optional buffer)
+;; * print-log (files buffer &optional shortlog start-revision limit)
;;
-;; 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.)
+;; Insert the revision log for FILES into BUFFER.
+;; If SHORTLOG is true insert a short version of the log.
+;; If LIMIT is true insert only insert LIMIT log entries. If the
+;; backend does not support limiting the number of entries to show
+;; it should return `limit-unsupported'.
+;; If START-REVISION is given, then show the log starting from the
+;; revision. At this point START-REVISION is only required to work
+;; in conjunction with LIMIT = 1.
;;
;; - log-view-mode ()
;;
;;
;; 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.
+;; retaining comment information.
;;
;; - update-changelog (files)
;;
;; Invoked from a buffer in vc-annotate-mode, return the revision
;; corresponding to the current line, or nil if there is no revision
;; corresponding to the current line.
+;; If the backend supports annotating through copies and renames,
+;; and displays a file name and a revision, then return a cons
+;; (REVISION . FILENAME).
;;
;; TAG SYSTEM
;;
;;
;; MISCELLANEOUS
;;
-;; - root (dir)
-;;
-;; Return DIR's "root" directory, that is, a parent directory of
-;; DIR for which the same backend as used for DIR applies. If no
-;; such parent exists, this function should return DIR.
-;;
;; - make-version-backups-p (file)
;;
;; Return non-nil if unmodified repository revisions of FILE should be
;; `revert' operations itself, without calling the backend system. The
;; default implementation always returns nil.
;;
+;; - root (file)
+;; Return the root of the VC controlled hierarchy for file.
+;;
;; - repository-hostname (dirname)
;;
;; Return the hostname that the backend will have to contact
;; 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
;; to your backend and which does not map to any of the VC generic
;; concepts.
;;
-;; - extra-status-menu ()
+;; - extra-dir-menu ()
;;
;; Return a menu keymap, the items in the keymap will appear at the
;; end of the VC Status menu. The goal is to allow backends to
;;; Todo:
+;; - Get rid of the "master file" terminology.
+
+;; - Add key-binding for vc-delete-file.
+
;;;; New Primitives:
;;
;; - deal with push/pull operations.
;; update/merge on a file basis, but on a whole repository basis.
;; vc-update and vc-merge assume the arguments are always files,
;; they don't deal with directories. Make sure the *vc-dir* buffer
-;; is updated after these operations.
+;; is updated after these operations.
;; At least bzr, git and hg should benefit from this.
;;
;;;; Improved branch and tag handling:
;; display the branch name in the mode-line. Replace
;; vc-cvs-sticky-tag with that.
;;
-;; - C-x v b does switch to a different backend, but the mode line is not
-;; adapted accordingly. Also, it considers RCS and CVS to be the same,
-;; which is pretty confusing.
-;;
;; - vc-create-tag and vc-retrieve-tag should update the
;; buffers that might be visiting the affected files.
;;
-;;;; Default Behavior:
-;;
-;; - do not default to RCS anymore when the current directory is not
-;; controlled by any VCS and the user does C-x v v
-;;
-;; - vc-responsible-backend should not return RCS if no backend
-;; declares itself responsible.
-;;
;;;; Internal cleanups:
;;
;; - backends that care about vc-stay-local should try to take it into
-;; account for vc-dir. Is this likely to be useful???
+;; account for vc-dir. Is this likely to be useful??? YES!
;;
;; - vc-expand-dirs should take a backend parameter and only look for
;; files managed by that backend.
;; the two branches. Or you locally add file FOO and then pull a
;; change that also adds a new file FOO, ...
;;
-;; - vc-diff should be able to show the diff for all files in a
-;; changeset, especially for VC systems that have per repository
-;; version numbers. log-view should take advantage of this.
-;;
;; - make it easier to write logs. Maybe C-x 4 a should add to the log
;; buffer, if one is present, instead of adding to the ChangeLog.
;;
;; vc-dir, it is possible that these commands are called
;; for unregistered/ignored files.
;;
-;; - Using multiple backends needs work. Given a CVS directory with some
-;; files checked into git (but not all), using C-x v l to get a log file
-;; from a file only present in git, and then typing RET on some log entry,
-;; vc will bombs out because it wants to see the file being in CVS.
-;; Those logs should likely use a local variable to hardware the VC they
-;; are supposed to work with.
+;; - vc-next-action needs work in order to work with multiple
+;; backends: `vc-state' returns the state for the default backend,
+;; not for the backend in the current *vc-dir* buffer.
+;;
+;; - vc-dir-kill-dir-status-process should not be specific to dir-status,
+;; it should work for other async commands done through vc-do-command
+;; as well,
+;;
+;; - vc-dir toolbar needs more icons.
+;;
+;; - The backends should avoid using `vc-file-setprop' and `vc-file-getprop'.
;;
-
;;; Code:
(require 'vc-hooks)
(require 'vc-dispatcher)
-(require 'tool-bar)
-(require 'ewoc)
(eval-when-compile
- (require 'cl))
+ (require 'cl)
+ (require 'dired))
(unless (assoc 'vc-parent-buffer minor-mode-alist)
(setq minor-mode-alist
(defcustom vc-diff-switches nil
"A string or list of strings specifying switches for diff under VC.
-When running diff under a given BACKEND, VC concatenates the values of
-`diff-switches', `vc-diff-switches', and `vc-BACKEND-diff-switches' to
-get the switches for that command. Thus, `vc-diff-switches' should
-contain switches that are specific to version control, but not
-specific to any particular backend."
- :type '(choice (const :tag "None" nil)
+When running diff under a given BACKEND, VC uses the first
+non-nil value of `vc-BACKEND-diff-switches', `vc-diff-switches',
+and `diff-switches', in that order. Since nil means to check the
+next variable in the sequence, either of the first two may use
+the value t to mean no switches at all. `vc-diff-switches'
+should contain switches that are specific to version control, but
+not specific to any particular backend."
+ :type '(choice (const :tag "Unspecified" nil)
+ (const :tag "None" t)
(string :tag "Argument String")
- (repeat :tag "Argument List"
- :value ("")
- string))
+ (repeat :tag "Argument List" :value ("") string))
:group 'vc
:version "21.1")
(defcustom vc-diff-knows-L nil
- "*Indicates whether diff understands the -L option.
+ "Indicates whether diff understands the -L option.
The value is either `yes', `no', or nil. If it is nil, VC tries
to use -L and sets this variable to remember whether it worked."
:type '(choice (const :tag "Work out" nil) (const yes) (const no))
:group 'vc)
+(defcustom vc-log-show-limit 2000
+ "Limit the number of items shown by the VC log commands.
+Zero means unlimited.
+Not all VC backends are able to support this feature."
+ :type 'integer
+ :group 'vc)
+
(defcustom vc-allow-async-revert nil
"Specifies whether the diff during \\[vc-revert] may be asynchronous.
Enabling this option means that you can confirm a revert operation even
:group 'vc
:version "21.1")
-(defcustom vc-annotate-display-mode 'fullscale
- "Which mode to color the output of \\[vc-annotate] with by default."
- :type '(choice (const :tag "By Color Map Range" nil)
- (const :tag "Scale to Oldest" scale)
- (const :tag "Scale Oldest->Newest" fullscale)
- (number :tag "Specify Fractional Number of Days"
- :value "20.5"))
- :group 'vc)
-
;;;###autoload
(defcustom vc-checkin-hook nil
"Normal hook (list of functions) run after commit or file checkin.
:type 'hook
:group 'vc)
-;; Annotate customization
-(defcustom vc-annotate-color-map
- (if (and (tty-display-color-p) (<= (display-color-cells) 8))
- ;; A custom sorted TTY colormap
- (let* ((colors
- (sort
- (delq nil
- (mapcar (lambda (x)
- (if (not (or
- (string-equal (car x) "white")
- (string-equal (car x) "black") ))
- (car x)))
- (tty-color-alist)))
- (lambda (a b)
- (cond
- ((or (string-equal a "red") (string-equal b "blue")) t)
- ((or (string-equal b "red") (string-equal a "blue")) nil)
- ((string-equal a "yellow") t)
- ((string-equal b "yellow") nil)
- ((string-equal a "cyan") t)
- ((string-equal b "cyan") nil)
- ((string-equal a "green") t)
- ((string-equal b "green") nil)
- ((string-equal a "magenta") t)
- ((string-equal b "magenta") nil)
- (t (string< a b))))))
- (date 20.)
- (delta (/ (- 360. date) (1- (length colors)))))
- (mapcar (lambda (x)
- (prog1
- (cons date x)
- (setq date (+ date delta)))) colors))
- ;; Normal colormap: hue stepped from 0-240deg, value=1., saturation=0.75
- '(( 20. . "#FF3F3F")
- ( 40. . "#FF6C3F")
- ( 60. . "#FF993F")
- ( 80. . "#FFC63F")
- (100. . "#FFF33F")
- (120. . "#DDFF3F")
- (140. . "#B0FF3F")
- (160. . "#83FF3F")
- (180. . "#56FF3F")
- (200. . "#3FFF56")
- (220. . "#3FFF83")
- (240. . "#3FFFB0")
- (260. . "#3FFFDD")
- (280. . "#3FF3FF")
- (300. . "#3FC6FF")
- (320. . "#3F99FF")
- (340. . "#3F6CFF")
- (360. . "#3F3FFF")))
- "Association list of age versus color, for \\[vc-annotate].
-Ages are given in units of fractional days. Default is eighteen
-steps using a twenty day increment, from red to blue. For TTY
-displays with 8 or fewer colors, the default is red to blue with
-all other colors between (excluding black and white)."
- :type 'alist
- :group 'vc)
-
-(defcustom vc-annotate-very-old-color "#3F3FFF"
- "Color for lines older than the current color range in \\[vc-annotate]]."
- :type 'string
- :group 'vc)
-
-(defcustom vc-annotate-background "black"
- "Background color for \\[vc-annotate].
-Default color is used if nil."
- :type '(choice (const :tag "Default background" nil) (color))
- :group 'vc)
-
-(defcustom vc-annotate-menu-elements '(2 0.5 0.1 0.01)
- "Menu elements for the mode-specific menu of VC-Annotate mode.
-List of factors, used to expand/compress the time scale. See `vc-annotate'."
- :type '(repeat number)
- :group 'vc)
-
-(defvar vc-annotate-mode-map
- (let ((m (make-sparse-keymap)))
- (define-key m "A" 'vc-annotate-revision-previous-to-line)
- (define-key m "D" 'vc-annotate-show-diff-revision-at-line)
- (define-key m "f" 'vc-annotate-find-revision-at-line)
- (define-key m "J" 'vc-annotate-revision-at-line)
- (define-key m "L" 'vc-annotate-show-log-revision-at-line)
- (define-key m "N" 'vc-annotate-next-revision)
- (define-key m "P" 'vc-annotate-prev-revision)
- (define-key m "W" 'vc-annotate-working-revision)
- (define-key m "V" 'vc-annotate-toggle-annotation-visibility)
- m)
- "Local keymap used for VC-Annotate mode.")
-
;; Header-insertion hair
(defcustom vc-static-header-alist
'(("\\.c\\'" .
"\n#ifndef lint\nstatic char vcid[] = \"\%s\";\n#endif /* lint */\n"))
- "*Associate static header string templates with file types.
+ "Associate static header string templates with file types.
A \%s in the template is replaced with the first string associated with
the file's version control type in `vc-header-alist'."
:type '(repeat (cons :format "%v"
(defcustom vc-comment-alist
'((nroff-mode ".\\\"" ""))
- "*Special comment delimiters for generating VC headers.
+ "Special comment delimiters for generating VC headers.
Add an entry in this list if you need to override the normal `comment-start'
and `comment-end' variables. This will only be necessary if the mode language
is sensitive to blank lines."
:group 'vc)
(defcustom vc-checkout-carefully (= (user-uid) 0)
- "*Non-nil means be extra-careful in checkout.
+ "Non-nil means be extra-careful in checkout.
Verify that the file really is not locked
and that its contents match what the master file says."
:type 'boolean
;;; Code for deducing what fileset and backend to assume
-(defun vc-responsible-backend (file &optional register)
+(defun vc-backend-for-registration (file)
+ "Return a backend that can be used for registering FILE.
+
+If no backend declares itself responsible for FILE, then FILE
+must not be in a version controlled directory, so try to create a
+repository, prompting for the directory and the VC backend to
+use."
+ (catch 'found
+ ;; First try: find a responsible backend, it must be a backend
+ ;; under which FILE is not yet registered.
+ (dolist (backend vc-handled-backends)
+ (and (not (vc-call-backend backend 'registered file))
+ (vc-call-backend backend 'responsible-p file)
+ (throw 'found backend)))
+ ;; no responsible backend
+ (let* ((possible-backends
+ (let (pos)
+ (dolist (crt vc-handled-backends)
+ (when (vc-find-backend-function crt 'create-repo)
+ (push crt pos)))
+ pos))
+ (bk
+ (intern
+ ;; Read the VC backend from the user, only
+ ;; complete with the backends that have the
+ ;; 'create-repo method.
+ (completing-read
+ (format "%s is not in a version controlled directory.\nUse VC backend: " file)
+ (mapcar 'symbol-name possible-backends) nil t)))
+ (repo-dir
+ (let ((def-dir (file-name-directory file)))
+ ;; read the directory where to create the
+ ;; repository, make sure it's a parent of
+ ;; file.
+ (read-file-name
+ (format "create %s repository in: " bk)
+ default-directory def-dir t nil
+ (lambda (arg)
+ (message "arg %s" arg)
+ (and (file-directory-p arg)
+ (vc-string-prefix-p (expand-file-name arg) def-dir)))))))
+ (let ((default-directory repo-dir))
+ (vc-call-backend bk 'create-repo))
+ (throw 'found bk))))
+
+(defun vc-responsible-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
+If FILE is already registered, return the
+backend of FILE. If FILE is not registered, 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."
- (when (not vc-handled-backends)
- (error "No handled backends"))
- (or (and (not (file-directory-p file)) (not register) (vc-backend file))
+responsible for FILE is returned."
+ (or (and (not (file-directory-p file)) (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")))))
+ (and (vc-call-backend backend 'responsible-p file)
+ (throw 'found backend))))
+ (error "No VC backend is responsible for %s" file)))
(defun vc-expand-dirs (file-or-dir-list)
"Expands directories in a file list specification.
Within directories, only files already under version control are noticed."
(let ((flattened '()))
(dolist (node file-or-dir-list)
- (if (file-directory-p node)
- (vc-file-tree-walk
- node (lambda (f) (when (vc-backend f) (push f flattened)))))
- (push node flattened))
+ (when (file-directory-p node)
+ (vc-file-tree-walk
+ node (lambda (f) (when (vc-backend f) (push f flattened)))))
+ (unless (file-directory-p node) (push node flattened)))
(nreverse flattened)))
-(defun vc-derived-from-dir-mode (&optional buffer)
- "Are we in a VC-directory buffer, or do we have one as an ancestor?"
- (let ((buffer (or buffer (current-buffer))))
- (cond ((derived-mode-p 'vc-dir-mode) t)
- (vc-parent-buffer (vc-derived-from-dir-mode vc-parent-buffer))
- (t nil))))
-
-(defun vc-deduce-fileset (&optional observer)
- "Deduce a set of files and a backend to which to apply an operation and
-the common state of the fileset. Return (BACKEND . FILESET)."
- (let* ((selection (vc-dispatcher-selection-set observer))
- (raw (car selection)) ;; Selection as user made it
- (cooked (cdr selection)) ;; Files only
- ;; FIXME: Store the backend in a buffer-local variable.
- (backend (if (vc-derived-from-dir-mode (current-buffer))
- (vc-responsible-backend default-directory)
- (assert (and (= 1 (length raw))
- (not (file-directory-p (car raw)))))
- (vc-backend (car cooked)))))
- (cons backend selection)))
+(defvar vc-dir-backend)
+
+(declare-function vc-dir-current-file "vc-dir" ())
+(declare-function vc-dir-deduce-fileset "vc-dir" (&optional state-model-only-files))
+
+(defun vc-deduce-fileset (&optional observer allow-unregistered
+ state-model-only-files)
+ "Deduce a set of files and a backend to which to apply an operation.
+
+Return (BACKEND FILESET FILESET-ONLY-FILES STATE CHECKOUT-MODEL).
+If we're in VC-dir mode, the fileset is the list of marked files.
+Otherwise, if we're looking at a buffer visiting a version-controlled file,
+the fileset is a singleton containing this file.
+If none of these conditions is met, but ALLOW_UNREGISTERED is on and the
+visited file is not registered, return a singleton fileset containing it.
+Otherwise, throw an error.
+
+STATE-MODEL-ONLY-FILES if non-nil, means that the caller needs
+the FILESET-ONLY-FILES STATE and MODEL info. Otherwise, that
+part may be skipped.
+BEWARE: this function may change the
+current buffer."
+ ;; FIXME: OBSERVER is unused. The name is not intuitive and is not
+ ;; documented. It's set to t when called from diff and print-log.
+ (let (backend)
+ (cond
+ ((derived-mode-p 'vc-dir-mode)
+ (vc-dir-deduce-fileset state-model-only-files))
+ ((derived-mode-p 'dired-mode)
+ (if observer
+ (vc-dired-deduce-fileset)
+ (error "State changing VC operations not supported in `dired-mode'")))
+ ((setq backend (vc-backend buffer-file-name))
+ (if state-model-only-files
+ (list backend (list buffer-file-name)
+ (list buffer-file-name)
+ (vc-state buffer-file-name)
+ (vc-checkout-model backend buffer-file-name))
+ (list backend (list buffer-file-name))))
+ ((and (buffer-live-p vc-parent-buffer)
+ ;; FIXME: Why this test? --Stef
+ (or (buffer-file-name vc-parent-buffer)
+ (with-current-buffer vc-parent-buffer
+ (derived-mode-p 'vc-dir-mode))))
+ (progn ;FIXME: Why not `with-current-buffer'? --Stef.
+ (set-buffer vc-parent-buffer)
+ (vc-deduce-fileset observer allow-unregistered state-model-only-files)))
+ ((not buffer-file-name)
+ (error "Buffer %s is not associated with a file" (buffer-name)))
+ ((and allow-unregistered (not (vc-registered buffer-file-name)))
+ (if state-model-only-files
+ (list (vc-backend-for-registration (buffer-file-name))
+ (list buffer-file-name)
+ (list buffer-file-name)
+ (when state-model-only-files 'unregistered)
+ nil)
+ (list (vc-backend-for-registration (buffer-file-name))
+ (list buffer-file-name))))
+ (t (error "No fileset is available here")))))
+
+(defun vc-dired-deduce-fileset ()
+ (let ((backend (vc-responsible-backend default-directory)))
+ (unless backend (error "Directory not under VC"))
+ (list backend
+ (dired-map-over-marks (dired-get-filename nil t) nil))))
(defun vc-ensure-vc-buffer ()
"Make sure that the current buffer visits a version-controlled file."
(cond
- ((vc-dispatcher-browsing)
+ ((derived-mode-p 'vc-dir-mode)
(set-buffer (find-file-noselect (vc-dir-current-file))))
(t
(while (and vc-parent-buffer
If the repository file is changed, you are asked if you want to
merge in the changes into your working copy."
(interactive "P")
- (let* ((vc-fileset (vc-deduce-fileset))
+ (let* ((vc-fileset (vc-deduce-fileset nil t 'state-model-only-files))
(backend (car vc-fileset))
- (files (cadr vc-fileset))
- (fileset-only-files (cddr vc-fileset))
+ (files (nth 1 vc-fileset))
+ (fileset-only-files (nth 2 vc-fileset))
;; FIXME: We used to call `vc-recompute-state' here.
- (state (vc-state (car fileset-only-files)))
+ (state (nth 3 vc-fileset))
;; The backend should check that the checkout-model is consistent
;; among all the `files'.
- (model (vc-checkout-model backend files))
+ (model (nth 4 vc-fileset))
revision)
- ;; Check that all files are in a consistent state, since we use that
- ;; state to decide which operation to perform.
- (dolist (file (cdr fileset-only-files))
- (unless (vc-compatible-state (vc-state file) state)
- (error "%s:%s clashes with %s:%s"
- file (vc-state file) (car fileset-only-files) state)))
-
;; Do the right thing
(cond
((eq state 'missing)
- (error "Fileset files are missing, so cannot be operated on."))
+ (error "Fileset files are missing, so cannot be operated on"))
((eq state 'ignored)
- (error "Fileset files are ignored by the version-control system."))
- ((eq state 'unregistered)
- (mapc (lambda (arg) (vc-register nil arg)) files))
+ (error "Fileset files are ignored by the version-control system"))
+ ((or (null state) (eq state 'unregistered))
+ (vc-register nil vc-fileset))
;; Files are up-to-date, or need a merge and user specified a revision
((or (eq state 'up-to-date) (and verbose (eq state 'needs-update)))
(cond
(verbose
;; go to a different revision
(setq revision (read-string "Branch, revision, or backend to move to: "))
- (let ((vsym (intern-soft (upcase revision))))
- (if (member vsym vc-handled-backends)
- (dolist (file files) (vc-transfer-file file vsym))
+ (let ((revision-downcase (downcase revision)))
+ (if (member
+ revision-downcase
+ (mapcar (lambda (arg) (downcase (symbol-name arg))) vc-handled-backends))
+ (let ((vsym (intern-soft revision-downcase)))
+ (dolist (file files) (vc-transfer-file file vsym)))
(dolist (file files)
(vc-checkout file (eq model 'implicit) revision)))))
((not (eq model 'implicit))
;; finishing the log entry and committing.
(not (and visited (buffer-modified-p))))
(vc-revert-file file)
- (delete file ready-for-commit)))))
+ (setq ready-for-commit (delete file ready-for-commit))))))
;; Remaining files need to be committed
(if (not ready-for-commit)
(message "No files remain to be committed")
(if (not verbose)
- (vc-checkin ready-for-commit)
- (progn
- (setq revision (read-string "New revision or backend: "))
- (let ((vsym (intern (upcase revision))))
- (if (member vsym vc-handled-backends)
- (dolist (file files) (vc-transfer-file file vsym))
- (vc-checkin ready-for-commit revision))))))))
+ (vc-checkin ready-for-commit backend)
+ (setq revision (read-string "New revision or backend: "))
+ (let ((revision-downcase (downcase revision)))
+ (if (member
+ revision-downcase
+ (mapcar (lambda (arg) (downcase (symbol-name arg)))
+ vc-handled-backends))
+ (let ((vsym (intern revision-downcase)))
+ (dolist (file files) (vc-transfer-file file vsym)))
+ (vc-checkin ready-for-commit backend revision)))))))
;; locked by somebody else (locking VCSes only)
((stringp state)
;; In the old days, we computed the revision once and used it on
(when (not (equal buffer-file-name file))
(find-file-other-window file))
(if (save-window-excursion
- (vc-diff-internal nil
+ (vc-diff-internal nil
(cons (car vc-fileset) (cons (cadr vc-fileset) (list file)))
(vc-working-revision file) nil)
(goto-char (point-min))
;; show that the file is locked now.
(vc-clear-headers file)
(write-file buffer-file-name)
- (vc-mode-line file))
+ (vc-mode-line file backend))
(if (not (yes-or-no-p
"Revert to checked-in revision, instead? "))
(error "Checkout aborted")
nil t)))))
(vc-call-backend backend 'create-repo))
+(declare-function vc-dir-move-to-goal-column "vc-dir" ())
+
;;;###autoload
-(defun vc-register (&optional set-revision fname comment)
+(defun vc-register (&optional set-revision vc-fileset comment)
"Register into a version control system.
-If FNAME is given register that file, otherwise register the current file.
+If VC-FILESET is given, register the files in that fileset.
+Otherwise register the current file.
With prefix argument SET-REVISION, allow user to specify initial revision
level. If COMMENT is present, use that as an initial comment.
register the file. If no backend declares itself responsible, the
first backend that could register the file is used."
(interactive "P")
- (when (and (null fname) (null buffer-file-name)) (error "No visited file"))
-
- (let ((bname (if fname (get-file-buffer fname) (current-buffer))))
- (unless fname (setq fname buffer-file-name))
- (when (vc-backend fname)
- (if (vc-registered fname)
- (error "This file is already registered")
- (unless (y-or-n-p "Previous master file has vanished. Make a new one? ")
- (error "Aborted"))))
- ;; Watch out for new buffers of size 0: the corresponding file
- ;; does not exist yet, even though buffer-modified-p is nil.
- (when bname
- (with-current-buffer bname
- (when (and (not (buffer-modified-p))
- (zerop (buffer-size))
- (not (file-exists-p buffer-file-name)))
- (set-buffer-modified-p t))
- (vc-buffer-sync)))
- (vc-start-logentry (list fname)
- (if set-revision
- (read-string (format "Initial revision level for %s: "
- fname))
- (vc-call-backend (vc-responsible-backend fname)
- 'init-revision))
- (or comment (not vc-initial-comment))
- nil
- "Enter initial comment."
- "*VC-log*"
- (lambda (files rev comment)
- (dolist (file files)
- (message "Registering %s... " file)
- (let ((backend (vc-responsible-backend file t)))
- (vc-file-clearprops file)
- (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)
- (setq backup-inhibited t)))
- (message "Registering %s... done" file))))))
+ (let* ((fileset-arg (or vc-fileset (vc-deduce-fileset nil t)))
+ (backend (car fileset-arg))
+ (files (nth 1 fileset-arg)))
+ ;; We used to operate on `only-files', but VC wants to provide the
+ ;; possibility to register directories rather than files only, since
+ ;; many VCS allow that as well.
+ (dolist (fname files)
+ (let ((bname (get-file-buffer fname)))
+ (unless fname (setq fname buffer-file-name))
+ (when (vc-backend fname)
+ (if (vc-registered fname)
+ (error "This file is already registered")
+ (unless (y-or-n-p "Previous master file has vanished. Make a new one? ")
+ (error "Aborted"))))
+ ;; Watch out for new buffers of size 0: the corresponding file
+ ;; does not exist yet, even though buffer-modified-p is nil.
+ (when bname
+ (with-current-buffer bname
+ (when (and (not (buffer-modified-p))
+ (zerop (buffer-size))
+ (not (file-exists-p buffer-file-name)))
+ (set-buffer-modified-p t))
+ (vc-buffer-sync)))))
+ (message "Registering %s... " files)
+ (mapc 'vc-file-clearprops files)
+ (vc-call-backend backend 'register files
+ (if set-revision
+ (read-string (format "Initial revision level for %s: " files))
+ (vc-call-backend backend 'init-revision))
+ comment)
+ (mapc
+ (lambda (file)
+ (vc-file-setprop file 'vc-backend backend)
+ ;; FIXME: This is wrong: it should set `backup-inhibited' in all
+ ;; the buffers visiting files affected by this `vc-register', not
+ ;; in the current-buffer.
+ ;; (unless vc-make-backup-files
+ ;; (make-local-variable 'backup-inhibited)
+ ;; (setq backup-inhibited t))
+
+ (vc-resynch-buffer file vc-keep-workfiles t))
+ files)
+ (when (derived-mode-p 'vc-dir-mode)
+ (vc-dir-move-to-goal-column))
+ (message "Registering %s... done" files)))
(defun vc-register-with (backend)
"Register the current file with a specified back end."
(interactive "SBackend: ")
(when (not (member backend vc-handled-backends))
- (error "Unknown back end."))
+ (error "Unknown back end"))
(let ((vc-handled-backends (list backend)))
(call-interactively 'vc-register)))
(run-hooks 'vc-checkout-hook))
(defun vc-mark-resolved (backend files)
- (with-vc-properties
- files
- (vc-call-backend backend 'mark-resolved files)
- ;; XXX: Is this TRTD? Might not be.
- `((vc-state . edited))))
+ (prog1 (with-vc-properties
+ files
+ (vc-call-backend backend 'mark-resolved files)
+ ;; FIXME: Is this TRTD? Might not be.
+ `((vc-state . edited)))
+ (message
+ (substitute-command-keys
+ "Conflicts have been resolved in %s. \
+Type \\[vc-next-action] to check in changes.")
+ (if (> (length files) 1)
+ (format "%d files" (length files))
+ "this file"))))
(defun vc-steal-lock (file rev owner)
"Steal the lock on FILE."
".\n")
(message "Please explain why you stole the lock. Type C-c C-c when done.")))
-(defun vc-checkin (files &optional rev comment initial-contents)
+(defun vc-checkin (files backend &optional rev comment initial-contents)
"Check in FILES.
The optional argument REV may be a string specifying the new revision
level (if nil increment the current level). COMMENT is a comment
Runs the normal hooks `vc-before-checkin-hook' and `vc-checkin-hook'."
(when vc-before-checkin-hook
(run-hooks 'vc-before-checkin-hook))
- (vc-start-logentry
- files rev comment initial-contents
- "Enter a change comment."
- "*VC-log*"
- (lambda (files rev comment)
- (message "Checking in %s..." (vc-delistify files))
- ;; "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
- files
- ;; We used to change buffers to get local value of vc-checkin-switches,
- ;; but 'the' local buffer is not a well-defined concept for filesets.
- (progn
- (vc-call checkin files rev comment)
- (mapc 'vc-delete-automatic-version-backups files))
- `((vc-state . up-to-date)
- (vc-checkout-time . ,(nth 5 (file-attributes file)))
- (vc-working-revision . nil)))
- (message "Checking in %s...done" (vc-delistify files)))
- 'vc-checkin-hook))
+ (lexical-let
+ ((backend backend))
+ (vc-start-logentry
+ files rev comment initial-contents
+ "Enter a change comment."
+ "*VC-log*"
+ (lambda (files rev comment)
+ (message "Checking in %s..." (vc-delistify files))
+ ;; "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
+ files
+ ;; We used to change buffers to get local value of vc-checkin-switches,
+ ;; but 'the' local buffer is not a well-defined concept for filesets.
+ (progn
+ (vc-call-backend backend 'checkin files rev comment)
+ (mapc 'vc-delete-automatic-version-backups files))
+ `((vc-state . up-to-date)
+ (vc-checkout-time . ,(nth 5 (file-attributes file)))
+ (vc-working-revision . nil)))
+ (message "Checking in %s...done" (vc-delistify files)))
+ 'vc-checkin-hook)))
;;; Additional entry points for examining version histories
'undecided))
(defun vc-switches (backend op)
+ "Return a list of vc-BACKEND switches for operation OP.
+BACKEND is a symbol such as `CVS', which will be downcased.
+OP is a symbol such as `diff'.
+
+In decreasing order of preference, return the value of:
+vc-BACKEND-OP-switches (e.g. `vc-cvs-diff-switches');
+vc-OP-switches (e.g. `vc-diff-switches'); or, in the case of
+diff only, `diff-switches'.
+
+If the chosen value is not a string or a list, return nil.
+This is so that you may set, e.g. `vc-svn-diff-switches' to t in order
+to override the value of `vc-diff-switches' and `diff-switches'."
(let ((switches
(or (when backend
(let ((sym (vc-make-backend-sym
;; I made it conditional on vc-diff-added-files but it should probably
;; just be removed (or copied/moved to specific backends). --Stef.
(when vc-diff-added-files
- (let ((filtered '()))
+ (let ((filtered '())
+ process-file-side-effects)
(dolist (file files)
(if (or (file-directory-p file)
(not (string= (vc-working-revision file) "0")))
;; because we don't know that yet.
t)))
+(defun vc-read-revision (prompt &optional files backend default initial-input)
+ (cond
+ ((null files)
+ (let ((vc-fileset (vc-deduce-fileset t))) ;FIXME: why t? --Stef
+ (setq files (cadr vc-fileset))
+ (setq backend (car vc-fileset))))
+ ((null backend) (setq backend (vc-backend (car files)))))
+ (let ((completion-table
+ (vc-call-backend backend 'revision-completion-table files)))
+ (if completion-table
+ (completing-read prompt completion-table
+ nil nil initial-input nil default)
+ (read-string prompt initial-input nil default))))
+
;;;###autoload
(defun vc-version-diff (files rev1 rev2)
"Report diffs between revisions of the fileset in the repository history."
(interactive
- (let* ((vc-fileset (vc-deduce-fileset t))
+ (let* ((vc-fileset (vc-deduce-fileset t)) ;FIXME: why t? --Stef
(files (cadr vc-fileset))
(backend (car vc-fileset))
(first (car files))
- (completion-table
- (vc-call-backend backend 'revision-completion-table files))
(rev1-default nil)
(rev2-default nil))
(cond
"Older revision: "))
(rev2-prompt (concat "Newer revision (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))))
+ (rev1 (vc-read-revision rev1-prompt files backend rev1-default))
+ (rev2 (vc-read-revision rev2-prompt files backend rev2-default)))
(when (string= rev1 "") (setq rev1 nil))
(when (string= rev2 "") (setq rev2 nil))
(list files rev1 rev2))))
;; All that was just so we could do argument completion!
(when (and (not rev1) rev2)
- (error "Not a valid revision range."))
+ (error "Not a valid revision range"))
;; Yes, it's painful to call (vc-deduce-fileset) again. Alas, the
;; placement rules for (interactive) don't actually leave us a choice.
- (vc-diff-internal t (vc-deduce-fileset) rev1 rev2 (interactive-p)))
-
-;; (defun vc-contains-version-controlled-file (dir)
-;; "Return t if DIR contains a version-controlled file, nil otherwise."
-;; (catch 'found
-;; (mapc (lambda (f) (and (not (file-directory-p f)) (vc-backend f) (throw 'found 't))) (directory-files dir))
-;; nil))
+ (vc-diff-internal t (vc-deduce-fileset t) rev1 rev2
+ (called-interactively-p 'interactive)))
;;;###autoload
(defun vc-diff (historic &optional not-urgent)
(if historic
(call-interactively 'vc-version-diff)
(when buffer-file-name (vc-buffer-sync not-urgent))
- (vc-diff-internal t (vc-deduce-fileset) nil nil (interactive-p))))
+ (vc-diff-internal t (vc-deduce-fileset t) nil nil
+ (called-interactively-p 'interactive))))
+
+;;;###autoload
+(defun vc-root-diff (historic &optional not-urgent)
+ "Display diffs between file revisions.
+Normally this compares the currently selected fileset with their
+working revisions. With a prefix argument HISTORIC, it reads two revision
+designators specifying which revisions to compare.
+
+The optional argument NOT-URGENT non-nil means it is ok to say no to
+saving the buffer."
+ (interactive (list current-prefix-arg t))
+ (if historic
+ ;; FIXME: this does not work right, `vc-version-diff' ends up
+ ;; calling `vc-deduce-fileset' to find the files to diff, and
+ ;; that's not what we want here, we want the diff for the VC root dir.
+ (call-interactively 'vc-version-diff)
+ (when buffer-file-name (vc-buffer-sync not-urgent))
+ (let ((backend
+ (cond ((derived-mode-p 'vc-dir-mode) vc-dir-backend)
+ ((derived-mode-p 'dired-mode) (vc-responsible-backend default-directory))
+ (vc-mode (vc-backend buffer-file-name))))
+ rootdir working-revision)
+ (unless backend
+ (error "Buffer is not version controlled"))
+ (setq rootdir (vc-call-backend backend 'root default-directory))
+ (setq working-revision (vc-working-revision rootdir))
+ (vc-diff-internal
+ t (list backend (list rootdir) working-revision) nil nil
+ (called-interactively-p 'interactive)))))
;;;###autoload
(defun vc-revision-other-window (rev)
(interactive
(save-current-buffer
(vc-ensure-vc-buffer)
- (let ((completion-table
- (vc-call revision-completion-table buffer-file-name))
- (prompt "Revision to visit (default is working revision): "))
- (list
- (if completion-table
- (completing-read prompt completion-table)
- (read-string prompt))))))
+ (list
+ (vc-read-revision "Revision to visit (default is working revision): "
+ (list buffer-file-name)))))
(vc-ensure-vc-buffer)
(let* ((file buffer-file-name)
(revision (if (string-equal rev "")
(vc-checkout file t)
(error "Merge aborted"))))
(setq first-revision
- (read-string (concat "Branch or revision to merge from "
- "(default news on current branch): ")))
+ (vc-read-revision
+ (concat "Branch or revision to merge from "
+ "(default news on current branch): ")
+ (list file)
+ backend))
(if (string= first-revision "")
(setq status (vc-call-backend backend 'merge-news file))
(if (not (vc-find-backend-function backend 'merge))
(error "Sorry, merging is not implemented for %s" backend)
(if (not (vc-branch-p first-revision))
(setq second-revision
- (read-string "Second revision: "
- (concat (vc-branch-part first-revision) ".")))
+ (vc-read-revision
+ "Second revision: "
+ (list file) backend nil
+ ;; FIXME: This is CVS/RCS/SCCS specific.
+ (concat (vc-branch-part first-revision) ".")))
;; We want to merge an entire branch. Set revisions
;; accordingly, so that vc-BACKEND-merge understands us.
(setq second-revision first-revision)
;;;###autoload
(defalias 'vc-resolve-conflicts 'smerge-ediff)
-;; VC status implementation
-
-(defun vc-default-status-extra-headers (backend dir)
- ;; Be loud by default to remind people to add coded to display
- ;; backend specific headers.
- ;; XXX: change this to return nil before the release.
- "Extra : Add backend specific headers here")
-
-(defun vc-dir-headers (backend dir)
- "Display the headers in the *VC status* buffer.
-It calls the `status-extra-headers' backend method to display backend
-specific headers."
- (concat
- (propertize "VC backend : " 'face 'font-lock-type-face)
- (propertize (format "%s\n" backend) 'face 'font-lock-variable-name-face)
- (propertize "Working dir: " 'face 'font-lock-type-face)
- (propertize (format "%s\n" dir) 'face 'font-lock-variable-name-face)
- (vc-call-backend backend 'status-extra-headers dir)
- "\n"))
-
-(defun vc-default-status-printer (backend fileentry)
- "Pretty print FILEENTRY."
- ;; If you change the layout here, change vc-dir-move-to-goal-column.
- (let ((state
- (if (vc-dir-fileinfo->directory fileentry)
- 'DIRECTORY
- (vc-dir-fileinfo->state fileentry))))
- (insert
- (propertize
- (format "%c" (if (vc-dir-fileinfo->marked fileentry) ?* ? ))
- 'face 'font-lock-type-face)
- " "
- (propertize
- (format "%-20s" state)
- 'face (cond ((eq state 'up-to-date) 'font-lock-builtin-face)
- ((memq state '(missing conflict)) 'font-lock-warning-face)
- (t 'font-lock-variable-name-face))
- 'mouse-face 'highlight)
- " "
- (propertize
- (format "%s" (vc-dir-fileinfo->name fileentry))
- 'face 'font-lock-function-name-face
- 'mouse-face 'highlight))))
-
-(defun vc-default-extra-status-menu (backend)
- nil)
-
-(defun vc-dir-refresh-files (files default-state)
- "Refresh some files in the VC status buffer."
- (let ((backend (vc-responsible-backend default-directory))
- (status-buffer (current-buffer))
- (def-dir default-directory))
- (vc-set-mode-line-busy-indicator)
- ;; Call the `dir-status-file' backend function.
- ;; `dir-status-file' is supposed to be asynchronous.
- ;; It should compute the results, and then call the function
- ;; passed as an argument in order to update the vc-dir buffer
- ;; with the results.
- (unless (buffer-live-p vc-dir-process-buffer)
- (setq vc-dir-process-buffer
- (generate-new-buffer (format " *VC-%s* tmp status" backend))))
- (lexical-let ((buffer (current-buffer)))
- (with-current-buffer vc-dir-process-buffer
- (cd def-dir)
- (erase-buffer)
- (vc-call-backend
- backend 'dir-status-files def-dir files default-state
- (lambda (entries &optional more-to-come)
- ;; ENTRIES is a list of (FILE VC_STATE EXTRA) items.
- ;; If MORE-TO-COME is true, then more updates will come from
- ;; the asynchronous process.
- (with-current-buffer buffer
- (vc-dir-update entries buffer)
- (unless more-to-come
- (setq mode-line-process nil)
- ;; Remove the ones that haven't been updated at all.
- ;; Those not-updated are those whose state is nil because the
- ;; file/dir doesn't exist and isn't versioned.
- (ewoc-filter vc-ewoc
- (lambda (info)
- (not (vc-dir-fileinfo->needs-update info))))))))))))
-
-(defun vc-dir-refresh ()
- "Refresh the contents of the VC status buffer.
-Throw an error if another update process is in progress."
- (interactive)
- (if (vc-dir-busy)
- (error "Another update process is in progress, cannot run two at a time")
- (let ((backend (vc-responsible-backend default-directory))
- (status-buffer (current-buffer))
- (def-dir default-directory))
- (vc-set-mode-line-busy-indicator)
- ;; Call the `dir-status' backend function.
- ;; `dir-status' is supposed to be asynchronous.
- ;; It should compute the results, and then call the function
- ;; passed as an argument in order to update the vc-dir buffer
- ;; with the results.
-
- ;; Create a buffer that can be used by `dir-status' and call
- ;; `dir-status' with this buffer as the current buffer. Use
- ;; `vc-dir-process-buffer' to remember this buffer, so that
- ;; it can be used later to kill the update process in case it
- ;; takes too long.
- (unless (buffer-live-p vc-dir-process-buffer)
- (setq vc-dir-process-buffer
- (generate-new-buffer (format " *VC-%s* tmp status" backend))))
- ;; set the needs-update flag on all entries
- (ewoc-map (lambda (info) (setf (vc-dir-fileinfo->needs-update info) t) nil)
- vc-ewoc)
- (lexical-let ((buffer (current-buffer)))
- (with-current-buffer vc-dir-process-buffer
- (cd def-dir)
- (erase-buffer)
- (vc-call-backend
- backend 'dir-status def-dir
- (lambda (entries &optional more-to-come)
- ;; ENTRIES is a list of (FILE VC_STATE EXTRA) items.
- ;; If MORE-TO-COME is true, then more updates will come from
- ;; the asynchronous process.
- (with-current-buffer buffer
- (vc-dir-update entries buffer)
- (unless more-to-come
- (let ((remaining
- (ewoc-collect
- vc-ewoc 'vc-dir-fileinfo->needs-update)))
- (if remaining
- (vc-dir-refresh-files
- (mapcar 'vc-dir-fileinfo->name remaining)
- 'up-to-date)
- (setq mode-line-process nil))))))))))))
-
-(defun vc-dir-show-fileentry (file)
- "Insert an entry for a specific file into the current VC status listing.
-This is typically used if the file is up-to-date (or has been added
-outside of VC) and one wants to do some operation on it."
- (interactive "fShow file: ")
- (vc-dir-update (list (list (file-relative-name file) (vc-state file))) (current-buffer)))
-
-(defun vc-dir-hide-up-to-date ()
- "Hide up-to-date items from display."
- (interactive)
- (ewoc-filter
- vc-ewoc
- (lambda (crt) (not (eq (vc-dir-fileinfo->state crt) 'up-to-date)))))
-
-(defun vc-dir-register ()
- "Register the marked files, or the current file if no marks."
- (interactive)
- ;; FIXME: Just pass the fileset to vc-register.
- (mapc (lambda (arg) (vc-register nil arg))
- (or (vc-dir-marked-files) (list (vc-dir-current-file)))))
-
-(defun vc-default-status-fileinfo-extra (backend file)
- "Default absence of extra information returned for a file."
- nil)
-
-;; FIXME: Replace these with a more efficient dispatch
-
-(defun vc-generic-status-printer (fileentry)
- (let* ((file (vc-dir-fileinfo->name fileentry))
- (backend (vc-responsible-backend (expand-file-name file))))
- (vc-call-backend backend 'status-printer fileentry)))
-
-(defun vc-generic-state (file)
- (let ((backend (vc-responsible-backend (expand-file-name file))))
- (vc-call-backend backend 'state file)))
-
-(defun vc-generic-status-fileinfo-extra (file)
- (let ((backend (vc-responsible-backend (expand-file-name file))))
- (vc-call-backend backend 'status-fileinfo-extra file)))
-
-(defun vc-generic-dir-headers (dir)
- (let ((backend (vc-responsible-backend dir)))
- (vc-dir-headers backend dir)))
-
-(defun vc-dir-extra-menu ()
- (vc-call-backend (vc-responsible-backend default-directory) 'extra-status-menu))
-
-(defun vc-make-backend-object (file-or-dir)
- "Create the backend capability object needed by vc-dispatcher."
- (vc-create-client-object
- "VC status"
- (let ((backend (vc-responsible-backend file-or-dir)))
- (vc-dir-headers backend file-or-dir))
- #'vc-generic-status-printer
- #'vc-generic-state
- #'vc-generic-status-fileinfo-extra
- #'vc-dir-refresh
- #'vc-dir-extra-menu))
-
-;;;###autoload
-(defun vc-dir (dir)
- "Show the VC status for DIR."
- (interactive "DVC status for directory: ")
- (pop-to-buffer (vc-dir-prepare-status-buffer "*vc-dir*" dir))
- (if (and (derived-mode-p 'vc-dir-mode) (boundp 'client-object))
- (vc-dir-refresh)
- ;; Otherwise, initialize a new view using the dispatcher layer
- (progn
- ;; Build a capability object and hand it to the dispatcher initializer
- (vc-dir-mode (vc-make-backend-object dir))
- ;; FIXME: Make a derived-mode instead.
- ;; Add VC-specific keybindings
- (let ((map (current-local-map)))
- (define-key map "v" 'vc-diff) ;; C-x v v
- (define-key map "=" 'vc-diff) ;; C-x v =
- (define-key map "i" 'vc-dir-register) ;; C-x v i
- (define-key map "+" 'vc-update) ;; C-x v +
- (define-key map "l" 'vc-print-log) ;; C-x v l
- ;; More confusing than helpful, probably
- ;(define-key map "R" 'vc-revert) ;; u is taken by dispatcher unmark.
- ;(define-key map "A" 'vc-annotate) ;; g is taken by dispatcher refresh
- (define-key map "x" 'vc-dir-hide-up-to-date))
- )
- ;; FIXME: Needs to alter a buffer-local map, otherwise clients may clash
- (let ((map vc-dir-menu-map))
- ;; VC info details
- (define-key map [sepvcdet] '("--"))
- (define-key map [remup]
- '(menu-item "Hide up-to-date" vc-dir-hide-up-to-date
- :help "Hide up-to-date items from display"))
- ;; FIXME: This needs a key binding. And maybe a better name
- ;; ("Insert" like PCL-CVS uses does not sound that great either)...
- (define-key map [ins]
- '(menu-item "Show File" vc-dir-show-fileentry
- :help "Show a file in the VC status listing even though it might be up to date"))
- (define-key map [annotate]
- '(menu-item "Annotate" vc-annotate
- :help "Display the edit history of the current file using colors"))
- (define-key map [diff]
- '(menu-item "Compare with Base Version" vc-diff
- :help "Compare file set with the base version"))
- (define-key map [log]
- '(menu-item "Show history" vc-print-log
- :help "List the change log of the current file set in a window"))
- ;; VC commands.
- (define-key map [sepvccmd] '("--"))
- (define-key map [update]
- '(menu-item "Update to latest version" vc-update
- :help "Update the current fileset's files to their tip revisions"))
- (define-key map [revert]
- '(menu-item "Revert to base version" vc-revert
- :help "Revert working copies of the selected fileset to their repository contents."))
- (define-key map [next-action]
- ;; FIXME: This really really really needs a better name!
- ;; And a key binding too.
- '(menu-item "Check In/Out" vc-next-action
- :help "Do the next logical version control operation on the current fileset"))
- (define-key map [register]
- '(menu-item "Register" vc-dir-register
- :help "Register file set into the version control system"))
- )))
-
;; Named-configuration entry points
(defun vc-tag-precondition (dir)
;; Miscellaneous other entry points
-;;;###autoload
-(defun vc-print-log (&optional working-revision)
- "List the change log of the current fileset in a window.
-If WORKING-REVISION is non-nil, leave the point at that revision."
- (interactive)
- (let* ((vc-fileset (vc-deduce-fileset t))
- (backend (car vc-fileset))
- (files (cadr vc-fileset))
- (working-revision (or working-revision (vc-working-revision (car files)))))
- ;; Don't switch to the output buffer before running the command,
- ;; so that any buffer-local settings in the vc-controlled
- ;; buffer can be accessed by the command.
- (vc-call-backend backend 'print-log files "*vc-change-log*")
+;; FIXME: this should be a defcustom
+;; FIXME: maybe add another choice:
+;; `root-directory' (or somesuch), which would mean show a short log
+;; for the root directory.
+(defvar vc-log-short-style '(directory)
+ "Whether or not to show a short log.
+If it contains `directory' then if the fileset contains a directory show a short log.
+If it contains `file' then show short logs for files.
+Not all VC backends support short logs!")
+
+(defvar log-view-vc-backend)
+(defvar log-view-vc-fileset)
+
+(defun vc-print-log-internal (backend files working-revision
+ &optional is-start-revision limit)
+ ;; Don't switch to the output buffer before running the command,
+ ;; so that any buffer-local settings in the vc-controlled
+ ;; buffer can be accessed by the command.
+ (let ((dir-present nil)
+ (vc-short-log nil)
+ pl-return)
+ (dolist (file files)
+ (when (file-directory-p file)
+ (setq dir-present t)))
+ (setq vc-short-log
+ (not (null (if dir-present
+ (memq 'directory vc-log-short-style)
+ (memq 'file vc-log-short-style)))))
+
+ (setq pl-return (vc-call-backend
+ backend 'print-log files "*vc-change-log*"
+ vc-short-log (when is-start-revision working-revision) limit))
(pop-to-buffer "*vc-change-log*")
+ (let ((inhibit-read-only t))
+ ;; log-view-mode used to be called with inhibit-read-only bound
+ ;; to t, so let's keep doing it, just in case.
+ (vc-call-backend backend 'log-view-mode))
+ (set (make-local-variable 'log-view-vc-backend) backend)
+ (set (make-local-variable 'log-view-vc-fileset) files)
+
(vc-exec-after
`(let ((inhibit-read-only t))
- (vc-call-backend ',backend 'log-view-mode)
- (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))
- (when (looking-at "[\b\t\n\v\f\r ]+")
- (delete-char (- (match-end 0) (match-beginning 0))))
+ (when (and ,limit (not ,(eq 'limit-unsupported pl-return))
+ (not ,is-start-revision))
+ (goto-char (point-max))
+ (widget-create 'push-button
+ :notify (lambda (&rest ignore)
+ (vc-print-log-internal
+ ',backend ',files ',working-revision nil (* 2 ,limit)))
+ :help-echo "Show the log again, and double the number of log entries shown"
+ "Show 2X entries")
+ (widget-insert " ")
+ (widget-create 'push-button
+ :notify (lambda (&rest ignore)
+ (vc-print-log-internal
+ ',backend ',files ',working-revision nil nil))
+ :help-echo "Show the log again, showing all entries"
+ "Show unlimited entries")
+ (widget-setup))
+
(shrink-window-if-larger-than-buffer)
;; move point to the log entry for the working revision
(vc-call-backend ',backend 'show-log-entry ',working-revision)
- (setq vc-sentinel-movepoint (point))
- (set-buffer-modified-p nil)))))
+ (setq vc-sentinel-movepoint (point))
+ (set-buffer-modified-p nil)))))
+
+;;;###autoload
+(defun vc-print-log (&optional working-revision limit)
+ "List the change log of the current fileset in a window.
+If WORKING-REVISION is non-nil, leave the point at that revision."
+ (interactive
+ (cond
+ (current-prefix-arg
+ (let ((rev (read-from-minibuffer "Log from revision (default: last revision): " nil
+ nil nil nil))
+ (lim (string-to-number
+ (read-from-minibuffer
+ "Limit display (unlimited: 0): "
+ (format "%s" vc-log-show-limit)
+ nil nil nil))))
+ (when (string= rev "") (setq rev nil))
+ (when (<= lim 0) (setq lim nil))
+ (list rev lim)))
+ (t
+ (list nil (when (> vc-log-show-limit 0) vc-log-show-limit)))))
+ (let* ((vc-fileset (vc-deduce-fileset t)) ;FIXME: Why t? --Stef
+ (backend (car vc-fileset))
+ (files (cadr vc-fileset))
+ (working-revision (or working-revision (vc-working-revision (car files)))))
+ (vc-print-log-internal backend files working-revision nil limit)))
+
+;;;###autoload
+(defun vc-print-root-log (&optional limit)
+ "List the change log of for the current VC controlled tree in a window."
+ (interactive
+ (cond
+ (current-prefix-arg
+ (let ((lim (string-to-number
+ (read-from-minibuffer
+ "Limit display (unlimited: 0): "
+ (format "%s" vc-log-show-limit)
+ nil nil nil))))
+ (when (<= lim 0) (setq lim nil))
+ (list lim)))
+ (t
+ (list (when (> vc-log-show-limit 0) vc-log-show-limit)))))
+ (let ((backend
+ (cond ((derived-mode-p 'vc-dir-mode) vc-dir-backend)
+ ((derived-mode-p 'dired-mode) (vc-responsible-backend default-directory))
+ (vc-mode (vc-backend buffer-file-name))))
+ rootdir working-revision)
+ (unless backend
+ (error "Buffer is not version controlled"))
+ (setq rootdir (vc-call-backend backend 'root default-directory))
+ (setq working-revision (vc-working-revision rootdir))
+ (vc-print-log-internal backend (list rootdir) working-revision nil limit)))
;;;###autoload
(defun vc-revert ()
(dolist (file files)
(let ((buf (get-file-buffer file)))
(when (and buf (buffer-modified-p buf))
- (error "Please kill or save all modified buffers before reverting.")))
+ (error "Please kill or save all modified buffers before reverting")))
(when (vc-up-to-date-p file)
(unless (yes-or-no-p (format "%s seems up-to-date. Revert anyway? " file))
(error "Revert canceled"))))
(when (vc-diff-internal vc-allow-async-revert vc-fileset nil nil)
- (unless (yes-or-no-p (format "Discard changes in %s? " (vc-delistify files)))
+ (unless (yes-or-no-p
+ (format "Discard changes in %s? "
+ (let ((str (vc-delistify files))
+ (nfiles (length files)))
+ (if (< (length str) 50)
+ str
+ (format "%d file%s" nfiles
+ (if (= nfiles 1) "" "s"))))))
(error "Revert canceled"))
(delete-windows-on "*vc-diff*")
(kill-buffer "*vc-diff*"))
(error "Rollback requires a singleton fileset or repository versioning"))
;; FIXME: latest-on-branch-p should take the fileset.
(when (not (vc-call-backend backend 'latest-on-branch-p (car files)))
- (error "Rollback is only possible at the tip revision."))
+ (error "Rollback is only possible at the tip revision"))
;; If any of the files is visited by the current buffer, make
;; sure buffer is saved. If the user says `no', abort since
;; we cannot show the changes and ask for confirmation to
(vc-buffer-sync nil))
(dolist (file files)
(when (buffer-modified-p (get-file-buffer file))
- (error "Please kill or save all modified buffers before rollback."))
+ (error "Please kill or save all modified buffers before rollback"))
(when (not (vc-up-to-date-p file))
- (error "Please revert all modified workfiles before rollback.")))
+ (error "Please revert all modified workfiles before rollback")))
;; Accumulate changes associated with the fileset
(vc-setup-buffer "*vc-diff*")
(not-modified)
(let* ((vc-fileset (vc-deduce-fileset))
(backend (car vc-fileset))
(files (cadr vc-fileset)))
+ (save-some-buffers ; save buffers visiting files
+ nil (lambda ()
+ (and (buffer-modified-p)
+ (let ((file (buffer-file-name)))
+ (and file (member file files))))))
(dolist (file files)
- (when (let ((buf (get-file-buffer file)))
- (and buf (buffer-modified-p buf)))
- (error "Please kill or save all modified buffers before updating."))
(if (vc-up-to-date-p file)
(vc-checkout file nil t)
(if (eq (vc-checkout-model backend (list file)) 'locking)
(list
(or buffer-file-name
(error "There is no version-controlled file in this buffer"))
- (let ((backend (vc-backend buffer-file-name))
+ (let ((crt-bk (vc-backend buffer-file-name))
(backends nil))
- (unless backend
+ (unless crt-bk
(error "File %s is not under version control" buffer-file-name))
;; Find the registered backends.
- (dolist (backend vc-handled-backends)
- (when (vc-call-backend backend 'registered buffer-file-name)
- (push backend backends)))
+ (dolist (crt vc-handled-backends)
+ (when (and (vc-call-backend crt 'registered buffer-file-name)
+ (not (eq crt-bk crt)))
+ (push crt backends)))
;; Find the next backend.
- (let ((def (car (delq backend (append (memq backend backends) backends))))
- (others (delete backend backends)))
+ (let ((def (car backends))
+ (others backends))
(cond
((null others) (error "No other backend to switch to"))
(current-prefix-arg
(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))))))
+ (t def))))))
(unless (eq backend (vc-backend file))
(vc-file-clearprops file)
(vc-file-setprop file 'vc-backend backend)
(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)))))
+ (vc-mode-line file new-backend)
+ (vc-checkin file new-backend nil comment (stringp comment)))))
(defun vc-rename-master (oldmaster newfile templates)
"Rename OLDMASTER to be the master file for NEWFILE based on TEMPLATES."
(throw 'found f)))
(error "New file lacks a version control directory")))))
+;;;###autoload
(defun vc-delete-file (file)
"Delete file and mark it as such in the version control system."
(interactive "fVC delete file: ")
(not (file-exists-p file)))
(with-current-buffer (or buf (find-file-noselect file))
(let ((backup-inhibited nil))
- (backup-buffer))
- ;; If we didn't have a buffer visiting the file before this
- ;; command, kill the buffer created by the above
- ;; `find-file-noselect' call.
- (unless buf (kill-buffer (current-buffer)))))
- (vc-call-backend backend 'delete-file file)
+ (backup-buffer))))
+ ;; Bind `default-directory' so that the command that the backend
+ ;; runs to remove the file is invoked in the correct context.
+ (let ((default-directory (file-name-directory file)))
+ (vc-call-backend backend 'delete-file file))
;; If the backend hasn't deleted the file itself, let's do it for him.
(when (file-exists-p file) (delete-file file))
;; Forget what VC knew about the file.
(vc-file-clearprops file)
- (vc-resynch-buffer file buf t)))
+ ;; Make sure the buffer is deleted and the *vc-dir* buffers are
+ ;; updated after this.
+ (vc-resynch-buffer file nil t)))
;;;###autoload
(defun vc-rename-file (old new)
"Rename file OLD to NEW, and rename its master file likewise."
(interactive "fVC rename file: \nFRename to: ")
+ ;; in CL I would have said (setq new (merge-pathnames new old))
+ (let ((old-base (file-name-nondirectory old)))
+ (when (and (not (string= "" old-base))
+ (string= "" (file-name-nondirectory new)))
+ (setq new (concat new old-base))))
(let ((oldbuf (get-file-buffer old)))
(when (and oldbuf (buffer-modified-p oldbuf))
(error "Please save files before moving them"))
(with-current-buffer oldbuf
(let ((buffer-read-only buffer-read-only))
(set-visited-file-name new))
- (vc-backend new)
- (vc-mode-line new)
+ (vc-mode-line new (vc-backend new))
(set-buffer-modified-p nil)))))
;;;###autoload
(vc-call-backend (vc-responsible-backend default-directory)
'update-changelog args))
-;;; The default back end. Assumes RCS-like revision 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))))
(when index
(substring rev 0 index))))
-(defun vc-minor-part (rev)
- "Return the minor revision number of a revision number REV."
- (string-match "[0-9]+\\'" rev)
- (substring rev (match-beginning 0) (match-end 0)))
-
-(defun vc-default-previous-revision (backend file rev)
- "Return the revision number immediately preceding REV for FILE,
-or nil if there is no previous revision. This default
-implementation works for MAJOR.MINOR-style revision 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)
- ;; revision 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 revision of starting point
- (vc-branch-part branch))))))
-
-(defun vc-default-next-revision (backend file rev)
- "Return the revision number immediately following REV for FILE,
-or nil if there is no next revision. This default implementation
-works for MAJOR.MINOR-style revision numbers as used by RCS
-and CVS."
- (when (not (string= rev (vc-working-revision file)))
- (let ((branch (vc-branch-part rev))
- (minor-num (string-to-number (vc-minor-part rev))))
- (concat branch "." (number-to-string (1+ minor-num))))))
+(define-obsolete-function-alias
+ 'vc-default-previous-version 'vc-default-previous-revision "23.1")
(defun vc-default-responsible-p (backend file)
"Indicate whether BACKEND is reponsible for FILE.
(defun vc-default-init-revision (backend) vc-default-init-revision)
-(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
- (let ((odefault default-directory)
- (changelog (find-change-log))
- ;; Presumably not portable to non-Unixy systems, along with rcs2log:
- (tempfile (make-temp-file
- (expand-file-name "vc"
- (or small-temporary-file-directory
- temporary-file-directory))))
- (login-name (or user-login-name
- (format "uid%d" (number-to-string (user-uid)))))
- (full-name (or add-log-full-name
- (user-full-name)
- (user-login-name)
- (format "uid%d" (number-to-string (user-uid)))))
- (mailing-address (or add-log-mailing-address
- user-mail-address)))
- (find-file-other-window changelog)
- (barf-if-buffer-read-only)
- (vc-buffer-sync)
- (undo-boundary)
- (goto-char (point-min))
- (push-mark)
- (message "Computing change log entries...")
- (message "Computing change log entries... %s"
- (unwind-protect
- (progn
- (setq default-directory odefault)
- (if (eq 0 (apply 'call-process
- (expand-file-name "rcs2log"
- exec-directory)
- nil (list t tempfile) nil
- "-c" changelog
- "-u" (concat login-name
- "\t" full-name
- "\t" mailing-address)
- (mapcar
- (lambda (f)
- (file-relative-name
- (expand-file-name f odefault)))
- files)))
- "done"
- (pop-to-buffer (get-buffer-create "*vc*"))
- (erase-buffer)
- (insert-file-contents tempfile)
- "failed"))
- (setq default-directory (file-name-directory changelog))
- (delete-file tempfile)))))
-
(defun vc-default-find-revision (backend file rev buffer)
"Provide the new `find-revision' op based on the old `checkout' op.
This is only for compatibility with old backends. They should be updated
(insert-file-contents-literally tmpfile)))
(delete-file tmpfile))))
-(defun vc-default-prettify-state-info (backend file)
- (let* ((state (vc-state file))
- (statestring
- (cond
- ((stringp state) (concat "(" state ")"))
- ((eq state 'edited) "(modified)")
- ((eq state 'needs-merge) "(merge)")
- ((eq state 'needs-update) "(update)")
- ((eq state 'added) "(added)")
- ((eq state 'removed) "(removed)")
- ((eq state 'ignored) "(ignored)")
- ((eq state 'unregistered) "?")
- ((eq state 'unlocked-changes) "(stale)")
- ((not state) "(unknown)")))
- (buffer
- (get-file-buffer file))
- (modflag
- (if (and buffer (buffer-modified-p buffer)) "+" "")))
- (concat statestring modflag)))
-
(defun vc-default-rename-file (backend old new)
(condition-case nil
(add-name-to-file old new)
(defun vc-default-receive-file (backend file rev)
"Let BACKEND receive FILE from another version control system."
- (vc-call-backend backend 'register file rev ""))
+ (vc-call-backend backend 'register (list file) rev ""))
(defun vc-default-retrieve-tag (backend dir name update)
(if (string= name "")
(message "Checking out %s...done" file))))
(defalias 'vc-default-revision-completion-table 'ignore)
+(defalias 'vc-default-mark-resolved 'ignore)
(defun vc-default-dir-status-files (backend dir files default-state update-function)
(funcall update-function
(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
-;; parameter). The use of annotate-ratio is deprecated in favor of
-;; annotate-mode, which replaces it with the more sensible "span-to
-;; days", along with autoscaling support.
-(defvar vc-annotate-ratio nil "Global variable.")
-
-;; internal buffer-local variables
-(defvar vc-annotate-backend nil)
-(defvar vc-annotate-parent-file nil)
-(defvar vc-annotate-parent-rev nil)
-(defvar vc-annotate-parent-display-mode nil)
-
-(defconst vc-annotate-font-lock-keywords
- ;; The fontification is done by vc-annotate-lines instead of font-lock.
- '((vc-annotate-lines)))
-
-(define-derived-mode vc-annotate-mode fundamental-mode "Annotate"
- "Major mode for output buffers of the `vc-annotate' command.
-
-You can use the mode-specific menu to alter the time-span of the used
-colors. See variable `vc-annotate-menu-elements' for customizing the
-menu items."
- ;; Frob buffer-invisibility-spec so that if it is originally a naked t,
- ;; it will become a list, to avoid initial annotations being invisible.
- (add-to-invisibility-spec 'foo)
- (remove-from-invisibility-spec 'foo)
- (set (make-local-variable 'truncate-lines) t)
- (set (make-local-variable 'font-lock-defaults)
- '(vc-annotate-font-lock-keywords t))
- (view-mode 1))
-
-(defun vc-annotate-toggle-annotation-visibility ()
- "Toggle whether or not the annotation is visible."
- (interactive)
- (funcall (if (memq 'vc-annotate-annotation buffer-invisibility-spec)
- 'remove-from-invisibility-spec
- 'add-to-invisibility-spec)
- 'vc-annotate-annotation)
- (force-window-update (current-buffer)))
-
-(defun vc-annotate-display-default (ratio)
- "Display the output of \\[vc-annotate] using the default color range.
-The color range is given by `vc-annotate-color-map', scaled by RATIO.
-The current time is used as the offset."
- (interactive (progn (kill-local-variable 'vc-annotate-color-map) '(1.0)))
- (message "Redisplaying annotation...")
- (vc-annotate-display ratio)
- (message "Redisplaying annotation...done"))
-
-(defun vc-annotate-oldest-in-map (color-map)
- "Return the oldest time in the COLOR-MAP."
- ;; Since entries should be sorted, we can just use the last one.
- (caar (last color-map)))
-
-(defun vc-annotate-get-time-set-line-props ()
- (let ((bol (point))
- (date (vc-call-backend vc-annotate-backend 'annotate-time))
- (inhibit-read-only t))
- (assert (>= (point) bol))
- (put-text-property bol (point) 'invisible 'vc-annotate-annotation)
- date))
-
-(defun vc-annotate-display-autoscale (&optional full)
- "Highlight the output of \\[vc-annotate] using an autoscaled color map.
-Autoscaling means that the map is scaled from the current time to the
-oldest annotation in the buffer, or, with prefix argument FULL, to
-cover the range from the oldest annotation to the newest."
- (interactive "P")
- (let ((newest 0.0)
- (oldest 999999.) ;Any CVS users at the founding of Rome?
- (current (vc-annotate-convert-time (current-time)))
- date)
- (message "Redisplaying annotation...")
- ;; Run through this file and find the oldest and newest dates annotated.
- (save-excursion
- (goto-char (point-min))
- (while (not (eobp))
- (when (setq date (vc-annotate-get-time-set-line-props))
- (when (> date newest)
- (setq newest date))
- (when (< 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))
- (if full newest))
- (message "Redisplaying annotation...done \(%s\)"
- (if full
- (format "Spanned from %.1f to %.1f days old"
- (- current oldest)
- (- current newest))
- (format "Spanned to %.1f days old" (- current oldest))))))
-
-;; Menu -- Using easymenu.el
-(easy-menu-define vc-annotate-mode-menu vc-annotate-mode-map
- "VC Annotate Display Menu"
- `("VC-Annotate"
- ["By Color Map Range" (unless (null vc-annotate-display-mode)
- (setq vc-annotate-display-mode nil)
- (vc-annotate-display-select))
- :style toggle :selected (null vc-annotate-display-mode)]
- ,@(let ((oldest-in-map (vc-annotate-oldest-in-map vc-annotate-color-map)))
- (mapcar (lambda (element)
- (let ((days (* element oldest-in-map)))
- `[,(format "Span %.1f days" days)
- (vc-annotate-display-select nil ,days)
- :style toggle :selected
- (eql vc-annotate-display-mode ,days) ]))
- vc-annotate-menu-elements))
- ["Span ..."
- (vc-annotate-display-select
- nil (float (string-to-number (read-string "Span how many days? "))))]
- "--"
- ["Span to Oldest"
- (unless (eq vc-annotate-display-mode 'scale)
- (vc-annotate-display-select nil 'scale))
- :help
- "Use an autoscaled color map from the oldest annotation to the current time"
- :style toggle :selected
- (eq vc-annotate-display-mode 'scale)]
- ["Span Oldest->Newest"
- (unless (eq vc-annotate-display-mode 'fullscale)
- (vc-annotate-display-select nil 'fullscale))
- :help
- "Use an autoscaled color map from the oldest to the newest annotation"
- :style toggle :selected
- (eq vc-annotate-display-mode 'fullscale)]
- "--"
- ["Toggle annotation visibility" vc-annotate-toggle-annotation-visibility
- :help
- "Toggle whether the annotation is visible or not"]
- ["Annotate previous revision" vc-annotate-prev-revision
- :help "Visit the annotation of the revision previous to this one"]
- ["Annotate next revision" vc-annotate-next-revision
- :help "Visit the annotation of the revision after this one"]
- ["Annotate revision at line" vc-annotate-revision-at-line
- :help
- "Visit the annotation of the revision identified in the current line"]
- ["Annotate revision previous to line" vc-annotate-revision-previous-to-line
- :help "Visit the annotation of the revision before the revision at line"]
- ["Annotate latest revision" vc-annotate-working-revision
- :help "Visit the annotation of the working revision of this file"]
- ["Show log of revision at line" vc-annotate-show-log-revision-at-line
- :help "Visit the log of the revision at line"]
- ["Show diff of revision at line" vc-annotate-show-diff-revision-at-line
- :help
- "Visit the diff of the revision at line from its previous revision"]
- ["Visit revision at line" vc-annotate-find-revision-at-line
- :help "Visit the revision identified in the current line"]))
-
-(defun vc-annotate-display-select (&optional buffer mode)
- "Highlight the output of \\[vc-annotate].
-By default, the current buffer is highlighted, unless overridden by
-BUFFER. `vc-annotate-display-mode' specifies the highlighting mode to
-use; you may override this using the second optional arg MODE."
- (interactive)
- (when mode (setq vc-annotate-display-mode mode))
- (pop-to-buffer (or buffer (current-buffer)))
- (cond ((null vc-annotate-display-mode)
- ;; The ratio is global, thus relative to the global color-map.
- (kill-local-variable 'vc-annotate-color-map)
- (vc-annotate-display-default (or vc-annotate-ratio 1.0)))
- ;; One of the auto-scaling modes
- ((eq vc-annotate-display-mode 'scale)
- (vc-exec-after `(vc-annotate-display-autoscale)))
- ((eq vc-annotate-display-mode 'fullscale)
- (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
- (vc-annotate-oldest-in-map vc-annotate-color-map))))
- (t (error "No such display mode: %s"
- vc-annotate-display-mode))))
-
-;;;###autoload
-(defun vc-annotate (file rev &optional display-mode buf move-point-to)
- "Display the edit history of the current file using colors.
-
-This command creates a buffer that shows, for each line of the current
-file, when it was last edited and by whom. Additionally, colors are
-used to show the age of each line--blue means oldest, red means
-youngest, and intermediate colors indicate intermediate ages. By
-default, the time scale stretches back one year into the past;
-everything that is older than that is shown in blue.
-
-With a prefix argument, this command asks two questions in the
-minibuffer. First, you may enter a revision number; then the buffer
-displays and annotates that revision instead of the working revision
-\(type RET in the minibuffer to leave that default unchanged). Then,
-you are prompted for the time span in days which the color range
-should cover. For example, a time span of 20 days means that changes
-over the past 20 days are shown in red to blue, according to their
-age, and everything that is older than that is shown in blue.
-
-If MOVE-POINT-TO is given, move the point to that line.
-
-Customization variables:
-
-`vc-annotate-menu-elements' customizes the menu elements of the
-mode-specific menu. `vc-annotate-color-map' and
-`vc-annotate-very-old-color' define the mapping of time to colors.
-`vc-annotate-background' specifies the background color."
- (interactive
- (save-current-buffer
- (vc-ensure-vc-buffer)
- (list buffer-file-name
- (let ((def (vc-working-revision buffer-file-name)))
- (if (null current-prefix-arg) def
- (read-string
- (format "Annotate from revision (default %s): " def)
- nil nil def)))
- (if (null current-prefix-arg)
- vc-annotate-display-mode
- (float (string-to-number
- (read-string "Annotate span days (default 20): "
- nil nil "20")))))))
- (vc-ensure-vc-buffer)
- (setq vc-annotate-display-mode display-mode) ;Not sure why. --Stef
- (let* ((temp-buffer-name (format "*Annotate %s (rev %s)*" (buffer-name) rev))
- (temp-buffer-show-function 'vc-annotate-display-select)
- ;; If BUF is specified, we presume the caller maintains current line,
- ;; so we don't need to do it here. This implementation may give
- ;; strange results occasionally in the case of REV != WORKFILE-REV.
- (current-line (or move-point-to (unless buf (line-number-at-pos)))))
- (message "Annotating...")
- ;; If BUF is specified it tells in which buffer we should put the
- ;; annotations. This is used when switching annotations to another
- ;; revision, so we should update the buffer's name.
- (when buf (with-current-buffer buf
- (rename-buffer temp-buffer-name t)
- ;; In case it had to be uniquified.
- (setq temp-buffer-name (buffer-name))))
- (with-output-to-temp-buffer temp-buffer-name
- (let ((backend (vc-backend file)))
- (vc-call-backend backend 'annotate-command file
- (get-buffer temp-buffer-name) rev)
- ;; we must setup the mode first, and then set our local
- ;; variables before the show-function is called at the exit of
- ;; with-output-to-temp-buffer
- (with-current-buffer temp-buffer-name
- (unless (equal major-mode 'vc-annotate-mode)
- (vc-annotate-mode))
- (set (make-local-variable 'vc-annotate-backend) backend)
- (set (make-local-variable 'vc-annotate-parent-file) file)
- (set (make-local-variable 'vc-annotate-parent-rev) rev)
- (set (make-local-variable 'vc-annotate-parent-display-mode)
- display-mode))))
-
- (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 (point)))
- (unless (active-minibuffer-window)
- (message "Annotating... done")))))))
-
-(defun vc-annotate-prev-revision (prefix)
- "Visit the annotation of the revision previous to this one.
-
-With a numeric prefix argument, annotate the revision that many
-revisions previous."
- (interactive "p")
- (vc-annotate-warp-revision (- 0 prefix)))
-
-(defun vc-annotate-next-revision (prefix)
- "Visit the annotation of the revision after this one.
-
-With a numeric prefix argument, annotate the revision that many
-revisions after."
- (interactive "p")
- (vc-annotate-warp-revision prefix))
-
-(defun vc-annotate-working-revision ()
- "Visit the annotation of the working revision of this file."
- (interactive)
- (if (not (equal major-mode 'vc-annotate-mode))
- (message "Cannot be invoked outside of a vc annotate buffer")
- (let ((warp-rev (vc-working-revision vc-annotate-parent-file)))
- (if (equal warp-rev vc-annotate-parent-rev)
- (message "Already at revision %s" warp-rev)
- (vc-annotate-warp-revision warp-rev)))))
-
-(defun vc-annotate-extract-revision-at-line ()
- "Extract the revision number of the current line."
- ;; This function must be invoked from a buffer in vc-annotate-mode
- (vc-call-backend vc-annotate-backend 'annotate-extract-revision-at-line))
-
-(defun vc-annotate-revision-at-line ()
- "Visit the annotation of the revision identified in the current line."
- (interactive)
- (if (not (equal major-mode 'vc-annotate-mode))
- (message "Cannot be invoked outside of a vc annotate buffer")
- (let ((rev-at-line (vc-annotate-extract-revision-at-line)))
- (if (not rev-at-line)
- (message "Cannot extract revision number from the current line")
- (if (equal rev-at-line vc-annotate-parent-rev)
- (message "Already at revision %s" rev-at-line)
- (vc-annotate-warp-revision rev-at-line))))))
-
-(defun vc-annotate-find-revision-at-line ()
- "Visit the revision identified in the current line."
- (interactive)
- (if (not (equal major-mode 'vc-annotate-mode))
- (message "Cannot be invoked outside of a vc annotate buffer")
- (let ((rev-at-line (vc-annotate-extract-revision-at-line)))
- (if (not rev-at-line)
- (message "Cannot extract revision number from the current line")
- (vc-revision-other-window rev-at-line)))))
-
-(defun vc-annotate-revision-previous-to-line ()
- "Visit the annotation of the revision before the revision at line."
- (interactive)
- (if (not (equal major-mode 'vc-annotate-mode))
- (message "Cannot be invoked outside of a vc annotate buffer")
- (let ((rev-at-line (vc-annotate-extract-revision-at-line))
- (prev-rev nil))
- (if (not rev-at-line)
- (message "Cannot extract revision number from the current line")
- (setq prev-rev
- (vc-call-backend vc-annotate-backend 'previous-revision
- vc-annotate-parent-file rev-at-line))
- (vc-annotate-warp-revision prev-rev)))))
-
-(defun vc-annotate-show-log-revision-at-line ()
- "Visit the log of the revision at line."
- (interactive)
- (if (not (equal major-mode 'vc-annotate-mode))
- (message "Cannot be invoked outside of a vc annotate buffer")
- (let ((rev-at-line (vc-annotate-extract-revision-at-line)))
- (if (not rev-at-line)
- (message "Cannot extract revision number from the current line")
- (vc-print-log rev-at-line)))))
-
-(defun vc-annotate-show-diff-revision-at-line ()
- "Visit the diff of the revision at line from its previous revision."
- (interactive)
- (if (not (equal major-mode 'vc-annotate-mode))
- (message "Cannot be invoked outside of a vc annotate buffer")
- (let ((rev-at-line (vc-annotate-extract-revision-at-line))
- (prev-rev nil))
- (if (not rev-at-line)
- (message "Cannot extract revision number from the current line")
- (setq prev-rev
- (vc-call-backend vc-annotate-backend 'previous-revision
- vc-annotate-parent-file rev-at-line))
- (if (not prev-rev)
- (message "Cannot diff from any revision prior to %s" rev-at-line)
- (save-window-excursion
- (vc-diff-internal
- nil
- (cons vc-annotate-backend (list vc-annotate-parent-file))
- prev-rev rev-at-line))
- (switch-to-buffer "*vc-diff*"))))))
-
-(defun vc-annotate-warp-revision (revspec)
- "Annotate the revision described by REVSPEC.
-
-If REVSPEC is a positive integer, warp that many revisions
-forward, if possible, otherwise echo a warning message. If
-REVSPEC is a negative integer, warp that many revisions backward,
-if possible, otherwise echo a warning message. If REVSPEC is a
-string, then it describes a revision number, so warp to that
-revision."
- (if (not (equal major-mode 'vc-annotate-mode))
- (message "Cannot be invoked outside of a vc annotate buffer")
- (let* ((buf (current-buffer))
- (oldline (line-number-at-pos))
- (revspeccopy revspec)
- (newrev nil))
- (cond
- ((and (integerp revspec) (> revspec 0))
- (setq newrev vc-annotate-parent-rev)
- (while (and (> revspec 0) newrev)
- (setq newrev (vc-call-backend vc-annotate-backend 'next-revision
- vc-annotate-parent-file newrev))
- (setq revspec (1- revspec)))
- (unless newrev
- (message "Cannot increment %d revisions from revision %s"
- revspeccopy vc-annotate-parent-rev)))
- ((and (integerp revspec) (< revspec 0))
- (setq newrev vc-annotate-parent-rev)
- (while (and (< revspec 0) newrev)
- (setq newrev (vc-call-backend vc-annotate-backend 'previous-revision
- vc-annotate-parent-file newrev))
- (setq revspec (1+ revspec)))
- (unless newrev
- (message "Cannot decrement %d revisions from revision %s"
- (- 0 revspeccopy) vc-annotate-parent-rev)))
- ((stringp revspec) (setq newrev revspec))
- (t (error "Invalid argument to vc-annotate-warp-revision")))
- (when newrev
- (vc-annotate vc-annotate-parent-file newrev
- vc-annotate-parent-display-mode
- buf
- ;; Pass the current line so that vc-annotate will
- ;; place the point in the line.
- (min oldline (progn (goto-char (point-max))
- (forward-line -1)
- (line-number-at-pos))))))))
-
-(defun vc-annotate-compcar (threshold a-list)
- "Test successive cons cells of A-LIST against THRESHOLD.
-Return the first cons cell with a car that is not less than THRESHOLD,
-nil if no such cell exists."
- (let ((i 1)
- (tmp-cons (car a-list)))
- (while (and tmp-cons (< (car tmp-cons) threshold))
- (setq tmp-cons (car (nthcdr i a-list)))
- (setq i (+ i 1)))
- tmp-cons)) ; Return the appropriate value
-
-(defun vc-annotate-convert-time (time)
- "Convert a time value to a floating-point number of days.
-The argument TIME is a list as returned by `current-time' or
-`encode-time', only the first two elements of that list are considered."
- (/ (+ (* (float (car time)) (lsh 1 16)) (cadr time)) 24 3600))
-
-(defun vc-annotate-difference (&optional offset)
- "Return the time span in days to the next annotation.
-This calls the backend function annotate-time, and returns the
-difference in days between the time returned and the current time,
-or OFFSET if present."
- (let ((next-time (vc-annotate-get-time-set-line-props)))
- (when next-time
- (- (or offset
- (vc-call-backend vc-annotate-backend 'annotate-current-time))
- next-time))))
-
-(defun vc-default-annotate-current-time (backend)
- "Return the current time, encoded as fractional days."
- (vc-annotate-convert-time (current-time)))
-
-(defvar vc-annotate-offset nil)
-
-(defun vc-annotate-display (ratio &optional offset)
- "Highlight `vc-annotate' output in the current buffer.
-RATIO, is the expansion that should be applied to `vc-annotate-color-map'.
-The annotations are relative to the current time, unless overridden by OFFSET."
- (when (/= ratio 1.0)
- (set (make-local-variable 'vc-annotate-color-map)
- (mapcar (lambda (elem) (cons (* (car elem) ratio) (cdr elem)))
- vc-annotate-color-map)))
- (set (make-local-variable 'vc-annotate-offset) offset)
- (font-lock-mode 1))
-
-(defun vc-annotate-lines (limit)
- (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))
- (when 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)
\f
;; These things should probably be generally available
+(defun vc-string-prefix-p (prefix string)
+ (let ((lpref (length prefix)))
+ (and (>= (length string) lpref)
+ (eq t (compare-strings prefix nil nil string nil lpref)))))
+
(defun vc-file-tree-walk (dirname func &rest args)
"Walk recursively through DIRNAME.
Invoke FUNC f ARGS on each VC-managed file f underneath it."
(provide 'vc)
-;; DEVELOPER'S NOTES ON CONCURRENCY PROBLEMS IN THIS CODE
-;;
-;; These may be useful to anyone who has to debug or extend the package.
-;; (Note that this information corresponds to versions 5.x. Some of it
-;; might have been invalidated by the additions to support branching
-;; and RCS keyword lookup. AS, 1995/03/24)
-;;
-;; A fundamental problem in VC is that there are time windows between
-;; vc-next-action's computations of the file's version-control state and
-;; the actions that change it. This is a window open to lossage in a
-;; multi-user environment; someone else could nip in and change the state
-;; of the master during it.
-;;
-;; The performance problem is that rlog/prs calls are very expensive; we want
-;; to avoid them as much as possible.
-;;
-;; ANALYSIS:
-;;
-;; The performance problem, it turns out, simplifies in practice to the
-;; problem of making vc-state fast. The two other functions that call
-;; prs/rlog will not be so commonly used that the slowdown is a problem; one
-;; makes tags, the other deletes the calling user's last change in the
-;; master.
-;;
-;; The race condition implies that we have to either (a) lock the master
-;; during the entire execution of vc-next-action, or (b) detect and
-;; recover from errors resulting from dispatch on an out-of-date state.
-;;
-;; Alternative (a) appears to be infeasible. The problem is that we can't
-;; guarantee that the lock will ever be removed. Suppose a user starts a
-;; checkin, the change message buffer pops up, and the user, having wandered
-;; off to do something else, simply forgets about it?
-;;
-;; Alternative (b), on the other hand, works well with a cheap way to speed up
-;; vc-state. Usually, if a file is registered, we can read its locked/
-;; unlocked state and its current owner from its permissions.
-;;
-;; This shortcut will fail if someone has manually changed the workfile's
-;; permissions; also if developers are munging the workfile in several
-;; directories, with symlinks to a master (in this latter case, the
-;; permissions shortcut will fail to detect a lock asserted from another
-;; directory).
-;;
-;; Note that these cases correspond exactly to the errors which could happen
-;; because of a competing checkin/checkout race in between two instances of
-;; vc-next-action.
-;;
-;; For VC's purposes, a workfile/master pair may have the following states:
-;;
-;; A. Unregistered. There is a workfile, there is no master.
-;;
-;; B. Registered and not locked by anyone.
-;;
-;; C. Locked by calling user and unchanged.
-;;
-;; D. Locked by the calling user and changed.
-;;
-;; E. Locked by someone other than the calling user.
-;;
-;; This makes for 25 states and 20 error conditions. Here's the matrix:
-;;
-;; VC's idea of state
-;; |
-;; V Actual state RCS action SCCS action Effect
-;; A B C D E
-;; A . 1 2 3 4 ci -u -t- admin -fb -i<file> initial admin
-;; B 5 . 6 7 8 co -l get -e checkout
-;; C 9 10 . 11 12 co -u unget; get revert
-;; D 13 14 15 . 16 ci -u -m<comment> delta -y<comment>; get checkin
-;; E 17 18 19 20 . rcs -u -M -l unget -n ; get -g steal lock
-;;
-;; All commands take the master file name as a last argument (not shown).
-;;
-;; In the discussion below, a "self-race" is a pathological situation in
-;; which VC operations are being attempted simultaneously by two or more
-;; Emacsen running under the same username.
-;;
-;; The vc-next-action code has the following windows:
-;;
-;; Window P:
-;; Between the check for existence of a master file and the call to
-;; admin/checkin in vc-buffer-admin (apparent state A). This window may
-;; never close if the initial-comment feature is on.
-;;
-;; Window Q:
-;; Between the call to vc-workfile-unchanged-p in and the immediately
-;; following revert (apparent state C).
-;;
-;; Window R:
-;; Between the call to vc-workfile-unchanged-p in and the following
-;; checkin (apparent state D). This window may never close.
-;;
-;; Window S:
-;; Between the unlock and the immediately following checkout during a
-;; revert operation (apparent state C). Included in window Q.
-;;
-;; Window T:
-;; Between vc-state and the following checkout (apparent state B).
-;;
-;; Window U:
-;; Between vc-state and the following revert (apparent state C).
-;; Includes windows Q and S.
-;;
-;; Window V:
-;; Between vc-state and the following checkin (apparent state
-;; D). This window may never be closed if the user fails to complete the
-;; checkin message. Includes window R.
-;;
-;; Window W:
-;; Between vc-state and the following steal-lock (apparent
-;; state E). This window may never close if the user fails to complete
-;; the steal-lock message. Includes window X.
-;;
-;; Window X:
-;; Between the unlock and the immediately following re-lock during a
-;; steal-lock operation (apparent state E). This window may never close
-;; if the user fails to complete the steal-lock message.
-;;
-;; Errors:
-;;
-;; Apparent state A ---
-;;
-;; 1. File looked unregistered but is actually registered and not locked.
-;;
-;; Potential cause: someone else's admin during window P, with
-;; caller's admin happening before their checkout.
-;;
-;; RCS: Prior to version 5.6.4, ci fails with message
-;; "no lock set by <user>". From 5.6.4 onwards, VC uses the new
-;; ci -i option and the message is "<file>,v: already exists".
-;; SCCS: admin will fail with error (ad19).
-;;
-;; We can let these errors be passed up to the user.
-;;
-;; 2. File looked unregistered but is actually locked by caller, unchanged.
-;;
-;; Potential cause: self-race during window P.
-;;
-;; RCS: Prior to version 5.6.4, reverts the file to the last saved
-;; version and unlocks it. From 5.6.4 onwards, VC uses the new
-;; ci -i option, failing with message "<file>,v: already exists".
-;; SCCS: will fail with error (ad19).
-;;
-;; Either of these consequences is acceptable.
-;;
-;; 3. File looked unregistered but is actually locked by caller, changed.
-;;
-;; Potential cause: self-race during window P.
-;;
-;; RCS: Prior to version 5.6.4, VC registers the caller's workfile as
-;; a delta with a null change comment (the -t- switch will be
-;; ignored). From 5.6.4 onwards, VC uses the new ci -i option,
-;; failing with message "<file>,v: already exists".
-;; SCCS: will fail with error (ad19).
-;;
-;; 4. File looked unregistered but is locked by someone else.
-;;;
-;; Potential cause: someone else's admin during window P, with
-;; caller's admin happening *after* their checkout.
-;;
-;; RCS: Prior to version 5.6.4, ci fails with a
-;; "no lock set by <user>" message. From 5.6.4 onwards,
-;; VC uses the new ci -i option, failing with message
-;; "<file>,v: already exists".
-;; SCCS: will fail with error (ad19).
-;;
-;; We can let these errors be passed up to the user.
-;;
-;; Apparent state B ---
-;;
-;; 5. File looked registered and not locked, but is actually unregistered.
-;;
-;; Potential cause: master file got nuked during window P.
-;;
-;; RCS: will fail with "RCS/<file>: No such file or directory"
-;; SCCS: will fail with error ut4.
-;;
-;; We can let these errors be passed up to the user.
-;;
-;; 6. File looked registered and not locked, but is actually locked by the
-;; calling user and unchanged.
-;;
-;; Potential cause: self-race during window T.
-;;
-;; RCS: in the same directory as the previous workfile, co -l will fail
-;; with "co error: writable foo exists; checkout aborted". In any other
-;; directory, checkout will succeed.
-;; SCCS: will fail with ge17.
-;;
-;; Either of these consequences is acceptable.
-;;
-;; 7. File looked registered and not locked, but is actually locked by the
-;; calling user and changed.
-;;
-;; As case 6.
-;;
-;; 8. File looked registered and not locked, but is actually locked by another
-;; user.
-;;
-;; Potential cause: someone else checks it out during window T.
-;;
-;; RCS: co error: revision 1.3 already locked by <user>
-;; SCCS: fails with ge4 (in directory) or ut7 (outside it).
-;;
-;; We can let these errors be passed up to the user.
-;;
-;; Apparent state C ---
-;;
-;; 9. File looks locked by calling user and unchanged, but is unregistered.
-;;
-;; As case 5.
-;;
-;; 10. File looks locked by calling user and unchanged, but is actually not
-;; locked.
-;;
-;; Potential cause: a self-race in window U, or by the revert's
-;; landing during window X of some other user's steal-lock or window S
-;; of another user's revert.
-;;
-;; RCS: succeeds, refreshing the file from the identical version in
-;; the master.
-;; SCCS: fails with error ut4 (p file nonexistent).
-;;
-;; Either of these consequences is acceptable.
-;;
-;; 11. File is locked by calling user. It looks unchanged, but is actually
-;; changed.
-;;
-;; Potential cause: the file would have to be touched by a self-race
-;; during window Q.
-;;
-;; The revert will succeed, removing whatever changes came with
-;; the touch. It is theoretically possible that work could be lost.
-;;
-;; 12. File looks like it's locked by the calling user and unchanged, but
-;; it's actually locked by someone else.
-;;
-;; Potential cause: a steal-lock in window V.
-;;
-;; RCS: co error: revision <rev> locked by <user>; use co -r or rcs -u
-;; SCCS: fails with error un2
-;;
-;; We can pass these errors up to the user.
-;;
-;; Apparent state D ---
-;;
-;; 13. File looks like it's locked by the calling user and changed, but it's
-;; actually unregistered.
-;;
-;; Potential cause: master file got nuked during window P.
-;;
-;; RCS: Prior to version 5.6.4, checks in the user's version as an
-;; initial delta. From 5.6.4 onwards, VC uses the new ci -j
-;; option, failing with message "no such file or directory".
-;; SCCS: will fail with error ut4.
-;;
-;; This case is kind of nasty. Under RCS prior to version 5.6.4,
-;; VC may fail to detect the loss of previous version information.
-;;
-;; 14. File looks like it's locked by the calling user and changed, but it's
-;; actually unlocked.
-;;
-;; Potential cause: self-race in window V, or the checkin happening
-;; during the window X of someone else's steal-lock or window S of
-;; someone else's revert.
-;;
-;; RCS: ci will fail with "no lock set by <user>".
-;; SCCS: delta will fail with error ut4.
-;;
-;; 15. File looks like it's locked by the calling user and changed, but it's
-;; actually locked by the calling user and unchanged.
-;;
-;; Potential cause: another self-race --- a whole checkin/checkout
-;; sequence by the calling user would have to land in window R.
-;;
-;; SCCS: checks in a redundant delta and leaves the file unlocked as usual.
-;; RCS: reverts to the file state as of the second user's checkin, leaving
-;; the file unlocked.
-;;
-;; It is theoretically possible that work could be lost under RCS.
-;;
-;; 16. File looks like it's locked by the calling user and changed, but it's
-;; actually locked by a different user.
-;;
-;; RCS: ci error: no lock set by <user>
-;; SCCS: unget will fail with error un2
-;;
-;; We can pass these errors up to the user.
-;;
-;; Apparent state E ---
-;;
-;; 17. File looks like it's locked by some other user, but it's actually
-;; unregistered.
-;;
-;; As case 13.
-;;
-;; 18. File looks like it's locked by some other user, but it's actually
-;; unlocked.
-;;
-;; Potential cause: someone released a lock during window W.
-;;
-;; RCS: The calling user will get the lock on the file.
-;; SCCS: unget -n will fail with cm4.
-;;
-;; Either of these consequences will be OK.
-;;
-;; 19. File looks like it's locked by some other user, but it's actually
-;; locked by the calling user and unchanged.
-;;
-;; Potential cause: the other user relinquishing a lock followed by
-;; a self-race, both in window W.
-;;
-;; Under both RCS and SCCS, both unlock and lock will succeed, making
-;; the sequence a no-op.
-;;
-;; 20. File looks like it's locked by some other user, but it's actually
-;; locked by the calling user and changed.
-;;
-;; As case 19.
-;;
-;; PROBLEM CASES:
-;;
-;; In order of decreasing severity:
-;;
-;; Cases 11 and 15 are the only ones that potentially lose work.
-;; They would require a self-race for this to happen.
-;;
-;; Case 13 in RCS loses information about previous deltas, retaining
-;; only the information in the current workfile. This can only happen
-;; if the master file gets nuked in window P.
-;;
-;; Case 3 in RCS and case 15 under SCCS insert a redundant delta with
-;; no change comment in the master. This would require a self-race in
-;; window P or R respectively.
-;;
-;; Cases 2, 10, 19 and 20 do extra work, but make no changes.
-;;
-;; Unfortunately, it appears to me that no recovery is possible in these
-;; cases. They don't yield error messages, so there's no way to tell that
-;; a race condition has occurred.
-;;
-;; All other cases don't change either the workfile or the master, and
-;; trigger command errors which the user will see.
-;;
-;; Thus, there is no explicit recovery code.
-
;; arch-tag: ca82c1de-3091-4e26-af92-460abc6213a6
;;; vc.el ends here
HCoop / bpt / emacs.git / blobdiff