From mboxrd@z Thu Jan 1 00:00:00 1970 Path: main.gmane.org!not-for-mail From: Wolfgang Scherer Newsgroups: gmane.emacs.bugs Subject: vc-cvs-stay-local-p Date: Tue, 23 Apr 2002 00:41:03 +0200 Sender: bug-gnu-emacs-admin@gnu.org Message-ID: <15556.37247.565817.511577@farmer.simul.de> NNTP-Posting-Host: localhost.gmane.org Mime-Version: 1.0 Content-Type: text/plain; charset=us-ascii Content-Transfer-Encoding: 7bit X-Trace: main.gmane.org 1019516958 31716 127.0.0.1 (22 Apr 2002 23:09:18 GMT) X-Complaints-To: usenet@main.gmane.org NNTP-Posting-Date: Mon, 22 Apr 2002 23:09:18 +0000 (UTC) Return-path: Original-Received: from fencepost.gnu.org ([199.232.76.164]) by main.gmane.org with esmtp (Exim 3.33 #1 (Debian)) id 16zmvt-0008FQ-00 for ; Tue, 23 Apr 2002 01:09:17 +0200 Original-Received: from localhost ([127.0.0.1] helo=fencepost.gnu.org) by fencepost.gnu.org with esmtp (Exim 3.34 #1 (Debian)) id 16zmvr-0000Z1-00; Mon, 22 Apr 2002 19:09:15 -0400 Original-Received: from mailout07.sul.t-online.com ([194.25.134.83]) by fencepost.gnu.org with esmtp (Exim 3.34 #1 (Debian)) id 16zmv7-0000TO-00 for ; Mon, 22 Apr 2002 19:08:29 -0400 Original-Received: from fwd09.sul.t-online.de by mailout07.sul.t-online.com with smtp id 16zmjT-00014k-03; Tue, 23 Apr 2002 00:56:27 +0200 Original-Received: from farmer.simul.de (520043676698-0001@[217.84.40.213]) by fmrl09.sul.t-online.com with esmtp id 16zmjM-1zCSY4C; Tue, 23 Apr 2002 00:56:20 +0200 Original-Received: (from ws@localhost) by farmer.simul.de (8.11.6/8.10.2/SuSE Linux 8.10.0-0.3) id g3MMfL716879; Tue, 23 Apr 2002 00:41:21 +0200 Original-To: bug-gnu-emacs@gnu.org X-Mailer: VM 7.04 under Emacs 21.1.1 X-Sender: 520043676698-0001@t-dialin.net Errors-To: bug-gnu-emacs-admin@gnu.org X-BeenThere: bug-gnu-emacs@gnu.org X-Mailman-Version: 2.0.9 Precedence: bulk List-Help: List-Post: List-Subscribe: , List-Id: Bug reports for GNU Emacs, the Swiss army knife of text editors List-Unsubscribe: , List-Archive: Xref: main.gmane.org gmane.emacs.bugs:875 X-Report-Spam: http://spam.gmane.org/gmane.emacs.bugs:875 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: C-s c v s C-s C-s C-x o C-SPC M-w 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