Merge branch 'ab/compat-regex'
[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 use_ttk NS
36
37         if {![info exists ::all_remotes]} {
38                 load_all_remotes
39         }
40
41         set w $path
42
43         if {$title ne {}} {
44                 ${NS}::labelframe $w -text $title
45         } else {
46                 ${NS}::frame $w
47         }
48         bind $w <Destroy> [cb _delete %W]
49
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
57         }
58
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}
69
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
97
98         if {$use_ttk} {
99                 ttk::frame $w.list -style SListbox.TFrame -padding 2
100         } else {
101                 frame $w.list
102         }
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
114         }
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]
121
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
127         }
128
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]
132
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 \
156                 ]
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
165                         }
166                 } elseif {[lindex $line 1 0] eq {commit}} {
167                         set sha1 [lindex $line 1 1]
168                 } else {
169                         continue
170                 }
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
175         }
176         close $fr_fd
177
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
184                         }
185                 }
186                 close $fr_fd
187         } else {
188                 foreach refn $all_refn {
189                         set inc($refn) 1
190                 }
191         }
192
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]
198                 }
199         }
200
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]
207                 }
208         }
209
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]
215                 }
216         }
217
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
223         }
224
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
232                         }
233                         incr i
234                 }
235         }
236
237         return $this
238 }
239
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
248         }
249         $w.none_r configure -text $text
250 }
251
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 {}
262                 }
263         }
264
265         HEAD { return HEAD                     }
266         expr { return $c_expr                  }
267         none { return {}                       }
268         default { error "unknown type of revision" }
269         }
270 }
271
272 method pick_tracking_branch {} {
273         set revtype trck
274 }
275
276 method focus_filter {} {
277         if {[$w_filter cget -state] eq {normal}} {
278                 focus $w_filter
279         }
280 }
281
282 method bind_listbox {event script}  {
283         bind $w_list $event $script
284 }
285
286 method get_local_branch {} {
287         if {$revtype eq {head}} {
288                 return [_expr $this]
289         } else {
290                 return {}
291         }
292 }
293
294 method get_tracking_branch {} {
295         set i [$w_list curselection]
296         if {$i eq {} || $revtype ne {trck}} {
297                 return {}
298         }
299         return [lrange [lindex $cur_specs $i] 1 end]
300 }
301
302 method get_commit {} {
303         set e [_expr $this]
304         if {$e eq {}} {
305                 return {}
306         }
307         return [git rev-parse --verify "$e^0"]
308 }
309
310 method commit_or_die {} {
311         if {[catch {set new [get_commit $this]} err]} {
312
313                 # Cleanup the not-so-friendly error from rev-parse.
314                 #
315                 regsub {^fatal:\s*} $err {} err
316                 if {$err eq {Needed a single revision}} {
317                         set err {}
318                 }
319
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
329         }
330         return $new
331 }
332
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."]
343                 }
344         }
345
346         expr {
347                 if {$c_expr ne {}} {
348                         return $c_expr
349                 } else {
350                         error [mc "Revision expression is empty."]
351                 }
352         }
353         HEAD { return HEAD                     }
354         none { return {}                       }
355         default { error "unknown type of revision"      }
356         }
357 }
358
359 method _validate {d S} {
360         if {$d == 1} {
361                 if {[regexp {\s} $S]} {
362                         return 0
363                 }
364                 if {[string length $S] > 0} {
365                         set revtype expr
366                 }
367         }
368         return 1
369 }
370
371 method _filter {P} {
372         if {[regexp {\s} $P]} {
373                 return 0
374         }
375         _rebuild $this $P
376         return 1
377 }
378
379 method _select {args} {
380         _rebuild $this $filter
381         focus_filter $this
382 }
383
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
395         }
396         }
397
398         if {[$w_list cget -state] eq {disabled}} {
399                 $w_list configure -state normal
400         }
401         $w_list delete 0 end
402
403         if {$pat ne {}} {
404                 set pat *${pat}*
405         }
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
412                 }
413         }
414         if {$cur_specs ne {}} {
415                 $w_list selection clear 0 end
416                 $w_list selection set 0
417         }
418
419         if {[$w_filter cget -state] ne $ste} {
420                 $w_list   configure -state $ste
421                 $w_filter configure -state $ste
422         }
423 }
424
425 method _delete {current} {
426         if {$current eq $w} {
427                 delete_this
428         }
429 }
430
431 method _sb_set {sb orient first last} {
432         global NS
433         set old_focus [focus -lastfor $w]
434
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
441                         }
442                 }
443                 return
444         }
445
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
453                 }
454                 if {$old_focus ne {}} {
455                         update
456                         focus $old_focus
457                 }
458         }
459
460         catch {$sb set $first $last}
461 }
462
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]]
468         }
469 }
470
471 method _open_tooltip {} {
472         global remote_url
473
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
480         }
481
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
489         }
490
491         set spec [lindex $cur_specs $lno]
492         set refn [lindex $spec 1]
493         if {$refn eq {}} {
494                 _hide_tooltip $this
495                 return
496         }
497
498         if {$tooltip_wm eq {}} {
499                 set tooltip_wm [toplevel $w_list.tooltip -borderwidth 1]
500                 wm overrideredirect $tooltip_wm 1
501                 wm transient $tooltip_wm [winfo toplevel $w_list]
502                 set tooltip_t $tooltip_wm.label
503                 text $tooltip_t \
504                         -takefocus 0 \
505                         -highlightthickness 0 \
506                         -relief flat \
507                         -borderwidth 0 \
508                         -wrap none \
509                         -background lightyellow \
510                         -foreground black
511                 $tooltip_t tag conf section_header -font font_uibold
512                 bind $tooltip_wm <Escape> [cb _hide_tooltip]
513                 pack $tooltip_t
514         } else {
515                 $tooltip_t conf -state normal
516                 $tooltip_t delete 0.0 end
517         }
518
519         set data $tip_data($refn)
520         if {[lindex $data 0 0] eq {tag}} {
521                 set tag  [lindex $data 0]
522                 if {[lindex $data 1 0] eq {commit}} {
523                         set cmit [lindex $data 1]
524                 } else {
525                         set cmit {}
526                 }
527         } elseif {[lindex $data 0 0] eq {commit}} {
528                 set tag  {}
529                 set cmit [lindex $data 0]
530         }
531
532         $tooltip_t insert end [lindex $spec 0]
533         set last [_reflog_last $this [lindex $spec 1]]
534         if {$last ne {}} {
535                 $tooltip_t insert end "\n"
536                 $tooltip_t insert end [mc "Updated"]
537                 $tooltip_t insert end " $last"
538         }
539         $tooltip_t insert end "\n"
540
541         if {$tag ne {}} {
542                 $tooltip_t insert end "\n"
543                 $tooltip_t insert end [mc "Tag"] section_header
544                 $tooltip_t insert end "  [lindex $tag 1]\n"
545                 $tooltip_t insert end [lindex $tag 2]
546                 $tooltip_t insert end " ([lindex $tag 3])\n"
547                 $tooltip_t insert end [lindex $tag 4]
548                 $tooltip_t insert end "\n"
549         }
550
551         if {$cmit ne {}} {
552                 $tooltip_t insert end "\n"
553                 $tooltip_t insert end [mc "Commit@@noun"] section_header
554                 $tooltip_t insert end "  [lindex $cmit 1]\n"
555                 $tooltip_t insert end [lindex $cmit 2]
556                 $tooltip_t insert end " ([lindex $cmit 3])\n"
557                 $tooltip_t insert end [lindex $cmit 4]
558         }
559
560         if {[llength $spec] > 2} {
561                 $tooltip_t insert end "\n"
562                 $tooltip_t insert end [mc "Remote"] section_header
563                 $tooltip_t insert end "  [lindex $spec 2]\n"
564                 $tooltip_t insert end [mc "URL"]
565                 $tooltip_t insert end " $remote_url([lindex $spec 2])\n"
566                 $tooltip_t insert end [mc "Branch"]
567                 $tooltip_t insert end " [lindex $spec 3]"
568         }
569
570         $tooltip_t conf -state disabled
571         _position_tooltip $this
572 }
573
574 method _reflog_last {name} {
575         if {[info exists reflog_last($name)]} {
576                 return reflog_last($name)
577         }
578
579         set last {}
580         if {[catch {set last [file mtime [gitdir $name]]}]
581         && ![catch {set g [open [gitdir logs $name] r]}]} {
582                 fconfigure $g -translation binary
583                 while {[gets $g line] >= 0} {
584                         if {[regexp {> ([1-9][0-9]*) } $line line when]} {
585                                 set last $when
586                         }
587                 }
588                 close $g
589         }
590
591         if {$last ne {}} {
592                 set last [format_date $last]
593         }
594         set reflog_last($name) $last
595         return $last
596 }
597
598 method _position_tooltip {} {
599         set max_h [lindex [split [$tooltip_t index end] .] 0]
600         set max_w 0
601         for {set i 1} {$i <= $max_h} {incr i} {
602                 set c [lindex [split [$tooltip_t index "$i.0 lineend"] .] 1]
603                 if {$c > $max_w} {set max_w $c}
604         }
605         $tooltip_t conf -width $max_w -height $max_h
606
607         set req_w [winfo reqwidth  $tooltip_t]
608         set req_h [winfo reqheight $tooltip_t]
609         set pos_x [expr {[winfo pointerx .] +  5}]
610         set pos_y [expr {[winfo pointery .] + 10}]
611
612         set g "${req_w}x${req_h}"
613         if {$pos_x >= 0} {append g +}
614         append g $pos_x
615         if {$pos_y >= 0} {append g +}
616         append g $pos_y
617
618         wm geometry $tooltip_wm $g
619         raise $tooltip_wm
620 }
621
622 method _hide_tooltip {} {
623         if {$tooltip_wm ne {}} {
624                 destroy $tooltip_wm
625                 set tooltip_wm {}
626         }
627         if {$tooltip_timer ne {}} {
628                 after cancel $tooltip_timer
629                 set tooltip_timer {}
630         }
631 }
632
633 }