# HG changeset patch # User Richard M. Stallman # Date 798891144 0 # Node ID d6d53a54da183d9a740cc6b0da1516dae722064a # Parent b59f906062272f4017a434505291af1b730bf1ce (vc-backend-checkout): Pass vc-checkout-switches arg properly to vc-do-command. (vc-update-change-log): Use vc-buffer-backend in menu-enable. (vc-file-clearprops, vc-workfile-version): Functions moved to vc-hooks.el. Add branch support for RCS; treat CVS more like RCS and SCCS. (vc-next-action-on-file): changed CVS handling, such that C-x C-q works as with RCS and SCCS. (vc-consult-rcs-headers): New function. (vc-branch-version): New per-file property, refers to the RCS version selected by `rcs -b'. (vc-workfile-version): New function. Also new per-file property (vc-consult-headers): New parameter variable. (vc-mistrust-permissions): Default set to `nil'. (vc-locking-user): Property is now cached. The other functions update it as necessary. Attempts to use RCS headers if enabled. (vc-log-info, vc-parse-buffer): Various bug fixes. Added support for property `vc-branch-version'. (vc-backend-checkout): RCS case: if no explicit version is specified, check out `vc-workfile-version'. After check-out, set `vc-workfile-version' according to the version number reported by "co". (vc-backend-checkin): RCS case: remove any remaining locks if a new branch was created. After every check-in, adjust the current branch using `rcs -b' (this cannot be avoided). CVS case: allow for explicit checkin, but only on the trunk. (vc-next-action-on-file, vc-backend-checkout, vc-backend-checkin, vc-backend-revert, vc-backend-diff): Explicitly use vc-workfile-version as the default version to operate on. diff -r b59f90606227 -r d6d53a54da18 lisp/vc.el --- a/lisp/vc.el Wed Apr 26 10:08:52 1995 +0000 +++ b/lisp/vc.el Wed Apr 26 10:12:24 1995 +0000 @@ -3,8 +3,10 @@ ;; Copyright (C) 1992, 1993, 1994, 1995 Free Software Foundation, Inc. ;; Author: Eric S. Raymond -;; Maintainer: ttn@netcom.com -;; Version: 5.6 +;; Modified by: +;; ttn@netcom.com +;; Per Cederqvist +;; Andre Spiegel ;; This file is part of GNU Emacs. @@ -88,7 +90,9 @@ "*Prompt for initial comment when a file is registered.") (defvar vc-command-messages nil "*Display run messages from back-end commands.") -(defvar vc-mistrust-permissions 'file-symlink-p +(defvar vc-consult-headers t + "*Identify work files by searching for version headers.") +(defvar vc-mistrust-permissions nil "*Don't assume that permissions and ownership track version-control status.") (defvar vc-checkin-switches nil "*Extra switches passed to the checkin program by \\[vc-checkin].") @@ -190,10 +194,6 @@ ;; File property caching -(defun vc-file-clearprops (file) - ;; clear all properties of a given file - (setplist (intern file vc-file-prop-obarray) nil)) - (defun vc-clear-context () "Clear all cached file properties and the comment ring." (interactive) @@ -289,6 +289,23 @@ status) ) +;; Everything eventually funnels through these functions. To implement +;; support for a new version-control system, add another branch to the +;; vc-backend-dispatch macro and fill it in in each call. The variable +;; vc-master-templates in vc-hooks.el will also have to change. + +(defmacro vc-backend-dispatch (f s r c) + "Execute FORM1, FORM2 or FORM3 depending whether we're using SCCS, RCS or CVS. +If FORM3 is RCS, use FORM2 even if we are using CVS. (CVS shares some code +with RCS)." + (list 'let (list (list 'type (list 'vc-backend-deduce f))) + (list 'cond + (list (list 'eq 'type (quote 'SCCS)) s) ;; SCCS + (list (list 'eq 'type (quote 'RCS)) r) ;; RCS + (list (list 'eq 'type (quote 'CVS)) ;; CVS + (if (eq c 'RCS) r c)) + ))) + ;;; Save a bit of the text around POSN in the current buffer, to help ;;; us find the corresponding position again later. This works even ;;; if all markers are destroyed or corrupted. @@ -357,7 +374,7 @@ (buffer-list))))))) (let ((in-font-lock-mode (and (boundp 'font-lock-fontified) - font-lock-fontified))) + font-lock-fontified))) (if in-font-lock-mode (font-lock-mode 0)) @@ -413,7 +430,7 @@ (or (equal checkout-time lastmod) (and (or (not checkout-time) want-differences-if-changed) (let ((unchanged (zerop (vc-backend-diff file nil nil - (not want-differences-if-changed))))) + (not want-differences-if-changed))))) ;; 0 stands for an unknown time; it can't match any mod time. (vc-file-setprop file 'vc-checkout-time (if unchanged lastmod 0)) unchanged))))) @@ -454,7 +471,14 @@ (vc-revert-buffer1 t t) (vc-checkout-writable-buffer file)) ) - (vc-checkout-writable-buffer file))) + (if verbose + (if (not (eq vc-type 'SCCS)) + (let ((rev (read-string "Branch or version to move to: "))) + (if (eq vc-type 'RCS) + (vc-do-command 0 "rcs" file 'MASTER (concat "-b" rev))) + (vc-checkout file nil rev)) + (error "Sorry, this is not implemented for SCCS.")) + (vc-checkout-writable-buffer file)))) ;; a checked-out version exists, but the user may not own the lock ((and (not (eq vc-type 'CVS)) ;There are no locks in CVS. @@ -463,18 +487,17 @@ (error "Sorry, you can't steal the lock on %s this way" file)) (vc-steal-lock file - (and verbose (read-string "Version to steal: ")) + (if verbose (read-string "Version to steal: ") + (vc-workfile-version file)) owner)) - ;; changes to the master file needs to be merged back into the - ;; working file + ;; CVS: changes to the master file need to be + ;; merged back into the working file ((and (eq vc-type 'CVS) ;; "0" means "added, but not yet committed" - (not (string= (vc-file-getprop file 'vc-your-latest-version) "0")) - (progn - (vc-fetch-properties file) - (not (string= (vc-file-getprop file 'vc-your-latest-version) - (vc-file-getprop file 'vc-latest-version))))) + (not (string= (vc-workfile-version file) "0")) + (not (string= (vc-workfile-version file) + (vc-latest-version file)))) (vc-buffer-sync) (if (yes-or-no-p (format "%s is not up-to-date. Merge in changes now? " (buffer-name))) @@ -494,14 +517,25 @@ (error "%s needs update" (buffer-name)))) - ((and buffer-read-only (eq vc-type 'CVS)) - (toggle-read-only) - ;; Sites who make link farms to a read-only gold tree (or - ;; something similar) can use the hook below to break the - ;; sym-link. - (run-hooks 'vc-make-buffer-writable-hook)) + ;; CVS: Buffer is read-only. Make the file "locked", i.e. + ;; make the buffer writable, and assert the user to be the locker + ((and (eq vc-type 'CVS) buffer-read-only) + (if verbose + (progn + (setq rev (read-string "Trunk version to move to: ")) + (if (not (string= rev "")) + (vc-checkout file nil rev) + (vc-do-command 0 "cvs" file 'WORKFILE "update" "-A") + (vc-checkout file))) + (setq buffer-read-only nil) + (vc-file-setprop file 'vc-locking-user (user-login-name)) + (vc-mode-line file) + ;; Sites who make link farms to a read-only gold tree (or + ;; something similar) can use the hook below to break the + ;; sym-link. + (run-hooks 'vc-make-buffer-writable-hook))) - ;; OK, user owns the lock on the file (or we are running CVS) + ;; OK, user owns the lock on the file (t (find-file file) @@ -515,13 +549,11 @@ ;; after finishing the log entry. (if (and (vc-workfile-unchanged-p file) (not (buffer-modified-p))) - (progn - (if (eq vc-type 'CVS) - (message "No changes to %s" file) - - (vc-backend-revert file) - ;; DO NOT revert the file without asking the user! - (vc-resynch-window file t nil))) + ;; DO NOT revert the file without asking the user! + (cond + ((yes-or-no-p "Revert to master version? ") + (vc-backend-revert file) + (vc-resynch-window file t t))) ;; user may want to set nonstandard parameters (if verbose @@ -551,6 +583,14 @@ ;;;###autoload (defun vc-next-action (verbose) "Do the next logical checkin or checkout operation on the current file. + If you call this from within a VC dired buffer with no files marked, +it will operate on the file in the current line. + If you call this from within a VC dired buffer, and one or more +files are marked, it will accept a log message and then operate on +each one. The log message will be used as a comment for any register +or checkin operations, but ignored when doing checkouts. Attempted +lock steals will raise an error. + A prefix argument lets you specify the version number to use. For RCS and SCCS files: If the file is not already registered, this registers it for version @@ -579,20 +619,8 @@ message has been entered, it checks in the resulting changes along with the logmessage as change commentary. A writable file is retained. If the repository file is changed, you are asked if you want to -merge in the changes into your working copy. - -The following is true regardless of which version control system you -are using: +merge in the changes into your working copy." - If you call this from within a VC dired buffer with no files marked, -it will operate on the file in the current line. - If you call this from within a VC dired buffer, and one or more -files are marked, it will accept a log message and then operate on -each one. The log message will be used as a comment for any register -or checkin operations, but ignored when doing checkouts. Attempted -lock steals will raise an error. - - For checkin, a prefix argument lets you specify the version number to use." (interactive "P") (catch 'nogo (if vc-dired-mode @@ -611,9 +639,9 @@ ;;; These functions help the vc-next-action entry point -(defun vc-checkout-writable-buffer (&optional file) +(defun vc-checkout-writable-buffer (&optional file rev) "Retrieve a writable copy of the latest version of the current buffer's file." - (vc-checkout (or file (buffer-file-name)) t) + (vc-checkout (or file (buffer-file-name)) t rev) ) ;;;###autoload @@ -695,13 +723,13 @@ "Enter initial comment." 'vc-backend-admin nil)) -(defun vc-checkout (file &optional writable) +(defun vc-checkout (file &optional writable rev) "Retrieve a copy of the latest version of the given file." ;; If ftp is on this system and the name matches the ange-ftp format ;; for a remote file, the user is trying something that won't work. (if (and (string-match "^/[^/:]+:" file) (vc-find-binary "ftp")) (error "Sorry, you can't check out files over FTP")) - (vc-backend-checkout file writable) + (vc-backend-checkout file writable rev) (if (string-equal file buffer-file-name) (vc-resynch-window file t t)) ) @@ -1457,31 +1485,33 @@ (defun vc-parse-buffer (patterns &optional file properties) ;; Use PATTERNS to parse information out of the current buffer ;; by matching each regular expression in the list and returning \\1. - ;; If a regexp has two tag brackets, assume the second is a date + ;; If a regexp has three tag brackets, assume the third is a date ;; field and we want the most recent entry matching the template. ;; If FILE and PROPERTIES are given, the latter must be a list of ;; properties of the same length as PATTERNS; each property is assigned ;; the corresponding value. (mapcar (function (lambda (p) (goto-char (point-min)) - (if (string-match "\\\\(.*\\\\(" p) + (if (string-match "\\\\([^(]*\\\\([^(]*\\\\(" p) (let ((latest-date "") (latest-val)) (while (re-search-forward p nil t) - (let ((date (vc-match-substring 2))) + (let ((date (vc-match-substring 3))) (if (string< latest-date date) (progn (setq latest-date date) (setq latest-val (vc-match-substring 1)))))) - latest-val)) - (prog1 - (let ((value nil)) - (if (re-search-forward p nil t) - (setq value (vc-match-substring 1))) (if file - (vc-file-setprop file (car properties) value)) - value) - (setq properties (cdr properties))))) + (progn (vc-file-setprop file (car properties) latest-val) + (setq properties (cdr properties)))) + latest-val) + (let ((value nil)) + (if (re-search-forward p nil t) + (setq value (vc-match-substring 1))) + (if file + (progn (vc-file-setprop file (car properties) value) + (setq properties (cdr properties)))) + value)))) patterns) ) @@ -1508,7 +1538,9 @@ ) (defun vc-log-info (command file last flags patterns &optional properties) - ;; Search for information in log program output + ;; Search for information in log program output. + ;; If there is a string `\X' in any of the PATTERNS, replace + ;; it with a regexp to search for a branch revision. (if (and file (file-exists-p file)) (save-excursion ;; Don't switch to the *vc* buffer before running vc-do-command, @@ -1516,6 +1548,31 @@ (apply 'vc-do-command 0 command file last flags) (set-buffer (get-buffer "*vc*")) (set-buffer-modified-p nil) + (let ((branch + (car (vc-parse-buffer (list "^branch:[ \t]+\\([0-9.]+\\)$"))))) + (setq patterns + (mapcar + (function + (lambda (p) + (if (string-match "\\\\X" p) + (if branch + (cond ((vc-branch-p branch) + (concat + (substring p 0 (match-beginning 0)) + (regexp-quote branch) + "\\.[0-9]+" + (substring p (match-end 0)))) + (t + (concat + (substring p 0 (match-beginning 0)) + (regexp-quote branch) + (substring p (match-end 0))))) + ;; if there is no current branch, + ;; return a completely different regexp, + ;; which searches for the *head* + "^head:[ \t]+\\([0-9.]+\\)$") + p))) + patterns))) (prog1 (vc-parse-buffer patterns file properties) (kill-buffer (current-buffer)) @@ -1534,10 +1591,13 @@ Under CVS, a file is considered locked if it has been modified since it was checked out. Under CVS, this will sometimes return the uid of the owner of the file (as a number) instead of a string." + ;; The property is cached. If it is non-nil, it is simply returned. + ;; The other routines clear it when the locking state changes. (setq file (expand-file-name file));; ??? Work around bug in 19.0.4 (cond + ((vc-file-getprop file 'vc-locking-user)) ((eq (vc-backend-deduce file) 'CVS) - (if (vc-workfile-unchanged-p file t) + (if (vc-workfile-unchanged-p file) nil ;; The expression below should return the username of the owner ;; of the file. It doesn't. It returns the username if it is @@ -1555,34 +1615,38 @@ ;; modified. (let ((uid (nth 2 (file-attributes file)))) (if (= uid (user-uid)) - (user-login-name) - uid)))) + (vc-file-setprop file 'vc-locking-user (user-login-name)) + (vc-file-setprop file 'vc-locking-user uid))))) (t - (if (or (not vc-keep-workfiles) - (eq vc-mistrust-permissions 't) - (and vc-mistrust-permissions - (funcall vc-mistrust-permissions (vc-backend-subdirectory-name - file)))) - (vc-true-locking-user file) - ;; This implementation assumes that any file which is under version - ;; control and has -rw-r--r-- is locked by its owner. This is true - ;; for both RCS and SCCS, which keep unlocked files at -r--r--r--. - ;; We have to be careful not to exclude files with execute bits on; - ;; scripts can be under version control too. Also, we must ignore - ;; the group-read and other-read bits, since paranoid users turn them off. - ;; This hack wins because calls to the very expensive vc-fetch-properties - ;; function only have to be made if (a) the file is locked by someone - ;; other than the current user, or (b) some untoward manipulation - ;; behind vc's back has changed the owner or the `group' or `other' - ;; write bits. - (let ((attributes (file-attributes file))) - (cond ((string-match ".r-..-..-." (nth 8 attributes)) - nil) - ((and (= (nth 2 attributes) (user-uid)) - (string-match ".rw..-..-." (nth 8 attributes))) - (user-login-name)) - (t - (vc-true-locking-user file)))))))) + (if (and (eq (vc-backend-deduce file) 'RCS) + (eq (vc-consult-rcs-headers file) 'rev-and-lock)) + (vc-file-getprop file 'vc-locking-user) + (if (or (not vc-keep-workfiles) + (eq vc-mistrust-permissions 't) + (and vc-mistrust-permissions + (funcall vc-mistrust-permissions (vc-backend-subdirectory-name + file)))) + (vc-file-setprop file 'vc-locking-user (vc-true-locking-user file)) + ;; This implementation assumes that any file which is under version + ;; control and has -rw-r--r-- is locked by its owner. This is true + ;; for both RCS and SCCS, which keep unlocked files at -r--r--r--. + ;; We have to be careful not to exclude files with execute bits on; + ;; scripts can be under version control too. Also, we must ignore + ;; the group-read and other-read bits, since paranoid users turn them off. + ;; This hack wins because calls to the very expensive vc-fetch-properties + ;; function only have to be made if (a) the file is locked by someone + ;; other than the current user, or (b) some untoward manipulation + ;; behind vc's back has changed the owner or the `group' or `other' + ;; write bits. + (let ((attributes (file-attributes file))) + (cond ((string-match ".r-..-..-." (nth 8 attributes)) + nil) + ((and (= (nth 2 attributes) (user-uid)) + (string-match ".rw..-..-." (nth 8 attributes))) + (vc-file-setprop file 'vc-locking-user (user-login-name))) + (t + (vc-file-setprop file 'vc-locking-user + (vc-true-locking-user file)))))))))) (defun vc-true-locking-user (file) ;; The slow but reliable version @@ -1599,24 +1663,120 @@ (vc-fetch-properties file) (vc-file-getprop file 'vc-your-latest-version)) -;; Collect back-end-dependent stuff here -;; -;; Everything eventually funnels through these functions. To implement -;; support for a new version-control system, add another branch to the -;; vc-backend-dispatch macro and fill it in in each call. The variable -;; vc-master-templates in vc-hooks.el will also have to change. +(defun vc-branch-version (file) + ;; Return version level of the highest revision on the default branch + ;; If there is no default branch, return the highest version number + ;; on the trunk. + ;; This property is defined for RCS only. + (vc-fetch-properties file) + (vc-file-getprop file 'vc-branch-version)) + +(defun vc-workfile-version (file) + ;; Return version level of the current workfile FILE + ;; This is attempted by first looking at the RCS keywords. + ;; If there are no keywords in the working file, + ;; vc-branch-version is taken. + ;; Note that this value is cached, that is, it is only + ;; looked up if it is nil. + ;; For SCCS, this property is equivalent to vc-latest-version. + (cond ((vc-file-getprop file 'vc-workfile-version)) + (t (vc-backend-dispatch file + (vc-latest-version file) ;; SCCS + (if (vc-consult-rcs-headers file) ;; RCS + (vc-file-getprop file 'vc-workfile-version) + (let ((rev (cond ((vc-branch-version file)) + ((vc-latest-version file))))) + (vc-file-setprop file 'vc-workfile-version rev) + rev)) + (if (vc-consult-rcs-headers file) ;; CVS + (vc-file-getprop file 'vc-workfile-version) + (vc-find-cvs-master (file-name-directory file) + (file-name-nondirectory file)) + (vc-file-getprop file 'vc-workfile-version)))))) -(defmacro vc-backend-dispatch (f s r c) - "Execute FORM1, FORM2 or FORM3 depending whether we're using SCCS, RCS or CVS. -If FORM3 is RCS, use FORM2 even if we are using CVS. (CVS shares some code -with RCS)." - (list 'let (list (list 'type (list 'vc-backend-deduce f))) - (list 'cond - (list (list 'eq 'type (quote 'SCCS)) s) ;; SCCS - (list (list 'eq 'type (quote 'RCS)) r) ;; RCS - (list (list 'eq 'type (quote 'CVS)) ;; CVS - (if (eq c 'RCS) r c)) - ))) +(defun vc-consult-rcs-headers (file) + ;; Search for RCS headers in FILE, and set properties + ;; accordingly. This function can be disabled by setting + ;; vc-consult-headers to nil. + ;; Returns: nil if no headers were found + ;; (or if the feature is disabled, + ;; or if there is currently no buffer + ;; visiting FILE) + ;; 'rev if a workfile revision was found + ;; 'rev-and-lock if revision and lock info was found + (cond + ((or (not vc-consult-headers) + (not (get-file-buffer file)) nil)) + ((save-excursion + (set-buffer (get-file-buffer file)) + (goto-char (point-min)) + (cond + ;; search for $Id or $Header + ;; ------------------------- + ((re-search-forward "\\$\\(Id\\|Header\\): [^ ]+ \\([0-9.]+\\) " + nil t) + ;; if found, store the revision number ... + (let ((rev (buffer-substring (match-beginning 2) + (match-end 2)))) + ;; ... and check for the locking state + (if (re-search-forward + (concat "\\=[0-9]+/[0-9]+/[0-9]+ " ; date + "[0-9]+:[0-9]+:[0-9]+ " ; time + "[^ ]+ [^ ]+ ") ; author & state + nil t) + (cond + ;; unlocked revision + ((looking-at "\\$") + (vc-file-setprop file 'vc-workfile-version rev) + (vc-file-setprop file 'vc-locking-user nil) + (vc-file-setprop file 'vc-locked-version nil) + 'rev-and-lock) + ;; revision is locked by some user + ((looking-at "\\([^ ]+\\) \\$") + (vc-file-setprop file 'vc-workfile-version rev) + (vc-file-setprop file 'vc-locking-user + (buffer-substring (match-beginning 1) + (match-end 1))) + (vc-file-setprop file 'vc-locked-version rev) + 'rev-and-lock) + ;; everything else: false + (nil)) + ;; unexpected information in + ;; keyword string --> quit + nil))) + ;; search for $Revision + ;; -------------------- + ((re-search-forward (concat "\\$" + "Revision: \\([0-9.]+\\) \\$") + nil t) + ;; if found, store the revision number ... + (let ((rev (buffer-substring (match-beginning 1) + (match-end 1)))) + ;; and see if there's any lock information + (goto-char (point-min)) + (if (re-search-forward (concat "\\$" "Locker:") nil t) + (cond ((looking-at " \\([^ ]+\\) \\$") + (vc-file-setprop file 'vc-workfile-version rev) + (vc-file-setprop file 'vc-locking-user + (buffer-substring (match-beginning 1) + (match-end 1))) + (vc-file-setprop file 'vc-locked-version rev) + 'rev-and-lock) + ((looking-at " *\\$") + (vc-file-setprop file 'vc-workfile-version rev) + (vc-file-setprop file 'vc-locking-user nil) + (vc-file-setprop file 'vc-locked-version nil) + 'rev-and-lock) + (t + (vc-file-setprop file 'vc-workfile-version rev) + 'rev-and-lock)) + (vc-file-setprop file 'vc-workfile-version rev) + 'rev))) + ;; else: nothing found + ;; ------------------- + (t nil)))))) + +;; Collect back-end-dependent stuff here (defun vc-lock-file (file) ;; Generate lock file name corresponding to FILE @@ -1631,12 +1791,13 @@ (defun vc-fetch-properties (file) - ;; Re-fetch all properties associated with the given file. + ;; Re-fetch some properties associated with the given file. ;; Currently these properties are: ;; vc-locking-user ;; vc-locked-version ;; vc-latest-version ;; vc-your-latest-version + ;; vc-branch-version (RCS only) (vc-backend-dispatch file ;; SCCS @@ -1661,17 +1822,24 @@ (list "^locks: strict\n\t\\([^:]+\\)" "^locks: strict\n\t[^:]+: \\(.+\\)" - "^revision[\t ]+\\([0-9.]+\\).*\ndate: \\([ /0-9:]+\\);" + "^revision[\t ]+\\([0-9.]+\\)\\(\n\\|[ \t].*\n\\)date: \\([ /0-9:]+\\);" (concat - "^revision[\t ]+\\([0-9.]+\\)\n.*author: " + "^revision[\t ]+\\([0-9.]+\\)\\(\n\\|[ \t].*\n\\)date: \\([ /0-9:]+\\); *author: " (regexp-quote (user-login-name)) - ";")) - '(vc-locking-user vc-locked-version - vc-latest-version vc-your-latest-version)) + ";") + + ;; special regexp to search for branch revision: + ;; \X will be replaced by vc-log-info (see there) + "^revision[\t ]+\\(\\X\\)\\(\n\\|[ \t].*\n\\)date: \\([ /0-9:]+\\);") + + '(vc-locking-user + vc-locked-version + vc-latest-version + vc-your-latest-version + vc-branch-version)) ;; CVS - ;; Don't fetch vc-locking-user and vc-locked-version here, since they - ;; should always be nil anyhow. Don't fetch vc-your-latest-version, since - ;; that is done in vc-find-cvs-master. + ;; Only fetch vc-latest-version here, all other properties are + ;; computed elsehow. (vc-log-info "cvs" file 'WORKFILE '("status") ;; CVS 1.3 says "RCS Version:", other releases "RCS Revision:", @@ -1772,8 +1940,8 @@ (and failed (file-exists-p filename) (delete-file filename)))) (apply 'vc-do-command 0 "get" file 'MASTER;; SCCS (if writable "-e") - (and rev (concat "-r" (vc-lookup-triple file rev)))) - vc-checkout-switches) + (and rev (concat "-r" (vc-lookup-triple file rev))) + vc-checkout-switches)) (if workfile;; RCS ;; RCS doesn't let us check out into arbitrary file names directly. ;; Use `co -p' and make stdout point to the correct file. @@ -1798,10 +1966,25 @@ vc-checkout-switches) (setq failed nil)) (and failed (file-exists-p filename) (delete-file filename)))) - (apply 'vc-do-command 0 "co" file 'MASTER - (if writable "-l") - (and rev (concat "-r" rev))) - vc-checkout-switches) + (progn + (apply 'vc-do-command + 0 "co" file 'MASTER + (if writable "-l") + (if rev (concat "-r" rev) + ;; if no explicit revision was specified, + ;; check out that of the working file + (let ((workrev (vc-workfile-version file))) + (if workrev (concat "-r" workrev) + nil))) + vc-checkout-switches) + (save-excursion + (set-buffer "*vc*") + (goto-char (point-min)) + (if (re-search-forward "^revision \\([0-9.]+\\).*\n" nil t) + (vc-file-setprop file 'vc-workfile-version + (buffer-substring (match-beginning 1) + (match-end 1))) + (vc-file-setprop file 'vc-workfile-version nil))))) (if workfile;; CVS ;; CVS is much like RCS (let ((failed t)) @@ -1817,9 +2000,9 @@ vc-checkout-switches) (setq failed nil)) (and failed (file-exists-p filename) (delete-file filename)))) - (apply 'vc-do-command 0 "cvs" file 'WORKFILE + (apply 'vc-do-command 0 "cvs" file 'WORKFILE + "update" (and rev (concat "-r" rev)) - file vc-checkout-switches)) )) (or workfile @@ -1844,49 +2027,112 @@ ;; Automatically retrieves a read-only version of the file with ;; keywords expanded if vc-keep-workfiles is non-nil, otherwise ;; it deletes the workfile. + ;; Adaption for RCS branch support: if this is an explicit checkin, + ;; or if the checkin creates a new branch, set the master file branch + ;; accordingly. (message "Checking in %s..." file) (save-excursion ;; Change buffers to get local value of vc-checkin-switches. (set-buffer (or (get-file-buffer file) (current-buffer))) (vc-backend-dispatch file + ;; SCCS (progn (apply 'vc-do-command 0 "delta" file 'MASTER (if rev (concat "-r" rev)) (concat "-y" comment) vc-checkin-switches) + (vc-file-setprop file 'vc-locking-user nil) + (vc-file-setprop file 'vc-workfile-version nil) (if vc-keep-workfiles (vc-do-command 0 "get" file 'MASTER)) ) - (apply 'vc-do-command 0 "ci" file 'MASTER - (concat (if vc-keep-workfiles "-u" "-r") rev) - (concat "-m" comment) - vc-checkin-switches) + ;; RCS + (let ((lock-version nil)) + ;; if this is an explicit check-in to a different branch, + ;; remember the workfile version (in order to remove the lock later) + (if (and rev + (not (vc-trunk-p rev)) + (not (string= (vc-branch-part rev) + (vc-branch-part (vc-workfile-version file))))) + (setq lock-version (vc-workfile-version file))) + + (apply 'vc-do-command 0 "ci" file 'MASTER + (concat (if vc-keep-workfiles "-u" "-r") rev) + (concat "-m" comment) + vc-checkin-switches) + (vc-file-setprop file 'vc-locking-user nil) + (vc-file-setprop file 'vc-workfile-version nil) + + ;; determine the new workfile version and + ;; adjust the master file branch accordingly + ;; (this currently has to be done on every check-in) + (progn + (set-buffer "*vc*") + (goto-char (point-min)) + (if (re-search-forward "new revision: \\([0-9.]+\\);" nil t) + (progn (setq rev (buffer-substring (match-beginning 1) + (match-end 1))) + (vc-file-setprop file 'vc-workfile-version rev))) + (if (vc-trunk-p rev) + (vc-do-command 0 "rcs" file 'MASTER "-b") + (vc-do-command 0 "rcs" file 'MASTER + (concat "-b" (vc-branch-part rev)))) + (if lock-version + ;; exit status of 1 is also accepted. + ;; It means that the lock was removed before. + (vc-do-command 1 "rcs" file 'MASTER + (concat "-u" lock-version))))) + ;; CVS (progn + ;; explicit check-in to the trunk requires a + ;; double check-in (first unexplicit) (CVS-1.3) + (if (and rev (vc-trunk-p rev)) + (apply 'vc-do-command 0 "cvs" file 'WORKFILE + "ci" "-m" "intermediate" + vc-checkin-switches)) (apply 'vc-do-command 0 "cvs" file 'WORKFILE - "ci" "-m" comment + "ci" (if rev (concat "-r" rev)) + (if (and comment (not (string= comment ""))) + (concat "-m" comment) + "-m-") vc-checkin-switches) + ;; determine and store the new workfile version + (set-buffer "*vc*") + (goto-char (point-min)) + (if (re-search-forward + "^\\(new\\|initial\\) revision: \\([0-9.]+\\)" nil t) + (vc-file-setprop file 'vc-workfile-version + (buffer-substring (match-beginning 2) + (match-end 2))) + (vc-file-setprop file 'vc-workfile-version nil)) + ;; if this was an explicit check-in, remove the sticky tag + (if rev + (vc-do-command 0 "cvs" file 'WORKFILE "update" "-A")) + (vc-file-setprop file 'vc-locking-user nil) (vc-file-setprop file 'vc-checkout-time - (nth 5 (file-attributes file)))) - )) - (vc-file-setprop file 'vc-locking-user nil) + (nth 5 (file-attributes file)))))) (message "Checking in %s...done" file) ) (defun vc-backend-revert (file) ;; Revert file to latest checked-in version. + ;; (for RCS, to workfile version) (message "Reverting %s..." file) (vc-backend-dispatch file - (progn ;; SCCS + ;; SCCS + (progn (vc-do-command 0 "unget" file 'MASTER nil) (vc-do-command 0 "get" file 'MASTER nil)) - (vc-do-command 0 "co" file 'MASTER ;; RCS. This deletes the work file. - "-f" "-u") - (progn ;; CVS + ;; RCS + (vc-do-command 0 "co" file 'MASTER + "-f" (concat "-u" (vc-workfile-version file))) + ;; CVS + (progn (delete-file file) - (vc-do-command 0 "cvs" file 'WORKFILE "update")) - ) + (vc-do-command 0 "cvs" file 'WORKFILE "update"))) (vc-file-setprop file 'vc-locking-user nil) + (vc-file-setprop file 'vc-checkout-time (nth 5 (file-attributes file))) (message "Reverting %s...done" file) ) @@ -1942,9 +2188,11 @@ (cond ((eq backend 'SCCS) (setq oldvers (vc-lookup-triple file oldvers)) - (setq newvers (vc-lookup-triple file newvers)))) + (setq newvers (vc-lookup-triple file newvers))) + ((eq backend 'RCS) + (if (not oldvers) (setq oldvers (vc-workfile-version file))))) + ;; SCCS and RCS shares a lot of code. (cond - ;; SCCS and RCS shares a lot of code. ((or (eq backend 'SCCS) (eq backend 'RCS)) (let* ((command (if (eq backend 'SCCS) "vcdiff" @@ -1967,7 +2215,7 @@ ;; CVS is different. ;; cmp is not yet implemented -- we always do a full diff. ((eq backend 'CVS) - (if (string= (vc-file-getprop file 'vc-your-latest-version) "0") ;CVS + (if (string= (vc-workfile-version file) "0") ;CVS ;; This file is added but not yet committed; there is no master file. ;; diff it against /dev/null. (if (or oldvers newvers) @@ -2125,6 +2373,9 @@ ;;; 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