* 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.
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.
((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."
(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.
(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
(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
(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)))
(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)
(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."
;; 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)))))
;; 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
(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)
(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
;;; 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."
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)))))
(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)
(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)
(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))
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
;; 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
(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)
;; The default implementation always returns t, which means that
;; working with non-current revisions is not supported by default.
;;
-;; * checkout-model (file)
+;; * checkout-model (files)
;;
-;; Indicate whether FILE needs to be "checked out" before it can be
+;; 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)
(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.
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.
;; 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)))
(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)
(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))
(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
(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)))))
projects / emacs.git / commitdiff