Merge git://repo.or.cz/git-gui
[git] / git-gui / lib / choose_rev.tcl
1 # git-gui revision chooser
2 # Copyright (C) 2006, 2007 Shawn Pearce
3
4 class choose_rev {
5
6 image create photo ::choose_rev::img_find -data {R0lGODlhEAAQAIYAAPwCBCQmJDw+PBQSFAQCBMza3NTm5MTW1HyChOT29Ozq7MTq7Kze5Kzm7Oz6/NTy9Iza5GzGzKzS1Nzy9Nz29Kzq9HTGzHTK1Lza3AwKDLzu9JTi7HTW5GTCzITO1Mzq7Hza5FTK1ESyvHzKzKzW3DQyNDyqtDw6PIzW5HzGzAT+/Dw+RKyurNTOzMTGxMS+tJSGdATCxHRydLSqpLymnLSijBweHERCRNze3Pz69PTy9Oze1OTSxOTGrMSqlLy+vPTu5OzSvMymjNTGvNS+tMy2pMyunMSefAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAAAALAAAAAAQABAAAAe4gACCAAECA4OIiAIEBQYHBAKJgwIICQoLDA0IkZIECQ4PCxARCwSSAxITFA8VEBYXGBmJAQYLGhUbHB0eH7KIGRIMEBAgISIjJKaIJQQLFxERIialkieUGigpKRoIBCqJKyyLBwvJAioEyoICLS4v6QQwMQQyLuqLli8zNDU2BCf1lN3AkUPHDh49fAQAAEnGD1MCCALZEaSHkIUMBQS8wWMIkSJGhBzBmFEGgRsBUqpMiSgdAD+BAAAh/mhDcmVhdGVkIGJ5IEJNUFRvR0lGIFBybyB2ZXJzaW9uIDIuNQ0KqSBEZXZlbENvciAxOTk3LDE5OTguIEFsbCByaWdodHMgcmVzZXJ2ZWQuDQpodHRwOi8vd3d3LmRldmVsY29yLmNvbQA7}
7
8 field w               ; # our megawidget path
9 field w_list          ; # list of currently filtered specs
10 field w_filter        ; # filter entry for $w_list
11
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
21
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
25
26 proc new {path {title {}}} {
27         return [_new $path 0 $title]
28 }
29
30 proc new_unmerged {path {title {}}} {
31         return [_new $path 1 $title]
32 }
33
34 constructor _new {path unmerged_only title} {
35         global current_branch is_detached
36
37         if {![info exists ::all_remotes]} {
38                 load_all_remotes
39         }
40
41         set w $path
42
43         if {$title ne {}} {
44                 labelframe $w -text $title
45         } else {
46                 frame $w
47         }
48         bind $w <Destroy> [cb _delete %W]
49
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
57         }
58
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}
71
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
101
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]
118
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
124         }
125
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]
129
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 \
153                 ]
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
162                         }
163                 } elseif {[lindex $line 1 0] eq {commit}} {
164                         set sha1 [lindex $line 1 1]
165                 } else {
166                         continue
167                 }
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
172         }
173         close $fr_fd
174
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
181                         }
182                 }
183                 close $fr_fd
184         } else {
185                 foreach refn $all_refn {
186                         set inc($refn) 1
187                 }
188         }
189
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]
195                 }
196         }
197
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]
204                 }
205         }
206
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]
212                 }
213         }
214
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
220         }
221
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
229                         }
230                         incr i
231                 }
232         }
233
234         return $this
235 }
236
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
244         }
245         $w.none_r configure -text $text
246 }
247
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 {}
258                 }
259         }
260
261         HEAD { return HEAD                     }
262         expr { return $c_expr                  }
263         none { return {}                       }
264         default { error "unknown type of revision" }
265         }
266 }
267
268 method pick_tracking_branch {} {
269         set revtype trck
270 }
271
272 method focus_filter {} {
273         if {[$w_filter cget -state] eq {normal}} {
274                 focus $w_filter
275         }
276 }
277
278 method bind_listbox {event script}  {
279         bind $w_list $event $script
280 }
281
282 method get_local_branch {} {
283         if {$revtype eq {head}} {
284                 return [_expr $this]
285         } else {
286                 return {}
287         }
288 }
289
290 method get_tracking_branch {} {
291         set i [$w_list curselection]
292         if {$i eq {} || $revtype ne {trck}} {
293                 return {}
294         }
295         return [lrange [lindex $cur_specs $i] 1 end]
296 }
297
298 method get_commit {} {
299         set e [_expr $this]
300         if {$e eq {}} {
301                 return {}
302         }
303         return [git rev-parse --verify "$e^0"]
304 }
305
306 method commit_or_die {} {
307         if {[catch {set new [get_commit $this]} err]} {
308
309                 # Cleanup the not-so-friendly error from rev-parse.
310                 #
311                 regsub {^fatal:\s*} $err {} err
312                 if {$err eq {Needed a single revision}} {
313                         set err {}
314                 }
315
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
325         }
326         return $new
327 }
328
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."]
339                 }
340         }
341
342         expr {
343                 if {$c_expr ne {}} {
344                         return $c_expr
345                 } else {
346                         error [mc "Revision expression is empty."]
347                 }
348         }
349         HEAD { return HEAD                     }
350         none { return {}                       }
351         default { error "unknown type of revision"      }
352         }
353 }
354
355 method _validate {d S} {
356         if {$d == 1} {
357                 if {[regexp {\s} $S]} {
358                         return 0
359                 }
360                 if {[string length $S] > 0} {
361                         set revtype expr
362                 }
363         }
364         return 1
365 }
366
367 method _filter {P} {
368         if {[regexp {\s} $P]} {
369                 return 0
370         }
371         _rebuild $this $P
372         return 1
373 }
374
375 method _select {args} {
376         _rebuild $this $filter
377         focus_filter $this
378 }
379
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
391         }
392         }
393
394         if {[$w_list cget -state] eq {disabled}} {
395                 $w_list configure -state normal
396         }
397         $w_list delete 0 end
398
399         if {$pat ne {}} {
400                 set pat *${pat}*
401         }
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
408                 }
409         }
410         if {$cur_specs ne {}} {
411                 $w_list selection clear 0 end
412                 $w_list selection set 0
413         }
414
415         if {[$w_filter cget -state] ne $ste} {
416                 $w_list   configure -state $ste
417                 $w_filter configure -state $ste
418         }
419 }
420
421 method _delete {current} {
422         if {$current eq $w} {
423                 delete_this
424         }
425 }
426
427 method _sb_set {sb orient first last} {
428         set old_focus [focus -lastfor $w]
429
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
436                         }
437                 }
438                 return
439         }
440
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
448                 }
449                 if {$old_focus ne {}} {
450                         update
451                         focus $old_focus
452                 }
453         }
454
455         catch {$sb set $first $last}
456 }
457
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]]
463         }
464 }
465
466 method _open_tooltip {} {
467         global remote_url
468
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
475         }
476
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
484         }
485
486         set spec [lindex $cur_specs $lno]
487         set refn [lindex $spec 1]
488         if {$refn eq {}} {
489                 _hide_tooltip $this
490                 return
491         }
492
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
512         }
513
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 {}
521                 }
522         } elseif {[lindex $data 0 0] eq {commit}} {
523                 set tag  {}
524                 set cmit [lindex $data 0]
525         }
526
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"
533         }
534         $tooltip_t insert end "\n"
535
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"
544         }
545
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]
553         }
554
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]"
563         }
564
565         $tooltip_t conf -state disabled
566         _position_tooltip $this
567 }
568
569 method _reflog_last {name} {
570         if {[info exists reflog_last($name)]} {
571                 return reflog_last($name)
572         }
573
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
581                         }
582                 }
583                 close $g
584         }
585
586         if {$last ne {}} {
587                 set last [format_date $last]
588         }
589         set reflog_last($name) $last
590         return $last
591 }
592
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}
599         }
600         $tooltip_t conf -width $max_w -height $max_h
601
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}]
606
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
612
613         wm geometry $tooltip_wm $g
614         raise $tooltip_wm
615 }
616
617 method _hide_tooltip {} {
618         if {$tooltip_wm ne {}} {
619                 destroy $tooltip_wm
620                 set tooltip_wm {}
621         }
622         if {$tooltip_timer ne {}} {
623                 after cancel $tooltip_timer
624                 set tooltip_timer {}
625         }
626 }
627
628 }