;;; 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>
(autoload 'vc-expand-dirs "vc")
-(defun vc-rcs-dir-status (dir update-function)
- ;; FIXME: this function should be rewritten or `vc-expand-dirs'
- ;; should be changed to take a backend parameter. Using
- ;; `vc-expand-dirs' is not TRTD because it returns files from
- ;; multiple backends. It should also return 'unregistered files.
-
- ;; Doing individual vc-state calls is painful but there
- ;; is no better way in RCS-land.
- (let ((flist (vc-expand-dirs (list dir)))
- (result nil))
- (dolist (file flist)
+(defun vc-rcs-dir-status-files (dir files update-function)
+ (if (not files) (setq files (vc-expand-dirs (list dir) 'RCS)))
+ (let ((result nil))
+ (dolist (file files)
(let ((state (vc-state file))
(frel (file-relative-name file)))
(when (and (eq (vc-backend file) 'RCS)
(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")
+ "-u"
(and comment (concat "-t-" comment))
(vc-switches 'RCS 'register))
;; parse output to find master file name and workfile version
"RCS-specific version of `vc-backend-checkin'."
(let (rev (switches (vc-switches 'RCS 'checkin)))
;; Now operate on the files
- (dolist (file (vc-expand-dirs 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
(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)
"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)))
+ (mapc 'vc-rcs-checkout (vc-expand-dirs (list file) 'RCS))
(let ((file-buffer (get-file-buffer file))
switches)
(message "Checking out %s..." file)
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))
- (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."
(if (file-directory-p file)
- (mapc 'vc-rcs-revert (vc-expand-dirs (list file)))
+ (mapc 'vc-rcs-revert (vc-expand-dirs (list file) 'RCS))
(vc-do-command "*vc*" 0 "co" (vc-master-name file) "-f"
(concat (if (eq (vc-state file) 'edited) "-u" "-r")
(vc-working-revision file)))))
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)))
+ (mapc 'vc-rcs-steal-lock (vc-expand-dirs (list file) 'RCS))
(vc-do-command "*vc*" 0 "rcs" (vc-master-name file) "-M" (concat "-u" rev))
;; Do a real checkout after stealing the lock, so that we see
;; expanded headers.
- (vc-do-command "*vc*" 0 "co" (vc-master-name file) "-f" (concat "-l" rev))))
+ (vc-do-command "*vc*" 0 "co" (vc-master-name file) "-f" (concat "-l" rev))
+ ;; Must clear any headers here because they wouldn't
+ ;; show that the file is locked now.
+ (let* ((filename (or file buffer-file-name))
+ (visited (find-buffer-visiting filename)))
+ (if visited
+ (let ((context (vc-buffer-context)))
+ ;; save-excursion may be able to relocate point and mark
+ ;; properly. If it fails, vc-restore-buffer-context
+ ;; will give it a second try.
+ (save-excursion
+ (vc-rcs-clear-headers))
+ (vc-restore-buffer-context context))
+ (set-buffer (find-file-noselect filename))
+ (vc-rcs-clear-headers)
+ (kill-buffer filename)))))
(defun vc-rcs-modify-change-comment (files rev comment)
"Modify the change comments change on FILES on a specified REV. If FILE is a
directory the operation is applied to all registered files beneath it."
- (dolist (file (vc-expand-dirs files))
+ (dolist (file (vc-expand-dirs files 'RCS))
(vc-do-command "*vc*" 0 "rcs" (vc-master-name file)
(concat "-m" rev ":" comment))))
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-master-name (vc-expand-dirs files)))
+ (mapcar 'vc-master-name (vc-expand-dirs files 'RCS)))
(with-current-buffer (or buffer "*vc*")
(vc-rcs-print-log-cleanup))
(when limit 'limit-unsupported))
-(defun vc-rcs-diff (files &optional 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*")
- 1 ;; Always go synchronous, the repo is local
- "rcsdiff" (vc-expand-dirs files)
+ (if async 'async 1)
+ "rcsdiff" (vc-expand-dirs files 'RCS)
(append (list "-q"
(and oldvers (concat "-r" oldvers))
(and newvers (concat "-r" newvers)))
\\(: [\t -#%-\176\240-\377]*\\)?\\$" nil t)))
(defun vc-rcs-clear-headers ()
- "Implementation of vc-clear-headers for RCS."
+ "Clear RCS header value parts."
(let ((case-fold-search nil))
(goto-char (point-min))
(while (re-search-forward