Mercurial > emacs
changeset 94563:a0bb8ca25a33
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 | 46f178f2b009 |
| children | e4c0c68d78b4 |
| files | lisp/vc-arch.el 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-mtn.el lisp/vc-rcs.el lisp/vc-sccs.el lisp/vc-svn.el lisp/vc.el |
| diffstat | 12 files changed, 74 insertions(+), 79 deletions(-) [+] |
line wrap: on
line diff
--- a/lisp/vc-arch.el Fri May 02 17:39:02 2008 +0000 +++ b/lisp/vc-arch.el Fri May 02 17:47:25 2008 +0000 @@ -57,6 +57,11 @@ (eval-when-compile (require 'vc) (require 'cl)) +;;; Properties of the backend + +(defun vc-arch-revision-granularity () 'repository) +(defun vc-arch-checkout-model (files) 'implicit) + ;;; ;;; Customization options ;;; @@ -369,8 +374,6 @@ (message "There are unresolved conflicts in %s" (file-name-nondirectory rej)))))) -(defun vc-arch-checkout-model (file) 'implicit) - (defun vc-arch-checkin (files rev comment) (if rev (error "Committing to a specific revision is unsupported")) ;; FIXME: This implementation probably only works for singleton filesets
--- a/lisp/vc-bzr.el Fri May 02 17:39:02 2008 +0000 +++ b/lisp/vc-bzr.el Fri May 02 17:47:25 2008 +0000 @@ -44,6 +44,10 @@ ;; For an up-to-date list of bugs, please see: ;; https://bugs.launchpad.net/vc-bzr/+bugs +;;; Properties of the backend + +(defun vc-bzr-revision-granularity () 'repository) +(defun vc-bzr-checkout-model (files) 'implicit) ;;; Code: @@ -346,8 +350,6 @@ ((eq exitcode 0) (substring output 0 -1)) (t nil)))))) -(defun vc-bzr-checkout-model (files) 'implicit) - (defun vc-bzr-create-repo () "Create a new Bzr repository." (vc-bzr-command "init" nil 0 nil))
--- a/lisp/vc-cvs.el Fri May 02 17:39:02 2008 +0000 +++ b/lisp/vc-cvs.el Fri May 02 17:47:25 2008 +0000 @@ -35,6 +35,30 @@ ;; new functions when we reload this file. (put 'CVS 'vc-functions nil) +;;; Properties of the backend. + +(defun vc-cvs-revision-granularity () 'file) + +(defun vc-cvs-checkout-model (files) + "CVS-specific version of `vc-checkout-model'." + (if (getenv "CVSREAD") + 'announce + (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)))))) + ;;; ;;; Customization options ;;; @@ -238,26 +262,6 @@ (vc-cvs-registered file) (vc-file-getprop file 'vc-working-revision)) -(defun vc-cvs-checkout-model (files) - "CVS-specific version of `vc-checkout-model'." - (if (getenv "CVSREAD") - 'announce - (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. Compared to the default implementation, this function does two things: @@ -393,7 +397,7 @@ (if (and (file-exists-p file) (not rev)) ;; If no revision was specified, just make the file writable ;; if necessary (using `cvs-edit' if requested). - (and editable (not (eq (vc-cvs-checkout-model file) 'implicit)) + (and editable (not (eq (vc-cvs-checkout-model (list file)) 'implicit)) (if vc-cvs-use-edit (vc-cvs-command nil 0 file "edit") (set-file-modes file (logior (file-modes file) 128)) @@ -421,7 +425,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-cvs-checkout-model file) 'implicit) + (unless (eq (vc-cvs-checkout-model (list 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 Fri May 02 17:39:02 2008 +0000 +++ b/lisp/vc-git.el Fri May 02 17:47:25 2008 +0000 @@ -55,7 +55,7 @@ ;; - dir-state (dir) OK ;; * working-revision (file) OK ;; - latest-on-branch-p (file) NOT NEEDED -;; * checkout-model (file) OK +;; * checkout-model (files) OK ;; - workfile-unchanged-p (file) OK ;; - mode-line-string (file) OK ;; - prettify-state-info (file) OK @@ -118,8 +118,8 @@ ;;; BACKEND PROPERTIES -(defun vc-git-revision-granularity () - 'repository) +(defun vc-git-revision-granularity () 'repository) +(defun vc-git-checkout-model (files) 'implicit) ;;; STATE-QUERYING FUNCTIONS @@ -195,8 +195,6 @@ (match-string 2 str) str))) -(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 Fri May 02 17:39:02 2008 +0000 +++ b/lisp/vc-hg.el Fri May 02 17:47:25 2008 +0000 @@ -47,7 +47,7 @@ ;; - dir-state (dir) OK ;; * working-revision (file) OK ;; - latest-on-branch-p (file) ?? -;; * checkout-model (file) OK +;; * checkout-model (files) OK ;; - workfile-unchanged-p (file) OK ;; - mode-line-string (file) NOT NEEDED ;; - prettify-state-info (file) OK @@ -131,8 +131,8 @@ ;;; Properties of the backend -(defun vc-hg-revision-granularity () - 'repository) +(defun vc-hg-revision-granularity () 'repository) +(defun vc-hg-checkout-model (files) 'implicit) ;;; State querying functions @@ -444,8 +444,6 @@ (vc-hg-command t 0 file "cat" "-r" rev) (vc-hg-command t 0 file "cat"))))) -(defun vc-hg-checkout-model (files) 'implicit) - ;; Modelled after the similar function in vc-bzr.el (defun vc-hg-workfile-unchanged-p (file) (eq 'up-to-date (vc-hg-state file)))
--- a/lisp/vc-hooks.el Fri May 02 17:39:02 2008 +0000 +++ b/lisp/vc-hooks.el Fri May 02 17:47:25 2008 +0000 @@ -746,7 +746,7 @@ (ignore-errors ;Be careful not to prevent saving the file. (and (setq backend (vc-backend file)) (vc-up-to-date-p file) - (eq (vc-checkout-model backend file) 'implicit) + (eq (vc-checkout-model backend (list file)) 'implicit) (vc-call make-version-backups-p file) (vc-make-version-backup file))))) @@ -768,7 +768,7 @@ (vc-file-setprop file 'vc-checkout-time nil)) t) (vc-up-to-date-p file) - (eq (vc-checkout-model backend file) 'implicit) + (eq (vc-checkout-model backend (list file)) 'implicit) (vc-file-setprop file 'vc-state 'edited) (vc-mode-line file) (when (featurep 'vc)
--- a/lisp/vc-mcvs.el Fri May 02 17:39:02 2008 +0000 +++ b/lisp/vc-mcvs.el Fri May 02 17:47:25 2008 +0000 @@ -111,8 +111,8 @@ ;;; Properties of the backend -(defun vc-mcvs-revision-granularity () - 'file) +(defalias 'vc-mcvs-revision-granularity 'vc-cvs-revision-granularity) +(defalias 'vc-mcvs-checkout-model 'vc-cvs-checkout-model) ;;; ;;; State-querying functions @@ -202,8 +202,6 @@ (expand-file-name (vc-file-getprop file 'mcvs-inode) (vc-file-getprop file 'mcvs-root)))) -(defalias 'vc-mcvs-checkout-model 'vc-cvs-checkout-model) - ;;; ;;; State-changing functions ;;; @@ -344,7 +342,7 @@ (if (and (file-exists-p file) (not rev)) ;; If no revision was specified, just make the file writable ;; if necessary (using `cvs-edit' if requested). - (and editable (not (eq (vc-mcvs-checkout-model file) 'implicit)) + (and editable (not (eq (vc-mcvs-checkout-model (list file)) 'implicit)) (if vc-mcvs-use-edit (vc-mcvs-command nil 0 file "edit") (set-file-modes file (logior (file-modes file) 128)) @@ -367,7 +365,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-mcvs-checkout-model file) 'implicit) + (unless (eq (vc-mcvs-checkout-model (list 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-mtn.el Fri May 02 17:39:02 2008 +0000 +++ b/lisp/vc-mtn.el Fri May 02 17:47:25 2008 +0000 @@ -49,7 +49,7 @@ ;;;###autoload (vc-mtn-registered file)))) (defun vc-mtn-revision-granularity () 'repository) -(defun vc-mtn-checkout-model (file) 'implicit) +(defun vc-mtn-checkout-model (files) 'implicit) (defun vc-mtn-root (file) (setq file (if (file-directory-p file)
--- a/lisp/vc-rcs.el Fri May 02 17:39:02 2008 +0000 +++ b/lisp/vc-rcs.el Fri May 02 17:47:25 2008 +0000 @@ -102,8 +102,19 @@ ;;; Properties of the backend -(defun vc-rcs-revision-granularity () - 'file) +(defun vc-rcs-revision-granularity () 'file) + +(defun vc-rcs-checkout-model (files) + "RCS-specific version of `vc-checkout-model'." + (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) + (setq result (vc-file-getprop file 'vc-checkout-model))) + (or result + (progn (vc-rcs-fetch-master-state file) + (vc-file-getprop file 'vc-checkout-model))))) ;;; ;;; State-querying functions @@ -134,7 +145,7 @@ state (if (vc-workfile-unchanged-p file) 'up-to-date - (if (eq (vc-rcs-checkout-model file) 'locking) + (if (eq (vc-rcs-checkout-model (list file)) 'locking) 'unlocked-changes 'edited)))))) @@ -218,18 +229,6 @@ (vc-insert-file (vc-name file) "^desc") (vc-rcs-find-most-recent-rev (vc-branch-part version)))))) -(defun vc-rcs-checkout-model (files) - "RCS-specific version of `vc-checkout-model'." - (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) - (setq result (vc-file-getprop file 'vc-checkout-model))) - (or result - (progn (vc-rcs-fetch-master-state file) - (vc-file-getprop file 'vc-checkout-model))))) - (defun vc-rcs-workfile-unchanged-p (file) "RCS-specific implementation of `vc-workfile-unchanged-p'." ;; Try to use rcsdiff --brief. If rcsdiff does not understand that, @@ -320,7 +319,7 @@ (defun vc-rcs-receive-file (file rev) "Implementation of receive-file for RCS." - (let ((checkout-model (vc-rcs-checkout-model file))) + (let ((checkout-model (vc-rcs-checkout-model (list file)))) (vc-rcs-register file rev "") (when (eq checkout-model 'implicit) (vc-rcs-set-non-strict-locking file)) @@ -431,7 +430,7 @@ nil 0 "co" (vc-name file) ;; If locking is not strict, force to overwrite ;; the writable workfile. - (if (eq (vc-rcs-checkout-model file) 'implicit) "-f") + (if (eq (vc-rcs-checkout-model (list file)) 'implicit) "-f") (if editable "-l") (if (stringp rev) ;; a literal revision was specified @@ -894,7 +893,7 @@ ;; locked by the calling user ((and (stringp locking-user) (string= locking-user (vc-user-login-name file))) - (if (or (eq (vc-rcs-checkout-model file) 'locking) + (if (or (eq (vc-rcs-checkout-model (list file)) 'locking) workfile-is-latest (vc-rcs-latest-on-branch-p file working-revision)) 'edited
--- a/lisp/vc-sccs.el Fri May 02 17:39:02 2008 +0000 +++ b/lisp/vc-sccs.el Fri May 02 17:47:25 2008 +0000 @@ -102,6 +102,7 @@ ;;; Properties of the backend (defun vc-sccs-revision-granularity () 'file) +(defun vc-sccs-checkout-model (files) 'locking) ;;; ;;; State-querying functions @@ -177,10 +178,6 @@ (vc-insert-file (vc-name file) "^\001e\n\001[^s]") (vc-parse-buffer "^\001d D \\([^ ]+\\)" 1))) -(defun vc-sccs-checkout-model (file) - "SCCS-specific version of `vc-checkout-model'." - 'locking) - (defun vc-sccs-workfile-unchanged-p (file) "SCCS-specific implementation of `vc-workfile-unchanged-p'." (zerop (apply 'vc-do-command nil 1 "vcdiff" (vc-name file)
--- a/lisp/vc-svn.el Fri May 02 17:39:02 2008 +0000 +++ b/lisp/vc-svn.el Fri May 02 17:47:25 2008 +0000 @@ -91,8 +91,9 @@ ;;; Properties of the backend -(defun vc-svn-revision-granularity () - 'repository) +(defun vc-svn-revision-granularity () 'repository) +(defun vc-svn-checkout-model (files) 'implicit) + ;;; ;;; State-querying functions ;;; @@ -193,11 +194,6 @@ (vc-svn-registered file) (vc-file-getprop file 'vc-working-revision)) -(defun vc-svn-checkout-model (files) - "SVN-specific version of `vc-checkout-model'." - ;; It looks like Subversion has no equivalent of CVSREAD. - 'implicit) - ;; vc-svn-mode-line-string doesn't exist because the default implementation ;; works just fine.
--- a/lisp/vc.el Fri May 02 17:39:02 2008 +0000 +++ b/lisp/vc.el Fri May 02 17:47:25 2008 +0000 @@ -1537,7 +1537,7 @@ "Return non-nil if FILE can be edited." (let ((backend (vc-backend file))) (and backend - (or (eq (vc-checkout-model backend file) 'implicit) + (or (eq (vc-checkout-model backend (list file)) 'implicit) (memq (vc-state file) '(edited needs-merge conflict)))))) (defun vc-revert-buffer-internal (&optional arg no-confirm) @@ -1626,7 +1626,7 @@ (unless (vc-compatible-state (vc-state file) state) (error "%s:%s clashes with %s:%s" file (vc-state file) (car files) state)) - (unless (eq (vc-checkout-model backend file) model) + (unless (eq (vc-checkout-model backend (list file)) model) (error "Fileset has mixed checkout models")))) ;; Check for buffers in the fileset not matching the on-disk contents. (dolist (file files) @@ -1967,7 +1967,7 @@ (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) + `((vc-state . ,(if (or (eq (vc-checkout-model backend (list file)) 'implicit) (not writable)) (if (vc-call latest-on-branch-p file) 'up-to-date @@ -3857,7 +3857,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 backend file) 'locking) + (if (eq (vc-checkout-model backend (list file)) 'locking) (if (eq (vc-state file) 'edited) (error "%s" (substitute-command-keys @@ -3984,7 +3984,7 @@ (vc-call-backend new-backend 'receive-file file rev)) (when modified-file (vc-switch-backend file new-backend) - (unless (eq (vc-checkout-model new-backend file) 'implicit) + (unless (eq (vc-checkout-model new-backend (list file)) 'implicit) (vc-checkout file t nil)) (rename-file modified-file file 'ok-if-already-exists) (vc-file-setprop file 'vc-checkout-time nil)))))