diff options
author | Dan Nicolaescu <dann@ics.uci.edu> | 2009-08-26 17:54:05 +0000 |
---|---|---|
committer | Dan Nicolaescu <dann@ics.uci.edu> | 2009-08-26 17:54:05 +0000 |
commit | 3b64d86b56c392642f204efe4981fd8ec33e7f62 (patch) | |
tree | c312962751902fe286b894b9d5446a4739977a14 /lisp/vc-rcs.el | |
parent | 636a36a0708e8d6dd4849d5265a762a1c64ef3fa (diff) | |
download | emacs-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.el | 99 |
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 |