;; corresponding to the current line, or nil if there is no revision
;; corresponding to the current line.
;;
-;; SNAPSHOT SYSTEM
+;; TAG SYSTEM
;;
-;; - create-snapshot (dir name branchp)
+;; - create-tag (dir name branchp)
;;
-;; Take a snapshot of the current state of files under DIR and name it
-;; NAME. This should make sure that files are up-to-date before
-;; proceeding with the action. DIR can also be a file and if BRANCHP
-;; is specified, NAME should be created as a branch and DIR should be
-;; checked out under this new branch. The default implementation does
-;; not support branches but does a sanity check, a tree traversal and
-;; for each file calls `assign-name'.
+;; Attach the tag NAME to the state of the working copy. This
+;; should make sure that files are up-to-date before proceeding with
+;; the action. DIR can also be a file and if BRANCHP is specified,
+;; NAME should be created as a branch and DIR should be checked out
+;; under this new branch. The default implementation does not
+;; support branches but does a sanity check, a tree traversal and
+;; assigns the tag to each file.
;;
-;; - assign-name (file name)
+;; - retrieve-tag (dir name update)
;;
-;; Give name NAME to the working revision of FILE, assuming it is
-;; up-to-date. Only used by the default version of `create-snapshot'.
-;;
-;; - retrieve-snapshot (dir name update)
-;;
-;; Retrieve a named snapshot of all registered files at or below DIR.
+;; Retrieve the version tagged by NAME of all registered files at or below DIR.
;; If UPDATE is non-nil, then update buffers of any files in the
-;; snapshot that are currently visited. The default implementation
+;; tag that are currently visited. The default implementation
;; does a sanity check whether there aren't any uncommitted changes at
;; or below DIR, and then performs a tree walk, using the `checkout'
;; function to retrieve the corresponding revisions.
;;; Todo:
+;; - Add key-binding for vc-delete-file.
+
;;;; New Primitives:
;;
;; - deal with push/pull operations.
;;
;;;; Improved branch and tag handling:
;;
-;; - "snapshots" should be renamed to "tags", and thoroughly reworked.
-;;
;; - add a generic mechanism for remembering the current branch names,
;; display the branch name in the mode-line. Replace
;; vc-cvs-sticky-tag with that.
;; adapted accordingly. Also, it considers RCS and CVS to be the same,
;; which is pretty confusing.
;;
-;; - vc-create-snapshot and vc-retrieve-snapshot should update the
+;; - vc-create-tag and vc-retrieve-tag should update the
;; buffers that might be visiting the affected files.
;;
;;;; Default Behavior:
;;;; 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, ...
;;
+;; - C-x v l should insert the file set in the *VC-log* buffer so that
+;; log-view can recognize it and use it for its commands.
+;;
;; - 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.
;; `diff-add-change-log-entries-other-window' to create a detailed
;; skeleton for the log...
;;
+;; - The *vc-dir* buffer needs to be updated properly after VC
+;; operations on directories that change the file VC state.
+;;
;; - most vc-dir backends need more work. They might need to
;; provide custom headers, use the `extra' field and deal with all
;; possible VC states.
;; Those logs should likely use a local variable to hardware the VC they
;; are supposed to work with.
;;
-
+;;;; Problems:
+;;
+;; - the *vc-dir* buffer is not updated correctly anymore after VC
+;; operations that change the file state.
+;;
;;; Code:
(require 'vc-hooks)
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-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* ((fileset (vc-dispatcher-selection-set observer))
- ;; FIXME: Store the backend in a buffer-local variable.
- (backend (if (derived-mode-p 'vc-dir-mode)
- (vc-responsible-backend default-directory)
- (assert (and (= 1 (length fileset))
- (not (file-directory-p (car fileset)))))
- (vc-backend (car fileset)))))
- (cons backend fileset)))
+(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))))
+
+(defvar vc-dir-backend nil
+ "The backend used by the current *vc-dir* buffer.")
+
+;; FIXME: this is not functional, commented out.
+;; (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))
+;; ;; FIXME: this should use vc-dir-backend from
+;; ;; the *vc-dir* buffer.
+;; (vc-responsible-backend default-directory)
+;; (assert (and (= 1 (length raw))
+;; (not (file-directory-p (car raw)))))
+;; (vc-backend (car cooked)))))
+;; (cons backend selection)))
+
+(defun vc-deduce-fileset (&optional observer allow-unregistered)
+ "Deduce a set of files and a backend to which to apply an operation.
+
+Return (BACKEND FILESET FILESET_ONLY_FILES).
+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."
+ ;; FIXME: OBSERVER is unused. The name is not intuitive and is not
+ ;; documented.
+ (let (backend)
+ (cond
+ ((derived-mode-p 'vc-dir-mode)
+ (let ((marked (vc-dir-marked-files)))
+ (if marked
+ (list vc-dir-backend marked (vc-dir-marked-only-files))
+ (let ((crt (vc-dir-current-file)))
+ (list vc-dir-backend (list crt) (vc-dir-child-files))))))
+ ((setq backend (vc-backend buffer-file-name))
+ (list backend (list buffer-file-name) (list buffer-file-name)))
+ ((and vc-parent-buffer (or (buffer-file-name vc-parent-buffer)
+ (with-current-buffer vc-parent-buffer
+ (eq major-mode 'vc-dir-mode))))
+ (progn
+ (set-buffer vc-parent-buffer)
+ (vc-deduce-fileset)))
+ ((and allow-unregistered (not (vc-registered buffer-file-name)))
+ (list (vc-responsible-backend
+ (file-name-directory (buffer-file-name)))
+ (list buffer-file-name) (list buffer-file-name)))
+ (t (error "No fileset is available here.")))))
(defun vc-ensure-vc-buffer ()
"Make sure that the current buffer visits a version-controlled file."
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))
(backend (car vc-fileset))
- (files (cdr vc-fileset))
- (fileset-only-files (vc-expand-dirs files))
+ (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)))
;; The backend should check that the checkout-model is consistent
;; among all the `files'.
- (model (vc-checkout-model backend files))
+ (model
+ ;; FIXME: This is not very elegant...
+ (when (and state (not (eq state 'unregistered)))
+ (vc-checkout-model backend files)))
revision)
;; Check that all files are in a consistent state, since we use that
(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)
+ ((or (null state) (eq state 'unregistered))
(mapc (lambda (arg) (vc-register nil arg)) files))
;; 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)))
(or comment (not vc-initial-comment))
nil
"Enter initial comment."
+ "*VC-log*"
(lambda (files rev comment)
(dolist (file files)
(message "Registering %s... " file)
(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".
"Report diffs between two revisions of a fileset.
Diff output goes to the *vc-diff* buffer. The function
returns t if the buffer had changes, nil otherwise."
- (let* ((files (cdr vc-fileset))
+ (let* ((files (cadr vc-fileset))
(messages (cons (format "Finding changes in %s..."
(vc-delistify files))
(format "No changes between %s and %s"
"Report diffs between revisions of the fileset in the repository history."
(interactive
(let* ((vc-fileset (vc-deduce-fileset t))
- (files (cdr vc-fileset))
+ (files (cadr vc-fileset))
(backend (car vc-fileset))
(first (car files))
(completion-table
(vc-start-logentry
files rev oldcomment t
"Enter a replacement change comment."
+ "*VC-log*"
(lambda (files rev comment)
(vc-call-backend
;; Less of a kluge than it looks like; log-view mode only passes
;; 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.
+ ;; Be loud by default to remind people to add code to display
+ ;; backend specific headers.
;; XXX: change this to return nil before the release.
- "Extra : Add backend specific headers here")
+ (concat
+ (propertize "Extra : " 'face 'font-lock-type-face)
+ (propertize "Please add backend specific headers here. It's easy!"
+ 'face 'font-lock-warning-face)))
(defun vc-dir-headers (backend dir)
- "Display the headers in the *VC status* buffer.
+ "Display the headers in the *VC dir* buffer.
It calls the `status-extra-headers' backend method to display backend
specific headers."
(concat
(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))))
+ (let* ((isdir (vc-dir-fileinfo->directory fileentry))
+ (state (if isdir 'DIRECTORY (vc-dir-fileinfo->state fileentry)))
+ (filename (vc-dir-fileinfo->name fileentry)))
+ ;; FIXME: Backends that want to print the state in a different way
+ ;; can do it by defining the `status-printer' function. Using
+ ;; `prettify-state-info' adds two extra vc-calls per item, which
+ ;; is too expensive.
+ ;;(prettified (if isdir state (vc-call-backend backend 'prettify-state-info filename))))
(insert
(propertize
(format "%c" (if (vc-dir-fileinfo->marked fileentry) ?* ? ))
'mouse-face 'highlight)
" "
(propertize
- (format "%s" (vc-dir-fileinfo->name fileentry))
+ (format "%s" filename)
'face 'font-lock-function-name-face
'mouse-face 'highlight))))
(defun vc-default-extra-status-menu (backend)
nil)
-;; This is used to that VC backends could add backend specific menu
-;; items to vc-dir-menu-map.
-(defun vc-dir-menu-map-filter (orig-binding)
- (when (and (symbolp orig-binding) (fboundp orig-binding))
- (setq orig-binding (indirect-function orig-binding)))
- (let ((ext-binding
- (vc-call-backend (vc-responsible-backend default-directory)
- 'extra-status-menu)))
- (if (null ext-binding)
- orig-binding
- (append orig-binding
- '("----")
- ext-binding))))
-
(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))
+ "Refresh some files in the *VC-dir* buffer."
+ (let ((def-dir default-directory)
+ (backend vc-dir-backend))
(vc-set-mode-line-busy-indicator)
;; Call the `dir-status-file' backend function.
;; `dir-status-file' is supposed to be asynchronous.
;; file/dir doesn't exist and isn't versioned.
(ewoc-filter vc-ewoc
(lambda (info)
+ ;; The state for directory entries might
+ ;; have been changed to 'up-to-date,
+ ;; reset it, othewise it will be removed when doing 'x'
+ ;; next time.
+ ;; FIXME: There should be a more elegant way to do this.
+ (when (and (vc-dir-fileinfo->directory info)
+ (eq (vc-dir-fileinfo->state info)
+ 'up-to-date))
+ (setf (vc-dir-fileinfo->state info) nil))
+
(not (vc-dir-fileinfo->needs-update info))))))))))))
(defun vc-dir-refresh ()
- "Refresh the contents of the VC status buffer.
+ "Refresh the contents of the *VC-dir* 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))
+ (let ((def-dir default-directory)
+ (backend vc-dir-backend))
(vc-set-mode-line-busy-indicator)
;; Call the `dir-status' backend function.
;; `dir-status' is supposed to be asynchronous.
(setq mode-line-process nil))))))))))))
(defun vc-dir-show-fileentry (file)
- "Insert an entry for a specific file into the current VC status listing.
+ "Insert an entry for a specific file into the current *VC-dir* 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: ")
;; 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)))
-
+ (vc-call-backend vc-dir-backend 'status-printer fileentry))
+
(defun vc-generic-state (file)
- (let ((backend (vc-responsible-backend (expand-file-name file))))
- (vc-call-backend backend 'state file)))
-
+ (vc-call-backend vc-dir-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)))
+ (vc-call-backend vc-dir-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-dir-backend '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 dir"
+ (vc-dir-headers vc-dir-backend file-or-dir)
#'vc-generic-status-printer
#'vc-generic-state
#'vc-generic-status-fileinfo-extra
- #'vc-dir-refresh))
+ #'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 dir))
+ (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
+ (set (make-local-variable 'vc-dir-backend) (vc-responsible-backend dir))
;; 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 "v" 'vc-next-action) ;; 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 +
;; Named-configuration entry points
-(defun vc-snapshot-precondition (dir)
+(defun vc-tag-precondition (dir)
"Scan the tree below DIR, looking for files not up-to-date.
If any file is not up-to-date, return the name of the first such file.
-\(This means, neither snapshot creation nor retrieval is allowed.\)
+\(This means, neither tag creation nor retrieval is allowed.\)
If one or more of the files are currently visited, return `visited'.
Otherwise, return nil."
(let ((status nil))
status)))
;;;###autoload
-(defun vc-create-snapshot (dir name branchp)
- "Descending recursively from DIR, make a snapshot called NAME.
+(defun vc-create-tag (dir name branchp)
+ "Descending recursively from DIR, make a tag called NAME.
For each registered file, the working revision becomes part of
the named configuration. If the prefix argument BRANCHP is
-given, the snapshot is made as a new branch and the files are
+given, the tag is made as a new branch and the files are
checked out in that new branch."
(interactive
(list (read-file-name "Directory: " default-directory default-directory t)
- (read-string "New snapshot name: ")
+ (read-string "New tag name: ")
current-prefix-arg))
- (message "Making %s... " (if branchp "branch" "snapshot"))
+ (message "Making %s... " (if branchp "branch" "tag"))
(when (file-directory-p dir) (setq dir (file-name-as-directory dir)))
(vc-call-backend (vc-responsible-backend dir)
- 'create-snapshot dir name branchp)
- (message "Making %s... done" (if branchp "branch" "snapshot")))
+ 'create-tag dir name branchp)
+ (message "Making %s... done" (if branchp "branch" "tag")))
;;;###autoload
-(defun vc-retrieve-snapshot (dir name)
- "Descending recursively from DIR, retrieve the snapshot called NAME.
+(defun vc-retrieve-tag (dir name)
+ "Descending recursively from DIR, retrieve the tag called NAME.
If NAME is empty, it refers to the latest revisions.
If locking is used for the files in DIR, then there must not be any
locked files at or below DIR (but if NAME is empty, locked files are
allowed and simply skipped)."
(interactive
(list (read-file-name "Directory: " default-directory default-directory t)
- (read-string "Snapshot name to retrieve (default latest revisions): ")))
+ (read-string "Tag name to retrieve (default latest revisions): ")))
(let ((update (yes-or-no-p "Update any affected buffers? "))
(msg (if (or (not name) (string= name ""))
(format "Updating %s... " (abbreviate-file-name dir))
- (format "Retrieving snapshot into %s... "
+ (format "Retrieving tag into %s... "
(abbreviate-file-name dir)))))
(message "%s" msg)
(vc-call-backend (vc-responsible-backend dir)
- 'retrieve-snapshot dir name update)
+ 'retrieve-tag dir name update)
(message "%s" (concat msg "done"))))
;; Miscellaneous other entry points
(interactive)
(let* ((vc-fileset (vc-deduce-fileset t))
(backend (car vc-fileset))
- (files (cdr 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
to the working revision (except for keyword expansion)."
(interactive)
(let* ((vc-fileset (vc-deduce-fileset))
- (files (cdr vc-fileset)))
+ (files (cadr vc-fileset)))
;; 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
(interactive)
(let* ((vc-fileset (vc-deduce-fileset))
(backend (car vc-fileset))
- (files (cdr vc-fileset))
+ (files (cadr vc-fileset))
(granularity (vc-call-backend backend 'revision-granularity)))
(unless (vc-find-backend-function backend 'rollback)
(error "Rollback is not supported in %s" backend))
(interactive)
(let* ((vc-fileset (vc-deduce-fileset))
(backend (car vc-fileset))
- (files (cdr vc-fileset)))
+ (files (cadr vc-fileset)))
(dolist (file files)
(when (let ((buf (get-file-buffer file)))
(and buf (buffer-modified-p buf)))
(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)))))
+ (backup-buffer))))
(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)
(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)
(let* ((state (vc-state file))
(statestring
(cond
- ((stringp state) (concat "(" state ")"))
+ ((stringp state) (concat "(locked:" 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 'unregistered) "(unregistered)")
((eq state 'unlocked-changes) "(stale)")
- ((not state) "(unknown)")))
+ (t (format "(unknown:%s)" state))))
(buffer
(get-file-buffer file))
(modflag
"Let BACKEND receive FILE from another version control system."
(vc-call-backend backend 'register file rev ""))
-(defun vc-default-create-snapshot (backend dir name branchp)
- (when branchp
- (error "VC backend %s does not support module branches" backend))
- (let ((result (vc-snapshot-precondition dir)))
- (if (stringp result)
- (error "File %s is not up-to-date" result)
- (vc-file-tree-walk
- dir
- (lambda (f)
- (vc-call-backend backend 'assign-name f name))))))
-
-(defun vc-default-retrieve-snapshot (backend dir name update)
+(defun vc-default-retrieve-tag (backend dir name update)
(if (string= name "")
(progn
(vc-file-tree-walk
(vc-error-occurred
(vc-call-backend backend 'checkout f nil "")
(when update (vc-resynch-buffer f t t)))))))
- (let ((result (vc-snapshot-precondition dir)))
+ (let ((result (vc-tag-precondition dir)))
(if (stringp result)
(error "File %s is locked" result)
(setq update (and (eq result 'visited) update))
(save-window-excursion
(vc-diff-internal
nil
- (cons vc-annotate-backend (list vc-annotate-parent-file))
+ ;; The value passed here should follow what
+ ;; `vc-deduce-fileset' returns.
+ (cons vc-annotate-backend
+ (cons (list vc-annotate-parent-file) nil))
prev-rev rev-at-line))
(switch-to-buffer "*vc-diff*"))))))
(provide 'vc)
-;; DEVELOPER'S NOTES ON CONCURRENCY PROBLEMS IN THIS CODE
-;;
-;; These may be useful to anyone who has to debug or extend the package.
-;; (Note that this information corresponds to versions 5.x. Some of it
-;; might have been invalidated by the additions to support branching
-;; and RCS keyword lookup. AS, 1995/03/24)
-;;
-;; A fundamental problem in VC is that there are time windows between
-;; vc-next-action's computations of the file's version-control state and
-;; the actions that change it. This is a window open to lossage in a
-;; multi-user environment; someone else could nip in and change the state
-;; of the master during it.
-;;
-;; The performance problem is that rlog/prs calls are very expensive; we want
-;; to avoid them as much as possible.
-;;
-;; ANALYSIS:
-;;
-;; The performance problem, it turns out, simplifies in practice to the
-;; problem of making vc-state fast. The two other functions that call
-;; prs/rlog will not be so commonly used that the slowdown is a problem; one
-;; makes snapshots, the other deletes the calling user's last change in the
-;; master.
-;;
-;; The race condition implies that we have to either (a) lock the master
-;; during the entire execution of vc-next-action, or (b) detect and
-;; recover from errors resulting from dispatch on an out-of-date state.
-;;
-;; Alternative (a) appears to be infeasible. The problem is that we can't
-;; guarantee that the lock will ever be removed. Suppose a user starts a
-;; checkin, the change message buffer pops up, and the user, having wandered
-;; off to do something else, simply forgets about it?
-;;
-;; Alternative (b), on the other hand, works well with a cheap way to speed up
-;; vc-state. Usually, if a file is registered, we can read its locked/
-;; unlocked state and its current owner from its permissions.
-;;
-;; This shortcut will fail if someone has manually changed the workfile's
-;; permissions; also if developers are munging the workfile in several
-;; directories, with symlinks to a master (in this latter case, the
-;; permissions shortcut will fail to detect a lock asserted from another
-;; directory).
-;;
-;; Note that these cases correspond exactly to the errors which could happen
-;; because of a competing checkin/checkout race in between two instances of
-;; vc-next-action.
-;;
-;; For VC's purposes, a workfile/master pair may have the following states:
-;;
-;; A. Unregistered. There is a workfile, there is no master.
-;;
-;; B. Registered and not locked by anyone.
-;;
-;; C. Locked by calling user and unchanged.
-;;
-;; D. Locked by the calling user and changed.
-;;
-;; E. Locked by someone other than the calling user.
-;;
-;; This makes for 25 states and 20 error conditions. Here's the matrix:
-;;
-;; VC's idea of state
-;; |
-;; V Actual state RCS action SCCS action Effect
-;; A B C D E
-;; A . 1 2 3 4 ci -u -t- admin -fb -i<file> initial admin
-;; B 5 . 6 7 8 co -l get -e checkout
-;; C 9 10 . 11 12 co -u unget; get revert
-;; D 13 14 15 . 16 ci -u -m<comment> delta -y<comment>; get checkin
-;; E 17 18 19 20 . rcs -u -M -l unget -n ; get -g steal lock
-;;
-;; All commands take the master file name as a last argument (not shown).
-;;
-;; In the discussion below, a "self-race" is a pathological situation in
-;; which VC operations are being attempted simultaneously by two or more
-;; Emacsen running under the same username.
-;;
-;; The vc-next-action code has the following windows:
-;;
-;; Window P:
-;; Between the check for existence of a master file and the call to
-;; admin/checkin in vc-buffer-admin (apparent state A). This window may
-;; never close if the initial-comment feature is on.
-;;
-;; Window Q:
-;; Between the call to vc-workfile-unchanged-p in and the immediately
-;; following revert (apparent state C).
-;;
-;; Window R:
-;; Between the call to vc-workfile-unchanged-p in and the following
-;; checkin (apparent state D). This window may never close.
-;;
-;; Window S:
-;; Between the unlock and the immediately following checkout during a
-;; revert operation (apparent state C). Included in window Q.
-;;
-;; Window T:
-;; Between vc-state and the following checkout (apparent state B).
-;;
-;; Window U:
-;; Between vc-state and the following revert (apparent state C).
-;; Includes windows Q and S.
-;;
-;; Window V:
-;; Between vc-state and the following checkin (apparent state
-;; D). This window may never be closed if the user fails to complete the
-;; checkin message. Includes window R.
-;;
-;; Window W:
-;; Between vc-state and the following steal-lock (apparent
-;; state E). This window may never close if the user fails to complete
-;; the steal-lock message. Includes window X.
-;;
-;; Window X:
-;; Between the unlock and the immediately following re-lock during a
-;; steal-lock operation (apparent state E). This window may never close
-;; if the user fails to complete the steal-lock message.
-;;
-;; Errors:
-;;
-;; Apparent state A ---
-;;
-;; 1. File looked unregistered but is actually registered and not locked.
-;;
-;; Potential cause: someone else's admin during window P, with
-;; caller's admin happening before their checkout.
-;;
-;; RCS: Prior to version 5.6.4, ci fails with message
-;; "no lock set by <user>". From 5.6.4 onwards, VC uses the new
-;; ci -i option and the message is "<file>,v: already exists".
-;; SCCS: admin will fail with error (ad19).
-;;
-;; We can let these errors be passed up to the user.
-;;
-;; 2. File looked unregistered but is actually locked by caller, unchanged.
-;;
-;; Potential cause: self-race during window P.
-;;
-;; RCS: Prior to version 5.6.4, reverts the file to the last saved
-;; version and unlocks it. From 5.6.4 onwards, VC uses the new
-;; ci -i option, failing with message "<file>,v: already exists".
-;; SCCS: will fail with error (ad19).
-;;
-;; Either of these consequences is acceptable.
-;;
-;; 3. File looked unregistered but is actually locked by caller, changed.
-;;
-;; Potential cause: self-race during window P.
-;;
-;; RCS: Prior to version 5.6.4, VC registers the caller's workfile as
-;; a delta with a null change comment (the -t- switch will be
-;; ignored). From 5.6.4 onwards, VC uses the new ci -i option,
-;; failing with message "<file>,v: already exists".
-;; SCCS: will fail with error (ad19).
-;;
-;; 4. File looked unregistered but is locked by someone else.
-;;;
-;; Potential cause: someone else's admin during window P, with
-;; caller's admin happening *after* their checkout.
-;;
-;; RCS: Prior to version 5.6.4, ci fails with a
-;; "no lock set by <user>" message. From 5.6.4 onwards,
-;; VC uses the new ci -i option, failing with message
-;; "<file>,v: already exists".
-;; SCCS: will fail with error (ad19).
-;;
-;; We can let these errors be passed up to the user.
-;;
-;; Apparent state B ---
-;;
-;; 5. File looked registered and not locked, but is actually unregistered.
-;;
-;; Potential cause: master file got nuked during window P.
-;;
-;; RCS: will fail with "RCS/<file>: No such file or directory"
-;; SCCS: will fail with error ut4.
-;;
-;; We can let these errors be passed up to the user.
-;;
-;; 6. File looked registered and not locked, but is actually locked by the
-;; calling user and unchanged.
-;;
-;; Potential cause: self-race during window T.
-;;
-;; RCS: in the same directory as the previous workfile, co -l will fail
-;; with "co error: writable foo exists; checkout aborted". In any other
-;; directory, checkout will succeed.
-;; SCCS: will fail with ge17.
-;;
-;; Either of these consequences is acceptable.
-;;
-;; 7. File looked registered and not locked, but is actually locked by the
-;; calling user and changed.
-;;
-;; As case 6.
-;;
-;; 8. File looked registered and not locked, but is actually locked by another
-;; user.
-;;
-;; Potential cause: someone else checks it out during window T.
-;;
-;; RCS: co error: revision 1.3 already locked by <user>
-;; SCCS: fails with ge4 (in directory) or ut7 (outside it).
-;;
-;; We can let these errors be passed up to the user.
-;;
-;; Apparent state C ---
-;;
-;; 9. File looks locked by calling user and unchanged, but is unregistered.
-;;
-;; As case 5.
-;;
-;; 10. File looks locked by calling user and unchanged, but is actually not
-;; locked.
-;;
-;; Potential cause: a self-race in window U, or by the revert's
-;; landing during window X of some other user's steal-lock or window S
-;; of another user's revert.
-;;
-;; RCS: succeeds, refreshing the file from the identical version in
-;; the master.
-;; SCCS: fails with error ut4 (p file nonexistent).
-;;
-;; Either of these consequences is acceptable.
-;;
-;; 11. File is locked by calling user. It looks unchanged, but is actually
-;; changed.
-;;
-;; Potential cause: the file would have to be touched by a self-race
-;; during window Q.
-;;
-;; The revert will succeed, removing whatever changes came with
-;; the touch. It is theoretically possible that work could be lost.
-;;
-;; 12. File looks like it's locked by the calling user and unchanged, but
-;; it's actually locked by someone else.
-;;
-;; Potential cause: a steal-lock in window V.
-;;
-;; RCS: co error: revision <rev> locked by <user>; use co -r or rcs -u
-;; SCCS: fails with error un2
-;;
-;; We can pass these errors up to the user.
-;;
-;; Apparent state D ---
-;;
-;; 13. File looks like it's locked by the calling user and changed, but it's
-;; actually unregistered.
-;;
-;; Potential cause: master file got nuked during window P.
-;;
-;; RCS: Prior to version 5.6.4, checks in the user's version as an
-;; initial delta. From 5.6.4 onwards, VC uses the new ci -j
-;; option, failing with message "no such file or directory".
-;; SCCS: will fail with error ut4.
-;;
-;; This case is kind of nasty. Under RCS prior to version 5.6.4,
-;; VC may fail to detect the loss of previous version information.
-;;
-;; 14. File looks like it's locked by the calling user and changed, but it's
-;; actually unlocked.
-;;
-;; Potential cause: self-race in window V, or the checkin happening
-;; during the window X of someone else's steal-lock or window S of
-;; someone else's revert.
-;;
-;; RCS: ci will fail with "no lock set by <user>".
-;; SCCS: delta will fail with error ut4.
-;;
-;; 15. File looks like it's locked by the calling user and changed, but it's
-;; actually locked by the calling user and unchanged.
-;;
-;; Potential cause: another self-race --- a whole checkin/checkout
-;; sequence by the calling user would have to land in window R.
-;;
-;; SCCS: checks in a redundant delta and leaves the file unlocked as usual.
-;; RCS: reverts to the file state as of the second user's checkin, leaving
-;; the file unlocked.
-;;
-;; It is theoretically possible that work could be lost under RCS.
-;;
-;; 16. File looks like it's locked by the calling user and changed, but it's
-;; actually locked by a different user.
-;;
-;; RCS: ci error: no lock set by <user>
-;; SCCS: unget will fail with error un2
-;;
-;; We can pass these errors up to the user.
-;;
-;; Apparent state E ---
-;;
-;; 17. File looks like it's locked by some other user, but it's actually
-;; unregistered.
-;;
-;; As case 13.
-;;
-;; 18. File looks like it's locked by some other user, but it's actually
-;; unlocked.
-;;
-;; Potential cause: someone released a lock during window W.
-;;
-;; RCS: The calling user will get the lock on the file.
-;; SCCS: unget -n will fail with cm4.
-;;
-;; Either of these consequences will be OK.
-;;
-;; 19. File looks like it's locked by some other user, but it's actually
-;; locked by the calling user and unchanged.
-;;
-;; Potential cause: the other user relinquishing a lock followed by
-;; a self-race, both in window W.
-;;
-;; Under both RCS and SCCS, both unlock and lock will succeed, making
-;; the sequence a no-op.
-;;
-;; 20. File looks like it's locked by some other user, but it's actually
-;; locked by the calling user and changed.
-;;
-;; As case 19.
-;;
-;; PROBLEM CASES:
-;;
-;; In order of decreasing severity:
-;;
-;; Cases 11 and 15 are the only ones that potentially lose work.
-;; They would require a self-race for this to happen.
-;;
-;; Case 13 in RCS loses information about previous deltas, retaining
-;; only the information in the current workfile. This can only happen
-;; if the master file gets nuked in window P.
-;;
-;; Case 3 in RCS and case 15 under SCCS insert a redundant delta with
-;; no change comment in the master. This would require a self-race in
-;; window P or R respectively.
-;;
-;; Cases 2, 10, 19 and 20 do extra work, but make no changes.
-;;
-;; Unfortunately, it appears to me that no recovery is possible in these
-;; cases. They don't yield error messages, so there's no way to tell that
-;; a race condition has occurred.
-;;
-;; All other cases don't change either the workfile or the master, and
-;; trigger command errors which the user will see.
-;;
-;; Thus, there is no explicit recovery code.
-
;; arch-tag: ca82c1de-3091-4e26-af92-460abc6213a6
;;; vc.el ends here
HCoop / bpt / emacs.git / blobdiff