builtin-mailinfo.c: check error status from rewind and ftruncate
[git/spearce.git] / git-gui / lib / choose_rev.tcl
blobc8821c146386f850c0794df70f605cd9f18dcff3
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
37 if {![info exists ::all_remotes]} {
38 load_all_remotes
41 set w $path
43 if {$title ne {}} {
44 labelframe $w -text $title
45 } else {
46 frame $w
48 bind $w <Destroy> [cb _delete %W]
50 if {$is_detached} {
51 radiobutton $w.detachedhead_r \
52 -anchor w \
53 -text [mc "This Detached Checkout"] \
54 -value HEAD \
55 -variable @revtype
56 grid $w.detachedhead_r -sticky we -padx {0 5} -columnspan 2
59 radiobutton $w.expr_r \
60 -text [mc "Revision Expression:"] \
61 -value expr \
62 -variable @revtype
63 entry $w.expr_t \
64 -borderwidth 1 \
65 -relief sunken \
66 -width 50 \
67 -textvariable @c_expr \
68 -validate key \
69 -validatecommand [cb _validate %d %S]
70 grid $w.expr_r $w.expr_t -sticky we -padx {0 5}
72 frame $w.types
73 radiobutton $w.types.head_r \
74 -text [mc "Local Branch"] \
75 -value head \
76 -variable @revtype
77 pack $w.types.head_r -side left
78 radiobutton $w.types.trck_r \
79 -text [mc "Tracking Branch"] \
80 -value trck \
81 -variable @revtype
82 pack $w.types.trck_r -side left
83 radiobutton $w.types.tag_r \
84 -text [mc "Tag"] \
85 -value tag \
86 -variable @revtype
87 pack $w.types.tag_r -side left
88 set w_filter $w.types.filter
89 entry $w_filter \
90 -borderwidth 1 \
91 -relief sunken \
92 -width 12 \
93 -textvariable @filter \
94 -validate key \
95 -validatecommand [cb _filter %P]
96 pack $w_filter -side right
97 pack [label $w.types.filter_icon \
98 -image ::choose_rev::img_find \
99 ] -side right
100 grid $w.types -sticky we -padx {0 5} -columnspan 2
102 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 pack $w_list -fill both -expand 1
113 grid $w.list -sticky nswe -padx {20 5} -columnspan 2
114 bind $w_list <Any-Motion> [cb _show_tooltip @%x,%y]
115 bind $w_list <Any-Enter> [cb _hide_tooltip]
116 bind $w_list <Any-Leave> [cb _hide_tooltip]
117 bind $w_list <Destroy> [cb _hide_tooltip]
119 grid columnconfigure $w 1 -weight 1
120 if {$is_detached} {
121 grid rowconfigure $w 3 -weight 1
122 } else {
123 grid rowconfigure $w 2 -weight 1
126 trace add variable @revtype write [cb _select]
127 bind $w_filter <Key-Return> [list focus $w_list]\;break
128 bind $w_filter <Key-Down> [list focus $w_list]
130 set fmt list
131 append fmt { %(refname)}
132 append fmt { [list}
133 append fmt { %(objecttype)}
134 append fmt { %(objectname)}
135 append fmt { [concat %(taggername) %(authorname)]}
136 append fmt { [reformat_date [concat %(taggerdate) %(authordate)]]}
137 append fmt { %(subject)}
138 append fmt {] [list}
139 append fmt { %(*objecttype)}
140 append fmt { %(*objectname)}
141 append fmt { %(*authorname)}
142 append fmt { [reformat_date %(*authordate)]}
143 append fmt { %(*subject)}
144 append fmt {]}
145 set all_refn [list]
146 set fr_fd [git_read for-each-ref \
147 --tcl \
148 --sort=-taggerdate \
149 --format=$fmt \
150 refs/heads \
151 refs/remotes \
152 refs/tags \
154 fconfigure $fr_fd -translation lf -encoding utf-8
155 while {[gets $fr_fd line] > 0} {
156 set line [eval $line]
157 if {[lindex $line 1 0] eq {tag}} {
158 if {[lindex $line 2 0] eq {commit}} {
159 set sha1 [lindex $line 2 1]
160 } else {
161 continue
163 } elseif {[lindex $line 1 0] eq {commit}} {
164 set sha1 [lindex $line 1 1]
165 } else {
166 continue
168 set refn [lindex $line 0]
169 set tip_data($refn) [lrange $line 1 end]
170 lappend cmt_refn($sha1) $refn
171 lappend all_refn $refn
173 close $fr_fd
175 if {$unmerged_only} {
176 set fr_fd [git_read rev-list --all ^$::HEAD]
177 while {[gets $fr_fd sha1] > 0} {
178 if {[catch {set rlst $cmt_refn($sha1)}]} continue
179 foreach refn $rlst {
180 set inc($refn) 1
183 close $fr_fd
184 } else {
185 foreach refn $all_refn {
186 set inc($refn) 1
190 set spec_head [list]
191 foreach name [load_all_heads] {
192 set refn refs/heads/$name
193 if {[info exists inc($refn)]} {
194 lappend spec_head [list $name $refn]
198 set spec_trck [list]
199 foreach spec [all_tracking_branches] {
200 set refn [lindex $spec 0]
201 if {[info exists inc($refn)]} {
202 regsub ^refs/(heads|remotes)/ $refn {} name
203 lappend spec_trck [concat $name $spec]
207 set spec_tag [list]
208 foreach name [load_all_tags] {
209 set refn refs/tags/$name
210 if {[info exists inc($refn)]} {
211 lappend spec_tag [list $name $refn]
215 if {$is_detached} { set revtype HEAD
216 } elseif {[llength $spec_head] > 0} { set revtype head
217 } elseif {[llength $spec_trck] > 0} { set revtype trck
218 } elseif {[llength $spec_tag ] > 0} { set revtype tag
219 } else { set revtype expr
222 if {$revtype eq {head} && $current_branch ne {}} {
223 set i 0
224 foreach spec $spec_head {
225 if {[lindex $spec 0] eq $current_branch} {
226 $w_list selection clear 0 end
227 $w_list selection set $i
228 break
230 incr i
234 return $this
237 method none {text} {
238 if {![winfo exists $w.none_r]} {
239 radiobutton $w.none_r \
240 -anchor w \
241 -value none \
242 -variable @revtype
243 grid $w.none_r -sticky we -padx {0 5} -columnspan 2
245 $w.none_r configure -text $text
248 method get {} {
249 switch -- $revtype {
250 head -
251 trck -
252 tag {
253 set i [$w_list curselection]
254 if {$i ne {}} {
255 return [lindex $cur_specs $i 0]
256 } else {
257 return {}
261 HEAD { return HEAD }
262 expr { return $c_expr }
263 none { return {} }
264 default { error "unknown type of revision" }
268 method pick_tracking_branch {} {
269 set revtype trck
272 method focus_filter {} {
273 if {[$w_filter cget -state] eq {normal}} {
274 focus $w_filter
278 method bind_listbox {event script} {
279 bind $w_list $event $script
282 method get_local_branch {} {
283 if {$revtype eq {head}} {
284 return [_expr $this]
285 } else {
286 return {}
290 method get_tracking_branch {} {
291 set i [$w_list curselection]
292 if {$i eq {} || $revtype ne {trck}} {
293 return {}
295 return [lrange [lindex $cur_specs $i] 1 end]
298 method get_commit {} {
299 set e [_expr $this]
300 if {$e eq {}} {
301 return {}
303 return [git rev-parse --verify "$e^0"]
306 method commit_or_die {} {
307 if {[catch {set new [get_commit $this]} err]} {
309 # Cleanup the not-so-friendly error from rev-parse.
311 regsub {^fatal:\s*} $err {} err
312 if {$err eq {Needed a single revision}} {
313 set err {}
316 set top [winfo toplevel $w]
317 set msg [strcat [mc "Invalid revision: %s" [get $this]] "\n\n$err"]
318 tk_messageBox \
319 -icon error \
320 -type ok \
321 -title [wm title $top] \
322 -parent $top \
323 -message $msg
324 error $msg
326 return $new
329 method _expr {} {
330 switch -- $revtype {
331 head -
332 trck -
333 tag {
334 set i [$w_list curselection]
335 if {$i ne {}} {
336 return [lindex $cur_specs $i 1]
337 } else {
338 error [mc "No revision selected."]
342 expr {
343 if {$c_expr ne {}} {
344 return $c_expr
345 } else {
346 error [mc "Revision expression is empty."]
349 HEAD { return HEAD }
350 none { return {} }
351 default { error "unknown type of revision" }
355 method _validate {d S} {
356 if {$d == 1} {
357 if {[regexp {\s} $S]} {
358 return 0
360 if {[string length $S] > 0} {
361 set revtype expr
364 return 1
367 method _filter {P} {
368 if {[regexp {\s} $P]} {
369 return 0
371 _rebuild $this $P
372 return 1
375 method _select {args} {
376 _rebuild $this $filter
377 focus_filter $this
380 method _rebuild {pat} {
381 set ste normal
382 switch -- $revtype {
383 head { set new $spec_head }
384 trck { set new $spec_trck }
385 tag { set new $spec_tag }
386 expr -
387 HEAD -
388 none {
389 set new [list]
390 set ste disabled
394 if {[$w_list cget -state] eq {disabled}} {
395 $w_list configure -state normal
397 $w_list delete 0 end
399 if {$pat ne {}} {
400 set pat *${pat}*
402 set cur_specs [list]
403 foreach spec $new {
404 set txt [lindex $spec 0]
405 if {$pat eq {} || [string match $pat $txt]} {
406 lappend cur_specs $spec
407 $w_list insert end $txt
410 if {$cur_specs ne {}} {
411 $w_list selection clear 0 end
412 $w_list selection set 0
415 if {[$w_filter cget -state] ne $ste} {
416 $w_list configure -state $ste
417 $w_filter configure -state $ste
421 method _delete {current} {
422 if {$current eq $w} {
423 delete_this
427 method _sb_set {sb orient first last} {
428 set old_focus [focus -lastfor $w]
430 if {$first == 0 && $last == 1} {
431 if {[winfo exists $sb]} {
432 destroy $sb
433 if {$old_focus ne {}} {
434 update
435 focus $old_focus
438 return
441 if {![winfo exists $sb]} {
442 if {$orient eq {h}} {
443 scrollbar $sb -orient h -command [list $w_list xview]
444 pack $sb -fill x -side bottom -before $w_list
445 } else {
446 scrollbar $sb -orient v -command [list $w_list yview]
447 pack $sb -fill y -side right -before $w_list
449 if {$old_focus ne {}} {
450 update
451 focus $old_focus
455 catch {$sb set $first $last}
458 method _show_tooltip {pos} {
459 if {$tooltip_wm ne {}} {
460 _open_tooltip $this
461 } elseif {$tooltip_timer eq {}} {
462 set tooltip_timer [after 1000 [cb _open_tooltip]]
466 method _open_tooltip {} {
467 global remote_url
469 set tooltip_timer {}
470 set pos_x [winfo pointerx $w_list]
471 set pos_y [winfo pointery $w_list]
472 if {[winfo containing $pos_x $pos_y] ne $w_list} {
473 _hide_tooltip $this
474 return
477 set pos @[join [list \
478 [expr {$pos_x - [winfo rootx $w_list]}] \
479 [expr {$pos_y - [winfo rooty $w_list]}]] ,]
480 set lno [$w_list index $pos]
481 if {$lno eq {}} {
482 _hide_tooltip $this
483 return
486 set spec [lindex $cur_specs $lno]
487 set refn [lindex $spec 1]
488 if {$refn eq {}} {
489 _hide_tooltip $this
490 return
493 if {$tooltip_wm eq {}} {
494 set tooltip_wm [toplevel $w_list.tooltip -borderwidth 1]
495 wm overrideredirect $tooltip_wm 1
496 wm transient $tooltip_wm [winfo toplevel $w_list]
497 set tooltip_t $tooltip_wm.label
498 text $tooltip_t \
499 -takefocus 0 \
500 -highlightthickness 0 \
501 -relief flat \
502 -borderwidth 0 \
503 -wrap none \
504 -background lightyellow \
505 -foreground black
506 $tooltip_t tag conf section_header -font font_uibold
507 bind $tooltip_wm <Escape> [cb _hide_tooltip]
508 pack $tooltip_t
509 } else {
510 $tooltip_t conf -state normal
511 $tooltip_t delete 0.0 end
514 set data $tip_data($refn)
515 if {[lindex $data 0 0] eq {tag}} {
516 set tag [lindex $data 0]
517 if {[lindex $data 1 0] eq {commit}} {
518 set cmit [lindex $data 1]
519 } else {
520 set cmit {}
522 } elseif {[lindex $data 0 0] eq {commit}} {
523 set tag {}
524 set cmit [lindex $data 0]
527 $tooltip_t insert end [lindex $spec 0]
528 set last [_reflog_last $this [lindex $spec 1]]
529 if {$last ne {}} {
530 $tooltip_t insert end "\n"
531 $tooltip_t insert end [mc "Updated"]
532 $tooltip_t insert end " $last"
534 $tooltip_t insert end "\n"
536 if {$tag ne {}} {
537 $tooltip_t insert end "\n"
538 $tooltip_t insert end [mc "Tag"] section_header
539 $tooltip_t insert end " [lindex $tag 1]\n"
540 $tooltip_t insert end [lindex $tag 2]
541 $tooltip_t insert end " ([lindex $tag 3])\n"
542 $tooltip_t insert end [lindex $tag 4]
543 $tooltip_t insert end "\n"
546 if {$cmit ne {}} {
547 $tooltip_t insert end "\n"
548 $tooltip_t insert end [mc "Commit@@noun"] section_header
549 $tooltip_t insert end " [lindex $cmit 1]\n"
550 $tooltip_t insert end [lindex $cmit 2]
551 $tooltip_t insert end " ([lindex $cmit 3])\n"
552 $tooltip_t insert end [lindex $cmit 4]
555 if {[llength $spec] > 2} {
556 $tooltip_t insert end "\n"
557 $tooltip_t insert end [mc "Remote"] section_header
558 $tooltip_t insert end " [lindex $spec 2]\n"
559 $tooltip_t insert end [mc "URL"]
560 $tooltip_t insert end " $remote_url([lindex $spec 2])\n"
561 $tooltip_t insert end [mc "Branch"]
562 $tooltip_t insert end " [lindex $spec 3]"
565 $tooltip_t conf -state disabled
566 _position_tooltip $this
569 method _reflog_last {name} {
570 if {[info exists reflog_last($name)]} {
571 return reflog_last($name)
574 set last {}
575 if {[catch {set last [file mtime [gitdir $name]]}]
576 && ![catch {set g [open [gitdir logs $name] r]}]} {
577 fconfigure $g -translation binary
578 while {[gets $g line] >= 0} {
579 if {[regexp {> ([1-9][0-9]*) } $line line when]} {
580 set last $when
583 close $g
586 if {$last ne {}} {
587 set last [format_date $last]
589 set reflog_last($name) $last
590 return $last
593 method _position_tooltip {} {
594 set max_h [lindex [split [$tooltip_t index end] .] 0]
595 set max_w 0
596 for {set i 1} {$i <= $max_h} {incr i} {
597 set c [lindex [split [$tooltip_t index "$i.0 lineend"] .] 1]
598 if {$c > $max_w} {set max_w $c}
600 $tooltip_t conf -width $max_w -height $max_h
602 set req_w [winfo reqwidth $tooltip_t]
603 set req_h [winfo reqheight $tooltip_t]
604 set pos_x [expr {[winfo pointerx .] + 5}]
605 set pos_y [expr {[winfo pointery .] + 10}]
607 set g "${req_w}x${req_h}"
608 if {$pos_x >= 0} {append g +}
609 append g $pos_x
610 if {$pos_y >= 0} {append g +}
611 append g $pos_y
613 wm geometry $tooltip_wm $g
614 raise $tooltip_wm
617 method _hide_tooltip {} {
618 if {$tooltip_wm ne {}} {
619 destroy $tooltip_wm
620 set tooltip_wm {}
622 if {$tooltip_timer ne {}} {
623 after cancel $tooltip_timer
624 set tooltip_timer {}