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 {[tk_messageBox \
212 -icon warning \
213 -type yesno \
214 -title [wm title $w] \
215 -parent $w \
216 -message [mc "Recovering deleted branches is difficult.\n\nDelete the selected branches?"]] ne yes} {
217 return
218 }
219
220 destroy $w
221
222 set cons [console::new \
223 "push $uri" \
224 [mc "Deleting branches from %s" $uri]]
225 console::exec $cons $push_cmd
226}
227
228method _rescan {{force 1}} {
229 switch $urltype {
230 remote {set uri $remote}
231 url {set uri $url}
232 }
233
234 if {$force} {
235 unset -nocomplain cached($urltype:$uri)
236 }
237
238 if {$idle_id ne {}} {
239 after cancel $idle_id
240 set idle_id {}
241 }
242
243 _load $this $urltype:$uri $uri
244}
245
246method _write_remote {args} { set urltype remote }
247method _write_url {args} { set urltype url }
248method _write_check_head {args} { set checktype head }
249
250method _write_head_list {args} {
251 $head_m delete 0 end
252 foreach abr $head_list {
253 $head_m insert end radiobutton \
254 -label $abr \
255 -value $abr \
256 -variable @check_head
257 }
258 if {[lsearch -exact -sorted $head_list $check_head] < 0} {
259 set check_head {}
260 }
261}
262
263method _write_urltype {args} {
264 if {$urltype eq {url}} {
265 if {$idle_id ne {}} {
266 after cancel $idle_id
267 }
268 _load $this none: {}
269 set idle_id [after 1000 [cb _rescan 0]]
270 } else {
271 _rescan $this 0
272 }
273}
274
275method _load {cache uri} {
276 if {$active_ls ne {}} {
277 catch {close $active_ls}
278 }
279
280 if {$uri eq {}} {
281 $w.heads.l conf -state disabled
282 set head_list [list]
283 set full_list [list]
284 set status [mc "No repository selected."]
285 return
286 }
287
288 if {[catch {set x $cached($cache)}]} {
289 set status [mc "Scanning %s..." $uri]
290 $w.heads.l conf -state disabled
291 set head_list [list]
292 set full_list [list]
293 set head_cache($cache) [list]
294 set full_cache($cache) [list]
295 set active_ls [git_read ls-remote $uri]
296 fconfigure $active_ls \
297 -blocking 0 \
298 -translation lf \
299 -encoding utf-8
300 fileevent $active_ls readable [cb _read $cache $active_ls]
301 } else {
302 set status {}
303 set full_list $full_cache($cache)
304 set head_list $head_cache($cache)
305 $w.heads.l conf -state normal
306 }
307}
308
309method _read {cache fd} {
310 if {$fd ne $active_ls} {
311 catch {close $fd}
312 return
313 }
314
315 while {[gets $fd line] >= 0} {
316 if {[string match {*^{}} $line]} continue
317 if {[regexp {^([0-9a-f]{40}) (.*)$} $line _junk obj ref]} {
318 if {[regsub ^refs/heads/ $ref {} abr]} {
319 lappend head_list $abr
320 lappend head_cache($cache) $abr
321 lappend full_list $ref
322 lappend full_cache($cache) $ref
323 set full_cache("$cache\n$ref") $obj
324 }
325 }
326 }
327
328 if {[eof $fd]} {
329 if {[catch {close $fd} err]} {
330 set status $err
331 set head_list [list]
332 set full_list [list]
333 } else {
334 set status {}
335 set cached($cache) 1
336 $w.heads.l conf -state normal
337 }
338 }
339} ifdeleted {
340 catch {close $fd}
341}
342
343}