Mercurial > emacs
changeset 50668:01d84e9d30e0
Patch by Wolfgang Scherer <Wolfgang.Scherer@gmx.de>
(vc-cvs-stay-local): Allow lists of host regexps.
(vc-cvs-stay-local-p): Handle them.
(vc-cvs-parse-root): New function, used by the above.
| author | André Spiegel <spiegel@gnu.org> |
|---|---|
| date | Wed, 23 Apr 2003 12:49:25 +0000 |
| parents | c475369e6995 |
| children | c678565b9253 |
| files | lisp/vc-cvs.el |
| diffstat | 1 files changed, 110 insertions(+), 19 deletions(-) [+] |
line wrap: on
line diff
--- a/lisp/vc-cvs.el Tue Apr 22 19:03:18 2003 +0000 +++ b/lisp/vc-cvs.el Wed Apr 23 12:49:25 2003 +0000 @@ -5,7 +5,7 @@ ;; Author: FSF (see vc.el for full credits) ;; Maintainer: Andre Spiegel <spiegel@gnu.org> -;; $Id: vc-cvs.el,v 1.53 2003/04/05 15:51:14 spiegel Exp $ +;; $Id: vc-cvs.el,v 1.54 2003/04/19 22:40:18 monnier Exp $ ;; This file is part of GNU Emacs. @@ -81,15 +81,24 @@ :version "21.1" :group 'vc) -(defcustom vc-cvs-stay-local t +(defcustom vc-cvs-stay-local '(except "^\\(localhost\\)$") "*Non-nil means use local operations when possible for remote repositories. This avoids slow queries over the network and instead uses heuristics and past information to determine the current status of a file. -The value can also be a regular expression to match against the host name -of a repository; then VC only stays local for hosts that match it." +The value can also be a regular expression or list of regular +expressions to match against the host name of a repository; then VC +only stays local for hosts that match it. +This is useful in a setup, where most CVS servers should be contacted +directly, and only a few CVS servers cannot be reached easily. +For the opposite scenario, when only a few CVS servers are to be +queried directly, a list of regular expressions can be specified, +whose first element is the symbol `except'." :type '(choice (const :tag "Always stay local" t) - (string :tag "Host regexp") - (const :tag "Don't stay local" nil)) + (const :tag "Don't stay local" nil) + (list :format "\nExamine hostname and %v" :tag "Examine hostname ..." + (set :format "%v" :inline t (const :format "%t" :tag "don't" except)) + (regexp :format " stay local,\n%t: %v" :tag "if it matches") + (repeat :format "%v%i\n" :inline t (regexp :tag "or")))) :version "21.1" :group 'vc) @@ -715,7 +724,8 @@ flags)))) (defun vc-cvs-stay-local-p (file) - "Return non-nil if VC should stay local when handling FILE." + "Return non-nil if VC should stay local when handling FILE. +See `vc-cvs-stay-local'." (if vc-cvs-stay-local (let* ((dirname (if (file-directory-p file) (directory-file-name file) @@ -726,18 +736,99 @@ (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)))) + (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 (nth 2 cvs-root-members))) + (if (not hostname) + 'no + (let ((stay-local t) rx) + (cond + ;; vc-cvs-stay-local: rx + ((stringp vc-cvs-stay-local) + (setq rx vc-cvs-stay-local)) + ;; vc-cvs-stay-local: '( [except] rx ... ) + ((consp vc-cvs-stay-local) + (setq rx (mapconcat + (function + (lambda (elt) + elt)) + (if (not (eq (car vc-cvs-stay-local) + 'except)) + vc-cvs-stay-local + (setq stay-local nil) + (cdr vc-cvs-stay-local)) + "\\|")))) + (if (not rx) + 'yes + (if (not (string-match rx hostname)) + (setq stay-local (not stay-local))) + (if stay-local + 'yes + 'no)))))))))))) + (if (eq prop 'yes) t nil)))) + +(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 (illegal 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))))) (defun vc-cvs-parse-status (&optional full) "Parse output of \"cvs status\" command in the current buffer.