Mercurial > emacs
changeset 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 | cf998cc4d006 |
| children | 67355325dc88 |
| files | lisp/ChangeLog lisp/vc-bzr.el lisp/vc-cvs.el lisp/vc-git.el lisp/vc-hg.el lisp/vc-hooks.el lisp/vc-mcvs.el lisp/vc-rcs.el lisp/vc-svn.el lisp/vc.el |
| diffstat | 10 files changed, 102 insertions(+), 81 deletions(-) [+] |
line wrap: on
line diff
--- a/lisp/ChangeLog Tue Apr 29 14:48:57 2008 +0000 +++ b/lisp/ChangeLog Tue Apr 29 15:32:56 2008 +0000 @@ -1,5 +1,23 @@ 2008-04-29 Stefan Monnier <monnier@iro.umontreal.ca> + 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. + * dired.el (dired-read-dir-and-switches): Replace last change with a new approach that mixes read-file-name and read-directory-name.
--- a/lisp/vc-bzr.el Tue Apr 29 14:48:57 2008 +0000 +++ b/lisp/vc-bzr.el Tue Apr 29 15:32:56 2008 +0000 @@ -346,8 +346,7 @@ ((eq exitcode 0) (substring output 0 -1)) (t nil)))))) -(defun vc-bzr-checkout-model (file) - 'implicit) +(defun vc-bzr-checkout-model (files) 'implicit) (defun vc-bzr-create-repo () "Create a new Bzr repository."
--- a/lisp/vc-cvs.el Tue Apr 29 14:48:57 2008 +0000 +++ b/lisp/vc-cvs.el Tue Apr 29 15:32:56 2008 +0000 @@ -238,21 +238,25 @@ (vc-cvs-registered file) (vc-file-getprop file 'vc-working-revision)) -(defun vc-cvs-checkout-model (file) +(defun vc-cvs-checkout-model (files) "CVS-specific version of `vc-checkout-model'." (if (getenv "CVSREAD") 'announce - (let ((attrib (file-attributes file))) - (if (and attrib ;; don't check further if FILE doesn't exist - ;; If the file is not writable (despite CVSREAD being - ;; undefined), this is probably because the file is being - ;; "watched" by other developers. - ;; (If vc-mistrust-permissions was t, we actually shouldn't - ;; trust this, but there is no other way to learn this from CVS - ;; at the moment (version 1.9).) - (string-match "r-..-..-." (nth 8 attrib))) - 'announce - 'implicit)))) + (let* ((file (if (consp files) (car files) files)) + (attrib (file-attributes file))) + (or (vc-file-getprop file 'vc-checkout-model) + (vc-file-setprop + file 'vc-checkout-model + (if (and attrib ;; don't check further if FILE doesn't exist + ;; If the file is not writable (despite CVSREAD being + ;; undefined), this is probably because the file is being + ;; "watched" by other developers. + ;; (If vc-mistrust-permissions was t, we actually shouldn't + ;; trust this, but there is no other way to learn this from + ;; CVS at the moment (version 1.9).) + (string-match "r-..-..-." (nth 8 attrib))) + 'announce + 'implicit)))))) (defun vc-cvs-mode-line-string (file) "Return string for placement into the modeline for FILE. @@ -356,7 +360,7 @@ (vc-file-setprop (car files) 'vc-working-revision (vc-parse-buffer "^\\(new\\|initial\\) revision: \\([0-9.]+\\)" 2)) - (mapc (lambda (file) (vc-file-clearprops file)) files)) + (mapc 'vc-file-clearprops files)) ;; Anyway, forget the checkout model of the file, because we might have ;; guessed wrong when we found the file. After commit, we can ;; tell it from the permissions of the file (see @@ -418,7 +422,7 @@ (defun vc-cvs-revert (file &optional contents-done) "Revert FILE to the working revision on which it was based." (vc-default-revert 'CVS file contents-done) - (unless (eq (vc-checkout-model file) 'implicit) + (unless (eq (vc-cvs-checkout-model file) 'implicit) (if vc-cvs-use-edit (vc-cvs-command nil 0 file "unedit") ;; Make the file read-only by switching off all w-bits
--- a/lisp/vc-git.el Tue Apr 29 14:48:57 2008 +0000 +++ b/lisp/vc-git.el Tue Apr 29 15:32:56 2008 +0000 @@ -193,8 +193,7 @@ (match-string 2 str) str))) -(defun vc-git-checkout-model (file) - 'implicit) +(defun vc-git-checkout-model (files) 'implicit) (defun vc-git-workfile-unchanged-p (file) (eq 'up-to-date (vc-git-state file)))
--- a/lisp/vc-hg.el Tue Apr 29 14:48:57 2008 +0000 +++ b/lisp/vc-hg.el Tue Apr 29 15:32:56 2008 +0000 @@ -444,8 +444,7 @@ (vc-hg-command t 0 file "cat" "-r" rev) (vc-hg-command t 0 file "cat"))))) -(defun vc-hg-checkout-model (file) - 'implicit) +(defun vc-hg-checkout-model (files) 'implicit) ;; Modelled after the similar function in vc-bzr.el (defun vc-hg-workfile-unchanged-p (file)
--- a/lisp/vc-hooks.el Tue Apr 29 14:48:57 2008 +0000 +++ b/lisp/vc-hooks.el Tue Apr 29 15:32:56 2008 +0000 @@ -440,26 +440,23 @@ (vc-call-backend (vc-backend file) 'registered file)) (vc-file-getprop file 'vc-name)))) -(defun vc-checkout-model (file) - "Indicate how FILE is checked out. +(defun vc-checkout-model (backend files) + "Indicate how FILES are checked out. -If FILE is not registered, this function always returns nil. +If FILES are not registered, this function always returns nil. For registered files, the possible values are: - 'implicit FILE is always writeable, and checked out `implicitly' + 'implicit FILES are always writeable, and checked out `implicitly' when the user saves the first changes to the file. - 'locking FILE is read-only if up-to-date; user must type + 'locking FILES are read-only if up-to-date; user must type \\[vc-next-action] before editing. Strict locking is assumed. - 'announce FILE is read-only if up-to-date; user must type + 'announce FILES are read-only if up-to-date; user must type \\[vc-next-action] before editing. But other users may be editing at the same time." - (or (vc-file-getprop file 'vc-checkout-model) - (if (vc-backend file) - (vc-file-setprop file 'vc-checkout-model - (vc-call checkout-model file))))) + (vc-call-backend backend 'checkout-model files)) (defun vc-user-login-name (file) "Return the name under which the user accesses the given FILE." @@ -752,11 +749,12 @@ ;; If the file on disk is still in sync with the repository, ;; and version backups should be made, copy the file to ;; another name. This enables local diffs and local reverting. - (let ((file buffer-file-name)) + (let ((file buffer-file-name) + backend) (ignore-errors ;Be careful not to prevent saving the file. - (and (vc-backend file) + (and (setq backend (vc-backend file)) (vc-up-to-date-p file) - (eq (vc-checkout-model file) 'implicit) + (eq (vc-checkout-model backend file) 'implicit) (vc-call make-version-backups-p file) (vc-make-version-backup file))))) @@ -767,8 +765,9 @@ ;; If the file in the current buffer is under version control, ;; up-to-date, and locking is not used for the file, set ;; the state to 'edited and redisplay the mode line. - (let ((file buffer-file-name)) - (and (vc-backend file) + (let* ((file buffer-file-name) + (backend (vc-backend file))) + (and backend (or (and (equal (vc-file-getprop file 'vc-checkout-time) (nth 5 (file-attributes file))) ;; File has been saved in the same second in which @@ -777,7 +776,7 @@ (vc-file-setprop file 'vc-checkout-time nil)) t) (vc-up-to-date-p file) - (eq (vc-checkout-model file) 'implicit) + (eq (vc-checkout-model backend file) 'implicit) (vc-file-setprop file 'vc-state 'edited) (vc-mode-line file) (when (featurep 'vc)
--- a/lisp/vc-mcvs.el Tue Apr 29 14:48:57 2008 +0000 +++ b/lisp/vc-mcvs.el Tue Apr 29 15:32:56 2008 +0000 @@ -367,7 +367,7 @@ (defun vc-mcvs-revert (file &optional contents-done) "Revert FILE to the working revision it was based on." (vc-default-revert 'MCVS file contents-done) - (unless (eq (vc-checkout-model file) 'implicit) + (unless (eq (vc-mcvs-checkout-model file) 'implicit) (if vc-mcvs-use-edit (vc-mcvs-command nil 0 file "unedit") ;; Make the file read-only by switching off all w-bits
--- a/lisp/vc-rcs.el Tue Apr 29 14:48:57 2008 +0000 +++ b/lisp/vc-rcs.el Tue Apr 29 15:32:56 2008 +0000 @@ -109,13 +109,12 @@ ;;; State-querying functions ;;; -;;; The autoload cookie below places vc-rcs-registered directly into -;;; loaddefs.el, so that vc-rcs.el does not need to be loaded for -;;; every file that is visited. The definition is repeated below -;;; so that Help and etags can find it. - -;;;###autoload (defun vc-rcs-registered (f) (vc-default-registered 'RCS f)) -(defun vc-rcs-registered (f) (vc-default-registered 'RCS f)) +;; The autoload cookie below places vc-rcs-registered directly into +;; loaddefs.el, so that vc-rcs.el does not need to be loaded for +;; every file that is visited. +;;;###autoload +(progn +(defun vc-rcs-registered (f) (vc-default-registered 'RCS f))) (defun vc-rcs-state (file) "Implementation of `vc-state' for RCS." @@ -133,7 +132,7 @@ state (if (vc-workfile-unchanged-p file) 'up-to-date - (if (eq (vc-checkout-model file) 'locking) + (if (eq (vc-rcs-checkout-model file) 'locking) 'unlocked-changes 'edited))))) @@ -168,7 +167,7 @@ (vc-file-setprop file 'vc-checkout-model 'locking) 'up-to-date) ((string-match ".rw..-..-." permissions) - (if (eq (vc-checkout-model file) 'locking) + (if (eq (vc-rcs-checkout-model file) 'locking) (if (file-ownership-preserved-p file) 'edited owner-name) @@ -218,9 +217,10 @@ (vc-insert-file (vc-name file) "^desc") (vc-rcs-find-most-recent-rev (vc-branch-part version)))))) -(defun vc-rcs-checkout-model (file) +(defun vc-rcs-checkout-model (files) "RCS-specific version of `vc-checkout-model'." - (let (result) + (let ((file (if (consp files) (car files) files)) + result) (when vc-consult-headers (vc-file-setprop file 'vc-checkout-model nil) (vc-rcs-consult-headers file) @@ -319,7 +319,7 @@ (defun vc-rcs-receive-file (file rev) "Implementation of receive-file for RCS." - (let ((checkout-model (vc-checkout-model file))) + (let ((checkout-model (vc-rcs-checkout-model file))) (vc-rcs-register file rev "") (when (eq checkout-model 'implicit) (vc-rcs-set-non-strict-locking file)) @@ -430,7 +430,7 @@ nil 0 "co" (vc-name file) ;; If locking is not strict, force to overwrite ;; the writable workfile. - (if (eq (vc-checkout-model file) 'implicit) "-f") + (if (eq (vc-rcs-checkout-model file) 'implicit) "-f") (if editable "-l") (if (stringp rev) ;; a literal revision was specified @@ -893,7 +893,7 @@ ;; locked by the calling user ((and (stringp locking-user) (string= locking-user (vc-user-login-name file))) - (if (or (eq (vc-checkout-model file) 'locking) + (if (or (eq (vc-rcs-checkout-model file) 'locking) workfile-is-latest (vc-rcs-latest-on-branch-p file working-revision)) 'edited
--- a/lisp/vc-svn.el Tue Apr 29 14:48:57 2008 +0000 +++ b/lisp/vc-svn.el Tue Apr 29 15:32:56 2008 +0000 @@ -193,7 +193,7 @@ (vc-svn-registered file) (vc-file-getprop file 'vc-working-revision)) -(defun vc-svn-checkout-model (file) +(defun vc-svn-checkout-model (files) "SVN-specific version of `vc-checkout-model'." ;; It looks like Subversion has no equivalent of CVSREAD. 'implicit)
--- a/lisp/vc.el Tue Apr 29 14:48:57 2008 +0000 +++ b/lisp/vc.el Tue Apr 29 15:32:56 2008 +0000 @@ -228,9 +228,9 @@ ;; The default implementation always returns t, which means that ;; working with non-current revisions is not supported by default. ;; -;; * checkout-model (file) -;; -;; Indicate whether FILE needs to be "checked out" before it can be +;; * checkout-model (files) +;; +;; Indicate whether FILES need to be "checked out" before they can be ;; edited. See `vc-checkout-model' for a list of possible values. ;; ;; - workfile-unchanged-p (file) @@ -1506,13 +1506,16 @@ (unless (vc-backend buffer-file-name) (error "File %s is not under version control" buffer-file-name)))))) -;;; Support for the C-x v v command. This is where all the single-file-oriented -;;; code from before the fileset rewrite lives. +;;; Support for the C-x v v command. +;; This is where all the single-file-oriented code from before the fileset +;; rewrite lives. (defsubst vc-editable-p (file) "Return non-nil if FILE can be edited." - (or (eq (vc-checkout-model file) 'implicit) - (memq (vc-state file) '(edited needs-merge conflict)))) + (let ((backend (vc-backend file))) + (and backend + (or (eq (vc-checkout-model backend file) 'implicit) + (memq (vc-state file) '(edited needs-merge conflict)))))) (defun vc-revert-buffer-internal (&optional arg no-confirm) "Revert buffer, keeping point and mark where user expects them. @@ -1585,9 +1588,10 @@ merge in the changes into your working copy." (interactive "P") (let* ((vc-fileset (vc-deduce-fileset nil t)) + (backend (car vc-fileset)) (files (cdr vc-fileset)) state - model + (model (vc-checkout-model backend files)) revision) ;; Check if there's at least one file present, and get `state' and ;; `model' from it. @@ -1595,7 +1599,6 @@ ;; present, or `files' is nil. (dolist (file files) (unless (file-directory-p file) - (setq model (vc-checkout-model (car files))) (setq state (vc-state file)) (return))) @@ -1605,7 +1608,7 @@ (unless (file-directory-p file) (unless (vc-compatible-state (vc-state file) state) (error "Fileset is in a mixed-up state")) - (unless (eq (vc-checkout-model file) model) + (unless (eq (vc-checkout-model backend file) model) (error "Fileset has mixed checkout models")))) ;; Check for buffers in the fileset not matching the on-disk contents. (dolist (file files) @@ -1932,23 +1935,23 @@ (vc-call make-version-backups-p file) (vc-up-to-date-p file) (vc-make-version-backup file)) - (with-vc-properties - (list file) - (condition-case err - (vc-call checkout file writable rev) - (file-error - ;; Maybe the backend is not installed ;-( - (when writable - (let ((buf (get-file-buffer file))) - (when buf (with-current-buffer buf (toggle-read-only -1))))) - (signal (car err) (cdr err)))) - `((vc-state . ,(if (or (eq (vc-checkout-model file) 'implicit) - (not writable)) - (if (vc-call latest-on-branch-p file) - 'up-to-date - 'needs-patch) - 'edited)) - (vc-checkout-time . ,(nth 5 (file-attributes file))))) + (let ((backend (vc-backend file))) + (with-vc-properties (list file) + (condition-case err + (vc-call-backend 'checkout file writable rev) + (file-error + ;; Maybe the backend is not installed ;-( + (when writable + (let ((buf (get-file-buffer file))) + (when buf (with-current-buffer buf (toggle-read-only -1))))) + (signal (car err) (cdr err)))) + `((vc-state . ,(if (or (eq (vc-checkout-model backend file) 'implicit) + (not writable)) + (if (vc-call latest-on-branch-p file) + 'up-to-date + 'needs-patch) + 'edited)) + (vc-checkout-time . ,(nth 5 (file-attributes file)))))) (vc-resynch-buffer file t t) (run-hooks 'vc-checkout-hook)) @@ -3769,7 +3772,7 @@ (error "Please kill or save all modified buffers before updating.")) (if (vc-up-to-date-p file) (vc-checkout file nil t) - (if (eq (vc-checkout-model file) 'locking) + (if (eq (vc-checkout-model backend file) 'locking) (if (eq (vc-state file) 'edited) (error "%s" (substitute-command-keys @@ -3896,7 +3899,7 @@ (vc-call-backend new-backend 'receive-file file rev)) (when modified-file (vc-switch-backend file new-backend) - (unless (eq (vc-checkout-model file) 'implicit) + (unless (eq (vc-checkout-model new-backend file) 'implicit) (vc-checkout file t nil)) (rename-file modified-file file 'ok-if-already-exists) (vc-file-setprop file 'vc-checkout-time nil)))))