;;; vc-rcs.el --- support for RCS version-control -*- lexical-binding:t -*-
-;; Copyright (C) 1992-2014 Free Software Foundation, Inc.
+;; Copyright (C) 1992-2015 Free Software Foundation, Inc.
;; Author: FSF (see vc.el for full credits)
;; Maintainer: Andre Spiegel <spiegel@gnu.org>
:version "21.1"
:group 'vc-rcs)
-(defcustom vc-rcs-header '("\$Id\$")
+(defcustom vc-rcs-header '("$Id\ $")
"Header keywords to be inserted by `vc-insert-headers'."
:type '(repeat string)
:version "24.1" ; no longer consult the obsolete vc-header-alist
(defun vc-rcs-register (files &optional comment)
"Register FILES into the RCS version-control system.
+Automatically retrieve a read-only version of the file with keywords expanded.
COMMENT can be used to provide an initial description for each FILES.
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."
+to the RCS command."
(let (subdir name)
(dolist (file files)
(and (not (file-exists-p
(apply #'vc-do-command "*vc*" 0 "ci" file
;; if available, use the secure registering option
(and (vc-rcs-release-p "5.6.4") "-i")
- (and comment (concat "-t-" comment))
+ "-u"
+ ;; Some old MS-Windows ports of RCS crash when "ci -i" is
+ ;; invoked without -t; indulge them.
+ (concat "-t-" (or comment ""))
(vc-switches 'RCS 'register))
;; parse output to find master file name and workfile version
(with-current-buffer "*vc*"
"Unregister FILE from RCS.
If this leaves the RCS subdirectory empty, ask the user
whether to remove it."
- (let* ((master (vc-master-name file))
- (dir (file-name-directory master))
- (backup-info (find-backup-file-name master)))
- (if (not backup-info)
- (delete-file master)
- (rename-file master (car backup-info) 'ok-if-already-exists)
- (dolist (f (cdr backup-info)) (ignore-errors (delete-file f))))
- (and (string= (file-name-nondirectory (directory-file-name dir)) "RCS")
- ;; check whether RCS dir is empty, i.e. it does not
- ;; contain any files except "." and ".."
- (not (directory-files dir nil
- "^\\([^.]\\|\\.[^.]\\|\\.\\.[^.]\\).*"))
- (yes-or-no-p (format "Directory %s is empty; remove it? " dir))
- (delete-directory dir))))
-
-;; It used to be possible to pass in a value for the variable rev, but
-;; nothing in the rest of VC used this capability. Removing it makes the
-;; backend interface simpler for all modes.
-;;
-(defun vc-rcs-checkin (files comment)
+ (unless (memq (vc-state file) '(nil unregistered))
+ (let* ((master (vc-master-name file))
+ (dir (file-name-directory master))
+ (backup-info (find-backup-file-name master)))
+ (if (not backup-info)
+ (delete-file master)
+ (rename-file master (car backup-info) 'ok-if-already-exists)
+ (dolist (f (cdr backup-info)) (ignore-errors (delete-file f))))
+ (and (string= (file-name-nondirectory (directory-file-name dir)) "RCS")
+ ;; check whether RCS dir is empty, i.e. it does not
+ ;; contain any files except "." and ".."
+ (not (directory-files dir nil
+ "^\\([^.]\\|\\.[^.]\\|\\.\\.[^.]\\).*"))
+ (yes-or-no-p (format "Directory %s is empty; remove it? " dir))
+ (delete-directory dir)))))
+
+(defun vc-rcs-checkin (files comment &optional rev)
"RCS-specific version of `vc-backend-checkin'."
- (let (rev (switches (vc-switches 'RCS 'checkin)))
+ (let ((switches (vc-switches 'RCS 'checkin)))
;; Now operate on the files
(dolist (file (vc-expand-dirs files 'RCS))
(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.
- (and default-branch
+ (and (not rev)
+ default-branch
(string-match (concat "^" (regexp-quote old-version) "\\.")
default-branch)
(setq rev default-branch)
(setq switches (cons "-f" switches)))
- (if old-version
- (setq rev (vc-branch-part old-version))
- (error "can't find current branch"))
+ (if (and (not rev) old-version)
+ (setq rev (vc-branch-part old-version)))
(apply #'vc-do-command "*vc*" 0 "ci" (vc-master-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 "-u" rev)
(concat "-m" comment)
switches)
(vc-file-setprop file 'vc-working-revision nil)
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 registered subfiles in them."
- (if (not files)
- (error "RCS backend doesn't support directory-level rollback"))
- (dolist (file (vc-expand-dirs files 'RCS))
- (let* ((discard (vc-working-revision file))
- (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? "
- discard file)))
- (error "Aborted"))
- (message "Removing revision %s from %s." discard file)
- (vc-do-command "*vc*" 0 "rcs" (vc-master-name file) (concat "-o" discard))
- ;; Check out the most recent remaining version. If it
- ;; fails, because the whole branch got deleted, do a
- ;; double-take and check out the version where the branch
- ;; started.
- (while (not done)
- (condition-case err
- (progn
- (vc-do-command "*vc*" 0 "co" (vc-master-name file) "-f"
- (concat "-u" previous))
- (setq done t))
- (error (set-buffer "*vc*")
- (goto-char (point-min))
- (if (search-forward "no side branches present for" nil t)
- (progn (setq previous (vc-branch-part previous))
- (vc-rcs-set-default-branch file previous)
- ;; vc-do-command popped up a window with
- ;; the error message. Get rid of it, by
- ;; restoring the old window configuration.
- (set-window-configuration config))
- ;; No, it was some other error: re-signal it.
- (signal (car err) (cdr err)))))))))
-
(defun vc-rcs-revert (file &optional _contents-done)
"Revert FILE to the version it was based on. If FILE is a directory,
revert all registered files beneath it."
(vc-rcs-print-log-cleanup))
(when limit 'limit-unsupported))
-(defun vc-rcs-diff (files &optional async oldvers newvers buffer)
+(defun vc-rcs-diff (files &optional oldvers newvers buffer async)
"Get a difference report using RCS between two sets of files."
(apply #'vc-do-command (or buffer "*vc-diff*")
(if async 'async 1)
(insert (gethash (get-text-property (point) :vc-rcs-r/d/a) ht))
(forward-line 1))))
-(declare-function vc-annotate-convert-time "vc-annotate" (time))
+(declare-function vc-annotate-convert-time "vc-annotate" (&optional time))
(defun vc-rcs-annotate-current-time ()
"Return the current time, based at midnight of the current day, 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
- (if (or (not (vc-insert-file (vc-master-name file) "^[0-9]"))
- (progn (goto-char (point-min))
- (not (looking-at "^head[ \t\n]+[^;]+;$"))))
- (error "File %s is not an RCS master file" (vc-master-name file)))
- (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 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
- ;; revision number.
- (cond
- ;; no default branch
- ((or (not default-branch) (string= "" default-branch))
- (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 working-revision default-branch))
- ;; else, search for the head of the default branch
- (t (vc-insert-file (vc-master-name file) "^desc")
+ (when (and (file-regular-p file) (vc-master-name file))
+ (with-temp-buffer
+ (if (or (not (vc-insert-file (vc-master-name file) "^[0-9]"))
+ (progn (goto-char (point-min))
+ (not (looking-at "^head[ \t\n]+[^;]+;$"))))
+ (error "File %s is not an RCS master file" (vc-master-name file)))
+ (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 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
+ ;; revision number.
+ (cond
+ ;; no default branch
+ ((or (not default-branch) (string= "" default-branch))
(setq working-revision
- (vc-rcs-find-most-recent-rev default-branch))
- (setq workfile-is-latest t)))
- (vc-file-setprop file 'vc-working-revision working-revision))
- ;; 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 working-revision)
- "[^0-9.]")
- 1)))
- (cond
- ;; not locked
- ((not locking-user)
- (if (or workfile-is-latest
- (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-update))
- ;; locked by the calling user
- ((and (stringp locking-user)
- (string= locking-user (vc-user-login-name file)))
- ;; Don't call `vc-rcs-checkout-model' to avoid inf-looping.
- (if (or (eq (vc-file-getprop file 'vc-checkout-model) 'locking)
- workfile-is-latest
- (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
- ;; 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")))))))
+ (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 working-revision default-branch))
+ ;; else, search for the head of the default branch
+ (t (vc-insert-file (vc-master-name file) "^desc")
+ (setq working-revision
+ (vc-rcs-find-most-recent-rev default-branch))
+ (setq workfile-is-latest t)))
+ (vc-file-setprop file 'vc-working-revision working-revision))
+ ;; 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 working-revision)
+ "[^0-9.]")
+ 1)))
+ (cond
+ ;; not locked
+ ((not locking-user)
+ (if (or workfile-is-latest
+ (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-update))
+ ;; locked by the calling user
+ ((and (stringp locking-user)
+ (string= locking-user (vc-user-login-name file)))
+ ;; Don't call `vc-rcs-checkout-model' to avoid inf-looping.
+ (if (or (eq (vc-file-getprop file 'vc-checkout-model) 'locking)
+ workfile-is-latest
+ (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
+ ;; 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.
(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
+\(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\)."
+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)