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