;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
+;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; See vc.el
+;; TODO:
+;; - remove call to vc-expand-dirs by implementing our own (which can just
+;; list the RCS subdir instead).
+
;;; Code:
;;;
:group 'vc)
\f
+;;; Properties of the backend
+
+(defun vc-rcs-revision-granularity ()
+ 'file)
+
;;;
;;; State-querying functions
;;;
(and vc-consult-headers
(vc-rcs-consult-headers file)))
(let ((state
- ;; vc-workfile-version might not be known; in that case the
+ ;; vc-working-revision might not be known; in that case the
;; property is nil. vc-rcs-fetch-master-state knows how to
;; handle that.
(vc-rcs-fetch-master-state file
(vc-file-getprop file
- 'vc-workfile-version))))
+ 'vc-working-revision))))
(if (not (eq state 'up-to-date))
state
(if (vc-workfile-unchanged-p file)
(vc-rcs-state file))))
(vc-rcs-state file)))))
-(defun vc-rcs-workfile-version (file)
- "RCS-specific version of `vc-workfile-version'."
+(defun vc-rcs-working-revision (file)
+ "RCS-specific version of `vc-working-revision'."
(or (and vc-consult-headers
(vc-rcs-consult-headers file)
- (vc-file-getprop file 'vc-workfile-version))
+ (vc-file-getprop file 'vc-working-revision))
(progn
(vc-rcs-fetch-master-state file)
- (vc-file-getprop file 'vc-workfile-version))))
+ (vc-file-getprop file 'vc-working-revision))))
(defun vc-rcs-latest-on-branch-p (file &optional version)
"Return non-nil if workfile version of FILE is the latest on its branch.
When VERSION is given, perform check for that version."
- (unless version (setq version (vc-workfile-version file)))
+ (unless version (setq version (vc-working-revision file)))
(with-temp-buffer
(string= version
(if (vc-trunk-p version)
"RCS-specific implementation of `vc-workfile-unchanged-p'."
;; Try to use rcsdiff --brief. If rcsdiff does not understand that,
;; do a double take and remember the fact for the future
- (let* ((version (concat "-r" (vc-workfile-version file)))
+ (let* ((version (concat "-r" (vc-working-revision file)))
(status (if (eq vc-rcsdiff-knows-brief 'no)
(vc-do-command nil 1 "rcsdiff" file version)
(vc-do-command nil 2 "rcsdiff" file "--brief" version))))
;; The workfile is unchanged if rcsdiff found no differences.
(zerop status)))
+(defun vc-rcs-find-file-not-found-hook ()
+ (if (yes-or-no-p
+ (format "File %s was lost; check out from version control? "
+ (file-name-nondirectory buffer-file-name)))
+ (save-excursion
+ (require 'vc)
+ (let ((default-directory (file-name-directory buffer-file-name)))
+ (not (vc-error-occurred (vc-checkout buffer-file-name)))))))
\f
;;;
;;; State-changing functions
;;;
-(defun vc-rcs-register (file &optional rev comment)
- "Register FILE into the RCS version-control system.
-REV is the optional revision number for the file. COMMENT can be used
-to provide an initial description of FILE.
+(defun vc-rcs-create-repo ()
+ "Create a new RCS repository."
+ ;; RCS is totally file-oriented, so all we have to do is make the directory
+ (make-directory "RCS"))
+
+(defun vc-rcs-register (files &optional rev comment)
+ "Register FILES into the RCS version-control system.
+REV is the optional revision number for the files. COMMENT can be used
+to provide an initial description for each FILES.
`vc-register-switches' and `vc-rcs-register-switches' are passed to
the RCS command (in that order).
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 (expand-file-name "RCS" (file-name-directory file))))
+ (let ((subdir (expand-file-name "RCS" (file-name-directory file))))
+ (dolist (file files)
(and (not (file-exists-p subdir))
(not (directory-files (file-name-directory file)
nil ".*,v$" t))
(expand-file-name
name
(file-name-directory file))))))
- (vc-file-setprop file 'vc-workfile-version
+ (vc-file-setprop file 'vc-working-revision
(if (re-search-forward
"^initial revision: \\([0-9.]+\\).*\n"
nil t)
- (match-string 1))))))
+ (match-string 1)))))))
(defun vc-rcs-responsible-p (file)
"Return non-nil if RCS thinks it would be responsible for registering FILE."
(yes-or-no-p (format "Directory %s is empty; remove it? " dir))
(delete-directory dir))))
-(defun vc-rcs-checkin (file rev comment)
+(defun vc-rcs-checkin (files rev comment)
"RCS-specific version of `vc-backend-checkin'."
(let ((switches (vc-switches 'RCS 'checkin)))
- (let ((old-version (vc-workfile-version file)) new-version
- (default-branch (vc-file-getprop file 'vc-rcs-default-branch)))
- ;; Force branch creation if an appropriate
- ;; default branch has been set.
- (and (not rev)
- default-branch
- (string-match (concat "^" (regexp-quote old-version) "\\.")
- default-branch)
- (setq rev default-branch)
- (setq switches (cons "-f" switches)))
- (if (and (not rev) old-version)
- (setq rev (vc-branch-part old-version)))
- (apply 'vc-do-command nil 0 "ci" (vc-name file)
- ;; if available, use the secure check-in option
- (and (vc-rcs-release-p "5.6.4") "-j")
- (concat (if vc-keep-workfiles "-u" "-r") rev)
- (concat "-m" comment)
- switches)
- (vc-file-setprop file 'vc-workfile-version nil)
-
- ;; determine the new workfile version
- (set-buffer "*vc*")
- (goto-char (point-min))
- (when (or (re-search-forward
- "new revision: \\([0-9.]+\\);" nil t)
- (re-search-forward
- "reverting to previous revision \\([0-9.]+\\)" nil t))
- (setq new-version (match-string 1))
- (vc-file-setprop file 'vc-workfile-version new-version))
-
- ;; if we got to a different branch, adjust the default
- ;; branch accordingly
- (cond
- ((and old-version new-version
- (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
- (vc-branch-part new-version)))
- ;; If this is an old RCS release, we might have
- ;; to remove a remaining lock.
- (if (not (vc-rcs-release-p "5.6.2"))
- ;; exit status of 1 is also accepted.
- ;; It means that the lock was removed before.
- (vc-do-command nil 1 "rcs" (vc-name file)
- (concat "-u" old-version))))))))
-
-(defun vc-rcs-find-version (file rev buffer)
+ ;; Now operate on the files
+ (dolist (file files)
+ (let ((old-version (vc-working-revision file)) new-version
+ (default-branch (vc-file-getprop file 'vc-rcs-default-branch)))
+ ;; Force branch creation if an appropriate
+ ;; default branch has been set.
+ (and (not rev)
+ default-branch
+ (string-match (concat "^" (regexp-quote old-version) "\\.")
+ default-branch)
+ (setq rev default-branch)
+ (setq switches (cons "-f" switches)))
+ (if (and (not rev) old-version)
+ (setq rev (vc-branch-part old-version)))
+ (apply 'vc-do-command nil 0 "ci" (vc-name file)
+ ;; if available, use the secure check-in option
+ (and (vc-rcs-release-p "5.6.4") "-j")
+ (concat (if vc-keep-workfiles "-u" "-r") rev)
+ (concat "-m" comment)
+ switches)
+ (vc-file-setprop file 'vc-working-revision nil)
+
+ ;; determine the new workfile version
+ (set-buffer "*vc*")
+ (goto-char (point-min))
+ (when (or (re-search-forward
+ "new revision: \\([0-9.]+\\);" nil t)
+ (re-search-forward
+ "reverting to previous revision \\([0-9.]+\\)" nil t))
+ (setq new-version (match-string 1))
+ (vc-file-setprop file 'vc-working-revision new-version))
+
+ ;; if we got to a different branch, adjust the default
+ ;; branch accordingly
+ (cond
+ ((and old-version new-version
+ (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
+ (vc-branch-part new-version)))
+ ;; If this is an old RCS release, we might have
+ ;; to remove a remaining lock.
+ (if (not (vc-rcs-release-p "5.6.2"))
+ ;; exit status of 1 is also accepted.
+ ;; It means that the lock was removed before.
+ (vc-do-command nil 1 "rcs" (vc-name file)
+ (concat "-u" old-version)))))))))
+
+(defun vc-rcs-find-revision (file rev buffer)
(apply 'vc-do-command
buffer 0 "co" (vc-name file)
"-q" ;; suppress diagnostic output
(if (stringp rev)
;; a literal revision was specified
(concat "-r" rev)
- (let ((workrev (vc-workfile-version file)))
+ (let ((workrev (vc-working-revision file)))
(if workrev
(concat "-r"
(if (not rev)
(with-current-buffer "*vc*"
(setq new-version
(vc-parse-buffer "^revision \\([0-9.]+\\).*\n" 1)))
- (vc-file-setprop file 'vc-workfile-version new-version)
+ (vc-file-setprop file 'vc-working-revision new-version)
;; if necessary, adjust the default branch
(and rev (not (string= rev ""))
(vc-rcs-set-default-branch
new-version)))))
(message "Checking out %s...done" file)))))
+(defun vc-rcs-rollback (files)
+ "Roll back, undoing the most recent checkins of FILES."
+ (if (not files)
+ (error "RCS backend doesn't support directory-level rollback."))
+ (dolist (file files)
+ (let* ((discard (vc-working-revision file))
+ (previous (if (vc-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? "
+ discard file)))
+ (error "Aborted"))
+ (message "Removing revision %s from %s." discard file)
+ (vc-do-command nil 0 "rcs" (vc-name file) (concat "-o" discard))
+ ;; Check out the most recent remaining version. If it
+ ;; fails, because the whole branch got deleted, do a
+ ;; double-take and check out the version where the branch
+ ;; started.
+ (while (not done)
+ (condition-case err
+ (progn
+ (vc-do-command nil 0 "co" (vc-name file) "-f"
+ (concat "-u" previous))
+ (setq done t))
+ (error (set-buffer "*vc*")
+ (goto-char (point-min))
+ (if (search-forward "no side branches present for" nil t)
+ (progn (setq previous (vc-branch-part previous))
+ (vc-rcs-set-default-branch file previous)
+ ;; vc-do-command popped up a window with
+ ;; the error message. Get rid of it, by
+ ;; restoring the old window configuration.
+ (set-window-configuration config))
+ ;; No, it was some other error: re-signal it.
+ (signal (car err) (cdr err)))))))))
+
(defun vc-rcs-revert (file &optional contents-done)
"Revert FILE to the version it was based on."
(vc-do-command nil 0 "co" (vc-name file) "-f"
(concat (if (eq (vc-state file) 'edited) "-u" "-r")
- (vc-workfile-version file))))
-
-(defun vc-rcs-cancel-version (file editable)
- "Undo the most recent checkin of FILE.
-EDITABLE non-nil means previous version should be locked."
- (let* ((target (vc-workfile-version file))
- (previous (if (vc-trunk-p target) "" (vc-branch-part target)))
- (config (current-window-configuration))
- (done nil))
- (vc-do-command nil 0 "rcs" (vc-name file) (concat "-o" target))
- ;; Check out the most recent remaining version. If it fails, because
- ;; the whole branch got deleted, do a double-take and check out the
- ;; version where the branch started.
- (while (not done)
- (condition-case err
- (progn
- (vc-do-command nil 0 "co" (vc-name file) "-f"
- (concat (if editable "-l" "-u") previous))
- (setq done t))
- (error (set-buffer "*vc*")
- (goto-char (point-min))
- (if (search-forward "no side branches present for" nil t)
- (progn (setq previous (vc-branch-part previous))
- (vc-rcs-set-default-branch file previous)
- ;; vc-do-command popped up a window with
- ;; the error message. Get rid of it, by
- ;; restoring the old window configuration.
- (set-window-configuration config))
- ;; No, it was some other error: re-signal it.
- (signal (car err) (cdr err))))))))
+ (vc-working-revision file))))
(defun vc-rcs-merge (file first-version &optional second-version)
"Merge changes into current working copy of FILE.
;;; History functions
;;;
-(defun vc-rcs-print-log (file &optional buffer)
+(defun vc-rcs-print-log (files &optional buffer)
"Get change log associated with FILE."
- (vc-do-command buffer 0 "rlog" (vc-name file)))
+ (vc-do-command buffer 0 "rlog" (mapcar 'vc-name files)))
-(defun vc-rcs-diff (file &optional oldvers newvers buffer)
- "Get a difference report using RCS between two versions of FILE."
- (if (not oldvers) (setq oldvers (vc-workfile-version file)))
- (apply 'vc-do-command (or buffer "*vc-diff*") 1 "rcsdiff" file
+(defun vc-rcs-diff (files &optional oldvers newvers buffer)
+ "Get a difference report using RCS between two sets of files."
+ (apply 'vc-do-command (or buffer "*vc-diff*")
+ 1 ;; Always go synchronous, the repo is local
+ "rcsdiff" (vc-expand-dirs files)
(append (list "-q"
- (concat "-r" oldvers)
+ (and oldvers (concat "-r" oldvers))
(and newvers (concat "-r" newvers)))
(vc-switches 'RCS 'diff))))
+(defun vc-rcs-wash-log ()
+ "Remove all non-comment information from log output."
+ (let ((separator (concat "^-+\nrevision [0-9.]+\ndate: .*\n"
+ "\\(branches: .*;\n\\)?"
+ "\\(\\*\\*\\* empty log message \\*\\*\\*\n\\)?")))
+ (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))
+ (if (looking-at "[\b\t\n\v\f\r ]+")
+ (delete-char (- (match-end 0) (match-beginning 0))))
+ (goto-char (point-min))
+ (re-search-forward separator nil t)
+ (delete-region (point-min) (point))
+ (while (re-search-forward separator nil t)
+ (delete-region (match-beginning 0) (match-end 0)))))
+
(defun vc-rcs-annotate-command (file buffer &optional revision)
"Annotate FILE, inserting the results in BUFFER.
Optional arg REVISION is a revision to annotate from."
" "
(aref rda 0)
ls)
+ :vc-annotate-prefix t
:vc-rcs-r/d/a rda)))
(maphash
(if all-me
"Return the time of the next annotation (as fraction of days)
systime, or nil if there is none. Also, reposition point."
(unless (eobp)
- (search-forward ": ")
- (vc-annotate-convert-time
- (aref (get-text-property (point) :vc-rcs-r/d/a) 1))))
+ (prog1 (vc-annotate-convert-time
+ (aref (get-text-property (point) :vc-rcs-r/d/a) 1))
+ (goto-char (next-single-property-change (point) :vc-annotate-prefix)))))
(defun vc-rcs-annotate-extract-revision-at-line ()
(aref (get-text-property (point) :vc-rcs-r/d/a) 0))
(or value
(vc-branch-part branch))))
-(defun vc-rcs-fetch-master-state (file &optional workfile-version)
+(defun vc-rcs-fetch-master-state (file &optional working-revision)
"Compute the master file's idea of the state of FILE.
If a WORKFILE-VERSION is given, compute the state of that version,
otherwise determine the workfile version based on the master file.
-This function sets the properties `vc-workfile-version' and
+This function sets the properties `vc-working-revision' and
`vc-checkout-model' to their correct values, based on the master
file."
(with-temp-buffer
(let ((workfile-is-latest nil)
(default-branch (vc-parse-buffer "^branch[ \t\n]+\\([^;]*\\);" 1)))
(vc-file-setprop file 'vc-rcs-default-branch default-branch)
- (unless workfile-version
+ (unless working-revision
;; Workfile version not known yet. Determine that first. It
;; is either the head of the trunk, the head of the default
;; branch, or the "default branch" itself, if that is a full
(cond
;; no default branch
((or (not default-branch) (string= "" default-branch))
- (setq workfile-version
+ (setq working-revision
(vc-parse-buffer "^head[ \t\n]+\\([^;]+\\);" 1))
(setq workfile-is-latest t))
;; default branch is actually a revision
((string-match "^[0-9]+\\.[0-9]+\\(\\.[0-9]+\\.[0-9]+\\)*$"
default-branch)
- (setq workfile-version default-branch))
+ (setq working-revision default-branch))
;; else, search for the head of the default branch
(t (vc-insert-file (vc-name file) "^desc")
- (setq workfile-version
+ (setq working-revision
(vc-rcs-find-most-recent-rev default-branch))
(setq workfile-is-latest t)))
- (vc-file-setprop file 'vc-workfile-version workfile-version))
+ (vc-file-setprop file 'vc-working-revision working-revision))
;; Check strict locking
(goto-char (point-min))
(vc-file-setprop file 'vc-checkout-model
(goto-char (point-min))
(let ((locking-user
(vc-parse-buffer (concat "^locks[ \t\n]+[^;]*[ \t\n]+\\([^:]+\\):"
- (regexp-quote workfile-version)
+ (regexp-quote working-revision)
"[^0-9.]")
1)))
(cond
;; not locked
((not locking-user)
(if (or workfile-is-latest
- (vc-rcs-latest-on-branch-p file workfile-version))
+ (vc-rcs-latest-on-branch-p file working-revision))
;; workfile version is latest on branch
'up-to-date
;; workfile version is not latest on branch
(string= locking-user (vc-user-login-name file)))
(if (or (eq (vc-checkout-model file) 'locking)
workfile-is-latest
- (vc-rcs-latest-on-branch-p file workfile-version))
+ (vc-rcs-latest-on-branch-p file working-revision))
'edited
;; Locking is not used for the file, but the owner does
;; have a lock, and there is a higher version on the current
;; else: nothing found
;; -------------------
(t nil)))
- (if status (vc-file-setprop file 'vc-workfile-version version))
+ (if status (vc-file-setprop file 'vc-working-revision version))
(and (eq status 'rev-and-lock)
(vc-file-setprop file 'vc-state
(cond
((eq locking-user 'none) 'up-to-date)
- ((string= locking-user (vc-user-login-name file))
+ ((string= locking-user (vc-user-login-name file))
'edited)
(t locking-user)))
;; If the file has headers, we don't want to query the
HCoop / bpt / emacs.git / blobdiff