summaryrefslogtreecommitdiff
path: root/lisp/vc-rcs.el
diff options
context:
space:
mode:
authorDan Nicolaescu <dann@ics.uci.edu>2009-08-26 17:54:05 +0000
committerDan Nicolaescu <dann@ics.uci.edu>2009-08-26 17:54:05 +0000
commit3b64d86b56c392642f204efe4981fd8ec33e7f62 (patch)
treec312962751902fe286b894b9d5446a4739977a14 /lisp/vc-rcs.el
parent636a36a0708e8d6dd4849d5265a762a1c64ef3fa (diff)
downloademacs-3b64d86b56c392642f204efe4981fd8ec33e7f62.tar.gz
* vc.el (vc-trunk-p): Rename to vc-rcs-trunk-p and move to vc-rcs.el.
(vc-minor-part): Rename to vc-rcs-minor-part and move to vc-rcs.el. (vc-default-previous-revision): Rename to vc-rcs-previous-revision and move to vc-rcs.el. (vc-default-next-revision): Rename to vc-rcs-next-revision and move to vc-rcs.el. (vc-cvs-update-changelog): Move to vc-cvs.el, use vc-call-backend. (vc-rcs-update-changelog): Remove. (vc-update-changelog-rcs2log): Rename to vc-rcs-update-changelog and move to vc-rcs.el. * vc-rcs.el (vc-rcs-latest-on-branch-p, vc-rcs-checkin) (vc-rcs-checkout, vc-rcs-rollback): Adjust for the vc-rcs-trunk-p renaming. (vc-rcs-trunk-p, vc-rcs-minor-part, vc-rcs-previous-revision) (vc-rcs-next-revision, vc-rcs-update-changelog): Moved here from vc.el, renamed to be RCS specific. * vc-cvs.el (vc-cvs-previous-revision, vc-cvs-next-revision): New functions. (vc-cvs-update-changelog): Moved here from vc.el. * vc-sccs.el (vc-sccs-previous-revision, vc-sccs-next-revision): New functions.
Diffstat (limited to 'lisp/vc-rcs.el')
-rw-r--r--lisp/vc-rcs.el99
1 files changed, 94 insertions, 5 deletions
diff --git a/lisp/vc-rcs.el b/lisp/vc-rcs.el
index 8e6eb62ae75..ffb6d21c638 100644
--- a/lisp/vc-rcs.el
+++ b/lisp/vc-rcs.el
@@ -220,7 +220,7 @@ When VERSION is given, perform check for that version."
(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]")
@@ -378,7 +378,7 @@ whether to remove it."
(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.
@@ -438,7 +438,7 @@ attempt the checkout for all registered files beneath it."
;; 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
@@ -456,7 +456,7 @@ attempt the checkout for all registered files beneath it."
(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))))))
@@ -468,7 +468,7 @@ expanded to all registered subfiles in them."
(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? "
@@ -799,6 +799,95 @@ systime, or nil if there is none. Also, reposition point."
;;; 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