(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
;;;
(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
;; 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:
((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))
;; 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
;;;
(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:
(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))
(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
;; - 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
;;; BACKEND PROPERTIES
-(defun vc-git-revision-granularity ()
- 'repository)
+(defun vc-git-revision-granularity () 'repository)
+(defun vc-git-checkout-model (files) 'implicit)
;;; STATE-QUERYING FUNCTIONS
(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)))
;; - 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
\f
;;; 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
(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)))
(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)))))
(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)
;;; 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
(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
;;;
(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))
(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
;;;###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)
\f
;;; 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
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))))))
(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,
(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))
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
;; 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
;;; Properties of the backend
(defun vc-sccs-revision-granularity () 'file)
+(defun vc-sccs-checkout-model (files) 'locking)
;;;
;;; State-querying functions
(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)
;;; 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
;;;
(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.
"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)
(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)
(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
(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
(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)))))