git-gui: Sort tags descending by tagger date
[git/jrn.git] / lib / choose_rev.tcl
blobf19da0f633bf4bba35655b700ce120b5be322f7c
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 get_tracking_branch {} {
163 set i [$w_list curselection]
164 if {$i eq {} || $revtype ne {trck}} {
165 return {}
167 return [lrange [lindex $cur_specs $i] 1 end]
170 method get_commit {} {
171 set e [_expr $this]
172 if {$e eq {}} {
173 return {}
175 return [git rev-parse --verify "$e^0"]
178 method commit_or_die {} {
179 if {[catch {set new [get_commit $this]} err]} {
181 # Cleanup the not-so-friendly error from rev-parse.
183 regsub {^fatal:\s*} $err {} err
184 if {$err eq {Needed a single revision}} {
185 set err {}
188 set top [winfo toplevel $w]
189 set msg "Invalid revision: [get $this]\n\n$err"
190 tk_messageBox \
191 -icon error \
192 -type ok \
193 -title [wm title $top] \
194 -parent $top \
195 -message $msg
196 error $msg
198 return $new
201 method _expr {} {
202 switch -- $revtype {
203 head -
204 trck -
205 tag {
206 set i [$w_list curselection]
207 if {$i ne {}} {
208 return [lindex $cur_specs $i 1]
209 } else {
210 error "No revision selected."
214 expr {
215 if {$c_expr ne {}} {
216 return $c_expr
217 } else {
218 error "Revision expression is empty."
221 none { return {} }
222 default { error "unknown type of revision" }
226 method _validate {d S} {
227 if {$d == 1} {
228 if {[regexp {\s} $S]} {
229 return 0
231 if {[string length $S] > 0} {
232 set revtype expr
235 return 1
238 method _filter {P} {
239 if {[regexp {\s} $P]} {
240 return 0
242 _rebuild $this $P
243 return 1
246 method _select {args} {
247 _rebuild $this $filter
248 if {[$w_filter cget -state] eq {normal}} {
249 focus $w_filter
253 method _rebuild {pat} {
254 set ste normal
255 switch -- $revtype {
256 head { set new $spec_head }
257 trck { set new $spec_trck }
258 tag { set new $spec_tag }
259 expr -
260 none {
261 set new [list]
262 set ste disabled
266 if {[$w_list cget -state] eq {disabled}} {
267 $w_list configure -state normal
269 $w_list delete 0 end
271 if {$pat ne {}} {
272 set pat *${pat}*
274 set cur_specs [list]
275 foreach spec $new {
276 set txt [lindex $spec 0]
277 if {$pat eq {} || [string match $pat $txt]} {
278 lappend cur_specs $spec
279 $w_list insert end $txt
283 if {[$w_filter cget -state] ne $ste} {
284 $w_list configure -state $ste
285 $w_filter configure -state $ste
289 method _delete {current} {
290 if {$current eq $w} {
291 delete_this
295 method _sb_set {sb orient first last} {
296 set old_focus [focus -lastfor $w]
298 if {$first == 0 && $last == 1} {
299 if {[winfo exists $sb]} {
300 destroy $sb
301 if {$old_focus ne {}} {
302 update
303 focus $old_focus
306 return
309 if {![winfo exists $sb]} {
310 if {$orient eq {h}} {
311 scrollbar $sb -orient h -command [list $w_list xview]
312 pack $sb -fill x -side bottom -before $w_list
313 } else {
314 scrollbar $sb -orient v -command [list $w_list yview]
315 pack $sb -fill y -side right -before $w_list
317 if {$old_focus ne {}} {
318 update
319 focus $old_focus
322 $sb set $first $last