;;; 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, 2008 Free Software Foundation, Inc.
+;; 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009
+;; Free Software Foundation, Inc.
;; Author: FSF (see vc.el for full credits)
;; Maintainer: Andre Spiegel <spiegel@gnu.org>
-;; $Id$
-
;; This file is part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
;; See vc.el
+;; 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.
+
;;; Code:
;;;
(require 'vc))
(defcustom vc-rcs-release nil
- "*The release number of your RCS installation, as a string.
+ "The release number of your RCS installation, as a string.
If nil, VC itself computes this value when it is first needed."
:type '(choice (const :tag "Auto" nil)
(string :tag "Specified")
:group 'vc)
(defcustom vc-rcs-register-switches nil
- "*Extra switches for registering a file in RCS.
-A string or list of strings. These are passed to the checkin program
-by \\[vc-rcs-register]."
- :type '(choice (const :tag "None" nil)
+ "Switches for registering a file in RCS.
+A string or list of strings passed to the checkin program by
+\\[vc-register]. If nil, use the value of `vc-register-switches'.
+If t, use no switches."
+ :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))
:version "21.1"
:group 'vc)
(defcustom vc-rcs-diff-switches nil
- "*A string or list of strings specifying extra switches for rcsdiff under VC."
- :type '(choice (const :tag "None" nil)
+ "String or list of strings specifying switches for RCS diff under VC.
+If nil, use the value of `vc-diff-switches'. If t, use no switches."
+ :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))
:version "21.1"
:group 'vc)
(defcustom vc-rcs-header (or (cdr (assoc 'RCS vc-header-alist)) '("\$Id\$"))
- "*Header keywords to be inserted by `vc-insert-headers'."
+ "Header keywords to be inserted by `vc-insert-headers'."
:type '(repeat string)
:version "21.1"
:group 'vc)
(defcustom vc-rcsdiff-knows-brief nil
- "*Indicates whether rcsdiff understands the --brief option.
+ "Indicates whether rcsdiff understands the --brief option.
The value is either `yes', `no', or nil. If it is nil, VC tries
to use --brief and sets this variable to remember whether it worked."
:type '(choice (const :tag "Work out" nil) (const yes) (const no))
;;;###autoload
(defcustom vc-rcs-master-templates
'("%sRCS/%s,v" "%s%s,v" "%sRCS/%s")
- "*Where to look for RCS master files.
+ "Where to look for RCS master files.
For a description of possible values, see `vc-check-master-templates'."
:type '(choice (const :tag "Use standard RCS file names"
'("%sRCS/%s,v" "%s%s,v" "%sRCS/%s"))
(unless version (setq version (vc-working-revision file)))
(with-temp-buffer
(string= version
- (if (vc-trunk-p version)
+ (if (vc-rcs-trunk-p version)
(progn
;; Compare VERSION to the head version number.
(vc-insert-file (vc-name file) "^[0-9]")
;; 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
(defun vc-rcs-create-repo ()
"Create a new RCS repository."
- ;; RCS is totally file-oriented, so all we have to do is make the directory
+ ;; RCS is totally file-oriented, so all we have to do is make the directory.
(make-directory "RCS"))
(defun vc-rcs-register (files &optional rev comment)
"Register FILES into the RCS version-control system.
REV is the optional revision number for the files. COMMENT can be used
to provide an initial description for each FILES.
-
-`vc-register-switches' and `vc-rcs-register-switches' are passed to
-the RCS command (in that order).
+Passes either `vc-rcs-register-switches' or `vc-register-switches'
+to the RCS command.
Automatically retrieve a read-only version of the file with keywords
expanded if `vc-keep-workfiles' is non-nil, otherwise, delete the workfile."
(not (string= (vc-branch-part old-version)
(vc-branch-part new-version))))
(vc-rcs-set-default-branch file
- (if (vc-trunk-p new-version) nil
+ (if (vc-rcs-trunk-p new-version) nil
(vc-branch-part new-version)))
;; If this is an old RCS release, we might have
;; to remove a remaining lock.
(vc-switches 'RCS 'checkout)))
(defun vc-rcs-checkout (file &optional editable rev)
- "Retrieve a copy of a saved version of FILE. If FILE is a directory,
+ "Retrieve a copy of a saved version of FILE. If FILE is a directory,
attempt the checkout for all registered files beneath it."
(if (file-directory-p file)
(mapc 'vc-rcs-checkout (vc-expand-dirs (list file)))
;; use current workfile version
workrev
;; REV is t ...
- (if (not (vc-trunk-p workrev))
+ (if (not (vc-rcs-trunk-p workrev))
;; ... go to head of current branch
(vc-branch-part workrev)
;; ... go to head of trunk
(vc-rcs-set-default-branch
file
(if (vc-rcs-latest-on-branch-p file new-version)
- (if (vc-trunk-p new-version) nil
+ (if (vc-rcs-trunk-p new-version) nil
(vc-branch-part new-version))
new-version)))))
(message "Checking out %s...done" file))))))
(defun vc-rcs-rollback (files)
"Roll back, undoing the most recent checkins of FILES. Directories are
-expanded to all regidtered subfuiles in them."
+expanded to all registered subfiles in them."
(if (not files)
- (error "RCS backend doesn't support directory-level rollback."))
+ (error "RCS backend doesn't support directory-level rollback"))
(dolist (file (vc-expand-dirs files))
(let* ((discard (vc-working-revision file))
- (previous (if (vc-trunk-p discard) "" (vc-branch-part discard)))
+ (previous (if (vc-rcs-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? "
(defun vc-rcs-steal-lock (file &optional rev)
"Steal the lock on the current workfile for FILE and revision REV.
-If FUILEis a directory, steal the lock on all registered files beneath it.
+If FILE is a directory, steal the lock on all registered files beneath it.
Needs RCS 5.6.2 or later for -M."
(if (file-directory-p file)
(mapc 'vc-rcs-steal-lock (vc-expand-dirs (list file)))
;;; History functions
;;;
-(defun vc-rcs-print-log (files &optional buffer)
+(defun vc-rcs-print-log-cleanup ()
+ (let ((inhibit-read-only t))
+ (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))))))
+
+(defun vc-rcs-print-log (files &optional buffer shortlog)
"Get change log associated with FILE. If FILE is a
directory the operation is applied to all registered files beneath it."
- (vc-do-command (or buffer "*vc*") 0 "rlog" (mapcar 'vc-name (vc-expand-dirs files))))
+ (vc-do-command (or buffer "*vc*") 0 "rlog" (mapcar 'vc-name (vc-expand-dirs files)))
+ (with-current-buffer (or buffer "*vc*")
+ (vc-rcs-print-log-cleanup)))
(defun vc-rcs-diff (files &optional oldvers newvers buffer)
"Get a difference report using RCS between two sets of files."
;; property of this approach is ability to push instructions
;; onto `path' directly, w/o need to maintain rev boundaries.
(dolist (insn (cdr (assq :insn meta)))
- (goto-line (pop insn))
+ (goto-char (point-min))
+ (forward-line (1- (pop insn)))
(setq p (point))
(case (pop insn)
(k (setq s (buffer-substring-no-properties
(setq meta (cdr (assoc pre revisions))
prda nil)
(dolist (insn (cdr (assq :insn meta)))
- (goto-line (pop insn))
+ (goto-char (point-min))
+ (forward-line (1- (pop insn)))
(case (pop insn)
(k (delete-region
(point) (progn (forward-line (car insn))
;;; Miscellaneous
;;;
+(defun vc-rcs-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-rcs-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-rcs-previous-revision (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-rcs-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-rcs-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-rcs-next-revision (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-rcs-minor-part rev))))
+ (concat branch "." (number-to-string (1+ minor-num))))))
+
+(defun vc-rcs-update-changelog (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-rcs-check-headers ()
"Check if the current file has any headers in it."
(save-excursion
;; Just move the master file (using vc-rcs-master-templates).
(vc-rename-master (vc-name old) new vc-rcs-master-templates))
+(defun vc-rcs-find-file-hook ()
+ ;; If the file is locked by some other user, make
+ ;; the buffer read-only. Like this, even root
+ ;; cannot modify a file that someone else has locked.
+ (and (stringp (vc-state buffer-file-name 'RCS))
+ (setq buffer-read-only t)))
+
\f
;;;
;;; 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
(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,
+If a WORKING-REVISION is given, compute the state of that version,
otherwise determine the workfile version based on the master file.
This function sets the properties `vc-working-revision' and
`vc-checkout-model' to their correct values, based on the master
(defun vc-rcs-system-release ()
"Return the RCS release installed on this system, as a string.
-Return symbol UNKNOWN if the release cannot be deducted. The user can
+Return symbol `unknown' if the release cannot be deducted. The user can
override this using variable `vc-rcs-release'.
If the user has not set variable `vc-rcs-release' and it is nil,
HCoop / bpt / emacs.git / blobdiff