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 all_heads current_branch
  13
  14         make_toplevel top w
  15         wm title $top "[appname] ([reponame]): Delete Branch"
  16         if {$top ne {.}} {
  17                 wm geometry $top "+[winfo rootx .]+[winfo rooty .]"
  18         }
  19
  20         label $w.header -text {Delete Local Branch} -font font_uibold
  21         pack $w.header -side top -fill x
  22
  23         frame $w.buttons
  24         set w_delete $w.buttons.delete
  25         button $w_delete \
  26                 -text Delete \
  27                 -default active \
  28                 -state disabled \
  29                 -command [cb _delete]
  30         pack $w_delete -side right
  31         button $w.buttons.cancel \
  32                 -text {Cancel} \
  33                 -command [list destroy $w]
  34         pack $w.buttons.cancel -side right -padx 5
  35         pack $w.buttons -side bottom -fill x -pady 10 -padx 10
  36
  37         labelframe $w.list -text {Local Branches}
  38         set w_heads $w.list.l
  39         listbox $w_heads \
  40                 -height 10 \
  41                 -width 70 \
  42                 -selectmode extended \
  43                 -yscrollcommand [list $w.list.sby set]
  44         scrollbar $w.list.sby -command [list $w.list.l yview]
  45         pack $w.list.sby -side right -fill y
  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                 {Delete Only If Merged Into} \
  52                 ]
  53         $w_check none {Always (Do not perform merge test.)}
  54         pack $w.check -anchor nw -fill x -pady 5 -padx 5
  55
  56         foreach h $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         tkwait window $w
  70 }
  71
  72 method _select {} {
  73         if {[$w_heads curselection] eq {}} {
  74                 $w_delete configure -state disabled
  75         } else {
  76                 $w_delete configure -state normal
  77         }
  78 }
  79
  80 method _delete {} {
  81         global all_heads
  82
  83         if {[catch {set check_cmt [$w_check get_commit]} err]} {
  84                 tk_messageBox \
  85                         -icon error \
  86                         -type ok \
  87                         -title [wm title $w] \
  88                         -parent $w \
  89                         -message "Invalid revision: [$w_check get]"
  90                 return
  91         }
  92
  93         set to_delete [list]
  94         set not_merged [list]
  95         foreach i [$w_heads curselection] {
  96                 set b [$w_heads get $i]
  97                 if {[catch {
  98                         set o [git rev-parse --verify "refs/heads/$b"]
  99                 }]} continue
 100                 if {$check_cmt ne {}} {
 101                         if {[catch {set m [git merge-base $o $check_cmt]}]} continue
 102                         if {$o ne $m} {
 103                                 lappend not_merged $b
 104                                 continue
 105                         }
 106                 }
 107                 lappend to_delete [list $b $o]
 108         }
 109         if {$not_merged ne {}} {
 110                 set msg "The following branches are not completely merged into [$w_check get]:
 111
 112  - [join $not_merged "\n - "]"
 113                 tk_messageBox \
 114                         -icon info \
 115                         -type ok \
 116                         -title [wm title $w] \
 117                         -parent $w \
 118                         -message $msg
 119         }
 120         if {$to_delete eq {}} return
 121         if {$check_cmt eq {}} {
 122                 set msg {Recovering deleted branches is difficult.
 123
 124 Delete the selected branches?}
 125                 if {[tk_messageBox \
 126                         -icon warning \
 127                         -type yesno \
 128                         -title [wm title $w] \
 129                         -parent $w \
 130                         -message $msg] ne yes} {
 131                         return
 132                 }
 133         }
 134
 135         set failed {}
 136         foreach i $to_delete {
 137                 set b [lindex $i 0]
 138                 set o [lindex $i 1]
 139                 if {[catch {git update-ref -d "refs/heads/$b" $o} err]} {
 140                         append failed " - $b: $err\n"
 141                 } else {
 142                         set x [lsearch -sorted -exact $all_heads $b]
 143                         if {$x >= 0} {
 144                                 set all_heads [lreplace $all_heads $x $x]
 145                         }
 146                 }
 147         }
 148
 149         if {$failed ne {}} {
 150                 tk_messageBox \
 151                         -icon error \
 152                         -type ok \
 153                         -title [wm title $w] \
 154                         -parent $w \
 155                         -message "Failed to delete branches:\n$failed"
 156         }
 157
 158         set all_heads [lsort $all_heads]
 159         populate_branch_menu
 160         destroy $w
 161 }
 162
 163 }