Mercurial > emacs
changeset 31809:a2c432c6b343
(vc-rcs-workfile-is-newer): New function.
(vc-rcs-state-heuristic): Use it to guess the state of files with
non-strict locking.
(vc-rcs-find-most-recent-rev): Handle the case when a branch has been
set with -b, but not created yet.
(vc-rcs-fetch-master-state): With non-strict locking, compare file
contents in order to find the state.
(vc-rcs-checkin): Allow creation of branches with no changes.
(vc-rcs-unregister, vc-rcs-receive-file,
vc-rcs-set-non-strict-locking): New functions.
| author | André Spiegel <spiegel@gnu.org> |
|---|---|
| date | Thu, 21 Sep 2000 13:21:41 +0000 |
| parents | 25632a490236 |
| children | 495ca3bd372d |
| files | lisp/vc-rcs.el |
| diffstat | 1 files changed, 90 insertions(+), 7 deletions(-) [+] |
line wrap: on
line diff
--- a/lisp/vc-rcs.el Thu Sep 21 13:15:26 2000 +0000 +++ b/lisp/vc-rcs.el Thu Sep 21 13:21:41 2000 +0000 @@ -5,7 +5,7 @@ ;; Author: FSF (see vc.el for full credits) ;; Maintainer: Andre Spiegel <spiegel@gnu.org> -;; $Id: vc-rcs.el,v 1.3 2000/09/07 20:02:38 fx Exp $ +;; $Id: vc-rcs.el,v 1.4 2000/09/09 00:48:40 monnier Exp $ ;; This file is part of GNU Emacs. @@ -132,7 +132,11 @@ (not (vc-mistrust-permissions file))) (cond ((string-match ".rw..-..-." (nth 8 (file-attributes file))) - (vc-file-setprop file 'vc-checkout-model 'implicit)) + (vc-file-setprop file 'vc-checkout-model 'implicit) + (setq state + (if (vc-rcs-workfile-is-newer file) + 'edited + 'up-to-date))) ((string-match ".r-..-..-." (nth 8 (file-attributes file))) (vc-file-setprop file 'vc-checkout-model 'locking)))) state) @@ -144,15 +148,29 @@ (vc-file-setprop file 'vc-checkout-model 'locking) 'up-to-date) ((string-match ".rw..-..-." permissions) - (if (file-ownership-preserved-p file) - 'edited - (vc-user-login-name owner-uid))) + (if (eq (vc-checkout-model file) 'locking) + (if (file-ownership-preserved-p file) + 'edited + (vc-user-login-name owner-uid)) + (if (vc-rcs-workfile-is-newer file) + 'edited + 'up-to-date))) (t ;; Strange permissions. Fall through to ;; expensive state computation. (vc-rcs-state file)))) (vc-rcs-state file))))) +(defun vc-rcs-workfile-is-newer (file) + "Return non-nil if FILE is newer than its RCS master. +This likely means that FILE has been changed with respect +to its master version." + (let ((file-time (nth 5 (file-attributes file))) + (master-time (nth 5 (file-attributes (vc-name file))))) + (or (> (nth 0 file-time) (nth 0 master-time)) + (and (= (nth 0 file-time) (nth 0 master-time)) + (> (nth 1 file-time) (nth 1 master-time)))))) + (defun vc-rcs-workfile-version (file) "RCS-specific version of `vc-workfile-version'." (or (and vc-consult-headers @@ -182,7 +200,8 @@ (when (< latest-rev rev) (setq latest-rev rev) (setq value (match-string 1))))) - value)) + (or value + (vc-rcs-branch-part branch)))) (defun vc-rcs-fetch-master-state (file &optional workfile-version) "Compute the master file's idea of the state of FILE. @@ -234,7 +253,12 @@ (if (or workfile-is-latest (vc-rcs-latest-on-branch-p file workfile-version)) ;; workfile version is latest on branch - 'up-to-date + (if (eq (vc-checkout-model file) 'locking) + 'up-to-date + (require 'vc) + (if (vc-workfile-unchanged-p file) + 'up-to-date + 'edited)) ;; workfile version is not latest on branch 'needs-patch)) ;; locked by the calling user @@ -565,6 +589,10 @@ (and (vc-rcs-release-p "5.6.4") "-j") (concat (if vc-keep-workfiles "-u" "-r") rev) (concat "-m" comment) + ;; allow creation of branches with no changes; + ;; this is used by vc-rcs-receive-file if the + ;; base version cannot be found + (if (string-match ".1.1$" rev) "-f") switches) (vc-file-setprop file 'vc-workfile-version nil) @@ -680,6 +708,61 @@ nil t) (match-string 1)))))) +(defun vc-rcs-unregister (file) + "Unregister FILE from RCS. +If this leaves the RCS subdirectory empty, ask the user +whether to remove it." + (let* ((master (vc-name file)) + (dir (file-name-directory master))) + (delete-file master) + (and (string= (file-name-nondirectory (directory-file-name dir)) "RCS") + ;; check whether RCS dir is empty, i.e. it does not + ;; contain any files except "." and ".." + (not (directory-files dir nil + "^\\([^.]\\|\\.[^.]\\|\\.\\.[^.]\\).*")) + (yes-or-no-p (format "Directory %s is empty; remove it? " dir)) + (delete-directory dir)))) + +(defun vc-rcs-receive-file (file move) + "Implementation of receive-file for RCS." + (let ((old-backend (vc-backend file)) + (rev (vc-workfile-version file)) + (state (vc-state file)) + (checkout-model (vc-checkout-model file)) + (comment (and move + (vc-find-backend-function old-backend 'comment-history) + (vc-call 'comment-history file)))) + (if move (vc-unregister file old-backend)) + (vc-file-clearprops file) + (if (not (vc-rcs-registered file)) + (progn + (with-vc-properties + file + ;; TODO: If the file was 'edited under the old backend, + ;; this should actually register the version + ;; it was based on. + (vc-rcs-register file rev "") + `((vc-backend ,backend))) + (if (eq checkout-model 'implicit) + (vc-rcs-set-non-strict-locking file)) + (if (not move) + (vc-do-command nil 0 "rcs" file (concat "-b" rev ".1")))) + (vc-file-setprop file 'vc-backend backend) + (vc-file-setprop file 'vc-state 'edited) + (set-file-modes file + (logior (file-modes file) 128))) + (when (or move (eq state 'edited)) + (vc-file-setprop file 'vc-state 'edited) + ;; TODO: The comment history should actually become the + ;; initial contents of the log entry buffer. + (and comment (ring-insert vc-comment-ring comment)) + (vc-checkin file (concat rev ".1.1"))))) + +(defun vc-rcs-set-non-strict-locking (file) + (vc-do-command nil 0 "rcs" file "-U") + (vc-file-setprop file 'vc-checkout-model 'implicit) + (set-file-modes file (logior (file-modes file) 128))) + (defun vc-rcs-checkout (file &optional writable rev workfile) "Retrieve a copy of a saved version of FILE into a workfile." (let ((filename (or workfile file))