Mercurial > emacs
comparison lisp/vc-rcs.el @ 104621:f4a041a8c69d
* 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.
| author | Dan Nicolaescu <dann@ics.uci.edu> |
|---|---|
| date | Wed, 26 Aug 2009 17:54:05 +0000 |
| parents | b0f266cccf0b |
| children | adeed914a5fb |
comparison
equal
deleted
inserted
replaced
| 104620:dbe0b4c419f5 | 104621:f4a041a8c69d |
|---|---|
| 218 "Return non-nil if workfile version of FILE is the latest on its branch. | 218 "Return non-nil if workfile version of FILE is the latest on its branch. |
| 219 When VERSION is given, perform check for that version." | 219 When VERSION is given, perform check for that version." |
| 220 (unless version (setq version (vc-working-revision file))) | 220 (unless version (setq version (vc-working-revision file))) |
| 221 (with-temp-buffer | 221 (with-temp-buffer |
| 222 (string= version | 222 (string= version |
| 223 (if (vc-trunk-p version) | 223 (if (vc-rcs-trunk-p version) |
| 224 (progn | 224 (progn |
| 225 ;; Compare VERSION to the head version number. | 225 ;; Compare VERSION to the head version number. |
| 226 (vc-insert-file (vc-name file) "^[0-9]") | 226 (vc-insert-file (vc-name file) "^[0-9]") |
| 227 (vc-parse-buffer "^head[ \t\n]+\\([^;]+\\);" 1)) | 227 (vc-parse-buffer "^head[ \t\n]+\\([^;]+\\);" 1)) |
| 228 ;; If we are not on the trunk, we need to examine the | 228 ;; If we are not on the trunk, we need to examine the |
| 376 (cond | 376 (cond |
| 377 ((and old-version new-version | 377 ((and old-version new-version |
| 378 (not (string= (vc-branch-part old-version) | 378 (not (string= (vc-branch-part old-version) |
| 379 (vc-branch-part new-version)))) | 379 (vc-branch-part new-version)))) |
| 380 (vc-rcs-set-default-branch file | 380 (vc-rcs-set-default-branch file |
| 381 (if (vc-trunk-p new-version) nil | 381 (if (vc-rcs-trunk-p new-version) nil |
| 382 (vc-branch-part new-version))) | 382 (vc-branch-part new-version))) |
| 383 ;; If this is an old RCS release, we might have | 383 ;; If this is an old RCS release, we might have |
| 384 ;; to remove a remaining lock. | 384 ;; to remove a remaining lock. |
| 385 (if (not (vc-rcs-release-p "5.6.2")) | 385 (if (not (vc-rcs-release-p "5.6.2")) |
| 386 ;; exit status of 1 is also accepted. | 386 ;; exit status of 1 is also accepted. |
| 436 (if (not rev) | 436 (if (not rev) |
| 437 ;; no revision specified: | 437 ;; no revision specified: |
| 438 ;; use current workfile version | 438 ;; use current workfile version |
| 439 workrev | 439 workrev |
| 440 ;; REV is t ... | 440 ;; REV is t ... |
| 441 (if (not (vc-trunk-p workrev)) | 441 (if (not (vc-rcs-trunk-p workrev)) |
| 442 ;; ... go to head of current branch | 442 ;; ... go to head of current branch |
| 443 (vc-branch-part workrev) | 443 (vc-branch-part workrev) |
| 444 ;; ... go to head of trunk | 444 ;; ... go to head of trunk |
| 445 (vc-rcs-set-default-branch file | 445 (vc-rcs-set-default-branch file |
| 446 nil) | 446 nil) |
| 454 ;; if necessary, adjust the default branch | 454 ;; if necessary, adjust the default branch |
| 455 (and rev (not (string= rev "")) | 455 (and rev (not (string= rev "")) |
| 456 (vc-rcs-set-default-branch | 456 (vc-rcs-set-default-branch |
| 457 file | 457 file |
| 458 (if (vc-rcs-latest-on-branch-p file new-version) | 458 (if (vc-rcs-latest-on-branch-p file new-version) |
| 459 (if (vc-trunk-p new-version) nil | 459 (if (vc-rcs-trunk-p new-version) nil |
| 460 (vc-branch-part new-version)) | 460 (vc-branch-part new-version)) |
| 461 new-version))))) | 461 new-version))))) |
| 462 (message "Checking out %s...done" file)))))) | 462 (message "Checking out %s...done" file)))))) |
| 463 | 463 |
| 464 (defun vc-rcs-rollback (files) | 464 (defun vc-rcs-rollback (files) |
| 466 expanded to all registered subfiles in them." | 466 expanded to all registered subfiles in them." |
| 467 (if (not files) | 467 (if (not files) |
| 468 (error "RCS backend doesn't support directory-level rollback.")) | 468 (error "RCS backend doesn't support directory-level rollback.")) |
| 469 (dolist (file (vc-expand-dirs files)) | 469 (dolist (file (vc-expand-dirs files)) |
| 470 (let* ((discard (vc-working-revision file)) | 470 (let* ((discard (vc-working-revision file)) |
| 471 (previous (if (vc-trunk-p discard) "" (vc-branch-part discard))) | 471 (previous (if (vc-rcs-trunk-p discard) "" (vc-branch-part discard))) |
| 472 (config (current-window-configuration)) | 472 (config (current-window-configuration)) |
| 473 (done nil)) | 473 (done nil)) |
| 474 (if (null (yes-or-no-p (format "Remove version %s from %s history? " | 474 (if (null (yes-or-no-p (format "Remove version %s from %s history? " |
| 475 discard file))) | 475 discard file))) |
| 476 (error "Aborted")) | 476 (error "Aborted")) |
| 796 | 796 |
| 797 | 797 |
| 798 ;;; | 798 ;;; |
| 799 ;;; Miscellaneous | 799 ;;; Miscellaneous |
| 800 ;;; | 800 ;;; |
| 801 | |
| 802 (defun vc-rcs-trunk-p (rev) | |
| 803 "Return t if REV is a revision on the trunk." | |
| 804 (not (eq nil (string-match "\\`[0-9]+\\.[0-9]+\\'" rev)))) | |
| 805 | |
| 806 (defun vc-rcs-minor-part (rev) | |
| 807 "Return the minor revision number of a revision number REV." | |
| 808 (string-match "[0-9]+\\'" rev) | |
| 809 (substring rev (match-beginning 0) (match-end 0))) | |
| 810 | |
| 811 (defun vc-rcs-previous-revision (file rev) | |
| 812 "Return the revision number immediately preceding REV for FILE, | |
| 813 or nil if there is no previous revision. This default | |
| 814 implementation works for MAJOR.MINOR-style revision numbers as | |
| 815 used by RCS and CVS." | |
| 816 (let ((branch (vc-branch-part rev)) | |
| 817 (minor-num (string-to-number (vc-rcs-minor-part rev)))) | |
| 818 (when branch | |
| 819 (if (> minor-num 1) | |
| 820 ;; revision does probably not start a branch or release | |
| 821 (concat branch "." (number-to-string (1- minor-num))) | |
| 822 (if (vc-rcs-trunk-p rev) | |
| 823 ;; we are at the beginning of the trunk -- | |
| 824 ;; don't know anything to return here | |
| 825 nil | |
| 826 ;; we are at the beginning of a branch -- | |
| 827 ;; return revision of starting point | |
| 828 (vc-branch-part branch)))))) | |
| 829 | |
| 830 (defun vc-rcs-next-revision (file rev) | |
| 831 "Return the revision number immediately following REV for FILE, | |
| 832 or nil if there is no next revision. This default implementation | |
| 833 works for MAJOR.MINOR-style revision numbers as used by RCS | |
| 834 and CVS." | |
| 835 (when (not (string= rev (vc-working-revision file))) | |
| 836 (let ((branch (vc-branch-part rev)) | |
| 837 (minor-num (string-to-number (vc-rcs-minor-part rev)))) | |
| 838 (concat branch "." (number-to-string (1+ minor-num)))))) | |
| 839 | |
| 840 (defun vc-rcs-update-changelog (files) | |
| 841 "Default implementation of update-changelog. | |
| 842 Uses `rcs2log' which only works for RCS and CVS." | |
| 843 ;; FIXME: We (c|sh)ould add support for cvs2cl | |
| 844 (let ((odefault default-directory) | |
| 845 (changelog (find-change-log)) | |
| 846 ;; Presumably not portable to non-Unixy systems, along with rcs2log: | |
| 847 (tempfile (make-temp-file | |
| 848 (expand-file-name "vc" | |
| 849 (or small-temporary-file-directory | |
| 850 temporary-file-directory)))) | |
| 851 (login-name (or user-login-name | |
| 852 (format "uid%d" (number-to-string (user-uid))))) | |
| 853 (full-name (or add-log-full-name | |
| 854 (user-full-name) | |
| 855 (user-login-name) | |
| 856 (format "uid%d" (number-to-string (user-uid))))) | |
| 857 (mailing-address (or add-log-mailing-address | |
| 858 user-mail-address))) | |
| 859 (find-file-other-window changelog) | |
| 860 (barf-if-buffer-read-only) | |
| 861 (vc-buffer-sync) | |
| 862 (undo-boundary) | |
| 863 (goto-char (point-min)) | |
| 864 (push-mark) | |
| 865 (message "Computing change log entries...") | |
| 866 (message "Computing change log entries... %s" | |
| 867 (unwind-protect | |
| 868 (progn | |
| 869 (setq default-directory odefault) | |
| 870 (if (eq 0 (apply 'call-process | |
| 871 (expand-file-name "rcs2log" | |
| 872 exec-directory) | |
| 873 nil (list t tempfile) nil | |
| 874 "-c" changelog | |
| 875 "-u" (concat login-name | |
| 876 "\t" full-name | |
| 877 "\t" mailing-address) | |
| 878 (mapcar | |
| 879 (lambda (f) | |
| 880 (file-relative-name | |
| 881 (expand-file-name f odefault))) | |
| 882 files))) | |
| 883 "done" | |
| 884 (pop-to-buffer (get-buffer-create "*vc*")) | |
| 885 (erase-buffer) | |
| 886 (insert-file-contents tempfile) | |
| 887 "failed")) | |
| 888 (setq default-directory (file-name-directory changelog)) | |
| 889 (delete-file tempfile))))) | |
| 801 | 890 |
| 802 (defun vc-rcs-check-headers () | 891 (defun vc-rcs-check-headers () |
| 803 "Check if the current file has any headers in it." | 892 "Check if the current file has any headers in it." |
| 804 (save-excursion | 893 (save-excursion |
| 805 (goto-char (point-min)) | 894 (goto-char (point-min)) |