git-gui: Add support for adding remotes
[git/dscho.git] / lib / remote.tcl
blob643f0bc543411093e034297fdce95f60acc42216
1 # git-gui remote management
2 # Copyright (C) 2006, 2007 Shawn Pearce
4 set some_heads_tracking 0; # assume not
6 proc is_tracking_branch {name} {
7 global tracking_branches
8 foreach spec $tracking_branches {
9 set t [lindex $spec 0]
10 if {$t eq $name || [string match $t $name]} {
11 return 1
14 return 0
17 proc all_tracking_branches {} {
18 global tracking_branches
20 set all [list]
21 set pat [list]
22 set cmd [list]
24 foreach spec $tracking_branches {
25 set dst [lindex $spec 0]
26 if {[string range $dst end-1 end] eq {/*}} {
27 lappend pat $spec
28 lappend cmd [string range $dst 0 end-2]
29 } else {
30 lappend all $spec
34 if {$pat ne {}} {
35 set fd [eval git_read for-each-ref --format=%(refname) $cmd]
36 while {[gets $fd n] > 0} {
37 foreach spec $pat {
38 set dst [string range [lindex $spec 0] 0 end-2]
39 set len [string length $dst]
40 if {[string equal -length $len $dst $n]} {
41 set src [string range [lindex $spec 2] 0 end-2]
42 set spec [list \
43 $n \
44 [lindex $spec 1] \
45 $src[string range $n $len end] \
47 lappend all $spec
51 close $fd
54 return [lsort -index 0 -unique $all]
57 proc load_all_remotes {} {
58 global repo_config
59 global all_remotes tracking_branches some_heads_tracking
60 global remote_url
62 set some_heads_tracking 0
63 set all_remotes [list]
64 set trck [list]
66 set rh_str refs/heads/
67 set rh_len [string length $rh_str]
68 set rm_dir [gitdir remotes]
69 if {[file isdirectory $rm_dir]} {
70 set all_remotes [glob \
71 -types f \
72 -tails \
73 -nocomplain \
74 -directory $rm_dir *]
76 foreach name $all_remotes {
77 catch {
78 set fd [open [file join $rm_dir $name] r]
79 while {[gets $fd line] >= 0} {
80 if {[regexp {^URL:[ ]*(.+)$} $line line url]} {
81 set remote_url($name) $url
82 continue
84 if {![regexp {^Pull:[ ]*([^:]+):(.+)$} \
85 $line line src dst]} continue
86 if {[string index $src 0] eq {+}} {
87 set src [string range $src 1 end]
89 if {![string equal -length 5 refs/ $src]} {
90 set src $rh_str$src
92 if {![string equal -length 5 refs/ $dst]} {
93 set dst $rh_str$dst
95 if {[string equal -length $rh_len $rh_str $dst]} {
96 set some_heads_tracking 1
98 lappend trck [list $dst $name $src]
100 close $fd
105 foreach line [array names repo_config remote.*.url] {
106 if {![regexp ^remote\.(.*)\.url\$ $line line name]} continue
107 lappend all_remotes $name
108 set remote_url($name) $repo_config(remote.$name.url)
110 if {[catch {set fl $repo_config(remote.$name.fetch)}]} {
111 set fl {}
113 foreach line $fl {
114 if {![regexp {^([^:]+):(.+)$} $line line src dst]} continue
115 if {[string index $src 0] eq {+}} {
116 set src [string range $src 1 end]
118 if {![string equal -length 5 refs/ $src]} {
119 set src $rh_str$src
121 if {![string equal -length 5 refs/ $dst]} {
122 set dst $rh_str$dst
124 if {[string equal -length $rh_len $rh_str $dst]} {
125 set some_heads_tracking 1
127 lappend trck [list $dst $name $src]
131 set tracking_branches [lsort -index 0 -unique $trck]
132 set all_remotes [lsort -unique $all_remotes]
135 proc add_fetch_entry {r} {
136 global repo_config
137 set remote_m .mbar.remote
138 set fetch_m $remote_m.fetch
139 set prune_m $remote_m.prune
140 set enable 0
141 if {![catch {set a $repo_config(remote.$r.url)}]} {
142 if {![catch {set a $repo_config(remote.$r.fetch)}]} {
143 set enable 1
145 } else {
146 catch {
147 set fd [open [gitdir remotes $r] r]
148 while {[gets $fd n] >= 0} {
149 if {[regexp {^Pull:[ \t]*([^:]+):} $n]} {
150 set enable 1
151 break
154 close $fd
158 if {$enable} {
159 if {![winfo exists $fetch_m]} {
160 menu $prune_m
161 $remote_m insert 0 cascade \
162 -label [mc "Prune from"] \
163 -menu $prune_m
165 menu $fetch_m
166 $remote_m insert 0 cascade \
167 -label [mc "Fetch from"] \
168 -menu $fetch_m
171 $fetch_m add command \
172 -label $r \
173 -command [list fetch_from $r]
174 $prune_m add command \
175 -label $r \
176 -command [list prune_from $r]
180 proc add_push_entry {r} {
181 global repo_config
182 set remote_m .mbar.remote
183 set push_m $remote_m.push
184 set enable 0
185 if {![catch {set a $repo_config(remote.$r.url)}]} {
186 if {![catch {set a $repo_config(remote.$r.push)}]} {
187 set enable 1
189 } else {
190 catch {
191 set fd [open [gitdir remotes $r] r]
192 while {[gets $fd n] >= 0} {
193 if {[regexp {^Push:[ \t]*([^:]+):} $n]} {
194 set enable 1
195 break
198 close $fd
202 if {$enable} {
203 if {![winfo exists $push_m]} {
204 menu $push_m
205 $remote_m insert 0 cascade \
206 -label [mc "Push to"] \
207 -menu $push_m
210 $push_m add command \
211 -label $r \
212 -command [list push_to $r]
216 proc populate_remotes_menu {} {
217 global all_remotes
219 foreach r $all_remotes {
220 add_fetch_entry $r
221 add_push_entry $r
225 proc add_single_remote {name location} {
226 global all_remotes repo_config
227 lappend all_remotes $name
229 git remote add $name $location
231 # XXX: Better re-read the config so that we will never get out
232 # of sync with git remote implementation?
233 set repo_config(remote.$name.url) $location
234 set repo_config(remote.$name.fetch) "+refs/heads/*:refs/remotes/$name/*"
236 add_fetch_entry $name
237 add_push_entry $name