From 70e2f6c752f2d83bd013406a96b809572203e8fa Mon Sep 17 00:00:00 2001 From: "Eric S. Raymond" Date: Fri, 2 May 2008 17:47:25 +0000 Subject: [PATCH] Clean up vc*-revision-granularity and vc*-checkout-model. --- lisp/vc-arch.el | 7 +++++-- lisp/vc-bzr.el | 6 ++++-- lisp/vc-cvs.el | 48 ++++++++++++++++++++++++++---------------------- lisp/vc-git.el | 8 +++----- lisp/vc-hg.el | 8 +++----- lisp/vc-hooks.el | 4 ++-- lisp/vc-mcvs.el | 10 ++++------ lisp/vc-mtn.el | 2 +- lisp/vc-rcs.el | 35 +++++++++++++++++------------------ lisp/vc-sccs.el | 5 +---- lisp/vc-svn.el | 10 +++------- lisp/vc.el | 10 +++++----- 12 files changed, 74 insertions(+), 79 deletions(-) diff --git a/lisp/vc-arch.el b/lisp/vc-arch.el index 1573e55bd78..18eddb6f9c7 100644 --- a/lisp/vc-arch.el +++ b/lisp/vc-arch.el @@ -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 @@ Return non-nil if FILE is unchanged." (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 diff --git a/lisp/vc-bzr.el b/lisp/vc-bzr.el index 15529e20f0c..3269bee7c0f 100644 --- a/lisp/vc-bzr.el +++ b/lisp/vc-bzr.el @@ -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 @@ 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 (files) 'implicit) - (defun vc-bzr-create-repo () "Create a new Bzr repository." (vc-bzr-command "init" nil 0 nil)) diff --git a/lisp/vc-cvs.el b/lisp/vc-cvs.el index d67352ab250..5c3a93ff36f 100644 --- a/lisp/vc-cvs.el +++ b/lisp/vc-cvs.el @@ -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 @@ 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 (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 @@ REV is the revision to check out." (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 @@ 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-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 diff --git a/lisp/vc-git.el b/lisp/vc-git.el index 9c8ebfc9993..ed13cb92081 100644 --- a/lisp/vc-git.el +++ b/lisp/vc-git.el @@ -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))) diff --git a/lisp/vc-hg.el b/lisp/vc-hg.el index a4e08e021ee..85ea6e13b07 100644 --- a/lisp/vc-hg.el +++ b/lisp/vc-hg.el @@ -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 @@ 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 (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))) diff --git a/lisp/vc-hooks.el b/lisp/vc-hooks.el index 0d63abc9b9e..a09d62604b6 100644 --- a/lisp/vc-hooks.el +++ b/lisp/vc-hooks.el @@ -746,7 +746,7 @@ Before doing that, check if there are any old backups and get rid of them." (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 @@ 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 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) diff --git a/lisp/vc-mcvs.el b/lisp/vc-mcvs.el index df8a4ebad0b..ff40647ead4 100644 --- a/lisp/vc-mcvs.el +++ b/lisp/vc-mcvs.el @@ -111,8 +111,8 @@ This is only meaningful if you don't use the implicit checkout model ;;; 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 @@ This is only meaningful if you don't use the implicit checkout model (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 @@ This is only possible if Meta-CVS is responsible for FILE's directory.") (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 @@ 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-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 diff --git a/lisp/vc-mtn.el b/lisp/vc-mtn.el index 9f300a8f8eb..558889dcba6 100644 --- a/lisp/vc-mtn.el +++ b/lisp/vc-mtn.el @@ -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) diff --git a/lisp/vc-rcs.el b/lisp/vc-rcs.el index d6157171985..84cd589d4b7 100644 --- a/lisp/vc-rcs.el +++ b/lisp/vc-rcs.el @@ -102,8 +102,19 @@ For a description of possible values, see `vc-check-master-templates'." ;;; 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 @@ For a description of possible values, see `vc-check-master-templates'." 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 @@ 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 (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 @@ 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-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 @@ whether to remove it." 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 @@ file." ;; 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 diff --git a/lisp/vc-sccs.el b/lisp/vc-sccs.el index 481d37ecc61..ce1b977e7f6 100644 --- a/lisp/vc-sccs.el +++ b/lisp/vc-sccs.el @@ -102,6 +102,7 @@ For a description of possible values, see `vc-check-master-templates'." ;;; Properties of the backend (defun vc-sccs-revision-granularity () 'file) +(defun vc-sccs-checkout-model (files) 'locking) ;;; ;;; State-querying functions @@ -177,10 +178,6 @@ For a description of possible values, see `vc-check-master-templates'." (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) diff --git a/lisp/vc-svn.el b/lisp/vc-svn.el index 053c7fd1965..5ddedc364ae 100644 --- a/lisp/vc-svn.el +++ b/lisp/vc-svn.el @@ -91,8 +91,9 @@ If you want to force an empty list of arguments, use t." ;;; 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 @@ 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 (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. diff --git a/lisp/vc.el b/lisp/vc.el index 426f7660eda..0434bde7cad 100644 --- a/lisp/vc.el +++ b/lisp/vc.el @@ -1537,7 +1537,7 @@ Otherwise, throw an error." "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 @@ merge in the changes into your working copy." (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 @@ After check-out, runs the normal hook `vc-checkout-hook'." (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 @@ 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 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 @@ 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 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))))) -- 2.11.4.GIT