mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2024-12-24 10:38:38 +00:00
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.
This commit is contained in:
Stefan Monnier
parent
b95ced6bee
commit
e0607aaa2c
@ -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.
|
||||
|
||||
|
||||
@ -346,8 +346,7 @@ If any error occurred in running `bzr status', then return nil."
|
||||
((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."
|
||||
|
||||
@ -238,21 +238,25 @@ See also variable `vc-cvs-sticky-date-format-string'."
|
||||
(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 @@ its parents."
|
||||
(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 @@ REV is the revision to check out."
|
||||
(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
|
||||
|
||||
@ -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)))
|
||||
|
||||
@ -444,8 +444,7 @@ REV is the revision to check out into WORKFILE."
|
||||
(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)
|
||||
|
||||
@ -440,26 +440,23 @@ If the file is not registered, or the master name is not known, return nil."
|
||||
(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 @@ Before doing that, check if there are any old backups and get rid of them."
|
||||
;; 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 @@ Before doing that, check if there are any old backups and get rid of them."
|
||||
;; 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 @@ Before doing that, check if there are any old backups and get rid of them."
|
||||
(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)
|
||||
|
||||
@ -367,7 +367,7 @@ This is only possible if Meta-CVS is responsible for FILE's directory.")
|
||||
(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
|
||||
|
||||
@ -109,13 +109,12 @@ For a description of possible values, see `vc-check-master-templates'."
|
||||
;;; 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 @@ For a description of possible values, see `vc-check-master-templates'."
|
||||
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 @@ For a description of possible values, see `vc-check-master-templates'."
|
||||
(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 @@ When VERSION is given, perform check for that version."
|
||||
(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 @@ expanded if `vc-keep-workfiles' is non-nil, otherwise, delete the workfile."
|
||||
|
||||
(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 @@ whether to remove it."
|
||||
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 @@ file."
|
||||
;; 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
|
||||
|
||||
@ -193,7 +193,7 @@ RESULT is a list of conses (FILE . STATE) for directory DIR."
|
||||
(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)
|
||||
|
||||
59
lisp/vc.el
59
lisp/vc.el
@ -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)
|
||||
;; * 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)
|
||||
@ -1506,13 +1506,16 @@ Otherwise, throw an error."
|
||||
(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 @@ with the logmessage as change commentary. A writable file is retained.
|
||||
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 @@ merge in the changes into your working copy."
|
||||
;; 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 @@ merge in the changes into your working copy."
|
||||
(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 @@ After check-out, runs the normal hook `vc-checkout-hook'."
|
||||
(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 @@ changes from the current branch are merged into the working file."
|
||||
(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 @@ backend to NEW-BACKEND, and unregister FILE from the current backend.
|
||||
(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)))))
|
||||
|
||||
Loading…
Reference in New Issue
Block a user