;;; vc-rcs.el --- support for RCS version-control
;; Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000,
-;; 2001, 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
+;; 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
;; Author: FSF (see vc.el for full credits)
;; Maintainer: Andre Spiegel <spiegel@gnu.org>
;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
+;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
\f
;;; Properties of the backend
-(defun vc-rcs-revision-granularity ()
- 'file)
+(defun vc-rcs-revision-granularity () 'file)
+
+(defun vc-rcs-checkout-model (files)
+ "RCS-specific version of `vc-checkout-model'."
+ (let ((file (if (consp files) (car files) files))
+ result)
+ (when vc-consult-headers
+ (vc-file-setprop file 'vc-checkout-model nil)
+ (vc-rcs-consult-headers file)
+ (setq result (vc-file-getprop file 'vc-checkout-model)))
+ (or result
+ (progn (vc-rcs-fetch-master-state file)
+ (vc-file-getprop file 'vc-checkout-model)))))
;;;
;;; State-querying functions
;;;
-;;; The autoload cookie below places vc-rcs-registered directly into
-;;; loaddefs.el, so that vc-rcs.el does not need to be loaded for
-;;; every file that is visited. The definition is repeated below
-;;; so that Help and etags can find it.
-
-;;;###autoload (defun vc-rcs-registered (f) (vc-default-registered 'RCS f))
-(defun vc-rcs-registered (f) (vc-default-registered 'RCS f))
+;; The autoload cookie below places vc-rcs-registered directly into
+;; loaddefs.el, so that vc-rcs.el does not need to be loaded for
+;; every file that is visited.
+;;;###autoload
+(progn
+(defun vc-rcs-registered (f) (vc-default-registered 'RCS f)))
(defun vc-rcs-state (file)
"Implementation of `vc-state' for RCS."
- (or (boundp 'vc-rcs-headers-result)
- (and vc-consult-headers
- (vc-rcs-consult-headers file)))
- (let ((state
- ;; vc-workfile-version might not be known; in that case the
- ;; property is nil. vc-rcs-fetch-master-state knows how to
- ;; handle that.
- (vc-rcs-fetch-master-state file
- (vc-file-getprop file
- 'vc-workfile-version))))
- (if (not (eq state 'up-to-date))
- state
- (if (vc-workfile-unchanged-p file)
- 'up-to-date
- (if (eq (vc-checkout-model file) 'locking)
- 'unlocked-changes
- 'edited)))))
+ (if (not (vc-rcs-registered file))
+ 'unregistered
+ (or (boundp 'vc-rcs-headers-result)
+ (and vc-consult-headers
+ (vc-rcs-consult-headers file)))
+ (let ((state
+ ;; vc-working-revision might not be known; in that case the
+ ;; property is nil. vc-rcs-fetch-master-state knows how to
+ ;; handle that.
+ (vc-rcs-fetch-master-state file
+ (vc-file-getprop file
+ 'vc-working-revision))))
+ (if (not (eq state 'up-to-date))
+ state
+ (if (vc-workfile-unchanged-p file)
+ 'up-to-date
+ (if (eq (vc-rcs-checkout-model (list file)) 'locking)
+ 'unlocked-changes
+ 'edited))))))
(defun vc-rcs-state-heuristic (file)
"State heuristic for RCS."
(vc-file-setprop file 'vc-checkout-model 'locking)
'up-to-date)
((string-match ".rw..-..-." permissions)
- (if (eq (vc-checkout-model file) 'locking)
+ (if (eq (vc-rcs-checkout-model file) 'locking)
(if (file-ownership-preserved-p file)
'edited
owner-name)
(vc-rcs-state file))))
(vc-rcs-state file)))))
-(defun vc-rcs-workfile-version (file)
- "RCS-specific version of `vc-workfile-version'."
+(defun vc-rcs-dir-status (dir update-function)
+ ;; Doing individual vc-state calls is painful but tgere
+ ;; is no better way in RCS-land.
+ (let ((flist (vc-expand-dirs (list dir)))
+ (result nil))
+ (dolist (file flist)
+ (let ((state (vc-state file))
+ (frel (file-relative-name file)))
+ (push (list frel state) result)))
+ (funcall update-function result)))
+
+(defun vc-rcs-working-revision (file)
+ "RCS-specific version of `vc-working-revision'."
(or (and vc-consult-headers
(vc-rcs-consult-headers file)
- (vc-file-getprop file 'vc-workfile-version))
+ (vc-file-getprop file 'vc-working-revision))
(progn
(vc-rcs-fetch-master-state file)
- (vc-file-getprop file 'vc-workfile-version))))
+ (vc-file-getprop file 'vc-working-revision))))
(defun vc-rcs-latest-on-branch-p (file &optional version)
"Return non-nil if workfile version of FILE is the latest on its branch.
When VERSION is given, perform check for that version."
- (unless version (setq version (vc-workfile-version file)))
+ (unless version (setq version (vc-working-revision file)))
(with-temp-buffer
(string= version
(if (vc-trunk-p version)
(vc-insert-file (vc-name file) "^desc")
(vc-rcs-find-most-recent-rev (vc-branch-part version))))))
-(defun vc-rcs-checkout-model (file)
- "RCS-specific version of `vc-checkout-model'."
- (let (result)
- (when vc-consult-headers
- (vc-file-setprop file 'vc-checkout-model nil)
- (vc-rcs-consult-headers file)
- (setq result (vc-file-getprop file 'vc-checkout-model)))
- (or result
- (progn (vc-rcs-fetch-master-state file)
- (vc-file-getprop file 'vc-checkout-model)))))
-
(defun vc-rcs-workfile-unchanged-p (file)
"RCS-specific implementation of `vc-workfile-unchanged-p'."
;; Try to use rcsdiff --brief. If rcsdiff does not understand that,
;; do a double take and remember the fact for the future
- (let* ((version (concat "-r" (vc-workfile-version file)))
+ (let* ((version (concat "-r" (vc-working-revision file)))
(status (if (eq vc-rcsdiff-knows-brief 'no)
(vc-do-command nil 1 "rcsdiff" file version)
(vc-do-command nil 2 "rcsdiff" file "--brief" version))))
;; The workfile is unchanged if rcsdiff found no differences.
(zerop status)))
+(defun vc-rcs-find-file-not-found-hook ()
+ (if (yes-or-no-p
+ (format "File %s was lost; check out from version control? "
+ (file-name-nondirectory buffer-file-name)))
+ (save-excursion
+ (require 'vc)
+ (let ((default-directory (file-name-directory buffer-file-name)))
+ (not (vc-error-occurred (vc-checkout buffer-file-name)))))))
\f
;;;
;;; State-changing functions
Automatically retrieve a read-only version of the file with keywords
expanded if `vc-keep-workfiles' is non-nil, otherwise, delete the workfile."
- (let ((subdir (expand-file-name "RCS" (file-name-directory file))))
+ (let (subdir name)
(dolist (file files)
- (and (not (file-exists-p subdir))
+ (and (not (file-exists-p
+ (setq subdir (expand-file-name "RCS"
+ (file-name-directory file)))))
(not (directory-files (file-name-directory file)
nil ".*,v$" t))
(yes-or-no-p "Create RCS subdirectory? ")
(vc-switches 'RCS 'register))
;; parse output to find master file name and workfile version
(with-current-buffer "*vc*"
- (goto-char (point-min))
- (let ((name (if (looking-at (concat "^\\(.*\\) <-- "
- (file-name-nondirectory file)))
- (match-string 1))))
- (if (not name)
- ;; if we couldn't find the master name,
- ;; run vc-rcs-registered to get it
- ;; (will be stored into the vc-name property)
- (vc-rcs-registered file)
- (vc-file-setprop file 'vc-name
- (if (file-name-absolute-p name)
- name
- (expand-file-name
- name
- (file-name-directory file))))))
- (vc-file-setprop file 'vc-workfile-version
- (if (re-search-forward
- "^initial revision: \\([0-9.]+\\).*\n"
- nil t)
- (match-string 1)))))))
+ (goto-char (point-min))
+ (if (not (setq name
+ (if (looking-at (concat "^\\(.*\\) <-- "
+ (file-name-nondirectory file)))
+ (match-string 1))))
+ ;; if we couldn't find the master name,
+ ;; run vc-rcs-registered to get it
+ ;; (will be stored into the vc-name property)
+ (vc-rcs-registered file)
+ (vc-file-setprop file 'vc-name
+ (if (file-name-absolute-p name)
+ name
+ (expand-file-name
+ name
+ (file-name-directory file))))))
+ (vc-file-setprop file 'vc-working-revision
+ (if (re-search-forward
+ "^initial revision: \\([0-9.]+\\).*\n"
+ nil t)
+ (match-string 1))))))
(defun vc-rcs-responsible-p (file)
"Return non-nil if RCS thinks it would be responsible for registering FILE."
(defun vc-rcs-receive-file (file rev)
"Implementation of receive-file for RCS."
- (let ((checkout-model (vc-checkout-model file)))
+ (let ((checkout-model (vc-rcs-checkout-model (list file))))
(vc-rcs-register file rev "")
(when (eq checkout-model 'implicit)
(vc-rcs-set-non-strict-locking file))
(let ((switches (vc-switches 'RCS 'checkin)))
;; Now operate on the files
(dolist (file files)
- (let ((old-version (vc-workfile-version file)) new-version
+ (let ((old-version (vc-working-revision file)) new-version
(default-branch (vc-file-getprop file 'vc-rcs-default-branch)))
;; Force branch creation if an appropriate
;; default branch has been set.
(concat (if vc-keep-workfiles "-u" "-r") rev)
(concat "-m" comment)
switches)
- (vc-file-setprop file 'vc-workfile-version nil)
+ (vc-file-setprop file 'vc-working-revision nil)
;; determine the new workfile version
(set-buffer "*vc*")
(re-search-forward
"reverting to previous revision \\([0-9.]+\\)" nil t))
(setq new-version (match-string 1))
- (vc-file-setprop file 'vc-workfile-version new-version))
+ (vc-file-setprop file 'vc-working-revision new-version))
;; if we got to a different branch, adjust the default
;; branch accordingly
(vc-do-command nil 1 "rcs" (vc-name file)
(concat "-u" old-version)))))))))
-(defun vc-rcs-find-version (file rev buffer)
+(defun vc-rcs-find-revision (file rev buffer)
(apply 'vc-do-command
buffer 0 "co" (vc-name file)
"-q" ;; suppress diagnostic output
nil 0 "co" (vc-name file)
;; If locking is not strict, force to overwrite
;; the writable workfile.
- (if (eq (vc-checkout-model file) 'implicit) "-f")
+ (if (eq (vc-rcs-checkout-model (list file)) 'implicit) "-f")
(if editable "-l")
(if (stringp rev)
;; a literal revision was specified
(concat "-r" rev)
- (let ((workrev (vc-workfile-version file)))
+ (let ((workrev (vc-working-revision file)))
(if workrev
(concat "-r"
(if (not rev)
(with-current-buffer "*vc*"
(setq new-version
(vc-parse-buffer "^revision \\([0-9.]+\\).*\n" 1)))
- (vc-file-setprop file 'vc-workfile-version new-version)
+ (vc-file-setprop file 'vc-working-revision new-version)
;; if necessary, adjust the default branch
(and rev (not (string= rev ""))
(vc-rcs-set-default-branch
(if (not files)
(error "RCS backend doesn't support directory-level rollback."))
(dolist (file files)
- (let* ((discard (vc-workfile-version file))
+ (let* ((discard (vc-working-revision file))
(previous (if (vc-trunk-p discard) "" (vc-branch-part discard)))
(config (current-window-configuration))
(done nil))
- (if (null (yes-or-no-p (format "Remove version %s from %s history? "
+ (if (null (yes-or-no-p (format "Remove version %s from %s history? "
discard file)))
(error "Aborted"))
(message "Removing revision %s from %s." discard file)
"Revert FILE to the version it was based on."
(vc-do-command nil 0 "co" (vc-name file) "-f"
(concat (if (eq (vc-state file) 'edited) "-u" "-r")
- (vc-workfile-version file))))
+ (vc-working-revision file))))
(defun vc-rcs-merge (file first-version &optional second-version)
"Merge changes into current working copy of FILE.
;; expanded headers.
(vc-do-command nil 0 "co" (vc-name file) "-f" (concat "-l" rev)))
+(defun vc-rcs-modify-change-comment (files rev comment)
+ "Modify the change comments change on FILES on a specified REV."
+ (dolist (file files)
+ (vc-do-command nil 0 "rcs" (vc-name file)
+ (concat "-m" rev ":" comment))))
\f
;;;
(defun vc-rcs-diff (files &optional oldvers newvers buffer)
"Get a difference report using RCS between two sets of files."
- (apply 'vc-do-command (or buffer "*vc-diff*")
+ (apply 'vc-do-command (or buffer "*vc-diff*")
1 ;; Always go synchronous, the repo is local
"rcsdiff" (vc-expand-dirs files)
(append (list "-q"
" "
(aref rda 0)
ls)
+ :vc-annotate-prefix t
:vc-rcs-r/d/a rda)))
(maphash
(if all-me
;;; Internal functions
;;;
+(defun vc-rcs-root (dir)
+ (vc-find-root dir "RCS" t))
+
(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
(or value
(vc-branch-part branch))))
-(defun vc-rcs-fetch-master-state (file &optional workfile-version)
+(defun vc-rcs-fetch-master-state (file &optional working-revision)
"Compute the master file's idea of the state of FILE.
If a WORKFILE-VERSION is given, compute the state of that version,
otherwise determine the workfile version based on the master file.
-This function sets the properties `vc-workfile-version' and
+This function sets the properties `vc-working-revision' and
`vc-checkout-model' to their correct values, based on the master
file."
(with-temp-buffer
(let ((workfile-is-latest nil)
(default-branch (vc-parse-buffer "^branch[ \t\n]+\\([^;]*\\);" 1)))
(vc-file-setprop file 'vc-rcs-default-branch default-branch)
- (unless workfile-version
+ (unless working-revision
;; Workfile version not known yet. Determine that first. It
;; is either the head of the trunk, the head of the default
;; branch, or the "default branch" itself, if that is a full
(cond
;; no default branch
((or (not default-branch) (string= "" default-branch))
- (setq workfile-version
+ (setq working-revision
(vc-parse-buffer "^head[ \t\n]+\\([^;]+\\);" 1))
(setq workfile-is-latest t))
;; default branch is actually a revision
((string-match "^[0-9]+\\.[0-9]+\\(\\.[0-9]+\\.[0-9]+\\)*$"
default-branch)
- (setq workfile-version default-branch))
+ (setq working-revision default-branch))
;; else, search for the head of the default branch
(t (vc-insert-file (vc-name file) "^desc")
- (setq workfile-version
+ (setq working-revision
(vc-rcs-find-most-recent-rev default-branch))
(setq workfile-is-latest t)))
- (vc-file-setprop file 'vc-workfile-version workfile-version))
+ (vc-file-setprop file 'vc-working-revision working-revision))
;; Check strict locking
(goto-char (point-min))
(vc-file-setprop file 'vc-checkout-model
(goto-char (point-min))
(let ((locking-user
(vc-parse-buffer (concat "^locks[ \t\n]+[^;]*[ \t\n]+\\([^:]+\\):"
- (regexp-quote workfile-version)
+ (regexp-quote working-revision)
"[^0-9.]")
1)))
(cond
;; not locked
((not locking-user)
(if (or workfile-is-latest
- (vc-rcs-latest-on-branch-p file workfile-version))
+ (vc-rcs-latest-on-branch-p file working-revision))
;; workfile version is latest on branch
'up-to-date
;; workfile version is not latest on branch
- 'needs-patch))
+ 'needs-update))
;; locked by the calling user
((and (stringp locking-user)
(string= locking-user (vc-user-login-name file)))
- (if (or (eq (vc-checkout-model file) 'locking)
+ (if (or (eq (vc-rcs-checkout-model (list file)) 'locking)
workfile-is-latest
- (vc-rcs-latest-on-branch-p file workfile-version))
+ (vc-rcs-latest-on-branch-p file working-revision))
'edited
;; Locking is not used for the file, but the owner does
;; have a lock, and there is a higher version on the current
;; else: nothing found
;; -------------------
(t nil)))
- (if status (vc-file-setprop file 'vc-workfile-version version))
+ (if status (vc-file-setprop file 'vc-working-revision version))
(and (eq status 'rev-and-lock)
(vc-file-setprop file 'vc-state
(cond
HCoop / bpt / emacs.git / blobdiff