;;; 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, 2009
+;; 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010
;; Free Software Foundation, Inc.
;; Author: FSF (see vc.el for full credits)
;; 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:
;;;
;;;###autoload
(defcustom vc-rcs-master-templates
- '("%sRCS/%s,v" "%s%s,v" "%sRCS/%s")
+ (purecopy '("%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"
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 name)
+ ;; When REV is specified, we need to force using "-t-".
+ (when rev (unless comment (setq comment "")))
(dolist (file files)
(and (not (file-exists-p
(setq subdir (expand-file-name "RCS"
(yes-or-no-p (format "Directory %s is empty; remove it? " dir))
(delete-directory dir))))
-(defun vc-rcs-checkin (files rev comment)
+(defun vc-rcs-checkin (files rev comment &optional extra-args-ignored)
"RCS-specific version of `vc-backend-checkin'."
(let ((switches (vc-switches 'RCS 'checkin)))
;; Now operate on the 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."))
+ (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)))
;;; 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 buffer &optional shortlog start-revision-ignored limit)
"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))
+ (when limit 'limit-unsupported))
(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))
(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)))
+ (with-current-buffer (get-file-buffer file)
+ (save-excursion
+ (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-working-revision version))
(and (eq status 'rev-and-lock)
(vc-file-setprop file 'vc-state
HCoop / bpt / emacs.git / blobdiff