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 |
|
|
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) |
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. |