(vc-rcs-show-log-entry): New function.
(vc-rcs-checkin, vc-rcs-checkout): Don't set all properties. (vc-rcs-register): If there is no RCS subdir, ask the user whether to create one. (vc-rcs-state-heuristic): Use file-ownership-preserved-p. (vc-rcs-checkout): Remove the error-handling for missing-rcs. (vc-rcs-state-heuristic): Don't use file-writable-p. (vc-rcs-print-log): Insert in the current buffer. (vc-rcs-diff): Insert in the current buffer and remove unused arg CMP. (vc-rcs-workfile-unchanged-p): Use vc-do-command instead of vc-simple-command. (vc-rcs-fetch-master-state): Removed check for unlocked-changes to avoid doing a diff when opening a file. (vc-rcs-state): Added check for unlocked-changes. (vc-rcs-header): Escape Id. (vc-rcs-workfile-unchanged-p): Remove optional arg VERSION. (vc-rcs-state): Call vc-workfile-unchanged-p, not the RCS-specific version. (vc-rcs-state-heuristic): Use file-writable-p instead of comparing userids. (vc-rcs-fetch-master-state): Handle the case where rcs is missing. Simplify the logic by eliminating unreachable code. (vc-rcs-diff): Only pass `2' to vc-do-command if necessary and just do a recursive call if we need to retry. (vc-rcs-checkout): Handle the case where rcs is missing by making the buffer read-write if requested and re-signalling the error. (vc-rcs-find-most-recent-rev): New function. The code derives from the old vc-parse-buffer but uses the revision number rather than the date (much easier to compare robustly). (vc-rcs-fetch-master-state): Use `with-temp-buffer'. Adapt to the new vc-parse-buffer (and vc-rcs-find-most-recent-rev). Find the locking-user more directly. Check strict locking and set checkout-model appropriately. (vc-rcs-parse-locks): Remove. (vc-rcs-latest-on-branch-p): Use with-temp-buffer and adapt to the new vc-parse-buffer (and vc-rcs-find-most-recent-rev). (vc-rcs-system-release): Use with-current-buffer and vc-parse-buffer. (vc-rcs-register, vc-rcs-checkout): Use with-current-buffer. Merge in code from vc-rcs-hooks.el. Don't require 'vc anymore. (vc-rcs-responsible-p): Use expand-file-name instead of concat and file-directory-p instead of file-exists-p. (vc-rcs-exists): Remove. (vc-rcs-header): New var. Update Copyright. (vc-rcs-rename-file): New function. (vc-rcs-diff): Remove unused `backend' variable. (vc-rcs-clear-headers): New function; code moved here from vc-clear-headers in vc.el. (tail): Provide vc-rcs and remove vc-rcs-logentry-check. (vc-rcs-register): Parse command output to find master file name and workfile version. (vc-rcs-checkout): Removed call to vc-file-clear-masterprops. Require vc and vc-rcs-hooks. (vc-rcs-trunk-p, vc-rcs-branch-part): Move to vc-rcs-hooks. (vc-rcs-backend-release-p): Remove (use vc-rcs-release-p). (vc-release-greater-or-equal-p): Move from vc. (vc-rcs-trunk-p, vc-rcs-branch-p, vc-rcs-branch-part, vc-rcs-minor-part, vc-rcs-previous-version): Remove duplicates. (vc-rcs-checkout): Add a missing `new-version' argument in the call to vc-rcs-latest-on-branch-p. Hopefully that was the right one. (vc-rcs-steal-lock): Renamed from `vc-rcs-steal'. Updated everything to use `vc-checkout-model'. (vc-rcs-backend-release-p): function added. other stuff updated to reference this function instead of the old `vc-backend-release-p'. (vc-rcs-logentry-check): Function added. (vc-rcs-checkin, vc-rcs-previous-version) (vc-rcs-checkout): Name space cleaned up. No more revision number crunching function names that are not prefixed with vc-rcs. (vc-rcs-checkout-model): Function added. References to `vc-checkout-model' replaced. (vc-rcs-admin): Added the query-only option as required by the vc.el file. (vc-rcs-exists): Function added. (vc-*-checkout): Use with-temp-file instead of /bin/sh. Merged from mainline (vc-rcs-latest-on-branch-p): Moved to vc-rcs-hooks.el. (vc-rcs-latest-on-branch-p, vc-rcs-trunk-p) (vc-rcs-branch-p, vc-rcs-branch-part, vc-rcs-minor-part) (vc-rcs-previous-version): Functions added. (vc-rcs-diff): Function added. (vc-rcs-checkout) Bug (typo) found and fixed. (vc-rcs-register-switches) Variable `vc-rcs-register-switches' added. Require vc when compiling. (vc-rcs-print-log, vc-rcs-assign-name, vc-rcs-merge) (vc-rcs-check-headers, vc-rcs-steal, vc-rcs-uncheck, vc-rcs-revert) (vc-rcs-checkin): New functions (code from vc.el). (vc-rcs-previous-version, vc-rcs-system-release, vc-rcs-checkout): Doc fix. (vc-rcs-release): Deleted. (Duplicated vc-rcs-system-release). (vc-rcs-trunk-p, vc-rcs-branch-p, vc-rcs-branch-part) (vc-rcs-minor-part, vc-rcs-previous-version, vc-rcs-release) (vc-rcs-release-p, vc-rcs-admin, vc-rcs-checkout): New functions from vc.el. (vc-rcs-system-release): Renamed from vc-rcs-backend-release.
This commit is contained in:
Gerd Moellmann
parent
0e0d98319e
commit
d8aff0773f
1 changed files with 737 additions and 0 deletions
737
lisp/vc-rcs.el
Normal file
737
lisp/vc-rcs.el
Normal file
|
|
@ -0,0 +1,737 @@
|
|||
;;; vc-rcs.el --- support for RCS version-control
|
||||
|
||||
;; Copyright (C) 1992,93,94,95,96,97,98,99,2000 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: FSF (see vc.el for full credits)
|
||||
;; Maintainer: Andre Spiegel <spiegel@gnu.org>
|
||||
|
||||
;; $Id: vc-rcs.el,v 1.36 2000/08/12 18:51:30 spiegel Exp $
|
||||
|
||||
;; This file is part of GNU Emacs.
|
||||
|
||||
;; 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)
|
||||
;; any later version.
|
||||
|
||||
;; GNU Emacs is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with GNU Emacs; see the file COPYING. If not, write to the
|
||||
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
|
||||
;; Boston, MA 02111-1307, USA.
|
||||
|
||||
;;; Commentary: see vc.el
|
||||
|
||||
;;; Code:
|
||||
|
||||
(defcustom vc-rcs-release nil
|
||||
"*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")
|
||||
(const :tag "Unknown" unknown))
|
||||
:group 'vc)
|
||||
|
||||
(defcustom vc-rcs-register-switches nil
|
||||
"*A string or list of strings; extra switches for registering a file
|
||||
in RCS. These are passed to the checkin program by
|
||||
\\[vc-rcs-register]."
|
||||
:type '(choice (const :tag "None" nil)
|
||||
(string :tag "Argument String")
|
||||
(repeat :tag "Argument List"
|
||||
:value ("")
|
||||
string))
|
||||
:group 'vc)
|
||||
|
||||
(defcustom vc-rcs-checkin-switches nil
|
||||
"*A string or list of strings specifying extra switches for RCS checkin.
|
||||
These are passed to the checkin program by \\[vc-rcs-checkin]."
|
||||
:type '(choice (const :tag "None" nil)
|
||||
(string :tag "Argument String")
|
||||
(repeat :tag "Argument List"
|
||||
:value ("")
|
||||
string))
|
||||
:group 'vc)
|
||||
|
||||
(defcustom vc-rcs-checkout-switches nil
|
||||
"*A string or list of strings specifying extra switches for RCS checkout.
|
||||
These are passed to the checkout program by \\[vc-rcs-checkout]."
|
||||
:type '(choice (const :tag "None" nil)
|
||||
(string :tag "Argument String")
|
||||
(repeat :tag "Argument List"
|
||||
:value ("")
|
||||
string))
|
||||
:group 'vc)
|
||||
|
||||
(defcustom vc-rcs-header (or (cdr (assoc 'RCS vc-header-alist)) '("\$Id\$"))
|
||||
"*Header keywords to be inserted by `vc-insert-headers'."
|
||||
:type 'string
|
||||
:group 'vc)
|
||||
|
||||
(defcustom vc-rcsdiff-knows-brief nil
|
||||
"*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))
|
||||
:group 'vc)
|
||||
|
||||
;;;###autoload
|
||||
(defcustom vc-rcs-master-templates
|
||||
'("%sRCS/%s,v" "%s%s,v" "%sRCS/%s")
|
||||
"*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"))
|
||||
(repeat :tag "User-specified"
|
||||
(choice string
|
||||
function)))
|
||||
:version "20.5"
|
||||
:group 'vc)
|
||||
|
||||
;;;###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 (eq state 'up-to-date)
|
||||
(if (vc-workfile-unchanged-p file)
|
||||
'up-to-date
|
||||
'unlocked-changes)
|
||||
state)))
|
||||
|
||||
(defun vc-rcs-state-heuristic (file)
|
||||
"State heuristic for RCS."
|
||||
(let (vc-rcs-headers-result)
|
||||
(if (and vc-consult-headers
|
||||
(setq vc-rcs-headers-result
|
||||
(vc-rcs-consult-headers file))
|
||||
(eq vc-rcs-headers-result 'rev-and-lock))
|
||||
(let ((state (vc-file-getprop file 'vc-state)))
|
||||
;; If the headers say that the file is not locked, the
|
||||
;; permissions can tell us whether locking is used for
|
||||
;; the file or not.
|
||||
(if (and (eq state 'up-to-date)
|
||||
(not (vc-mistrust-permissions file)))
|
||||
(cond
|
||||
((string-match ".rw..-..-." (nth 8 (file-attributes file)))
|
||||
(vc-file-setprop file 'vc-checkout-model 'implicit))
|
||||
((string-match ".r-..-..-." (nth 8 (file-attributes file)))
|
||||
(vc-file-setprop file 'vc-checkout-model 'locking))))
|
||||
state)
|
||||
(if (not (vc-mistrust-permissions file))
|
||||
(let* ((attributes (file-attributes file))
|
||||
(owner-uid (nth 2 attributes))
|
||||
(permissions (nth 8 attributes)))
|
||||
(cond ((string-match ".r-..-..-." permissions)
|
||||
(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)))
|
||||
(t
|
||||
;; Strange permissions. Fall through to
|
||||
;; expensive state computation.
|
||||
(vc-rcs-state file))))
|
||||
(vc-rcs-state file)))))
|
||||
|
||||
(defun vc-rcs-workfile-version (file)
|
||||
"RCS-specific version of `vc-workfile-version'."
|
||||
(or (and vc-consult-headers
|
||||
(vc-rcs-consult-headers file)
|
||||
(vc-file-getprop file 'vc-workfile-version))
|
||||
(progn
|
||||
(vc-rcs-fetch-master-state file)
|
||||
(vc-file-getprop file 'vc-workfile-version))))
|
||||
|
||||
(defun vc-rcs-checkout-model (file)
|
||||
"RCS-specific version of `vc-checkout-model'."
|
||||
(vc-rcs-consult-headers file)
|
||||
(or (vc-file-getprop file 'vc-checkout-model)
|
||||
(progn (vc-rcs-fetch-master-state file)
|
||||
(vc-file-getprop file 'vc-checkout-model))))
|
||||
|
||||
;;; internal code
|
||||
|
||||
(defun vc-rcs-find-most-recent-rev (branch)
|
||||
"Find most recent revision on BRANCH."
|
||||
(goto-char (point-min))
|
||||
(let ((latest-rev -1) value)
|
||||
(while (re-search-forward (concat "^\\(" (regexp-quote branch)
|
||||
"\\.\\([0-9]+\\)\\)\ndate[ \t]+[0-9.]+;")
|
||||
nil t)
|
||||
(let ((rev (string-to-number (match-string 2))))
|
||||
(when (< latest-rev rev)
|
||||
(setq latest-rev rev)
|
||||
(setq value (match-string 1)))))
|
||||
value))
|
||||
|
||||
(defun vc-rcs-fetch-master-state (file &optional workfile-version)
|
||||
"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
|
||||
`vc-checkout-model' to their correct values, based on the master
|
||||
file."
|
||||
(with-temp-buffer
|
||||
(vc-insert-file (vc-name file) "^[0-9]")
|
||||
(let ((workfile-is-latest nil))
|
||||
(unless workfile-version
|
||||
(let ((default-branch (vc-parse-buffer "^branch[ \t\n]+\\([^;]*\\);" 1)))
|
||||
;; 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
|
||||
;; revision number.
|
||||
(cond
|
||||
;; no default branch
|
||||
((or (not default-branch) (string= "" default-branch))
|
||||
(setq workfile-version
|
||||
(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))
|
||||
;; else, search for the head of the default branch
|
||||
(t (vc-insert-file (vc-name file) "^desc")
|
||||
(setq workfile-version
|
||||
(vc-rcs-find-most-recent-rev default-branch))
|
||||
(setq workfile-is-latest t)))
|
||||
(vc-file-setprop file 'vc-workfile-version workfile-version)))
|
||||
;; Check strict locking
|
||||
(goto-char (point-min))
|
||||
(vc-file-setprop file 'vc-checkout-model
|
||||
(if (re-search-forward ";[ \t\n]*strict;" nil t)
|
||||
'locking 'implicit))
|
||||
;; Compute state of workfile version
|
||||
(goto-char (point-min))
|
||||
(let ((locking-user
|
||||
(vc-parse-buffer (concat "^locks[ \t\n]+[^;]*[ \t\n]+\\([^:]+\\):"
|
||||
(regexp-quote workfile-version)
|
||||
"[^0-9.]")
|
||||
1)))
|
||||
(cond
|
||||
;; not locked
|
||||
((not locking-user)
|
||||
(if (or workfile-is-latest
|
||||
(vc-rcs-latest-on-branch-p file workfile-version))
|
||||
;; workfile version is latest on branch
|
||||
'up-to-date
|
||||
;; workfile version is not latest on branch
|
||||
'needs-patch))
|
||||
;; locked by the calling user
|
||||
((and (stringp locking-user)
|
||||
(string= locking-user (vc-user-login-name)))
|
||||
(if (or (eq (vc-checkout-model file) 'locking)
|
||||
workfile-is-latest
|
||||
(vc-rcs-latest-on-branch-p file workfile-version))
|
||||
'edited
|
||||
;; Locking is not used for the file, but the owner does
|
||||
;; have a lock, and there is a higher version on the current
|
||||
;; branch. Not sure if this can occur, and if it is right
|
||||
;; to use `needs-merge' in this case.
|
||||
'needs-merge))
|
||||
;; locked by somebody else
|
||||
((stringp locking-user)
|
||||
locking-user)
|
||||
(t
|
||||
(error "Error getting state of RCS file")))))))
|
||||
|
||||
(defun vc-rcs-consult-headers (file)
|
||||
"Search for RCS headers in FILE, and set properties accordingly.
|
||||
|
||||
Returns: nil if no headers were found
|
||||
'rev if a workfile revision was found
|
||||
'rev-and-lock if revision and lock info was found"
|
||||
(cond
|
||||
((not (get-file-buffer file)) nil)
|
||||
((let (status version locking-user)
|
||||
(save-excursion
|
||||
(set-buffer (get-file-buffer file))
|
||||
(goto-char (point-min))
|
||||
(cond
|
||||
;; search for $Id or $Header
|
||||
;; -------------------------
|
||||
;; The `\ 's below avoid an RCS 5.7 bug when checking in this file.
|
||||
((or (and (search-forward "$Id\ : " nil t)
|
||||
(looking-at "[^ ]+ \\([0-9.]+\\) "))
|
||||
(and (progn (goto-char (point-min))
|
||||
(search-forward "$Header\ : " nil t))
|
||||
(looking-at "[^ ]+ \\([0-9.]+\\) ")))
|
||||
(goto-char (match-end 0))
|
||||
;; if found, store the revision number ...
|
||||
(setq version (match-string-no-properties 1))
|
||||
;; ... and check for the locking state
|
||||
(cond
|
||||
((looking-at
|
||||
(concat "[0-9]+[/-][01][0-9][/-][0-3][0-9] " ; date
|
||||
"[0-2][0-9]:[0-5][0-9]+:[0-6][0-9]+\\([+-][0-9:]+\\)? " ; time
|
||||
"[^ ]+ [^ ]+ ")) ; author & state
|
||||
(goto-char (match-end 0)) ; [0-6] in regexp handles leap seconds
|
||||
(cond
|
||||
;; unlocked revision
|
||||
((looking-at "\\$")
|
||||
(setq locking-user 'none)
|
||||
(setq status 'rev-and-lock))
|
||||
;; revision is locked by some user
|
||||
((looking-at "\\([^ ]+\\) \\$")
|
||||
(setq locking-user (match-string-no-properties 1))
|
||||
(setq status '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 ...
|
||||
(setq version (match-string-no-properties 1))
|
||||
;; and see if there's any lock information
|
||||
(goto-char (point-min))
|
||||
(if (re-search-forward (concat "\\$" "Locker:") nil t)
|
||||
(cond ((looking-at " \\([^ ]+\\) \\$")
|
||||
(setq locking-user (match-string-no-properties 1))
|
||||
(setq status 'rev-and-lock))
|
||||
((looking-at " *\\$")
|
||||
(setq locking-user 'none)
|
||||
(setq status 'rev-and-lock))
|
||||
(t
|
||||
(setq locking-user 'none)
|
||||
(setq status 'rev-and-lock)))
|
||||
(setq status 'rev)))
|
||||
;; else: nothing found
|
||||
;; -------------------
|
||||
(t nil)))
|
||||
(if status (vc-file-setprop file 'vc-workfile-version version))
|
||||
(and (eq status 'rev-and-lock)
|
||||
(vc-file-setprop file 'vc-state
|
||||
(cond
|
||||
((eq locking-user 'none) 'up-to-date)
|
||||
((string= locking-user (vc-user-login-name)) 'edited)
|
||||
(t locking-user)))
|
||||
;; If the file has headers, we don't want to query the
|
||||
;; master file, because that would eliminate all the
|
||||
;; performance gain the headers brought us. We therefore
|
||||
;; use a heuristic now to find out whether locking is used
|
||||
;; for this file. If we trust the file permissions, and the
|
||||
;; file is not locked, then if the file is read-only we
|
||||
;; assume that locking is used for the file, otherwise
|
||||
;; locking is not used.
|
||||
(not (vc-mistrust-permissions file))
|
||||
(vc-up-to-date-p file)
|
||||
(if (string-match ".r-..-..-." (nth 8 (file-attributes file)))
|
||||
(vc-file-setprop file 'vc-checkout-model 'locking)
|
||||
(vc-file-setprop file 'vc-checkout-model 'implicit)))
|
||||
status))))
|
||||
|
||||
(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)))
|
||||
(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))))
|
||||
(if (eq status 2)
|
||||
(if (not vc-rcsdiff-knows-brief)
|
||||
(setq vc-rcsdiff-knows-brief 'no
|
||||
status (vc-do-command nil 1 "rcsdiff" file version))
|
||||
(error "rcsdiff failed"))
|
||||
(if (not vc-rcsdiff-knows-brief) (setq vc-rcsdiff-knows-brief 'yes)))
|
||||
;; The workfile is unchanged if rcsdiff found no differences.
|
||||
(zerop status)))
|
||||
|
||||
(defun vc-rcs-trunk-p (rev)
|
||||
"Return t if REV is an RCS revision on the trunk."
|
||||
(not (eq nil (string-match "\\`[0-9]+\\.[0-9]+\\'" rev))))
|
||||
|
||||
(defun vc-rcs-branch-part (rev)
|
||||
"Return the branch part of an RCS revision number REV"
|
||||
(substring rev 0 (string-match "\\.[0-9]+\\'" rev)))
|
||||
|
||||
(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)))
|
||||
(with-temp-buffer
|
||||
(string= version
|
||||
(if (vc-rcs-trunk-p version)
|
||||
(progn
|
||||
;; Compare VERSION to the head version number.
|
||||
(vc-insert-file (vc-name file) "^[0-9]")
|
||||
(vc-parse-buffer "^head[ \t\n]+\\([^;]+\\);" 1))
|
||||
;; If we are not on the trunk, we need to examine the
|
||||
;; whole current branch.
|
||||
(vc-insert-file (vc-name file) "^desc")
|
||||
(vc-rcs-find-most-recent-rev (vc-rcs-branch-part version))))))
|
||||
|
||||
(defun vc-rcs-branch-p (rev)
|
||||
"Return t if REV is an RCS branch revision"
|
||||
(not (eq nil (string-match "\\`[0-9]+\\(\\.[0-9]+\\.[0-9]+\\)*\\'" rev))))
|
||||
|
||||
(defun vc-rcs-minor-part (rev)
|
||||
"Return the minor version number of an RCS revision number REV."
|
||||
(string-match "[0-9]+\\'" rev)
|
||||
(substring rev (match-beginning 0) (match-end 0)))
|
||||
|
||||
(defun vc-rcs-previous-version (rev)
|
||||
"Guess the previous RCS version number"
|
||||
(let ((branch (vc-rcs-branch-part rev))
|
||||
(minor-num (string-to-number (vc-rcs-minor-part rev))))
|
||||
(if (> minor-num 1)
|
||||
;; version 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
|
||||
""
|
||||
;; we are at the beginning of a branch --
|
||||
;; return version of starting point
|
||||
(vc-rcs-branch-part branch)))))
|
||||
|
||||
(defun vc-rcs-print-log (file)
|
||||
"Get change log associated with FILE."
|
||||
(vc-do-command t 0 "rlog" (vc-name file)))
|
||||
|
||||
(defun vc-rcs-show-log-entry (version)
|
||||
(when (re-search-forward
|
||||
;; also match some context, for safety
|
||||
(concat "----\nrevision " version
|
||||
"\\(\tlocked by:.*\n\\|\n\\)date: ") nil t)
|
||||
;; set the display window so that
|
||||
;; the whole log entry is displayed
|
||||
(let (start end lines)
|
||||
(beginning-of-line) (forward-line -1) (setq start (point))
|
||||
(if (not (re-search-forward "^----*\nrevision" nil t))
|
||||
(setq end (point-max))
|
||||
(beginning-of-line) (forward-line -1) (setq end (point)))
|
||||
(setq lines (count-lines start end))
|
||||
(cond
|
||||
;; if the global information and this log entry fit
|
||||
;; into the window, display from the beginning
|
||||
((< (count-lines (point-min) end) (window-height))
|
||||
(goto-char (point-min))
|
||||
(recenter 0)
|
||||
(goto-char start))
|
||||
;; if the whole entry fits into the window,
|
||||
;; display it centered
|
||||
((< (1+ lines) (window-height))
|
||||
(goto-char start)
|
||||
(recenter (1- (- (/ (window-height) 2) (/ lines 2)))))
|
||||
;; otherwise (the entry is too large for the window),
|
||||
;; display from the start
|
||||
(t
|
||||
(goto-char start)
|
||||
(recenter 0))))))
|
||||
|
||||
(defun vc-rcs-assign-name (file name)
|
||||
"Assign to FILE's latest version a given NAME."
|
||||
(vc-do-command nil 0 "rcs" (vc-name file) (concat "-n" name ":")))
|
||||
|
||||
(defun vc-rcs-merge (file first-version &optional second-version)
|
||||
"Merge changes into current working copy of FILE.
|
||||
The changes are between FIRST-VERSION and SECOND-VERSION."
|
||||
(vc-do-command nil 1 "rcsmerge" (vc-name file)
|
||||
"-kk" ; ignore keyword conflicts
|
||||
(concat "-r" first-version)
|
||||
(if second-version (concat "-r" second-version))))
|
||||
|
||||
(defun vc-rcs-check-headers ()
|
||||
"Check if the current file has any headers in it."
|
||||
(save-excursion
|
||||
(goto-char (point-min))
|
||||
(re-search-forward "\\$[A-Za-z\300-\326\330-\366\370-\377]+\
|
||||
\\(: [\t -#%-\176\240-\377]*\\)?\\$" nil t)))
|
||||
|
||||
(defun vc-rcs-clear-headers ()
|
||||
"Implementation of vc-clear-headers for RCS."
|
||||
(let ((case-fold-search nil))
|
||||
(goto-char (point-min))
|
||||
(while (re-search-forward
|
||||
(concat "\\$\\(Author\\|Date\\|Header\\|Id\\|Locker\\|Name\\|"
|
||||
"RCSfile\\|Revision\\|Source\\|State\\): [^$\n]+\\$")
|
||||
nil t)
|
||||
(replace-match "$\\1$"))))
|
||||
|
||||
(defun vc-rcs-steal-lock (file &optional rev)
|
||||
"Steal the lock on the current workfile for FILE and revision REV.
|
||||
Needs RCS 5.6.2 or later for -M."
|
||||
(vc-do-command nil 0 "rcs" (vc-name file) "-M"
|
||||
(concat "-u" rev) (concat "-l" rev)))
|
||||
|
||||
(defun vc-rcs-uncheck (file target)
|
||||
"Undo the checkin of FILE's revision TARGET."
|
||||
(vc-do-command nil 0 "rcs" (vc-name file) (concat "-o" target)))
|
||||
|
||||
(defun vc-rcs-revert (file)
|
||||
"Revert FILE to the version it was based on."
|
||||
(vc-do-command nil 0 "co" (vc-name file) "-f"
|
||||
(concat "-u" (vc-workfile-version file))))
|
||||
|
||||
(defun vc-rcs-rename-file (old new)
|
||||
;; Just move the master file (using vc-rcs-master-templates).
|
||||
(vc-rename-master (vc-name old) new vc-rcs-master-templates))
|
||||
|
||||
(defun vc-release-greater-or-equal (r1 r2)
|
||||
"Compare release numbers, represented as strings. Release
|
||||
components are assumed cardinal numbers, not decimal fractions \(5.10
|
||||
is a higher release than 5.9\). Omitted fields are considered lower
|
||||
\(5.6.7 is earlier than 5.6.7.1\). Comparison runs till the end of
|
||||
the string is found, or a non-numeric component shows up \(5.6.7 is
|
||||
earlier than \"5.6.7 beta\", which is probably not what you want in
|
||||
some cases\). This code is suitable for existing RCS release numbers.
|
||||
CVS releases are handled reasonably, too \(1.3 < 1.4* < 1.5\)."
|
||||
(let (v1 v2 i1 i2)
|
||||
(catch 'done
|
||||
(or (and (string-match "^\\.?\\([0-9]+\\)" r1)
|
||||
(setq i1 (match-end 0))
|
||||
(setq v1 (string-to-number (match-string 1 r1)))
|
||||
(or (and (string-match "^\\.?\\([0-9]+\\)" r2)
|
||||
(setq i2 (match-end 0))
|
||||
(setq v2 (string-to-number (match-string 1 r2)))
|
||||
(if (> v1 v2) (throw 'done t)
|
||||
(if (< v1 v2) (throw 'done nil)
|
||||
(throw 'done
|
||||
(vc-release-greater-or-equal
|
||||
(substring r1 i1)
|
||||
(substring r2 i2)))))))
|
||||
(throw 'done t)))
|
||||
(or (and (string-match "^\\.?\\([0-9]+\\)" r2)
|
||||
(throw 'done nil))
|
||||
(throw 'done t)))))
|
||||
|
||||
(defun vc-rcs-release-p (release)
|
||||
"Return t if we have RELEASE or better"
|
||||
(let ((installation (vc-rcs-system-release)))
|
||||
(if (and installation
|
||||
(not (eq installation 'unknown)))
|
||||
(vc-release-greater-or-equal installation release))))
|
||||
|
||||
(defun vc-rcs-checkin (file rev comment)
|
||||
"RCS-specific version of `vc-backend-checkin'."
|
||||
;; Adaptation for RCS branch support: if this is an explicit checkin,
|
||||
;; or if the checkin creates a new branch, set the master file branch
|
||||
;; accordingly.
|
||||
(let ((switches (if (stringp vc-checkin-switches)
|
||||
(list vc-checkin-switches)
|
||||
vc-checkin-switches)))
|
||||
(let ((old-version (vc-workfile-version file)) new-version)
|
||||
(apply 'vc-do-command nil 0 "ci" (vc-name file)
|
||||
;; if available, use the secure check-in option
|
||||
(and (vc-rcs-release-p "5.6.4") "-j")
|
||||
(concat (if vc-keep-workfiles "-u" "-r") rev)
|
||||
(concat "-m" comment)
|
||||
switches)
|
||||
(vc-file-setprop file 'vc-workfile-version nil)
|
||||
|
||||
;; determine the new workfile version
|
||||
(set-buffer "*vc*")
|
||||
(goto-char (point-min))
|
||||
(when (or (re-search-forward
|
||||
"new revision: \\([0-9.]+\\);" nil t)
|
||||
(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))
|
||||
|
||||
;; if we got to a different branch, adjust the default
|
||||
;; branch accordingly
|
||||
(cond
|
||||
((and old-version new-version
|
||||
(not (string= (vc-rcs-branch-part old-version)
|
||||
(vc-rcs-branch-part new-version))))
|
||||
(vc-do-command nil 0 "rcs" (vc-name file)
|
||||
(if (vc-rcs-trunk-p new-version) "-b"
|
||||
(concat "-b" (vc-rcs-branch-part new-version))))
|
||||
;; If this is an old RCS release, we might have
|
||||
;; to remove a remaining lock.
|
||||
(if (not (vc-rcs-release-p "5.6.2"))
|
||||
;; exit status of 1 is also accepted.
|
||||
;; It means that the lock was removed before.
|
||||
(vc-do-command nil 1 "rcs" (vc-name file)
|
||||
(concat "-u" old-version))))))))
|
||||
|
||||
(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
|
||||
override this using variable `vc-rcs-release'.
|
||||
|
||||
If the user has not set variable `vc-rcs-release' and it is nil,
|
||||
variable `vc-rcs-release' is set to the returned value."
|
||||
(or vc-rcs-release
|
||||
(setq vc-rcs-release
|
||||
(or (and (zerop (vc-do-command nil nil "rcs" nil "-V"))
|
||||
(with-current-buffer (get-buffer "*vc*")
|
||||
(vc-parse-buffer "^RCS version \\([0-9.]+ *.*\\)" 1)))
|
||||
'unknown))))
|
||||
|
||||
(defun vc-rcs-diff (file &optional oldvers newvers)
|
||||
"Get a difference report using RCS between two versions of FILE."
|
||||
(if (not oldvers) (setq oldvers (vc-workfile-version file)))
|
||||
;; If we know that --brief is not supported, don't try it.
|
||||
(let* ((diff-switches-list (if (listp diff-switches)
|
||||
diff-switches
|
||||
(list diff-switches)))
|
||||
(options (append (list "-q"
|
||||
(concat "-r" oldvers)
|
||||
(and newvers (concat "-r" newvers)))
|
||||
diff-switches-list)))
|
||||
(apply 'vc-do-command t 1 "rcsdiff" file options)))
|
||||
|
||||
(defun vc-rcs-responsible-p (file)
|
||||
"Return non-nil if RCS thinks it would be responsible for registering FILE."
|
||||
;; TODO: check for all the patterns in vc-rcs-master-templates
|
||||
(file-directory-p (expand-file-name "RCS" (file-name-directory file))))
|
||||
|
||||
(defun vc-rcs-register (file &optional rev comment)
|
||||
"Register FILE into the RCS version-control system.
|
||||
REV is the optional revision number for the file. COMMENT can be used
|
||||
to provide an initial description of FILE.
|
||||
|
||||
`vc-register-switches' and `vc-rcs-register-switches' are passed to
|
||||
the RCS command (in that order).
|
||||
|
||||
Automatically retrieve a read-only version of the file with keywords
|
||||
expanded if `vc-keep-workfiles' is non-nil, otherwise, delete the workfile."
|
||||
(vc-file-clearprops file)
|
||||
(let ((subdir (expand-file-name "RCS" (file-name-directory file)))
|
||||
(switches (list
|
||||
(if (stringp vc-register-switches)
|
||||
(list vc-register-switches)
|
||||
vc-register-switches)
|
||||
(if (stringp vc-rcs-register-switches)
|
||||
(list vc-rcs-register-switches)
|
||||
vc-rcs-register-switches))))
|
||||
|
||||
(and (not (file-exists-p subdir))
|
||||
(not (directory-files (file-name-directory file)
|
||||
nil ".*,v$" t))
|
||||
(yes-or-no-p "Create RCS subdirectory? ")
|
||||
(make-directory subdir))
|
||||
(apply 'vc-do-command nil 0 "ci" file
|
||||
;; if available, use the secure registering option
|
||||
(and (vc-rcs-release-p "5.6.4") "-i")
|
||||
(concat (if vc-keep-workfiles "-u" "-r") rev)
|
||||
(and comment (concat "-t-" comment))
|
||||
switches)
|
||||
;; 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))))))
|
||||
|
||||
(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))
|
||||
(file-buffer (get-file-buffer file))
|
||||
switches)
|
||||
(message "Checking out %s..." filename)
|
||||
(save-excursion
|
||||
;; Change buffers to get local value of vc-checkout-switches.
|
||||
(if file-buffer (set-buffer file-buffer))
|
||||
(setq switches (if (stringp vc-checkout-switches)
|
||||
(list vc-checkout-switches)
|
||||
vc-checkout-switches))
|
||||
;; Save this buffer's default-directory
|
||||
;; and use save-excursion to make sure it is restored
|
||||
;; in the same buffer it was saved in.
|
||||
(let ((default-directory default-directory))
|
||||
(save-excursion
|
||||
;; Adjust the default-directory so that the check-out creates
|
||||
;; the file in the right place.
|
||||
(setq default-directory (file-name-directory filename))
|
||||
(if workfile ;; RCS
|
||||
;; RCS can't check out into arbitrary file names directly.
|
||||
;; Use `co -p' and make stdout point to the correct file.
|
||||
(let ((vc-modes (logior (file-modes (vc-name file))
|
||||
(if writable 128 0)))
|
||||
(failed t))
|
||||
(unwind-protect
|
||||
(progn
|
||||
(let ((coding-system-for-read 'no-conversion)
|
||||
(coding-system-for-write 'no-conversion))
|
||||
(with-temp-file filename
|
||||
(apply 'vc-do-command
|
||||
(current-buffer) 0 "co" (vc-name file)
|
||||
"-q" ;; suppress diagnostic output
|
||||
(if writable "-l")
|
||||
(concat "-p" rev)
|
||||
switches)))
|
||||
(set-file-modes filename
|
||||
(logior (file-modes (vc-name file))
|
||||
(if writable 128 0)))
|
||||
(setq failed nil))
|
||||
(and failed (file-exists-p filename)
|
||||
(delete-file filename))))
|
||||
(let (new-version)
|
||||
;; if we should go to the head of the trunk,
|
||||
;; clear the default branch first
|
||||
(and rev (string= rev "")
|
||||
(vc-do-command nil 0 "rcs" (vc-name file) "-b"))
|
||||
;; now do the checkout
|
||||
(apply 'vc-do-command
|
||||
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 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)))
|
||||
switches)
|
||||
;; determine the new workfile version
|
||||
(with-current-buffer "*vc*"
|
||||
(setq new-version
|
||||
(vc-parse-buffer "^revision \\([0-9.]+\\).*\n" 1)))
|
||||
(vc-file-setprop file 'vc-workfile-version new-version)
|
||||
;; if necessary, adjust the default branch
|
||||
(and rev (not (string= rev ""))
|
||||
(vc-do-command
|
||||
nil 0 "rcs" (vc-name file)
|
||||
(concat "-b"
|
||||
(if (vc-rcs-latest-on-branch-p file new-version)
|
||||
(if (vc-rcs-trunk-p new-version) nil
|
||||
(vc-rcs-branch-part new-version))
|
||||
new-version)))))))
|
||||
(message "Checking out %s...done" filename)))))
|
||||
|
||||
(provide 'vc-rcs)
|
||||
|
||||
;;; vc-rcs.el ends here
|
||||
Loading…
Add table
Reference in a new issue