/[emacs]/emacs/lisp/vc-cvs.el
ViewVC logotype

Diff of /emacs/lisp/vc-cvs.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.54 by monnier, Sat Apr 19 22:40:18 2003 UTC revision 1.55 by spiegel, Wed Apr 23 12:49:25 2003 UTC
# Line 81  This is only meaningful if you don't use Line 81  This is only meaningful if you don't use
81    :version "21.1"    :version "21.1"
82    :group 'vc)    :group 'vc)
83    
84  (defcustom vc-cvs-stay-local t  (defcustom vc-cvs-stay-local '(except "^\\(localhost\\)$")
85    "*Non-nil means use local operations when possible for remote repositories.    "*Non-nil means use local operations when possible for remote repositories.
86  This avoids slow queries over the network and instead uses heuristics  This avoids slow queries over the network and instead uses heuristics
87  and past information to determine the current status of a file.  and past information to determine the current status of a file.
88  The value can also be a regular expression to match against the host name  The value can also be a regular expression or list of regular
89  of a repository; then VC only stays local for hosts that match it."  expressions to match against the host name of a repository; then VC
90    only stays local for hosts that match it.
91    This is useful in a setup, where most CVS servers should be contacted
92    directly, and only a few CVS servers cannot be reached easily.
93    For the opposite scenario, when only a few CVS servers are to be
94    queried directly, a list of regular expressions can be specified,
95    whose first element is the symbol `except'."
96    :type '(choice (const :tag "Always stay local" t)    :type '(choice (const :tag "Always stay local" t)
97                   (string :tag "Host regexp")                  (const :tag "Don't stay local" nil)
98                   (const :tag "Don't stay local" nil))                   (list :format "\nExamine hostname and %v" :tag "Examine hostname ..."
99                           (set :format "%v" :inline t (const :format "%t" :tag "don't" except))
100                           (regexp :format " stay local,\n%t: %v" :tag "if it matches")
101                           (repeat :format "%v%i\n" :inline t (regexp :tag "or"))))
102    :version "21.1"    :version "21.1"
103    :group 'vc)    :group 'vc)
104    
# Line 715  and that it passes `vc-cvs-global-switch Line 724  and that it passes `vc-cvs-global-switch
724                     flags))))                     flags))))
725    
726  (defun vc-cvs-stay-local-p (file)  (defun vc-cvs-stay-local-p (file)
727    "Return non-nil if VC should stay local when handling FILE."    "Return non-nil if VC should stay local when handling FILE.
728    See `vc-cvs-stay-local'."
729    (if vc-cvs-stay-local    (if vc-cvs-stay-local
730        (let* ((dirname (if (file-directory-p file)        (let* ((dirname (if (file-directory-p file)
731                            (directory-file-name file)                            (directory-file-name file)
# Line 726  and that it passes `vc-cvs-global-switch Line 736  and that it passes `vc-cvs-global-switch
736                      (vc-file-setprop                      (vc-file-setprop
737                       dirname 'vc-cvs-stay-local-p                       dirname 'vc-cvs-stay-local-p
738                       (when (file-readable-p rootname)                       (when (file-readable-p rootname)
739                         (with-temp-buffer                        (with-temp-buffer
740                           (vc-insert-file rootname)                          (vc-insert-file rootname)
741                           (goto-char (point-min))                          (goto-char (point-min))
742                           (if (looking-at "\\([^:]*\\):")                           (looking-at "\\([^\n]*\\)")
743                               (if (not (stringp vc-cvs-stay-local))                           (let* ((cvs-root-members
744                                   'yes                                   (vc-cvs-parse-root (match-string 1)))
745                                 (let ((hostname (match-string 1)))                                  (hostname (nth 2 cvs-root-members)))
746                                   (if (string-match vc-cvs-stay-local hostname)                             (if (not hostname)
747                                       'yes                                 'no
748                                     'no)))                               (let ((stay-local t) rx)
749                             'no))))))))                                 (cond
750          (if (eq prop 'yes) t nil))))                                  ;; vc-cvs-stay-local: rx
751                                    ((stringp vc-cvs-stay-local)
752                                     (setq rx vc-cvs-stay-local))
753                                    ;; vc-cvs-stay-local: '( [except] rx ... )
754                                    ((consp vc-cvs-stay-local)
755                                     (setq rx (mapconcat
756                                               (function
757                                                (lambda (elt)
758                                                  elt))
759                                               (if (not (eq (car vc-cvs-stay-local)
760                                                            'except))
761                                                   vc-cvs-stay-local
762                                                 (setq stay-local nil)
763                                                 (cdr vc-cvs-stay-local))
764                                               "\\|"))))
765                                   (if (not rx)
766                                    'yes
767                                     (if (not (string-match rx hostname))
768                                         (setq stay-local (not stay-local)))
769                                     (if stay-local
770                                        'yes
771                                       'no))))))))))))
772           (if (eq prop 'yes) t nil))))
773    
774    (defun vc-cvs-parse-root ( root )
775      "Split CVS ROOT specification string into a list of fields.
776    A CVS root specification of the form
777      [:METHOD:][[USER@]HOSTNAME:]/path/to/repository
778    is converted to a normalized record with the following structure:
779      \(METHOD USER HOSTNAME CVS-ROOT).
780    The default METHOD for a CVS root of the form
781      /path/to/repository
782    is `local'.
783    The default METHOD for a CVS root of the form
784      [USER@]HOSTNAME:/path/to/repository
785    is `ext'.
786    For an empty string, nil is returned (illegal CVS root)."
787      ;; Split CVS root into colon separated fields (0-4).
788      ;; The `x:' makes sure, that leading colons are not lost;
789      ;; `HOST:/PATH' is then different from `:METHOD:/PATH'.
790      (let* ((root-list (cdr (split-string (concat "x:" root) ":")))
791             (len (length root-list))
792             ;; All syntactic varieties will get a proper METHOD.
793             (root-list
794              (cond
795               ((= len 0)
796                ;; Invalid CVS root
797                nil)
798               ((= len 1)
799                ;; Simple PATH => method `local'
800                (cons "local"
801                      (cons nil root-list)))
802               ((= len 2)
803                ;; [USER@]HOST:PATH => method `ext'
804                (and (not (equal (car root-list) ""))
805                     (cons "ext" root-list)))
806               ((= len 3)
807                ;; :METHOD:PATH
808                (cons (cadr root-list)
809                      (cons nil (cddr root-list))))
810               (t
811                ;; :METHOD:[USER@]HOST:PATH
812                (cdr root-list)))))
813        (if root-list
814            (let ((method (car root-list))
815                  (uhost (or (cadr root-list) ""))
816                  (root (nth 2 root-list))
817                  user host)
818              ;; Split USER@HOST
819              (if (string-match "\\(.*\\)@\\(.*\\)" uhost)
820                  (setq user (match-string 1 uhost)
821                        host (match-string 2 uhost))
822                (setq host uhost))
823              ;; Remove empty HOST
824              (and (equal host "")
825                   (setq host))
826              ;; Fix windows style CVS root `:local:C:\\project\\cvs\\some\\dir'
827              (and host
828                   (equal method "local")
829                   (setq root (concat host ":" root) host))
830              ;; Normalize CVS root record
831              (list method user host root)))))
832    
833  (defun vc-cvs-parse-status (&optional full)  (defun vc-cvs-parse-status (&optional full)
834    "Parse output of \"cvs status\" command in the current buffer.    "Parse output of \"cvs status\" command in the current buffer.

Legend:
Removed from v.1.54  
changed lines
  Added in v.1.55

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26