[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
vc-cvs-stay-local-p
|
From: |
Wolfgang Scherer |
|
Subject: |
vc-cvs-stay-local-p |
|
Date: |
Tue, 23 Apr 2002 00:41:03 +0200 |
This bug report will be sent to the Free Software Foundation,
not to your local site managers!
Please write in English, because the Emacs maintainers do not have
translators to read other languages for them.
Your bug report will be posted to the bug-gnu-emacs@gnu.org mailing list,
and to the gnu.emacs.bug news group.
In GNU Emacs 21.1.1 (i386-suse-linux, X toolkit, Xaw3d scroll bars)
of 2002-03-25 on stephens
configured using `configure --with-gcc --with-pop --with-system-malloc
--prefix=/usr --exec-prefix=/usr --infodir=/usr/share/info
--mandir=/usr/share/man --sharedstatedir=/var/lib --libexecdir=/usr/lib
--with-x --with-xpm --with-jpeg --with-tiff --with-gif --with-png
--with-x-toolkit=lucid --x-includes=/usr/X11R6/include
--x-libraries=/usr/X11R6/lib i386-suse-linux CC=gcc 'CFLAGS=-O2 -march=i486
-mcpu=i686 -pipe -DSYSTEM_PURESIZE_EXTRA=25000
-DSITELOAD_PURESIZE_EXTRA=10000 -D_GNU_SOURCE ' LDFLAGS=-s
build_alias=i386-suse-linux host_alias=i386-suse-linux
target_alias=i386-suse-linux'
Important settings:
value of $LC_ALL: nil
value of $LC_COLLATE: POSIX
value of $LC_CTYPE: nil
value of $LC_MESSAGES: nil
value of $LC_MONETARY: nil
value of $LC_NUMERIC: nil
value of $LC_TIME: nil
value of $LANG: german
locale-coding-system: iso-latin-1
default-enable-multibyte-characters: nil
Please describe exactly what actions triggered the bug
and the precise symptoms of the bug:
The function `vc-cvs-stay-local-p' from vc-cvs.el does not work as
advertised.
The first section shows how I fixed it.
The second part contains the problem analysis (right below
`vct-vc-cvs-stay-local-algo-orig').
(defvar vc-cvs-go-remote "localhost\\|cvs"
"Regexp matching CVS remote hosts to be always contacted regardless
of `vc-cvs-stay-local'.")
(defun vcext-cvs-stay-local-p (file)
"Return non-nil if VC should stay local when handling FILE.
This function is modified to use the variable `vc-cvs-go-remote'."
(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))
(looking-at "\\([^\n]*\\)")
(let ((cvs-root-members
(vc-cvs-parse-root (match-string 1)))
hostname)
(if (or (vc-cvs-root-is-local-p cvs-root-members)
(not (setq hostname (nth 2
cvs-root-members))))
'no
(if (and vc-cvs-go-remote
(string-match vc-cvs-go-remote hostname))
'no
(if (not (stringp vc-cvs-stay-local))
'yes
(if (string-match vc-cvs-stay-local hostname)
'yes
'no))))))))))))
(if (eq prop 'yes) t nil))))
(defun vc-cvs-root-is-local-p ( root )
"Return t if CVS ROOT is local.
ROOT can be a string or root list."
(let ((root-list (or (and (listp root) root)
(vc-cvs-parse-root root))))
(or (not root-list)
(equal (car root-list) "local"))))
(defun vc-cvs-parse-root ( root )
"Parse CVS ROOT into fields.
\( method user hostname cvs-root)"
(let* ((root-list (cdr (split-string (concat "x:" root) ":")))
(len (length root-list))
(root-list
(cond
((= len 0) nil)
((= len 1)
(cons "local"
(cons nil root-list)))
((= len 2)
(cons "ext" root-list))
((= len 3)
(cons (cadr root-list)
(cons nil (cddr root-list))))
(t (cdr root-list)))))
(let* ((method (car root-list))
(uhost (split-string (or (cadr root-list) "") "@"))
(root (nth 2 root-list))
user host)
(if (< (length uhost) 2)
(setq host (car uhost))
(setq user (car uhost))
(setq host (cadr uhost)))
(and (equal method "local")
host
(setq root (concat host ":" root) host))
(and root-list
(list method user host root)))))
(eval-after-load "vc-cvs" '(defalias 'vc-cvs-stay-local-p
'vcext-cvs-stay-local-p))
;; @ Essence of cvs.info
(defvar vct-cvs-roots
'(
"" ; invalid
"/home/master" ; local
":local:/home/master" ; local
"farmer:/home/master" ; ext
"cvs:/home/master" ; ext
"ws@localhost:/home/master" ; ext
":ext:ws@localhost:/home/master" ; ext
":server:ws@localhost:/home/master" ; server
":pserver:ws@localhost:/cvsroot-kurs" ; pserver
":pserver:ws@cvs:/cvsroot-devel" ; pserver
":kserver:cvs:/cvsroot-devel" ; pserver
":gserver:cvs:/cvsroot-devel" ; pserver
":fork:/home/master" ; fork
":local:C:\\project\\cvs\\some\\dir" ; MSDOS
)
"Various CVSROOTs for testing.")
(defun vct-vc-cvs-stay-local-algo-orig ( vct-root )
"Original algorithm of `vc-cvs-stay-local-p'."
(if (string-match "\\([^:]*\\):" vct-root)
(if (not (stringp vc-cvs-stay-local))
'yes
(let ((hostname (match-string 1 vct-root)))
(princ (format ";; Hostname : %S\n" hostname))
(if (string-match vc-cvs-stay-local hostname)
'yes
'no)))
'no))
;; --------------------
;; vc-cvs-go-remote : nil
;; vc-cvs-stay-local: t
;; --------------------
;; CVSROOT : ""
;; Stay local? : no
;; --------------------
;; CVSROOT : "/home/master"
;; Stay local? : no
;; --------------------
;; CVSROOT : ":local:/home/master"
;; Stay local? : yes
;; --------------------
;; CVSROOT : "farmer:/home/master"
;; Stay local? : yes
;; --------------------
;; CVSROOT : "cvs:/home/master"
;; Stay local? : yes
;; --------------------
;; CVSROOT : "ws@localhost:/home/master"
;; Stay local? : yes
;; --------------------
;; CVSROOT : ":ext:ws@localhost:/home/master"
;; Stay local? : yes
;; --------------------
;; CVSROOT : ":server:ws@localhost:/home/master"
;; Stay local? : yes
;; --------------------
;; CVSROOT : ":pserver:ws@localhost:/cvsroot-kurs"
;; Stay local? : yes
;; --------------------
;; CVSROOT : ":pserver:ws@cvs:/cvsroot-devel"
;; Stay local? : yes
;; --------------------
;; CVSROOT : ":kserver:cvs:/cvsroot-devel"
;; Stay local? : yes
;; --------------------
;; CVSROOT : ":gserver:cvs:/cvsroot-devel"
;; Stay local? : yes
;; --------------------
;; CVSROOT : ":fork:/home/master"
;; Stay local? : yes
;; --------------------
;; CVSROOT : ":local:C:\\project\\cvs\\some\\dir"
;; Stay local? : yes
;; --------------------
;; vc-cvs-go-remote : nil
;; vc-cvs-stay-local: "cvs"
;; --------------------
;; CVSROOT : ""
;; Stay local? : no
;; --------------------
;; CVSROOT : "/home/master"
;; Stay local? : no
;; --------------------
;; CVSROOT : ":local:/home/master"
;; Hostname : ""
;; Stay local? : no
;; --------------------
;; CVSROOT : "farmer:/home/master"
;; Hostname : "farmer"
;; Stay local? : no
;; --------------------
;; CVSROOT : "cvs:/home/master"
;; Hostname : "cvs"
;; Stay local? : yes
;; --------------------
;; CVSROOT : "ws@localhost:/home/master"
;; Hostname : "ws@localhost"
;; Stay local? : no
;; --------------------
;; CVSROOT : ":ext:ws@localhost:/home/master"
;; Hostname : ""
;; Stay local? : no
;; --------------------
;; CVSROOT : ":server:ws@localhost:/home/master"
;; Hostname : ""
;; Stay local? : no
;; --------------------
;; CVSROOT : ":pserver:ws@localhost:/cvsroot-kurs"
;; Hostname : ""
;; Stay local? : no
;; --------------------
;; CVSROOT : ":pserver:ws@cvs:/cvsroot-devel"
;; Hostname : ""
;; Stay local? : no
;; --------------------
;; CVSROOT : ":kserver:cvs:/cvsroot-devel"
;; Hostname : ""
;; Stay local? : no
;; --------------------
;; CVSROOT : ":gserver:cvs:/cvsroot-devel"
;; Hostname : ""
;; Stay local? : no
;; --------------------
;; CVSROOT : ":fork:/home/master"
;; Hostname : ""
;; Stay local? : no
;; --------------------
;; CVSROOT : ":local:C:\\project\\cvs\\some\\dir"
;; Hostname : ""
;; Stay local? : no
(defun vct-vc-cvs-stay-local-algo-new ( vct-root )
"New algorithm for `vc-cvs-stay-local-p'."
(let* ((root-list (vc-cvs-parse-root vct-root))
hostname)
(if (or (vc-cvs-root-is-local-p root-list)
(not (setq hostname (nth 2 root-list))))
'no
(princ (format ";; Hostname : %S\n" hostname))
(if (and vc-cvs-go-remote
(string-match vc-cvs-go-remote hostname))
'no
(if (not (stringp vc-cvs-stay-local))
'yes
(if (string-match vc-cvs-stay-local hostname)
'yes
'no))))))
(defun vc-cvs-parse-root-raw ( root )
"Parse CVS ROOT in raw form."
(cdr (split-string (concat "x:" root) ":")))
;; --------------------
;; => [0] nil
;; --------------------
;; => [1] ("/home/master")
;; --------------------
;; => [3] ("" "local" "/home/master")
;; --------------------
;; => [2] ("farmer" "/home/master")
;; --------------------
;; => [2] ("ws@localhost" "/home/master")
;; --------------------
;; => [4] ("" "ext" "ws@localhost" "/home/master")
;; --------------------
;; => [4] ("" "server" "ws@localhost" "/home/master")
;; --------------------
;; => [4] ("" "pserver" "ws@localhost" "/cvsroot-kurs")
;; --------------------
;; => [4] ("" "pserver" "ws@cvs" "/cvsroot-devel")
;; --------------------
;; => [4] ("" "kserver" "cvs" "/cvsroot-devel")
;; --------------------
;; => [4] ("" "gserver" "cvs" "/cvsroot-devel")
;; --------------------
;; => [3] ("" "fork" "/home/master")
;; --------------------
;; => [4] ("" "local" "C" "\\project\\cvs\\some\\dir")
(defun vc-cvs-parse-root ( root )
"Parse CVS ROOT into fields.
\( method user hostname cvs-root)"
(let* ((root-list (cdr (split-string (concat "x:" root) ":")))
(len (length root-list))
(root-list
(cond
((= len 0) nil)
((= len 1)
(cons "local"
(cons nil root-list)))
((= len 2)
(cons "ext" root-list))
((= len 3)
(cons (cadr root-list)
(cons nil (cddr root-list))))
(t (cdr root-list)))))
(let* ((method (car root-list))
(uhost (split-string (or (cadr root-list) "") "@"))
(root (nth 2 root-list))
user host)
(if (< (length uhost) 2)
(setq host (car uhost))
(setq user (car uhost))
(setq host (cadr uhost)))
(and (equal method "local")
host
(setq root (concat host ":" root) host))
(and root-list
(list method user host root)))))
;; --------------------
;; => [0] nil
;; --------------------
;; => [4] ("local" nil nil "/home/master")
;; --------------------
;; => [4] ("local" nil nil "/home/master")
;; --------------------
;; => [4] ("ext" nil "farmer" "/home/master")
;; --------------------
;; => [4] ("ext" "ws" "localhost" "/home/master")
;; --------------------
;; => [4] ("ext" "ws" "localhost" "/home/master")
;; --------------------
;; => [4] ("server" "ws" "localhost" "/home/master")
;; --------------------
;; => [4] ("pserver" "ws" "localhost" "/cvsroot-kurs")
;; --------------------
;; => [4] ("pserver" "ws" "cvs" "/cvsroot-devel")
;; --------------------
;; => [4] ("kserver" nil "cvs" "/cvsroot-devel")
;; --------------------
;; => [4] ("gserver" nil "cvs" "/cvsroot-devel")
;; --------------------
;; => [4] ("fork" nil nil "/home/master")
;; --------------------
;; => [4] ("local" nil nil "C:\\project\\cvs\\some\\dir")
(if t nil
(defun vc-cvs-root-is-local-p ( root ) [...] ))
;; --------------------
;; => [1] t
;; --------------------
;; => [1] t
;; --------------------
;; => [1] t
;; --------------------
;; => [0] nil
;; --------------------
;; => [0] nil
;; --------------------
;; => [0] nil
;; --------------------
;; => [0] nil
;; --------------------
;; => [0] nil
;; --------------------
;; => [0] nil
;; --------------------
;; => [0] nil
;; --------------------
;; => [0] nil
;; --------------------
;; => [0] nil
;; --------------------
;; => [1] t
(defun vc-cvs-root-is-local-p-list-test (root)
"Test `vc-cvs-root-is-local-p' with parsed list."
(vc-cvs-root-is-local-p (vc-cvs-parse-root root)))
(defun vct-parse-root-test ( parse-func )
"Run test on `vc-cvs-parse-root'."
(with-output-to-temp-buffer "*vc-cvs-parse-root-test*"
(mapcar
(function
(lambda (vct-root)
(princ ";; --------------------\n")
;;(princ (format ";; (%s %S)\n" parse-func (concat vct-root)))
(let ((root-list
(funcall parse-func vct-root)))
(princ (format ";; => [%d] %S\n"
(or (and (sequencep root-list)
(length root-list))
1)
root-list)))))
vct-cvs-roots)))
(defun vct-vc-cvs-stay-local-test (algo &optional vct-roots go-remote
stay-local)
"Test algorithm for `vc-cvs-stay-local'.
Runs function ALGO as stay local matcher on VCT-ROOTS and displays
result in temporary buffer."
(let (
(vc-cvs-go-remote go-remote)
(vc-cvs-stay-local stay-local)
hostname
result
(temp-buffer-show-hook
(function
(lambda nil
(setq result (buffer-string)))))
)
(or vct-roots
(setq vct-roots vct-cvs-roots))
(with-output-to-temp-buffer "*vc-cvs-stay-local-test*"
(princ ";; --------------------\n")
(princ (format ";; vc-cvs-go-remote : %S\n" vc-cvs-go-remote))
(princ (format ";; vc-cvs-stay-local: %S\n" vc-cvs-stay-local))
(mapcar
(function
(lambda (vct-root)
(princ ";; --------------------\n")
(princ (format ";; CVSROOT : %S\n" vct-root))
(princ (format ";; Stay local? : %s\n" (funcall algo vct-root)))
))
vct-roots))
result))
;; |:here:|
;; From cvs.info
;; Node: The Repository
;; CVS can access a repository by a variety of means. It might be on
;; the local computer, or it might be on a computer across the room or
;; across the world. To distinguish various ways to access a repository,
;; the repository name can start with an "access method". For example,
;; the access method `:local:' means to access a repository directory, so
;; the repository `:local:/usr/local/cvsroot' means that the repository is
;; in `/usr/local/cvsroot' on the computer running CVS. For information
;; on other access methods, see *Note Remote repositories::.
;; If the access method is omitted, then if the repository does not
;; contain `:', then `:local:' is assumed. If it does contain `:' then
;; either `:ext:' or `:server:' is assumed. For example, if you have a
;; local repository in `/usr/local/cvsroot', you can use
;; `/usr/local/cvsroot' instead of `:local:/usr/local/cvsroot'. But if
;; (under Windows NT, for example) your local repository is
;; `c:\src\cvsroot', then you must specify the access method, as in
;; `:local:c:\src\cvsroot'.
;; Node: Remote repositories
;; :METHOD:USER@HOSTNAME:/path/to/repository
; [ .. ]
;; If METHOD is not specified, and the repository name contains `:',
;; then the default is `ext' or `server', depending on your platform; both
;; are described in *Note Connecting via rsh::.
;; There are two access methods that you use in `CVSROOT' for rsh.
;; `:server:' specifies an internal rsh client, which is supported only by
;; some CVS ports. `:ext:' specifies an external rsh program.
;; [ .. ]
;; Continuing our example, supposing you want to access the module
;; `foo' in the repository `/usr/local/cvsroot/', on machine
;; `faun.example.org', you are ready to go:
;; cvs -d :ext:bach@faun.example.org:/usr/local/cvsroot checkout foo
;; [ .. ]
;; To run a CVS command on a remote repository via the
;; password-authenticating server, one specifies the `pserver' protocol,
;; username, repository host, and path to the repository. For example:
;; cvs -d :pserver:bach@faun.example.org:/usr/local/cvsroot checkout
someproj
;; [ .. ]
;; To connect using GSSAPI, use `:gserver:'. For example,
;; cvs -d :gserver:faun.example.org:/usr/local/cvsroot checkout foo
;; [ .. ]
;; When you want to use CVS, get a ticket in the usual way (generally
;; `kinit'); it must be a ticket which allows you to log into the server
;; machine. Then you are ready to go:
;; cvs -d :kserver:faun.example.org:/usr/local/cvsroot checkout foo
;; [ .. ]
;; To connect using the `fork' method, use `:fork:' and the pathname to
;; your local repository. For example:
;; cvs -d :fork:/usr/local/cvsroot checkout foo
;; |:here:|
;;;
;;; :ide-menu: Emacs IDE Main Menu - Buffer @BUFFER@
;;; . M-x `eIDE-menu' ()(eIDE-menu "z")
;;; :ide: TPL: (mapcar ... )
;;; . (insert " (mapcar\n (function\n (lambda (elt)\n
\:here\:\n ))\n \:here\:)\n" )
;;; :ide: SEXP: "(looking-at \"\\\\([^:]+\\\\):\\\\([^:]+\\\\):\")"
;;; . (with-output-to-temp-buffer "*vct*" (princ (looking-at
":?\\([^:\n]+\\):\\(\\([^:\n]+\\):\\)?")) (princ "\n") (princ (format "(1):
%S\n" (match-string 1))) (princ (format "(3): %S\n" (match-string 3))))
;;; :ide: -
;;; . ()
;;; :ide: TEST: Run with 'vct-vc-cvs-stay-local-algo-new nil "cvs" t
;;; . (vct-vc-cvs-stay-local-test 'vct-vc-cvs-stay-local-algo-new nil "cvs" t)
;;; :ide: TEST: Run with 'vct-vc-cvs-stay-local-algo-new nil nil "cvs"
;;; . (vct-vc-cvs-stay-local-test 'vct-vc-cvs-stay-local-algo-new nil nil "cvs")
;;; :ide: TEST: Run with 'vct-vc-cvs-stay-local-algo-new nil nil t
;;; . (vct-vc-cvs-stay-local-test 'vct-vc-cvs-stay-local-algo-new nil nil t)
;;; :ide: -
;;; . ()
;;; :ide: TEST: Run with 'vct-vc-cvs-stay-local-algo-orig nil nil "cvs"
;;; . (vct-vc-cvs-stay-local-test 'vct-vc-cvs-stay-local-algo-orig nil nil
"cvs")
;;; :ide: TEST: Run with 'vct-vc-cvs-stay-local-algo-orig nil nil t
;;; . (vct-vc-cvs-stay-local-test 'vct-vc-cvs-stay-local-algo-orig nil nil t)
;;; :ide: -
;;; . ()
;;; :ide: TEST: (vct-parse-root-test 'vc-cvs-root-is-local-p-list-test)
;;; . (vct-parse-root-test (quote vc-cvs-root-is-local-p-list-test))
;;; :ide: TEST: (vct-parse-root-test 'vc-cvs-root-is-local-p)
;;; . (vct-parse-root-test (quote vc-cvs-root-is-local-p))
;;; :ide: -
;;; . ()
;;; :ide: TEST: (vct-parse-root-test 'vc-cvs-parse-root)
;;; . (vct-parse-root-test (quote vc-cvs-parse-root))
;;; :ide: TEST: (vct-parse-root-test 'vc-cvs-parse-root-raw)
;;; . (vct-parse-root-test (quote vc-cvs-parse-root-raw))
;;;
Recent input:
<triple-mouse-4> <triple-down-mouse-4> <triple-mouse-4>
<triple-down-mouse-4> <triple-mouse-4> <triple-down-mouse-4>
<triple-mouse-4> <triple-down-mouse-4> <triple-mouse-4>
<down-mouse-5> <mouse-5> <double-down-mouse-5> <double-mouse-5>
<triple-down-mouse-5> <triple-mouse-5> <triple-down-mouse-5>
<triple-mouse-5> <triple-down-mouse-5> <triple-mouse-5>
<triple-down-mouse-5> <triple-mouse-5> <triple-down-mouse-5>
<triple-mouse-5> <triple-down-mouse-5> <triple-mouse-5>
<triple-down-mouse-5> <triple-mouse-5> <triple-down-mouse-5>
<triple-mouse-5> <triple-down-mouse-5> <triple-mouse-5>
<triple-down-mouse-5> <triple-mouse-5> <triple-down-mouse-5>
<triple-mouse-5> <triple-down-mouse-5> <triple-mouse-5>
<triple-down-mouse-5> <triple-mouse-5> <triple-down-mouse-5>
<triple-mouse-5> <triple-down-mouse-5> <triple-mouse-5>
<triple-down-mouse-5> <triple-mouse-5> <triple-down-mouse-5>
<triple-mouse-5> <triple-down-mouse-5> <triple-mouse-5>
<triple-down-mouse-5> <triple-mouse-5> <triple-down-mouse-5>
<triple-mouse-5> <help-echo> <help-echo> <help-echo>
<help-echo> <menu-bar> <help-menu> <emacs-problems>
C-s c v s C-s C-s <C-prior> C-x o <M-S-return> <return>
<C-home> <down> <down> <down> <down> <down> <down>
<down> <down> <down> <down> <down> <C-right> <C-right>
<C-left> C-SPC <end> M-w <home> <help-echo> <help-echo>
<help-echo> <help-echo> <help-echo> <help-echo> <help-echo>
<menu-bar> <help-menu> <report-emacs-bug>
Recent messages:
Scanning buffer for index ( 87%)
Scanning buffer for index ( 99%)
Scanning buffer for index (100%)
Mark set
wheelx-scroll-down: Beginning of buffer [15 times]
Note: file is write protected
Type C-h for help, h for commands, q to quit.
Mark saved where search started
Mark set [2 times]
Loading emacsbug...done
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- vc-cvs-stay-local-p,
Wolfgang Scherer <=