summaryrefslogtreecommitdiff
path: root/lib/remote.tcl
blob: 0e86ddac0981fbb575a7dd5294ddaed29f7c3917 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
# git-gui remote management
# Copyright (C) 2006, 2007 Shawn Pearce

set some_heads_tracking 0;  # assume not

proc is_tracking_branch {name} {
	global tracking_branches
	foreach spec $tracking_branches {
		set t [lindex $spec 0]
		if {$t eq $name || [string match $t $name]} {
			return 1
		}
	}
	return 0
}

proc all_tracking_branches {} {
	global tracking_branches

	set all [list]
	set pat [list]
	set cmd [list]

	foreach spec $tracking_branches {
		set dst [lindex $spec 0]
		if {[string range $dst end-1 end] eq {/*}} {
			lappend pat $spec
			lappend cmd [string range $dst 0 end-2]
		} else {
			lappend all $spec
		}
	}

	if {$pat ne {}} {
		set fd [eval git_read for-each-ref --format=%(refname) $cmd]
		while {[gets $fd n] > 0} {
			foreach spec $pat {
				set dst [string range [lindex $spec 0] 0 end-2]
				set len [string length $dst]
				if {[string equal -length $len $dst $n]} {
					set src [string range [lindex $spec 2] 0 end-2]
					set spec [list \
						$n \
						[lindex $spec 1] \
						$src[string range $n $len end] \
						]
					lappend all $spec
				}
			}
		}
		close $fd
	}

	return [lsort -index 0 -unique $all]
}

proc load_all_remotes {} {
	global repo_config
	global all_remotes tracking_branches some_heads_tracking
	global remote_url

	set some_heads_tracking 0
	set all_remotes [list]
	set trck [list]

	set rh_str refs/heads/
	set rh_len [string length $rh_str]
	set rm_dir [gitdir remotes]
	if {[file isdirectory $rm_dir]} {
		set all_remotes [glob \
			-types f \
			-tails \
			-nocomplain \
			-directory $rm_dir *]

		foreach name $all_remotes {
			catch {
				set fd [open [file join $rm_dir $name] r]
				while {[gets $fd line] >= 0} {
					if {[regexp {^URL:[ 	]*(.+)$} $line line url]} {
						set remote_url($name) $url
						continue
					}
					if {![regexp {^Pull:[ 	]*([^:]+):(.+)$} \
						$line line src dst]} continue
					if {[string index $src 0] eq {+}} {
						set src [string range $src 1 end]
					}
					if {![string equal -length 5 refs/ $src]} {
						set src $rh_str$src
					}
					if {![string equal -length 5 refs/ $dst]} {
						set dst $rh_str$dst
					}
					if {[string equal -length $rh_len $rh_str $dst]} {
						set some_heads_tracking 1
					}
					lappend trck [list $dst $name $src]
				}
				close $fd
			}
		}
	}

	foreach line [array names repo_config remote.*.url] {
		if {![regexp ^remote\.(.*)\.url\$ $line line name]} continue
		lappend all_remotes $name
		set remote_url($name) $repo_config(remote.$name.url)

		if {[catch {set fl $repo_config(remote.$name.fetch)}]} {
			set fl {}
		}
		foreach line $fl {
			if {![regexp {^([^:]+):(.+)$} $line line src dst]} continue
			if {[string index $src 0] eq {+}} {
				set src [string range $src 1 end]
			}
			if {![string equal -length 5 refs/ $src]} {
				set src $rh_str$src
			}
			if {![string equal -length 5 refs/ $dst]} {
				set dst $rh_str$dst
			}
			if {[string equal -length $rh_len $rh_str $dst]} {
				set some_heads_tracking 1
			}
			lappend trck [list $dst $name $src]
		}
	}

	set tracking_branches [lsort -index 0 -unique $trck]
	set all_remotes [lsort -unique $all_remotes]
}

proc populate_fetch_menu {} {
	global all_remotes repo_config

	set remote_m .mbar.remote
	set fetch_m $remote_m.fetch
	set prune_m $remote_m.prune

	foreach r $all_remotes {
		set enable 0
		if {![catch {set a $repo_config(remote.$r.url)}]} {
			if {![catch {set a $repo_config(remote.$r.fetch)}]} {
				set enable 1
			}
		} else {
			catch {
				set fd [open [gitdir remotes $r] r]
				while {[gets $fd n] >= 0} {
					if {[regexp {^Pull:[ \t]*([^:]+):} $n]} {
						set enable 1
						break
					}
				}
				close $fd
			}
		}

		if {$enable} {
			if {![winfo exists $fetch_m]} {
				menu $prune_m
				$remote_m insert 0 cascade \
					-label [mc "Prune from"] \
					-menu $prune_m

				menu $fetch_m
				$remote_m insert 0 cascade \
					-label [mc "Fetch from"] \
					-menu $fetch_m
			}

			$fetch_m add command \
				-label $r \
				-command [list fetch_from $r]
			$prune_m add command \
				-label $r \
				-command [list prune_from $r]
		}
	}
}

proc populate_push_menu {} {
	global all_remotes repo_config

	set remote_m .mbar.remote
	set push_m $remote_m.push

	foreach r $all_remotes {
		set enable 0
		if {![catch {set a $repo_config(remote.$r.url)}]} {
			if {![catch {set a $repo_config(remote.$r.push)}]} {
				set enable 1
			}
		} else {
			catch {
				set fd [open [gitdir remotes $r] r]
				while {[gets $fd n] >= 0} {
					if {[regexp {^Push:[ \t]*([^:]+):} $n]} {
						set enable 1
						break
					}
				}
				close $fd
			}
		}

		if {$enable} {
			if {![winfo exists $push_m]} {
				menu $push_m
				$remote_m insert 0 cascade \
					-label [mc "Push to"] \
					-menu $push_m
			}

			$push_m add command \
				-label $r \
				-command [list push_to $r]
		}
	}
}