prune_refs(): also free the linked list
[git/debian.git] / git-gui / lib / choose_rev.tcl
blob6dae7937d589c174132e9f8b9bd77133e189590f
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
19 field tip_data ; # array of tip commit info by refname
20 field log_last ; # array of reflog date by refname
22 field tooltip_wm {} ; # Current tooltip toplevel, if open
23 field tooltip_t {} ; # Text widget in $tooltip_wm
24 field tooltip_timer {} ; # Current timer event for our tooltip
26 proc new {path {title {}}} {
27 return [_new $path 0 $title]
30 proc new_unmerged {path {title {}}} {
31 return [_new $path 1 $title]
34 constructor _new {path unmerged_only title} {
35 global current_branch is_detached use_ttk NS
37 if {![info exists ::all_remotes]} {
38 load_all_remotes
41 set w $path
43 if {$title ne {}} {
44 ${NS}::labelframe $w -text $title
45 } else {
46 ${NS}::frame $w
48 bind $w <Destroy> [cb _delete %W]
50 if {$is_detached} {
51 ${NS}::radiobutton $w.detachedhead_r \
52 -text [mc "This Detached Checkout"] \
53 -value HEAD \
54 -variable @revtype
55 if {!$use_ttk} {$w.detachedhead_r configure -anchor w}
56 grid $w.detachedhead_r -sticky we -padx {0 5} -columnspan 2
59 ${NS}::radiobutton $w.expr_r \
60 -text [mc "Revision Expression:"] \
61 -value expr \
62 -variable @revtype
63 ${NS}::entry $w.expr_t \
64 -width 50 \
65 -textvariable @c_expr \
66 -validate key \
67 -validatecommand [cb _validate %d %S]
68 grid $w.expr_r $w.expr_t -sticky we -padx {0 5}
70 ${NS}::frame $w.types
71 ${NS}::radiobutton $w.types.head_r \
72 -text [mc "Local Branch"] \
73 -value head \
74 -variable @revtype
75 pack $w.types.head_r -side left
76 ${NS}::radiobutton $w.types.trck_r \
77 -text [mc "Tracking Branch"] \
78 -value trck \
79 -variable @revtype
80 pack $w.types.trck_r -side left
81 ${NS}::radiobutton $w.types.tag_r \
82 -text [mc "Tag"] \
83 -value tag \
84 -variable @revtype
85 pack $w.types.tag_r -side left
86 set w_filter $w.types.filter
87 ${NS}::entry $w_filter \
88 -width 12 \
89 -textvariable @filter \
90 -validate key \
91 -validatecommand [cb _filter %P]
92 pack $w_filter -side right
93 pack [${NS}::label $w.types.filter_icon \
94 -image ::choose_rev::img_find \
95 ] -side right
96 grid $w.types -sticky we -padx {0 5} -columnspan 2
98 if {$use_ttk} {
99 ttk::frame $w.list -style SListbox.TFrame -padding 2
100 } else {
101 frame $w.list
103 set w_list $w.list.l
104 listbox $w_list \
105 -font font_diff \
106 -width 50 \
107 -height 10 \
108 -selectmode browse \
109 -exportselection false \
110 -xscrollcommand [cb _sb_set $w.list.sbx h] \
111 -yscrollcommand [cb _sb_set $w.list.sby v]
112 if {$use_ttk} {
113 $w_list configure -relief flat -highlightthickness 0 -borderwidth 0
115 pack $w_list -fill both -expand 1
116 grid $w.list -sticky nswe -padx {20 5} -columnspan 2
117 bind $w_list <Any-Motion> [cb _show_tooltip @%x,%y]
118 bind $w_list <Any-Enter> [cb _hide_tooltip]
119 bind $w_list <Any-Leave> [cb _hide_tooltip]
120 bind $w_list <Destroy> [cb _hide_tooltip]
122 grid columnconfigure $w 1 -weight 1
123 if {$is_detached} {
124 grid rowconfigure $w 3 -weight 1
125 } else {
126 grid rowconfigure $w 2 -weight 1
129 trace add variable @revtype write [cb _select]
130 bind $w_filter <Key-Return> [list focus $w_list]\;break
131 bind $w_filter <Key-Down> [list focus $w_list]
133 set fmt list
134 append fmt { %(refname)}
135 append fmt { [list}
136 append fmt { %(objecttype)}
137 append fmt { %(objectname)}
138 append fmt { [concat %(taggername) %(authorname)]}
139 append fmt { [reformat_date [concat %(taggerdate) %(authordate)]]}
140 append fmt { %(subject)}
141 append fmt {] [list}
142 append fmt { %(*objecttype)}
143 append fmt { %(*objectname)}
144 append fmt { %(*authorname)}
145 append fmt { [reformat_date %(*authordate)]}
146 append fmt { %(*subject)}
147 append fmt {]}
148 set all_refn [list]
149 set fr_fd [git_read for-each-ref \
150 --tcl \
151 --sort=-taggerdate \
152 --format=$fmt \
153 refs/heads \
154 refs/remotes \
155 refs/tags \
157 fconfigure $fr_fd -translation lf -encoding utf-8
158 while {[gets $fr_fd line] > 0} {
159 set line [eval $line]
160 if {[lindex $line 1 0] eq {tag}} {
161 if {[lindex $line 2 0] eq {commit}} {
162 set sha1 [lindex $line 2 1]
163 } else {
164 continue
166 } elseif {[lindex $line 1 0] eq {commit}} {
167 set sha1 [lindex $line 1 1]
168 } else {
169 continue
171 set refn [lindex $line 0]
172 set tip_data($refn) [lrange $line 1 end]
173 lappend cmt_refn($sha1) $refn
174 lappend all_refn $refn
176 close $fr_fd
178 if {$unmerged_only} {
179 set fr_fd [git_read rev-list --all ^$::HEAD]
180 while {[gets $fr_fd sha1] > 0} {
181 if {[catch {set rlst $cmt_refn($sha1)}]} continue
182 foreach refn $rlst {
183 set inc($refn) 1
186 close $fr_fd
187 } else {
188 foreach refn $all_refn {
189 set inc($refn) 1
193 set spec_head [list]
194 foreach name [load_all_heads] {
195 set refn refs/heads/$name
196 if {[info exists inc($refn)]} {
197 lappend spec_head [list $name $refn]
201 set spec_trck [list]
202 foreach spec [all_tracking_branches] {
203 set refn [lindex $spec 0]
204 if {[info exists inc($refn)]} {
205 regsub ^refs/(heads|remotes)/ $refn {} name
206 lappend spec_trck [concat $name $spec]
210 set spec_tag [list]
211 foreach name [load_all_tags] {
212 set refn refs/tags/$name
213 if {[info exists inc($refn)]} {
214 lappend spec_tag [list $name $refn]
218 if {$is_detached} { set revtype HEAD
219 } elseif {[llength $spec_head] > 0} { set revtype head
220 } elseif {[llength $spec_trck] > 0} { set revtype trck
221 } elseif {[llength $spec_tag ] > 0} { set revtype tag
222 } else { set revtype expr
225 if {$revtype eq {head} && $current_branch ne {}} {
226 set i 0
227 foreach spec $spec_head {
228 if {[lindex $spec 0] eq $current_branch} {
229 $w_list selection clear 0 end
230 $w_list selection set $i
231 break
233 incr i
237 return $this
240 method none {text} {
241 global NS use_ttk
242 if {![winfo exists $w.none_r]} {
243 ${NS}::radiobutton $w.none_r \
244 -value none \
245 -variable @revtype
246 if {!$use_ttk} {$w.none_r configure -anchor w}
247 grid $w.none_r -sticky we -padx {0 5} -columnspan 2
249 $w.none_r configure -text $text
252 method get {} {
253 switch -- $revtype {
254 head -
255 trck -
256 tag {
257 set i [$w_list curselection]
258 if {$i ne {}} {
259 return [lindex $cur_specs $i 0]
260 } else {
261 return {}
265 HEAD { return HEAD }
266 expr { return $c_expr }
267 none { return {} }
268 default { error "unknown type of revision" }
272 method pick_tracking_branch {} {
273 set revtype trck
276 method focus_filter {} {
277 if {[$w_filter cget -state] eq {normal}} {
278 focus $w_filter
282 method bind_listbox {event script} {
283 bind $w_list $event $script
286 method get_local_branch {} {
287 if {$revtype eq {head}} {
288 return [_expr $this]
289 } else {
290 return {}
294 method get_tracking_branch {} {
295 set i [$w_list curselection]
296 if {$i eq {} || $revtype ne {trck}} {
297 return {}
299 return [lrange [lindex $cur_specs $i] 1 end]
302 method get_commit {} {
303 set e [_expr $this]
304 if {$e eq {}} {
305 return {}
307 return [git rev-parse --verify "$e^0"]
310 method commit_or_die {} {
311 if {[catch {set new [get_commit $this]} err]} {
313 # Cleanup the not-so-friendly error from rev-parse.
315 regsub {^fatal:\s*} $err {} err
316 if {$err eq {Needed a single revision}} {
317 set err {}
320 set top [winfo toplevel $w]
321 set msg [strcat [mc "Invalid revision: %s" [get $this]] "\n\n$err"]
322 tk_messageBox \
323 -icon error \
324 -type ok \
325 -title [wm title $top] \
326 -parent $top \
327 -message $msg
328 error $msg
330 return $new
333 method _expr {} {
334 switch -- $revtype {
335 head -
336 trck -
337 tag {
338 set i [$w_list curselection]
339 if {$i ne {}} {
340 return [lindex $cur_specs $i 1]
341 } else {
342 error [mc "No revision selected."]
346 expr {
347 if {$c_expr ne {}} {
348 return $c_expr
349 } else {
350 error [mc "Revision expression is empty."]
353 HEAD { return HEAD }
354 none { return {} }
355 default { error "unknown type of revision" }
359 method _validate {d S} {
360 if {$d == 1} {
361 if {[regexp {\s} $S]} {
362 return 0
364 if {[string length $S] > 0} {
365 set revtype expr
368 return 1
371 method _filter {P} {
372 if {[regexp {\s} $P]} {
373 return 0
375 _rebuild $this $P
376 return 1
379 method _select {args} {
380 _rebuild $this $filter
381 focus_filter $this
384 method _rebuild {pat} {
385 set ste normal
386 switch -- $revtype {
387 head { set new $spec_head }
388 trck { set new $spec_trck }
389 tag { set new $spec_tag }
390 expr -
391 HEAD -
392 none {
393 set new [list]
394 set ste disabled
398 if {[$w_list cget -state] eq {disabled}} {
399 $w_list configure -state normal
401 $w_list delete 0 end
403 if {$pat ne {}} {
404 set pat *${pat}*
406 set cur_specs [list]
407 foreach spec $new {
408 set txt [lindex $spec 0]
409 if {$pat eq {} || [string match $pat $txt]} {
410 lappend cur_specs $spec
411 $w_list insert end $txt
414 if {$cur_specs ne {}} {
415 $w_list selection clear 0 end
416 $w_list selection set 0
419 if {[$w_filter cget -state] ne $ste} {
420 $w_list configure -state $ste
421 $w_filter configure -state $ste
425 method _delete {current} {
426 if {$current eq $w} {
427 delete_this
431 method _sb_set {sb orient first last} {
432 global NS
433 set old_focus [focus -lastfor $w]
435 if {$first == 0 && $last == 1} {
436 if {[winfo exists $sb]} {
437 destroy $sb
438 if {$old_focus ne {}} {
439 update
440 focus $old_focus
443 return
446 if {![winfo exists $sb]} {
447 if {$orient eq {h}} {
448 ${NS}::scrollbar $sb -orient h -command [list $w_list xview]
449 pack $sb -fill x -side bottom -before $w_list
450 } else {
451 ${NS}::scrollbar $sb -orient v -command [list $w_list yview]
452 pack $sb -fill y -side right -before $w_list
454 if {$old_focus ne {}} {
455 update
456 focus $old_focus
460 catch {$sb set $first $last}
463 method _show_tooltip {pos} {
464 if {$tooltip_wm ne {}} {
465 _open_tooltip $this
466 } elseif {$tooltip_timer eq {}} {
467 set tooltip_timer [after 1000 [cb _open_tooltip]]
471 method _open_tooltip {} {
472 global remote_url
474 set tooltip_timer {}
475 set pos_x [winfo pointerx $w_list]
476 set pos_y [winfo pointery $w_list]
477 if {[winfo containing $pos_x $pos_y] ne $w_list} {
478 _hide_tooltip $this
479 return
482 set pos @[join [list \
483 [expr {$pos_x - [winfo rootx $w_list]}] \
484 [expr {$pos_y - [winfo rooty $w_list]}]] ,]
485 set lno [$w_list index $pos]
486 if {$lno eq {}} {
487 _hide_tooltip $this
488 return
491 set spec [lindex $cur_specs $lno]
492 set refn [lindex $spec 1]
493 if {$refn eq {}} {
494 _hide_tooltip $this
495 return
498 if {$tooltip_wm eq {}} {
499 set tooltip_wm [toplevel $w_list.tooltip -borderwidth 1]
500 catch {wm attributes $tooltip_wm -type tooltip}
501 wm overrideredirect $tooltip_wm 1
502 wm transient $tooltip_wm [winfo toplevel $w_list]
503 set tooltip_t $tooltip_wm.label
504 text $tooltip_t \
505 -takefocus 0 \
506 -highlightthickness 0 \
507 -relief flat \
508 -borderwidth 0 \
509 -wrap none \
510 -background lightyellow \
511 -foreground black
512 $tooltip_t tag conf section_header -font font_uibold
513 bind $tooltip_wm <Escape> [cb _hide_tooltip]
514 pack $tooltip_t
515 } else {
516 $tooltip_t conf -state normal
517 $tooltip_t delete 0.0 end
520 set data $tip_data($refn)
521 if {[lindex $data 0 0] eq {tag}} {
522 set tag [lindex $data 0]
523 if {[lindex $data 1 0] eq {commit}} {
524 set cmit [lindex $data 1]
525 } else {
526 set cmit {}
528 } elseif {[lindex $data 0 0] eq {commit}} {
529 set tag {}
530 set cmit [lindex $data 0]
533 $tooltip_t insert end [lindex $spec 0]
534 set last [_reflog_last $this [lindex $spec 1]]
535 if {$last ne {}} {
536 $tooltip_t insert end "\n"
537 $tooltip_t insert end [mc "Updated"]
538 $tooltip_t insert end " $last"
540 $tooltip_t insert end "\n"
542 if {$tag ne {}} {
543 $tooltip_t insert end "\n"
544 $tooltip_t insert end [mc "Tag"] section_header
545 $tooltip_t insert end " [lindex $tag 1]\n"
546 $tooltip_t insert end [lindex $tag 2]
547 $tooltip_t insert end " ([lindex $tag 3])\n"
548 $tooltip_t insert end [lindex $tag 4]
549 $tooltip_t insert end "\n"
552 if {$cmit ne {}} {
553 $tooltip_t insert end "\n"
554 $tooltip_t insert end [mc "Commit@@noun"] section_header
555 $tooltip_t insert end " [lindex $cmit 1]\n"
556 $tooltip_t insert end [lindex $cmit 2]
557 $tooltip_t insert end " ([lindex $cmit 3])\n"
558 $tooltip_t insert end [lindex $cmit 4]
561 if {[llength $spec] > 2} {
562 $tooltip_t insert end "\n"
563 $tooltip_t insert end [mc "Remote"] section_header
564 $tooltip_t insert end " [lindex $spec 2]\n"
565 $tooltip_t insert end [mc "URL"]
566 $tooltip_t insert end " $remote_url([lindex $spec 2])\n"
567 $tooltip_t insert end [mc "Branch"]
568 $tooltip_t insert end " [lindex $spec 3]"
571 $tooltip_t conf -state disabled
572 _position_tooltip $this
575 method _reflog_last {name} {
576 if {[info exists reflog_last($name)]} {
577 return reflog_last($name)
580 set last {}
581 if {[catch {set last [file mtime [gitdir $name]]}]
582 && ![catch {set g [open [gitdir logs $name] r]}]} {
583 fconfigure $g -translation binary
584 while {[gets $g line] >= 0} {
585 if {[regexp {> ([1-9][0-9]*) } $line line when]} {
586 set last $when
589 close $g
592 if {$last ne {}} {
593 set last [format_date $last]
595 set reflog_last($name) $last
596 return $last
599 method _position_tooltip {} {
600 set max_h [lindex [split [$tooltip_t index end] .] 0]
601 set max_w 0
602 for {set i 1} {$i <= $max_h} {incr i} {
603 set c [lindex [split [$tooltip_t index "$i.0 lineend"] .] 1]
604 if {$c > $max_w} {set max_w $c}
606 $tooltip_t conf -width $max_w -height $max_h
608 set req_w [winfo reqwidth $tooltip_t]
609 set req_h [winfo reqheight $tooltip_t]
610 set pos_x [expr {[winfo pointerx .] + 5}]
611 set pos_y [expr {[winfo pointery .] + 10}]
613 set g "${req_w}x${req_h}"
614 if {[tk windowingsystem] eq "win32" || $pos_x >= 0} {append g +}
615 append g $pos_x
616 if {[tk windowingsystem] eq "win32" || $pos_y >= 0} {append g +}
617 append g $pos_y
619 wm geometry $tooltip_wm $g
620 raise $tooltip_wm
623 method _hide_tooltip {} {
624 if {$tooltip_wm ne {}} {
625 destroy $tooltip_wm
626 set tooltip_wm {}
628 if {$tooltip_timer ne {}} {
629 after cancel $tooltip_timer
630 set tooltip_timer {}