git-gui: Increase the default height of the revision picker
[git/jrn.git] / lib / choose_rev.tcl
blob6c4c3188f0eab7bf81f35c9eabea6cf77f078f63
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 current_branch is_detached
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 if {$is_detached} {
33 radiobutton $w.detachedhead_r \
34 -anchor w \
35 -text {This Detached Checkout} \
36 -value HEAD \
37 -variable @revtype
38 grid $w.detachedhead_r -sticky we -padx {0 5} -columnspan 2
41 radiobutton $w.expr_r \
42 -text {Revision Expression:} \
43 -value expr \
44 -variable @revtype
45 entry $w.expr_t \
46 -borderwidth 1 \
47 -relief sunken \
48 -width 50 \
49 -textvariable @c_expr \
50 -validate key \
51 -validatecommand [cb _validate %d %S]
52 grid $w.expr_r $w.expr_t -sticky we -padx {0 5}
54 frame $w.types
55 radiobutton $w.types.head_r \
56 -text {Local Branch} \
57 -value head \
58 -variable @revtype
59 pack $w.types.head_r -side left
60 radiobutton $w.types.trck_r \
61 -text {Tracking Branch} \
62 -value trck \
63 -variable @revtype
64 pack $w.types.trck_r -side left
65 radiobutton $w.types.tag_r \
66 -text {Tag} \
67 -value tag \
68 -variable @revtype
69 pack $w.types.tag_r -side left
70 set w_filter $w.types.filter
71 entry $w_filter \
72 -borderwidth 1 \
73 -relief sunken \
74 -width 12 \
75 -textvariable @filter \
76 -validate key \
77 -validatecommand [cb _filter %P]
78 pack $w_filter -side right
79 pack [label $w.types.filter_icon \
80 -image ::choose_rev::img_find \
81 ] -side right
82 grid $w.types -sticky we -padx {0 5} -columnspan 2
84 frame $w.list
85 set w_list $w.list.l
86 listbox $w_list \
87 -font font_diff \
88 -width 50 \
89 -height 10 \
90 -selectmode browse \
91 -exportselection false \
92 -xscrollcommand [cb _sb_set $w.list.sbx h] \
93 -yscrollcommand [cb _sb_set $w.list.sby v]
94 pack $w_list -fill both -expand 1
95 grid $w.list -sticky nswe -padx {20 5} -columnspan 2
97 grid columnconfigure $w 1 -weight 1
98 if {$is_detached} {
99 grid rowconfigure $w 3 -weight 1
100 } else {
101 grid rowconfigure $w 2 -weight 1
104 trace add variable @revtype write [cb _select]
105 bind $w_filter <Key-Return> [list focus $w_list]\;break
106 bind $w_filter <Key-Down> [list focus $w_list]
108 set spec_head [list]
109 foreach name [load_all_heads] {
110 lappend spec_head [list $name refs/heads/$name]
113 set spec_trck [list]
114 foreach spec [all_tracking_branches] {
115 set name [lindex $spec 0]
116 regsub ^refs/(heads|remotes)/ $name {} name
117 lappend spec_trck [concat $name $spec]
120 set spec_tag [list]
121 foreach name [load_all_tags] {
122 lappend spec_tag [list $name refs/tags/$name]
125 if {$is_detached} { set revtype HEAD
126 } elseif {[llength $spec_head] > 0} { set revtype head
127 } elseif {[llength $spec_trck] > 0} { set revtype trck
128 } elseif {[llength $spec_tag ] > 0} { set revtype tag
129 } else { set revtype expr
132 if {$revtype eq {head} && $current_branch ne {}} {
133 set i 0
134 foreach spec $spec_head {
135 if {[lindex $spec 0] eq $current_branch} {
136 $w_list selection clear 0 end
137 $w_list selection set $i
138 break
140 incr i
144 return $this
147 method none {text} {
148 if {![winfo exists $w.none_r]} {
149 radiobutton $w.none_r \
150 -anchor w \
151 -value none \
152 -variable @revtype
153 grid $w.none_r -sticky we -padx {0 5} -columnspan 2
155 $w.none_r configure -text $text
158 method get {} {
159 switch -- $revtype {
160 head -
161 trck -
162 tag {
163 set i [$w_list curselection]
164 if {$i ne {}} {
165 return [lindex $cur_specs $i 0]
166 } else {
167 return {}
171 HEAD { return HEAD }
172 expr { return $c_expr }
173 none { return {} }
174 default { error "unknown type of revision" }
178 method pick_tracking_branch {} {
179 set revtype trck
182 method focus_filter {} {
183 if {[$w_filter cget -state] eq {normal}} {
184 focus $w_filter
188 method bind_listbox {event script} {
189 bind $w_list $event $script
192 method get_local_branch {} {
193 if {$revtype eq {head}} {
194 return [_expr $this]
195 } else {
196 return {}
200 method get_tracking_branch {} {
201 set i [$w_list curselection]
202 if {$i eq {} || $revtype ne {trck}} {
203 return {}
205 return [lrange [lindex $cur_specs $i] 1 end]
208 method get_commit {} {
209 set e [_expr $this]
210 if {$e eq {}} {
211 return {}
213 return [git rev-parse --verify "$e^0"]
216 method commit_or_die {} {
217 if {[catch {set new [get_commit $this]} err]} {
219 # Cleanup the not-so-friendly error from rev-parse.
221 regsub {^fatal:\s*} $err {} err
222 if {$err eq {Needed a single revision}} {
223 set err {}
226 set top [winfo toplevel $w]
227 set msg "Invalid revision: [get $this]\n\n$err"
228 tk_messageBox \
229 -icon error \
230 -type ok \
231 -title [wm title $top] \
232 -parent $top \
233 -message $msg
234 error $msg
236 return $new
239 method _expr {} {
240 switch -- $revtype {
241 head -
242 trck -
243 tag {
244 set i [$w_list curselection]
245 if {$i ne {}} {
246 return [lindex $cur_specs $i 1]
247 } else {
248 error "No revision selected."
252 expr {
253 if {$c_expr ne {}} {
254 return $c_expr
255 } else {
256 error "Revision expression is empty."
259 HEAD { return HEAD }
260 none { return {} }
261 default { error "unknown type of revision" }
265 method _validate {d S} {
266 if {$d == 1} {
267 if {[regexp {\s} $S]} {
268 return 0
270 if {[string length $S] > 0} {
271 set revtype expr
274 return 1
277 method _filter {P} {
278 if {[regexp {\s} $P]} {
279 return 0
281 _rebuild $this $P
282 return 1
285 method _select {args} {
286 _rebuild $this $filter
287 focus_filter $this
290 method _rebuild {pat} {
291 set ste normal
292 switch -- $revtype {
293 head { set new $spec_head }
294 trck { set new $spec_trck }
295 tag { set new $spec_tag }
296 expr -
297 HEAD -
298 none {
299 set new [list]
300 set ste disabled
304 if {[$w_list cget -state] eq {disabled}} {
305 $w_list configure -state normal
307 $w_list delete 0 end
309 if {$pat ne {}} {
310 set pat *${pat}*
312 set cur_specs [list]
313 foreach spec $new {
314 set txt [lindex $spec 0]
315 if {$pat eq {} || [string match $pat $txt]} {
316 lappend cur_specs $spec
317 $w_list insert end $txt
320 if {$cur_specs ne {}} {
321 $w_list selection clear 0 end
322 $w_list selection set 0
325 if {[$w_filter cget -state] ne $ste} {
326 $w_list configure -state $ste
327 $w_filter configure -state $ste
331 method _delete {current} {
332 if {$current eq $w} {
333 delete_this
337 method _sb_set {sb orient first last} {
338 set old_focus [focus -lastfor $w]
340 if {$first == 0 && $last == 1} {
341 if {[winfo exists $sb]} {
342 destroy $sb
343 if {$old_focus ne {}} {
344 update
345 focus $old_focus
348 return
351 if {![winfo exists $sb]} {
352 if {$orient eq {h}} {
353 scrollbar $sb -orient h -command [list $w_list xview]
354 pack $sb -fill x -side bottom -before $w_list
355 } else {
356 scrollbar $sb -orient v -command [list $w_list yview]
357 pack $sb -fill y -side right -before $w_list
359 if {$old_focus ne {}} {
360 update
361 focus $old_focus
364 $sb set $first $last