Mercurial > emacs

comparison lisp/vc-rcs.el @ 94563:a0bb8ca25a33

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Clean up vc*-revision-granularity and vc*-checkout-model.
author Eric S. Raymond <esr@snark.thyrsus.com>
date Fri, 02 May 2008 17:47:25 +0000
parents e158200330c2
children 9cc7bc51e055
comparison
equal deleted inserted replaced
94562:46f178f2b009 94563:a0bb8ca25a33
100 :group 'vc) 100 :group 'vc)
101 101
102 102
103 ;;; Properties of the backend 103 ;;; Properties of the backend
104 104
105 (defun vc-rcs-revision-granularity () 105 (defun vc-rcs-revision-granularity () 'file)
106 'file) 106
107 (defun vc-rcs-checkout-model (files)
108 "RCS-specific version of `vc-checkout-model'."
109 (let ((file (if (consp files) (car files) files))
110 result)
111 (when vc-consult-headers
112 (vc-file-setprop file 'vc-checkout-model nil)
113 (vc-rcs-consult-headers file)
114 (setq result (vc-file-getprop file 'vc-checkout-model)))
115 (or result
116 (progn (vc-rcs-fetch-master-state file)
117 (vc-file-getprop file 'vc-checkout-model)))))
107 118
108 ;;; 119 ;;;
109 ;;; State-querying functions 120 ;;; State-querying functions
110 ;;; 121 ;;;
111 122
132 'vc-working-revision)))) 143 'vc-working-revision))))
133 (if (not (eq state 'up-to-date)) 144 (if (not (eq state 'up-to-date))
134 state 145 state
135 (if (vc-workfile-unchanged-p file) 146 (if (vc-workfile-unchanged-p file)
136 'up-to-date 147 'up-to-date
137 (if (eq (vc-rcs-checkout-model file) 'locking) 148 (if (eq (vc-rcs-checkout-model (list file)) 'locking)
138 'unlocked-changes 149 'unlocked-changes
139 'edited)))))) 150 'edited))))))
140 151
141 (defun vc-rcs-state-heuristic (file) 152 (defun vc-rcs-state-heuristic (file)
142 "State heuristic for RCS." 153 "State heuristic for RCS."
216 ;; If we are not on the trunk, we need to examine the 227 ;; If we are not on the trunk, we need to examine the
217 ;; whole current branch. 228 ;; whole current branch.
218 (vc-insert-file (vc-name file) "^desc") 229 (vc-insert-file (vc-name file) "^desc")
219 (vc-rcs-find-most-recent-rev (vc-branch-part version)))))) 230 (vc-rcs-find-most-recent-rev (vc-branch-part version))))))
220 231
221 (defun vc-rcs-checkout-model (files)
222 "RCS-specific version of `vc-checkout-model'."
223 (let ((file (if (consp files) (car files) files))
224 result)
225 (when vc-consult-headers
226 (vc-file-setprop file 'vc-checkout-model nil)
227 (vc-rcs-consult-headers file)
228 (setq result (vc-file-getprop file 'vc-checkout-model)))
229 (or result
230 (progn (vc-rcs-fetch-master-state file)
231 (vc-file-getprop file 'vc-checkout-model)))))
232
233 (defun vc-rcs-workfile-unchanged-p (file) 232 (defun vc-rcs-workfile-unchanged-p (file)
234 "RCS-specific implementation of `vc-workfile-unchanged-p'." 233 "RCS-specific implementation of `vc-workfile-unchanged-p'."
235 ;; Try to use rcsdiff --brief. If rcsdiff does not understand that, 234 ;; Try to use rcsdiff --brief. If rcsdiff does not understand that,
236 ;; do a double take and remember the fact for the future 235 ;; do a double take and remember the fact for the future
237 (let* ((version (concat "-r" (vc-working-revision file))) 236 (let* ((version (concat "-r" (vc-working-revision file)))
318 ;; TODO: check for all the patterns in vc-rcs-master-templates 317 ;; TODO: check for all the patterns in vc-rcs-master-templates
319 (file-directory-p (expand-file-name "RCS" (file-name-directory file)))) 318 (file-directory-p (expand-file-name "RCS" (file-name-directory file))))
320 319
321 (defun vc-rcs-receive-file (file rev) 320 (defun vc-rcs-receive-file (file rev)
322 "Implementation of receive-file for RCS." 321 "Implementation of receive-file for RCS."
323 (let ((checkout-model (vc-rcs-checkout-model file))) 322 (let ((checkout-model (vc-rcs-checkout-model (list file))))
324 (vc-rcs-register file rev "") 323 (vc-rcs-register file rev "")
325 (when (eq checkout-model 'implicit) 324 (when (eq checkout-model 'implicit)
326 (vc-rcs-set-non-strict-locking file)) 325 (vc-rcs-set-non-strict-locking file))
327 (vc-rcs-set-default-branch file (concat rev ".1")))) 326 (vc-rcs-set-default-branch file (concat rev ".1"))))
328 327
429 ;; now do the checkout 428 ;; now do the checkout
430 (apply 'vc-do-command 429 (apply 'vc-do-command
431 nil 0 "co" (vc-name file) 430 nil 0 "co" (vc-name file)
432 ;; If locking is not strict, force to overwrite 431 ;; If locking is not strict, force to overwrite
433 ;; the writable workfile. 432 ;; the writable workfile.
434 (if (eq (vc-rcs-checkout-model file) 'implicit) "-f") 433 (if (eq (vc-rcs-checkout-model (list file)) 'implicit) "-f")
435 (if editable "-l") 434 (if editable "-l")
436 (if (stringp rev) 435 (if (stringp rev)
437 ;; a literal revision was specified 436 ;; a literal revision was specified
438 (concat "-r" rev) 437 (concat "-r" rev)
439 (let ((workrev (vc-working-revision file))) 438 (let ((workrev (vc-working-revision file)))
892 ;; workfile version is not latest on branch 891 ;; workfile version is not latest on branch
893 'needs-update)) 892 'needs-update))
894 ;; locked by the calling user 893 ;; locked by the calling user
895 ((and (stringp locking-user) 894 ((and (stringp locking-user)
896 (string= locking-user (vc-user-login-name file))) 895 (string= locking-user (vc-user-login-name file)))
897 (if (or (eq (vc-rcs-checkout-model file) 'locking) 896 (if (or (eq (vc-rcs-checkout-model (list file)) 'locking)
898 workfile-is-latest 897 workfile-is-latest
899 (vc-rcs-latest-on-branch-p file working-revision)) 898 (vc-rcs-latest-on-branch-p file working-revision))
900 'edited 899 'edited
901 ;; Locking is not used for the file, but the owner does 900 ;; Locking is not used for the file, but the owner does
902 ;; have a lock, and there is a higher version on the current 901 ;; have a lock, and there is a higher version on the current