-(defun vc-cvs-stay-local-p (file)
- "Return non-nil if VC should stay local when handling FILE."
- (if vc-cvs-stay-local
- (let* ((dirname (if (file-directory-p file)
- (directory-file-name file)
- (file-name-directory file)))
- (prop
- (or (vc-file-getprop dirname 'vc-cvs-stay-local-p)
- (let ((rootname (expand-file-name "CVS/Root" dirname)))
- (vc-file-setprop
- dirname 'vc-cvs-stay-local-p
- (when (file-readable-p rootname)
- (with-temp-buffer
- (vc-insert-file rootname)
- (goto-char (point-min))
- (if (looking-at "\\([^:]*\\):")
- (if (not (stringp vc-cvs-stay-local))
- 'yes
- (let ((hostname (match-string 1)))
- (if (string-match vc-cvs-stay-local hostname)
- 'yes
- 'no)))
- 'no))))))))
- (if (eq prop 'yes) t nil))))
+(defun vc-cvs-command (buffer okstatus file &rest flags)
+ "A wrapper around `vc-do-command' for use in vc-cvs.el.
+The difference to vc-do-command is that this function always invokes `cvs',
+and that it passes `vc-cvs-global-switches' to it before FLAGS."
+ (apply 'vc-do-command buffer okstatus "cvs" file
+ (if (stringp vc-cvs-global-switches)
+ (cons vc-cvs-global-switches flags)
+ (append vc-cvs-global-switches
+ flags))))
+
+(defalias 'vc-cvs-stay-local-p 'vc-stay-local-p) ;Back-compatibility.
+
+(defun vc-cvs-repository-hostname (dirname)
+ "Hostname of the CVS server associated to workarea DIRNAME."
+ (let ((rootname (expand-file-name "CVS/Root" dirname)))
+ (when (file-readable-p rootname)
+ (with-temp-buffer
+ (let ((coding-system-for-read
+ (or file-name-coding-system
+ default-file-name-coding-system)))
+ (vc-insert-file rootname))
+ (goto-char (point-min))
+ (nth 2 (vc-cvs-parse-root
+ (buffer-substring (point)
+ (line-end-position))))))))
+
+(defun vc-cvs-parse-root (root)
+ "Split CVS ROOT specification string into a list of fields.
+A CVS root specification of the form
+ [:METHOD:][[USER@]HOSTNAME:]/path/to/repository
+is converted to a normalized record with the following structure:
+ \(METHOD USER HOSTNAME CVS-ROOT).
+The default METHOD for a CVS root of the form
+ /path/to/repository
+is `local'.
+The default METHOD for a CVS root of the form
+ [USER@]HOSTNAME:/path/to/repository
+is `ext'.
+For an empty string, nil is returned (invalid CVS root)."
+ ;; Split CVS root into colon separated fields (0-4).
+ ;; The `x:' makes sure, that leading colons are not lost;
+ ;; `HOST:/PATH' is then different from `:METHOD:/PATH'.
+ (let* ((root-list (cdr (split-string (concat "x:" root) ":")))
+ (len (length root-list))
+ ;; All syntactic varieties will get a proper METHOD.
+ (root-list
+ (cond
+ ((= len 0)
+ ;; Invalid CVS root
+ nil)
+ ((= len 1)
+ ;; Simple PATH => method `local'
+ (cons "local"
+ (cons nil root-list)))
+ ((= len 2)
+ ;; [USER@]HOST:PATH => method `ext'
+ (and (not (equal (car root-list) ""))
+ (cons "ext" root-list)))
+ ((= len 3)
+ ;; :METHOD:PATH
+ (cons (cadr root-list)
+ (cons nil (cddr root-list))))
+ (t
+ ;; :METHOD:[USER@]HOST:PATH
+ (cdr root-list)))))
+ (if root-list
+ (let ((method (car root-list))
+ (uhost (or (cadr root-list) ""))
+ (root (nth 2 root-list))
+ user host)
+ ;; Split USER@HOST
+ (if (string-match "\\(.*\\)@\\(.*\\)" uhost)
+ (setq user (match-string 1 uhost)
+ host (match-string 2 uhost))
+ (setq host uhost))
+ ;; Remove empty HOST
+ (and (equal host "")
+ (setq host))
+ ;; Fix windows style CVS root `:local:C:\\project\\cvs\\some\\dir'
+ (and host
+ (equal method "local")
+ (setq root (concat host ":" root) host))
+ ;; Normalize CVS root record
+ (list method user host root)))))