1# git-gui remote branch deleting support
2# Copyright (C) 2007 Shawn Pearce
3
4class remote_branch_delete {
5
6field w
7field head_m
8
9field urltype {url}
10field remote {}
11field url {}
12
13field checktype {head}
14field check_head {}
15
16field status {}
17field idle_id {}
18field full_list {}
19field head_list {}
20field active_ls {}
21field head_cache
22field full_cache
23field cached
24
25constructor dialog {} {
26 global all_remotes M1B
27
28 make_toplevel top w
29 wm title $top [append "[appname] ([reponame]): " [mc "Delete Branch Remotely"]]
30 if {$top ne {.}} {
31 wm geometry $top "+[winfo rootx .]+[winfo rooty .]"
32 }
33
34 label $w.header -text [mc "Delete Branch Remotely"] -font font_uibold
35 pack $w.header -side top -fill x
36
37 frame $w.buttons
38 button $w.buttons.delete -text [mc Delete] \
39 -default active \
40 -command [cb _delete]
41 pack $w.buttons.delete -side right
42 button $w.buttons.cancel -text [mc "Cancel"] \
43 -command [list destroy $w]
44 pack $w.buttons.cancel -side right -padx 5
45 pack $w.buttons -side bottom -fill x -pady 10 -padx 10
46
47 labelframe $w.dest -text [mc "From Repository"]
48 if {$all_remotes ne {}} {
49 radiobutton $w.dest.remote_r \
50 -text [mc "Remote:"] \
51 -value remote \
52 -variable @urltype
53 eval tk_optionMenu $w.dest.remote_m @remote $all_remotes
54 grid $w.dest.remote_r $w.dest.remote_m -sticky w
55 if {[lsearch -sorted -exact $all_remotes origin] != -1} {
56 set remote origin
57 } else {
58 set remote [lindex $all_remotes 0]
59 }
60 set urltype remote
61 trace add variable @remote write [cb _write_remote]
62 } else {
63 set urltype url
64 }
65 radiobutton $w.dest.url_r \
66 -text [mc "Arbitrary Location:"] \
67 -value url \
68 -variable @urltype
69 entry $w.dest.url_t \
70 -borderwidth 1 \
71 -relief sunken \
72 -width 50 \
73 -textvariable @url \
74 -validate key \
75 -validatecommand {
76 if {%d == 1 && [regexp {\s} %S]} {return 0}
77 return 1
78 }
79 trace add variable @url write [cb _write_url]
80 grid $w.dest.url_r $w.dest.url_t -sticky we -padx {0 5}
81 grid columnconfigure $w.dest 1 -weight 1
82 pack $w.dest -anchor nw -fill x -pady 5 -padx 5
83
84 labelframe $w.heads -text [mc "Branches"]
85 listbox $w.heads.l \
86 -height 10 \
87 -width 70 \
88 -listvariable @head_list \
89 -selectmode extended \
90 -yscrollcommand [list $w.heads.sby set]
91 scrollbar $w.heads.sby -command [list $w.heads.l yview]
92
93 frame $w.heads.footer
94 label $w.heads.footer.status \
95 -textvariable @status \
96 -anchor w \
97 -justify left
98 button $w.heads.footer.rescan \
99 -text [mc "Rescan"] \
100 -command [cb _rescan]
101 pack $w.heads.footer.status -side left -fill x
102 pack $w.heads.footer.rescan -side right
103
104 pack $w.heads.footer -side bottom -fill x
105 pack $w.heads.sby -side right -fill y
106 pack $w.heads.l -side left -fill both -expand 1
107 pack $w.heads -fill both -expand 1 -pady 5 -padx 5
108
109 labelframe $w.validate -text [mc "Delete Only If"]
110 radiobutton $w.validate.head_r \
111 -text [mc "Merged Into:"] \
112 -value head \
113 -variable @checktype
114 set head_m [tk_optionMenu $w.validate.head_m @check_head {}]
115 trace add variable @head_list write [cb _write_head_list]
116 trace add variable @check_head write [cb _write_check_head]
117 grid $w.validate.head_r $w.validate.head_m -sticky w
118 radiobutton $w.validate.always_r \
119 -text [mc "Always (Do not perform merge checks)"] \
120 -value always \
121 -variable @checktype
122 grid $w.validate.always_r -columnspan 2 -sticky w
123 grid columnconfigure $w.validate 1 -weight 1
124 pack $w.validate -anchor nw -fill x -pady 5 -padx 5
125
126 trace add variable @urltype write [cb _write_urltype]
127 _rescan $this
128
129 bind $w <Key-F5> [cb _rescan]
130 bind $w <$M1B-Key-r> [cb _rescan]
131 bind $w <$M1B-Key-R> [cb _rescan]
132 bind $w <Key-Return> [cb _delete]
133 bind $w <Key-Escape> [list destroy $w]
134 return $w
135}
136
137method _delete {} {
138 switch $urltype {
139 remote {set uri $remote}
140 url {set uri $url}
141 }
142
143 set cache $urltype:$uri
144 set crev {}
145 if {$checktype eq {head}} {
146 if {$check_head eq {}} {
147 tk_messageBox \
148 -icon error \
149 -type ok \
150 -title [wm title $w] \
151 -parent $w \
152 -message [mc "A branch is required for 'Merged Into'."]
153 return
154 }
155 set crev $full_cache("$cache\nrefs/heads/$check_head")
156 }
157
158 set not_merged [list]
159 set need_fetch 0
160 set have_selection 0
161 set push_cmd [list git push]
162 lappend push_cmd -v
163 lappend push_cmd $uri
164
165 foreach i [$w.heads.l curselection] {
166 set ref [lindex $full_list $i]
167 if {$crev ne {}} {
168 set obj $full_cache("$cache\n$ref")
169 if {[catch {set m [git merge-base $obj $crev]}]} {
170 set need_fetch 1
171 set m {}
172 }
173 if {$obj ne $m} {
174 lappend not_merged [lindex $head_list $i]
175 continue
176 }
177 }
178
179 lappend push_cmd :$ref
180 set have_selection 1
181 }
182
183 if {$not_merged ne {}} {
184 set msg [mc "The following branches are not completely merged into %s:
185
186 - %s" $check_head [join $not_merged "\n - "]]
187
188 if {$need_fetch} {
189 append msg "\n\n" [mc "One or more of the merge tests failed because you have not fetched the necessary commits. Try fetching from %s first." $uri]
190 }
191
192 tk_messageBox \
193 -icon info \
194 -type ok \
195 -title [wm title $w] \
196 -parent $w \
197 -message $msg
198 if {!$have_selection} return
199 }
200
201 if {!$have_selection} {
202 tk_messageBox \
203 -icon error \
204 -type ok \
205 -title [wm title $w] \
206 -parent $w \
207 -message [mc "Please select one or more branches to delete."]
208 return
209 }
210
211 if {$checktype ne {head}} {
212 if {[tk_messageBox \
213 -icon warning \
214 -type yesno \
215 -title [wm title $w] \
216 -parent $w \
217 -message [mc "Recovering deleted branches is difficult.\n\nDelete the selected branches?"]] ne yes} {
218 return
219 }
220 }
221
222 destroy $w
223
224 set cons [console::new \
225 "push $uri" \
226 [mc "Deleting branches from %s" $uri]]
227 console::exec $cons $push_cmd
228}
229
230method _rescan {{force 1}} {
231 switch $urltype {
232 remote {set uri $remote}
233 url {set uri $url}
234 }
235
236 if {$force} {
237 unset -nocomplain cached($urltype:$uri)
238 }
239
240 if {$idle_id ne {}} {
241 after cancel $idle_id
242 set idle_id {}
243 }
244
245 _load $this $urltype:$uri $uri
246}
247
248method _write_remote {args} { set urltype remote }
249method _write_url {args} { set urltype url }
250method _write_check_head {args} { set checktype head }
251
252method _write_head_list {args} {
253 global current_branch
254
255 $head_m delete 0 end
256 foreach abr $head_list {
257 $head_m insert end radiobutton \
258 -label $abr \
259 -value $abr \
260 -variable @check_head
261 }
262 if {[lsearch -exact -sorted $head_list $check_head] < 0} {
263 if {[lsearch -exact -sorted $head_list $current_branch] < 0} {
264 set check_head {}
265 } else {
266 set check_head $current_branch
267 }
268 }
269}
270
271method _write_urltype {args} {
272 if {$urltype eq {url}} {
273 if {$idle_id ne {}} {
274 after cancel $idle_id
275 }
276 _load $this none: {}
277 set idle_id [after 1000 [cb _rescan 0]]
278 } else {
279 _rescan $this 0
280 }
281}
282
283method _load {cache uri} {
284 if {$active_ls ne {}} {
285 catch {close $active_ls}
286 }
287
288 if {$uri eq {}} {
289 $w.heads.l conf -state disabled
290 set head_list [list]
291 set full_list [list]
292 set status [mc "No repository selected."]
293 return
294 }
295
296 if {[catch {set x $cached($cache)}]} {
297 set status [mc "Scanning %s..." $uri]
298 $w.heads.l conf -state disabled
299 set head_list [list]
300 set full_list [list]
301 set head_cache($cache) [list]
302 set full_cache($cache) [list]
303 set active_ls [git_read ls-remote $uri]
304 fconfigure $active_ls \
305 -blocking 0 \
306 -translation lf \
307 -encoding utf-8
308 fileevent $active_ls readable [cb _read $cache $active_ls]
309 } else {
310 set status {}
311 set full_list $full_cache($cache)
312 set head_list $head_cache($cache)
313 $w.heads.l conf -state normal
314 }
315}
316
317method _read {cache fd} {
318 if {$fd ne $active_ls} {
319 catch {close $fd}
320 return
321 }
322
323 while {[gets $fd line] >= 0} {
324 if {[string match {*^{}} $line]} continue
325 if {[regexp {^([0-9a-f]{40}) (.*)$} $line _junk obj ref]} {
326 if {[regsub ^refs/heads/ $ref {} abr]} {
327 lappend head_list $abr
328 lappend head_cache($cache) $abr
329 lappend full_list $ref
330 lappend full_cache($cache) $ref
331 set full_cache("$cache\n$ref") $obj
332 }
333 }
334 }
335
336 if {[eof $fd]} {
337 if {[catch {close $fd} err]} {
338 set status $err
339 set head_list [list]
340 set full_list [list]
341 } else {
342 set status {}
343 set cached($cache) 1
344 $w.heads.l conf -state normal
345 }
346 }
347} ifdeleted {
348 catch {close $fd}
349}
350
351}