Mercurial > emacs
comparison lisp/vc-rcs.el @ 94481:ad6c174910db
Make `checkout-model' apply to filesets.
* vc-hooks.el (vc-checkout-model): Rewrite.
(vc-before-save, vc-after-save): Adjust callers accordingly.
* vc.el (vc-editable-p, vc-next-action, vc-checkout, vc-update)
(vc-transfer-file): Adjust callers accordingly.
* vc-rcs.el (vc-rcs-checkout-model): Adjust arg.
(vc-rcs-state, vc-rcs-state-heuristic, vc-rcs-receive-file)
(vc-rcs-checkout, vc-rcs-fetch-master-state): Use vc-rcs-checkout-model
instead of vc-checkout-model.
* vc-mcvs.el (vc-mcvs-revert):
Use vc-mcvs-checkout-model i.s.o vc-checkout-model.
* vc-cvs.el (vc-cvs-checkout-model): Adjust arg.
(vc-cvs-revert): Use vc-cvs-checkout-model i.s.o vc-checkout-model.
* vc-svn.el (vc-svn-checkout-model):
* vc-hg.el (vc-hg-checkout-model):
* vc-git.el (vc-git-checkout-model):
* vc-bzr.el (vc-bzr-checkout-model): Adjust arg.
| author | Stefan Monnier <monnier@iro.umontreal.ca> |
|---|---|
| date | Tue, 29 Apr 2008 15:32:56 +0000 |
| parents | 2ecb2ea8d5b5 |
| children | 2a61c5f918a5 |
comparison
equal
deleted
inserted
replaced
| 94480:cf998cc4d006 | 94481:ad6c174910db |
|---|---|
| 107 | 107 |
| 108 ;;; | 108 ;;; |
| 109 ;;; State-querying functions | 109 ;;; State-querying functions |
| 110 ;;; | 110 ;;; |
| 111 | 111 |
| 112 ;;; The autoload cookie below places vc-rcs-registered directly into | 112 ;; The autoload cookie below places vc-rcs-registered directly into |
| 113 ;;; loaddefs.el, so that vc-rcs.el does not need to be loaded for | 113 ;; loaddefs.el, so that vc-rcs.el does not need to be loaded for |
| 114 ;;; every file that is visited. The definition is repeated below | 114 ;; every file that is visited. |
| 115 ;;; so that Help and etags can find it. | 115 ;;;###autoload |
| 116 | 116 (progn |
| 117 ;;;###autoload (defun vc-rcs-registered (f) (vc-default-registered 'RCS f)) | 117 (defun vc-rcs-registered (f) (vc-default-registered 'RCS f))) |
| 118 (defun vc-rcs-registered (f) (vc-default-registered 'RCS f)) | |
| 119 | 118 |
| 120 (defun vc-rcs-state (file) | 119 (defun vc-rcs-state (file) |
| 121 "Implementation of `vc-state' for RCS." | 120 "Implementation of `vc-state' for RCS." |
| 122 (or (boundp 'vc-rcs-headers-result) | 121 (or (boundp 'vc-rcs-headers-result) |
| 123 (and vc-consult-headers | 122 (and vc-consult-headers |
| 131 'vc-working-revision)))) | 130 'vc-working-revision)))) |
| 132 (if (not (eq state 'up-to-date)) | 131 (if (not (eq state 'up-to-date)) |
| 133 state | 132 state |
| 134 (if (vc-workfile-unchanged-p file) | 133 (if (vc-workfile-unchanged-p file) |
| 135 'up-to-date | 134 'up-to-date |
| 136 (if (eq (vc-checkout-model file) 'locking) | 135 (if (eq (vc-rcs-checkout-model file) 'locking) |
| 137 'unlocked-changes | 136 'unlocked-changes |
| 138 'edited))))) | 137 'edited))))) |
| 139 | 138 |
| 140 (defun vc-rcs-state-heuristic (file) | 139 (defun vc-rcs-state-heuristic (file) |
| 141 "State heuristic for RCS." | 140 "State heuristic for RCS." |
| 166 (permissions (nth 8 attributes))) | 165 (permissions (nth 8 attributes))) |
| 167 (cond ((string-match ".r-..-..-." permissions) | 166 (cond ((string-match ".r-..-..-." permissions) |
| 168 (vc-file-setprop file 'vc-checkout-model 'locking) | 167 (vc-file-setprop file 'vc-checkout-model 'locking) |
| 169 'up-to-date) | 168 'up-to-date) |
| 170 ((string-match ".rw..-..-." permissions) | 169 ((string-match ".rw..-..-." permissions) |
| 171 (if (eq (vc-checkout-model file) 'locking) | 170 (if (eq (vc-rcs-checkout-model file) 'locking) |
| 172 (if (file-ownership-preserved-p file) | 171 (if (file-ownership-preserved-p file) |
| 173 'edited | 172 'edited |
| 174 owner-name) | 173 owner-name) |
| 175 (if (vc-rcs-workfile-is-newer file) | 174 (if (vc-rcs-workfile-is-newer file) |
| 176 'edited | 175 'edited |
| 216 ;; If we are not on the trunk, we need to examine the | 215 ;; If we are not on the trunk, we need to examine the |
| 217 ;; whole current branch. | 216 ;; whole current branch. |
| 218 (vc-insert-file (vc-name file) "^desc") | 217 (vc-insert-file (vc-name file) "^desc") |
| 219 (vc-rcs-find-most-recent-rev (vc-branch-part version)))))) | 218 (vc-rcs-find-most-recent-rev (vc-branch-part version)))))) |
| 220 | 219 |
| 221 (defun vc-rcs-checkout-model (file) | 220 (defun vc-rcs-checkout-model (files) |
| 222 "RCS-specific version of `vc-checkout-model'." | 221 "RCS-specific version of `vc-checkout-model'." |
| 223 (let (result) | 222 (let ((file (if (consp files) (car files) files)) |
| 223 result) | |
| 224 (when vc-consult-headers | 224 (when vc-consult-headers |
| 225 (vc-file-setprop file 'vc-checkout-model nil) | 225 (vc-file-setprop file 'vc-checkout-model nil) |
| 226 (vc-rcs-consult-headers file) | 226 (vc-rcs-consult-headers file) |
| 227 (setq result (vc-file-getprop file 'vc-checkout-model))) | 227 (setq result (vc-file-getprop file 'vc-checkout-model))) |
| 228 (or result | 228 (or result |
| 317 ;; TODO: check for all the patterns in vc-rcs-master-templates | 317 ;; TODO: check for all the patterns in vc-rcs-master-templates |
| 318 (file-directory-p (expand-file-name "RCS" (file-name-directory file)))) | 318 (file-directory-p (expand-file-name "RCS" (file-name-directory file)))) |
| 319 | 319 |
| 320 (defun vc-rcs-receive-file (file rev) | 320 (defun vc-rcs-receive-file (file rev) |
| 321 "Implementation of receive-file for RCS." | 321 "Implementation of receive-file for RCS." |
| 322 (let ((checkout-model (vc-checkout-model file))) | 322 (let ((checkout-model (vc-rcs-checkout-model file))) |
| 323 (vc-rcs-register file rev "") | 323 (vc-rcs-register file rev "") |
| 324 (when (eq checkout-model 'implicit) | 324 (when (eq checkout-model 'implicit) |
| 325 (vc-rcs-set-non-strict-locking file)) | 325 (vc-rcs-set-non-strict-locking file)) |
| 326 (vc-rcs-set-default-branch file (concat rev ".1")))) | 326 (vc-rcs-set-default-branch file (concat rev ".1")))) |
| 327 | 327 |
| 428 ;; now do the checkout | 428 ;; now do the checkout |
| 429 (apply 'vc-do-command | 429 (apply 'vc-do-command |
| 430 nil 0 "co" (vc-name file) | 430 nil 0 "co" (vc-name file) |
| 431 ;; If locking is not strict, force to overwrite | 431 ;; If locking is not strict, force to overwrite |
| 432 ;; the writable workfile. | 432 ;; the writable workfile. |
| 433 (if (eq (vc-checkout-model file) 'implicit) "-f") | 433 (if (eq (vc-rcs-checkout-model file) 'implicit) "-f") |
| 434 (if editable "-l") | 434 (if editable "-l") |
| 435 (if (stringp rev) | 435 (if (stringp rev) |
| 436 ;; a literal revision was specified | 436 ;; a literal revision was specified |
| 437 (concat "-r" rev) | 437 (concat "-r" rev) |
| 438 (let ((workrev (vc-working-revision file))) | 438 (let ((workrev (vc-working-revision file))) |
| 891 ;; workfile version is not latest on branch | 891 ;; workfile version is not latest on branch |
| 892 'needs-patch)) | 892 'needs-patch)) |
| 893 ;; locked by the calling user | 893 ;; locked by the calling user |
| 894 ((and (stringp locking-user) | 894 ((and (stringp locking-user) |
| 895 (string= locking-user (vc-user-login-name file))) | 895 (string= locking-user (vc-user-login-name file))) |
| 896 (if (or (eq (vc-checkout-model file) 'locking) | 896 (if (or (eq (vc-rcs-checkout-model file) 'locking) |
| 897 workfile-is-latest | 897 workfile-is-latest |
| 898 (vc-rcs-latest-on-branch-p file working-revision)) | 898 (vc-rcs-latest-on-branch-p file working-revision)) |
| 899 'edited | 899 'edited |
| 900 ;; Locking is not used for the file, but the owner does | 900 ;; Locking is not used for the file, but the owner does |
| 901 ;; 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 |