diff options
Diffstat (limited to 'lisp/vc/vc-rcs.el')
| -rw-r--r-- | lisp/vc/vc-rcs.el | 73 |
1 files changed, 44 insertions, 29 deletions
diff --git a/lisp/vc/vc-rcs.el b/lisp/vc/vc-rcs.el index 6ffc1a8a2ff..2422e99d3da 100644 --- a/lisp/vc/vc-rcs.el +++ b/lisp/vc/vc-rcs.el @@ -41,7 +41,6 @@ (require 'cl-lib) (require 'vc)) -(declare-function vc-branch-p "vc" (rev)) (declare-function vc-read-revision "vc" (prompt &optional files backend default initial-input)) (declare-function vc-buffer-context "vc-dispatcher" ()) @@ -173,6 +172,19 @@ For a description of possible values, see `vc-check-master-templates'." (defun vc-rcs-dir-extra-headers (&rest _ignore)) +;; functions that operate on RCS revision numbers. +(defun vc-rcs-branch-p (rev) + "Return t if REV is a branch revision." + (not (eq nil (string-match "\\`[0-9]+\\(\\.[0-9]+\\.[0-9]+\\)*\\'" rev)))) +(define-obsolete-function-alias 'vc-branch-p #'vc-rcs-branch-p "28.1") + +(defun vc-rcs-branch-part (rev) + "Return the branch part of a revision number REV." + (let ((index (string-match "\\.[0-9]+\\'" rev))) + (when index + (substring rev 0 index)))) +(define-obsolete-function-alias 'vc-branch-part #'vc-rcs-branch-part "28.1") + (defun vc-rcs-working-revision (file) "RCS-specific version of `vc-working-revision'." (or (and vc-consult-headers @@ -198,7 +210,7 @@ When VERSION is given, perform check for that version." ;; If we are not on the trunk, we need to examine the ;; whole current branch. (vc-insert-file (vc-master-name file) "^desc") - (vc-rcs-find-most-recent-rev (vc-branch-part version)))))) + (vc-rcs-find-most-recent-rev (vc-rcs-branch-part version)))))) (defun vc-rcs-workfile-unchanged-p (file) "Has FILE remained unchanged since last checkout?" @@ -230,7 +242,7 @@ When VERSION is given, perform check for that version." (autoload 'vc-switches "vc") (defun vc-rcs-register (files &optional comment) - "Register FILES into the RCS version-control system. + "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' @@ -278,10 +290,11 @@ to the RCS command." (defun vc-rcs-responsible-p (file) "Return non-nil if RCS thinks it would be responsible for registering FILE." ;; TODO: check for all the patterns in vc-rcs-master-templates - (file-directory-p (expand-file-name "RCS" - (if (file-directory-p file) - file - (file-name-directory file))))) + (let ((dir (if (file-directory-p file) + file + (file-name-directory file)))) + (and (file-directory-p (expand-file-name "RCS" dir)) + (file-name-directory (expand-file-name "RCS" dir))))) (defun vc-rcs-receive-file (file rev) "Implementation of receive-file for RCS." @@ -326,7 +339,7 @@ whether to remove it." (setq rev default-branch) (setq switches (cons "-f" switches))) (if (and (not rev) old-version) - (setq rev (vc-branch-part old-version))) + (setq rev (vc-rcs-branch-part old-version))) (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") @@ -349,11 +362,11 @@ whether to remove it." ;; branch accordingly (cond ((and old-version new-version - (not (string= (vc-branch-part old-version) - (vc-branch-part new-version)))) + (not (string= (vc-rcs-branch-part old-version) + (vc-rcs-branch-part new-version)))) (vc-rcs-set-default-branch file (if (vc-rcs-trunk-p new-version) nil - (vc-branch-part new-version))) + (vc-rcs-branch-part new-version))) ;; If this is an old (pre-1992!) RCS release, we might have ;; to remove a remaining lock. (if (not (vc-rcs-release-p "5.6.2")) @@ -370,8 +383,9 @@ whether to remove it." (vc-switches 'RCS 'checkout))) (defun vc-rcs-checkout (file &optional rev) - "Retrieve a copy of a saved version of FILE. If FILE is a directory, -attempt the checkout for all registered files beneath it." + "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) 'RCS)) (let ((file-buffer (get-file-buffer file)) @@ -414,7 +428,7 @@ attempt the checkout for all registered files beneath it." ;; REV is t ... (if (not (vc-rcs-trunk-p workrev)) ;; ... go to head of current branch - (vc-branch-part workrev) + (vc-rcs-branch-part workrev) ;; ... go to head of trunk (vc-rcs-set-default-branch file nil) @@ -431,13 +445,13 @@ attempt the checkout for all registered files beneath it." file (if (vc-rcs-latest-on-branch-p file new-version) (if (vc-rcs-trunk-p new-version) nil - (vc-branch-part new-version)) + (vc-rcs-branch-part new-version)) new-version))))) (message "Checking out %s...done" file)))))) (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." + "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) 'RCS)) (vc-do-command "*vc*" 0 "co" (vc-master-name file) "-f" @@ -456,17 +470,17 @@ revert all registered files beneath it." ((string= first-revision "") (error "A starting RCS revision is required")) (t - (if (not (vc-branch-p first-revision)) + (if (not (vc-rcs-branch-p first-revision)) (setq second-revision (vc-read-revision "Second RCS revision: " (list file) 'RCS nil - (concat (vc-branch-part first-revision) "."))) + (concat (vc-rcs-branch-part first-revision) "."))) ;; We want to merge an entire branch. Set revisions ;; accordingly, so that vc-rcs-merge understands us. (setq second-revision first-revision) ;; first-revision must be the starting point of the branch - (setq first-revision (vc-branch-part first-revision))))) + (setq first-revision (vc-rcs-branch-part first-revision))))) (vc-rcs-merge file first-revision second-revision))) (defun vc-rcs-merge (file first-version &optional second-version) @@ -504,8 +518,9 @@ Needs RCS 5.6.2 or later for -M." (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." + "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 'RCS)) (vc-do-command "*vc*" 0 "rcs" (vc-master-name file) (concat "-m" rev ":" comment)))) @@ -637,11 +652,11 @@ Optional arg REVISION is a revision to annotate from." ;; Find which branches (if any) must be included in the edits. (let ((par revision) bpt kids) - (while (setq bpt (vc-branch-part par) - par (vc-branch-part bpt)) + (while (setq bpt (vc-rcs-branch-part par) + par (vc-rcs-branch-part bpt)) (setq kids (cdr (assq 'branches (cdr (assoc par revisions))))) ;; A branchpoint may have multiple children. Find the right one. - (while (not (string= bpt (vc-branch-part (car kids)))) + (while (not (string= bpt (vc-rcs-branch-part (car kids)))) (setq kids (cdr kids))) (push (cons par (car kids)) nbls))) ;; Start with the full text. @@ -818,7 +833,7 @@ systime, or nil if there is none. Also, reposition point." 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)) + (let ((branch (vc-rcs-branch-part rev)) (minor-num (string-to-number (vc-rcs-minor-part rev)))) (when branch (if (> minor-num 1) @@ -830,7 +845,7 @@ used by RCS and CVS." nil ;; we are at the beginning of a branch -- ;; return revision of starting point - (vc-branch-part branch)))))) + (vc-rcs-branch-part branch)))))) (defun vc-rcs-next-revision (file rev) "Return the revision number immediately following REV for FILE, @@ -838,7 +853,7 @@ 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)) + (let ((branch (vc-rcs-branch-part rev)) (minor-num (string-to-number (vc-rcs-minor-part rev)))) (concat branch "." (number-to-string (1+ minor-num)))))) @@ -965,7 +980,7 @@ to its master version." (setq latest-rev rev) (setq value (match-string 1))))) (or value - (vc-branch-part branch)))) + (vc-rcs-branch-part branch)))) (defun vc-rcs-fetch-master-state (file &optional working-revision) "Compute the master file's idea of the state of FILE. |