Merge branch 'mh/remove-subtree-long-pathname-fix'
[git] / git-gui / lib / branch_delete.tcl
1 # git-gui branch delete support
2 # Copyright (C) 2007 Shawn Pearce
3
4 class branch_delete {
5
6 field w               ; # widget path
7 field w_heads         ; # listbox of local head names
8 field w_check         ; # revision picker for merge test
9 field w_delete        ; # delete button
10
11 constructor dialog {} {
12         global current_branch use_ttk NS
13
14         make_dialog top w
15         wm withdraw $w
16         wm title $top [append "[appname] ([reponame]): " [mc "Delete Branch"]]
17         if {$top ne {.}} {
18                 wm geometry $top "+[winfo rootx .]+[winfo rooty .]"
19         }
20
21         ${NS}::label $w.header -text [mc "Delete Local Branch"] \
22                 -font font_uibold -anchor center
23         pack $w.header -side top -fill x
24
25         ${NS}::frame $w.buttons
26         set w_delete $w.buttons.delete
27         ${NS}::button $w_delete \
28                 -text [mc Delete] \
29                 -default active \
30                 -state disabled \
31                 -command [cb _delete]
32         pack $w_delete -side right
33         ${NS}::button $w.buttons.cancel \
34                 -text [mc Cancel] \
35                 -command [list destroy $w]
36         pack $w.buttons.cancel -side right -padx 5
37         pack $w.buttons -side bottom -fill x -pady 10 -padx 10
38
39         ${NS}::labelframe $w.list -text [mc "Local Branches"]
40         set w_heads $w.list.l
41         slistbox $w_heads \
42                 -height 10 \
43                 -width 70 \
44                 -selectmode extended \
45                 -exportselection false
46         pack $w.list.l -side left -fill both -expand 1
47         pack $w.list -fill both -expand 1 -pady 5 -padx 5
48
49         set w_check [choose_rev::new \
50                 $w.check \
51                 [mc "Delete Only If Merged Into"] \
52                 ]
53         $w_check none [mc "Always (Do not perform merge checks)"]
54         pack $w.check -anchor nw -fill x -pady 5 -padx 5
55
56         foreach h [load_all_heads] {
57                 if {$h ne $current_branch} {
58                         $w_heads insert end $h
59                 }
60         }
61
62         bind $w_heads <<ListboxSelect>> [cb _select]
63         bind $w <Visibility> "
64                 grab $w
65                 focus $w
66         "
67         bind $w <Key-Escape> [list destroy $w]
68         bind $w <Key-Return> [cb _delete]\;break
69         wm deiconify $w
70         tkwait window $w
71 }
72
73 method _select {} {
74         if {[$w_heads curselection] eq {}} {
75                 $w_delete configure -state disabled
76         } else {
77                 $w_delete configure -state normal
78         }
79 }
80
81 method _delete {} {
82         if {[catch {set check_cmt [$w_check commit_or_die]}]} {
83                 return
84         }
85
86         set to_delete [list]
87         set not_merged [list]
88         foreach i [$w_heads curselection] {
89                 set b [$w_heads get $i]
90                 if {[catch {
91                         set o [git rev-parse --verify "refs/heads/$b"]
92                 }]} continue
93                 if {$check_cmt ne {}} {
94                         if {[catch {set m [git merge-base $o $check_cmt]}]} continue
95                         if {$o ne $m} {
96                                 lappend not_merged $b
97                                 continue
98                         }
99                 }
100                 lappend to_delete [list $b $o]
101         }
102         if {$not_merged ne {}} {
103                 set msg "[mc "The following branches are not completely merged into %s:" [$w_check get]]
104
105  - [join $not_merged "\n - "]"
106                 tk_messageBox \
107                         -icon info \
108                         -type ok \
109                         -title [wm title $w] \
110                         -parent $w \
111                         -message $msg
112         }
113         if {$to_delete eq {}} return
114         if {$check_cmt eq {}} {
115                 set msg [mc "Recovering deleted branches is difficult.\n\nDelete the selected branches?"]
116                 if {[tk_messageBox \
117                         -icon warning \
118                         -type yesno \
119                         -title [wm title $w] \
120                         -parent $w \
121                         -message $msg] ne yes} {
122                         return
123                 }
124         }
125
126         set failed {}
127         foreach i $to_delete {
128                 set b [lindex $i 0]
129                 set o [lindex $i 1]
130                 if {[catch {git branch -D $b} err]} {
131                         append failed " - $b: $err\n"
132                 }
133         }
134
135         if {$failed ne {}} {
136                 tk_messageBox \
137                         -icon error \
138                         -type ok \
139                         -title [wm title $w] \
140                         -parent $w \
141                         -message [mc "Failed to delete branches:\n%s" $failed]
142         }
143
144         destroy $w
145 }
146
147 }