git-gui: Option to default new branches to match tracking branches
[alt-git.git] / lib / choose_rev.tcl
blobe6af07359551abe1b585326137e987cc73fdab43
1 # git-gui revision chooser
2 # Copyright (C) 2006, 2007 Shawn Pearce
4 class choose_rev {
6 image create photo ::choose_rev::img_find -data {R0lGODlhEAAQAIYAAPwCBCQmJDw+PBQSFAQCBMza3NTm5MTW1HyChOT29Ozq7MTq7Kze5Kzm7Oz6/NTy9Iza5GzGzKzS1Nzy9Nz29Kzq9HTGzHTK1Lza3AwKDLzu9JTi7HTW5GTCzITO1Mzq7Hza5FTK1ESyvHzKzKzW3DQyNDyqtDw6PIzW5HzGzAT+/Dw+RKyurNTOzMTGxMS+tJSGdATCxHRydLSqpLymnLSijBweHERCRNze3Pz69PTy9Oze1OTSxOTGrMSqlLy+vPTu5OzSvMymjNTGvNS+tMy2pMyunMSefAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAAAALAAAAAAQABAAAAe4gACCAAECA4OIiAIEBQYHBAKJgwIICQoLDA0IkZIECQ4PCxARCwSSAxITFA8VEBYXGBmJAQYLGhUbHB0eH7KIGRIMEBAgISIjJKaIJQQLFxERIialkieUGigpKRoIBCqJKyyLBwvJAioEyoICLS4v6QQwMQQyLuqLli8zNDU2BCf1lN3AkUPHDh49fAQAAEnGD1MCCALZEaSHkIUMBQS8wWMIkSJGhBzBmFEGgRsBUqpMiSgdAD+BAAAh/mhDcmVhdGVkIGJ5IEJNUFRvR0lGIFBybyB2ZXJzaW9uIDIuNQ0KqSBEZXZlbENvciAxOTk3LDE5OTguIEFsbCByaWdodHMgcmVzZXJ2ZWQuDQpodHRwOi8vd3d3LmRldmVsY29yLmNvbQA7}
8 field w ; # our megawidget path
9 field w_list ; # list of currently filtered specs
10 field w_filter ; # filter entry for $w_list
12 field c_expr {}; # current revision expression
13 field filter ; # current filter string
14 field revtype head; # type of revision chosen
15 field cur_specs [list]; # list of specs for $revtype
16 field spec_head ; # list of all head specs
17 field spec_trck ; # list of all tracking branch specs
18 field spec_tag ; # list of all tag specs
20 constructor new {path {title {}}} {
21 global all_heads current_branch
23 set w $path
25 if {$title ne {}} {
26 labelframe $w -text $title
27 } else {
28 frame $w
30 bind $w <Destroy> [cb _delete %W]
32 radiobutton $w.expr_r \
33 -text {Revision Expression:} \
34 -value expr \
35 -variable @revtype
36 entry $w.expr_t \
37 -borderwidth 1 \
38 -relief sunken \
39 -width 50 \
40 -textvariable @c_expr \
41 -validate key \
42 -validatecommand [cb _validate %d %S]
43 grid $w.expr_r $w.expr_t -sticky we -padx {0 5}
45 frame $w.types
46 radiobutton $w.types.head_r \
47 -text {Local Branch} \
48 -value head \
49 -variable @revtype
50 pack $w.types.head_r -side left
51 radiobutton $w.types.trck_r \
52 -text {Tracking Branch} \
53 -value trck \
54 -variable @revtype
55 pack $w.types.trck_r -side left
56 radiobutton $w.types.tag_r \
57 -text {Tag} \
58 -value tag \
59 -variable @revtype
60 pack $w.types.tag_r -side left
61 set w_filter $w.types.filter
62 entry $w_filter \
63 -borderwidth 1 \
64 -relief sunken \
65 -width 12 \
66 -textvariable @filter \
67 -validate key \
68 -validatecommand [cb _filter %P]
69 pack $w_filter -side right
70 pack [label $w.types.filter_icon \
71 -image ::choose_rev::img_find \
72 ] -side right
73 grid $w.types -sticky we -padx {0 5} -columnspan 2
75 frame $w.list
76 set w_list $w.list.l
77 listbox $w_list \
78 -font font_diff \
79 -width 50 \
80 -height 5 \
81 -selectmode browse \
82 -exportselection false \
83 -xscrollcommand [cb _sb_set $w.list.sbx h] \
84 -yscrollcommand [cb _sb_set $w.list.sby v]
85 pack $w_list -fill both -expand 1
86 grid $w.list -sticky nswe -padx {20 5} -columnspan 2
88 grid columnconfigure $w 1 -weight 1
89 grid rowconfigure $w 2 -weight 1
91 trace add variable @revtype write [cb _select]
92 bind $w_filter <Key-Return> [list focus $w_list]\;break
93 bind $w_filter <Key-Down> [list focus $w_list]
95 set spec_head [list]
96 foreach name $all_heads {
97 lappend spec_head [list $name refs/heads/$name]
100 set spec_trck [list]
101 foreach spec [all_tracking_branches] {
102 set name [lindex $spec 0]
103 regsub ^refs/(heads|remotes)/ $name {} name
104 lappend spec_trck [concat $name $spec]
107 set spec_tag [list]
108 foreach name [load_all_tags] {
109 lappend spec_tag [list $name refs/tags/$name]
112 if {[llength $spec_head] > 0} { set revtype head
113 } elseif {[llength $spec_trck] > 0} { set revtype trck
114 } elseif {[llength $spec_tag ] > 0} { set revtype tag
115 } else { set revtype expr
118 if {$revtype eq {head} && $current_branch ne {}} {
119 set i 0
120 foreach spec $spec_head {
121 if {[lindex $spec 0] eq $current_branch} {
122 $w_list selection set $i
123 break
125 incr i
129 return $this
132 method none {text} {
133 if {![winfo exists $w.none_r]} {
134 radiobutton $w.none_r \
135 -anchor w \
136 -value none \
137 -variable @revtype
138 grid $w.none_r -sticky we -padx {0 5} -columnspan 2
140 $w.none_r configure -text $text
143 method get {} {
144 switch -- $revtype {
145 head -
146 trck -
147 tag {
148 set i [$w_list curselection]
149 if {$i ne {}} {
150 return [lindex $cur_specs $i 0]
151 } else {
152 return {}
156 expr { return $c_expr }
157 none { return {} }
158 default { error "unknown type of revision" }
162 method pick_tracking_branch {} {
163 set revtype trck
166 method get_tracking_branch {} {
167 set i [$w_list curselection]
168 if {$i eq {} || $revtype ne {trck}} {
169 return {}
171 return [lrange [lindex $cur_specs $i] 1 end]
174 method get_commit {} {
175 set e [_expr $this]
176 if {$e eq {}} {
177 return {}
179 return [git rev-parse --verify "$e^0"]
182 method commit_or_die {} {
183 if {[catch {set new [get_commit $this]} err]} {
185 # Cleanup the not-so-friendly error from rev-parse.
187 regsub {^fatal:\s*} $err {} err
188 if {$err eq {Needed a single revision}} {
189 set err {}
192 set top [winfo toplevel $w]
193 set msg "Invalid revision: [get $this]\n\n$err"
194 tk_messageBox \
195 -icon error \
196 -type ok \
197 -title [wm title $top] \
198 -parent $top \
199 -message $msg
200 error $msg
202 return $new
205 method _expr {} {
206 switch -- $revtype {
207 head -
208 trck -
209 tag {
210 set i [$w_list curselection]
211 if {$i ne {}} {
212 return [lindex $cur_specs $i 1]
213 } else {
214 error "No revision selected."
218 expr {
219 if {$c_expr ne {}} {
220 return $c_expr
221 } else {
222 error "Revision expression is empty."
225 none { return {} }
226 default { error "unknown type of revision" }
230 method _validate {d S} {
231 if {$d == 1} {
232 if {[regexp {\s} $S]} {
233 return 0
235 if {[string length $S] > 0} {
236 set revtype expr
239 return 1
242 method _filter {P} {
243 if {[regexp {\s} $P]} {
244 return 0
246 _rebuild $this $P
247 return 1
250 method _select {args} {
251 _rebuild $this $filter
252 if {[$w_filter cget -state] eq {normal}} {
253 focus $w_filter
257 method _rebuild {pat} {
258 set ste normal
259 switch -- $revtype {
260 head { set new $spec_head }
261 trck { set new $spec_trck }
262 tag { set new $spec_tag }
263 expr -
264 none {
265 set new [list]
266 set ste disabled
270 if {[$w_list cget -state] eq {disabled}} {
271 $w_list configure -state normal
273 $w_list delete 0 end
275 if {$pat ne {}} {
276 set pat *${pat}*
278 set cur_specs [list]
279 foreach spec $new {
280 set txt [lindex $spec 0]
281 if {$pat eq {} || [string match $pat $txt]} {
282 lappend cur_specs $spec
283 $w_list insert end $txt
287 if {[$w_filter cget -state] ne $ste} {
288 $w_list configure -state $ste
289 $w_filter configure -state $ste
293 method _delete {current} {
294 if {$current eq $w} {
295 delete_this
299 method _sb_set {sb orient first last} {
300 set old_focus [focus -lastfor $w]
302 if {$first == 0 && $last == 1} {
303 if {[winfo exists $sb]} {
304 destroy $sb
305 if {$old_focus ne {}} {
306 update
307 focus $old_focus
310 return
313 if {![winfo exists $sb]} {
314 if {$orient eq {h}} {
315 scrollbar $sb -orient h -command [list $w_list xview]
316 pack $sb -fill x -side bottom -before $w_list
317 } else {
318 scrollbar $sb -orient v -command [list $w_list yview]
319 pack $sb -fill y -side right -before $w_list
321 if {$old_focus ne {}} {
322 update
323 focus $old_focus
326 $sb set $first $last