Andrew's git / gitweb.git / git-gui/lib/choose_rev.tcl
?
git-gui / lib / choose_rev.tclon commit Merge branch 'as/read-tree-prefix-doc-fix' (3e25b6c)
   1# git-gui revision chooser
   2# Copyright (C) 2006, 2007 Shawn Pearce
   3
   4class choose_rev {
   5
   6image create photo ::choose_rev::img_find -data {R0lGODlhEAAQAIYAAPwCBCQmJDw+PBQSFAQCBMza3NTm5MTW1HyChOT29Ozq7MTq7Kze5Kzm7Oz6/NTy9Iza5GzGzKzS1Nzy9Nz29Kzq9HTGzHTK1Lza3AwKDLzu9JTi7HTW5GTCzITO1Mzq7Hza5FTK1ESyvHzKzKzW3DQyNDyqtDw6PIzW5HzGzAT+/Dw+RKyurNTOzMTGxMS+tJSGdATCxHRydLSqpLymnLSijBweHERCRNze3Pz69PTy9Oze1OTSxOTGrMSqlLy+vPTu5OzSvMymjNTGvNS+tMy2pMyunMSefAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAAAALAAAAAAQABAAAAe4gACCAAECA4OIiAIEBQYHBAKJgwIICQoLDA0IkZIECQ4PCxARCwSSAxITFA8VEBYXGBmJAQYLGhUbHB0eH7KIGRIMEBAgISIjJKaIJQQLFxERIialkieUGigpKRoIBCqJKyyLBwvJAioEyoICLS4v6QQwMQQyLuqLli8zNDU2BCf1lN3AkUPHDh49fAQAAEnGD1MCCALZEaSHkIUMBQS8wWMIkSJGhBzBmFEGgRsBUqpMiSgdAD+BAAAh/mhDcmVhdGVkIGJ5IEJNUFRvR0lGIFBybyB2ZXJzaW9uIDIuNQ0KqSBEZXZlbENvciAxOTk3LDE5OTguIEFsbCByaWdodHMgcmVzZXJ2ZWQuDQpodHRwOi8vd3d3LmRldmVsY29yLmNvbQA7}
   7
   8field w               ; # our megawidget path
   9field w_list          ; # list of currently filtered specs
  10field w_filter        ; # filter entry for $w_list
  11
  12field c_expr        {}; # current revision expression
  13field filter        ""; # current filter string
  14field revtype     head; # type of revision chosen
  15field cur_specs [list]; # list of specs for $revtype
  16field spec_head       ; # list of all head specs
  17field spec_trck       ; # list of all tracking branch specs
  18field spec_tag        ; # list of all tag specs
  19field tip_data        ; # array of tip commit info by refname
  20field log_last        ; # array of reflog date by refname
  21
  22field tooltip_wm        {} ; # Current tooltip toplevel, if open
  23field tooltip_t         {} ; # Text widget in $tooltip_wm
  24field tooltip_timer     {} ; # Current timer event for our tooltip
  25
  26proc new {path {title {}}} {
  27        return [_new $path 0 $title]
  28}
  29
  30proc new_unmerged {path {title {}}} {
  31        return [_new $path 1 $title]
  32}
  33
  34constructor _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
 240method 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
 252method 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
 272method pick_tracking_branch {} {
 273        set revtype trck
 274}
 275
 276method focus_filter {} {
 277        if {[$w_filter cget -state] eq {normal}} {
 278                focus $w_filter
 279        }
 280}
 281
 282method bind_listbox {event script}  {
 283        bind $w_list $event $script
 284}
 285
 286method get_local_branch {} {
 287        if {$revtype eq {head}} {
 288                return [_expr $this]
 289        } else {
 290                return {}
 291        }
 292}
 293
 294method 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
 302method get_commit {} {
 303        set e [_expr $this]
 304        if {$e eq {}} {
 305                return {}
 306        }
 307        return [git rev-parse --verify "$e^0"]
 308}
 309
 310method 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
 333method _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
 359method _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
 371method _filter {P} {
 372        if {[regexp {\s} $P]} {
 373                return 0
 374        }
 375        _rebuild $this $P
 376        return 1
 377}
 378
 379method _select {args} {
 380        _rebuild $this $filter
 381        focus_filter $this
 382}
 383
 384method _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
 425method _delete {current} {
 426        if {$current eq $w} {
 427                delete_this
 428        }
 429}
 430
 431method _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
 463method _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
 471method _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                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
 518        }
 519
 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 {}
 527                }
 528        } elseif {[lindex $data 0 0] eq {commit}} {
 529                set tag  {}
 530                set cmit [lindex $data 0]
 531        }
 532
 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"
 539        }
 540        $tooltip_t insert end "\n"
 541
 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"
 550        }
 551
 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]
 559        }
 560
 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]"
 569        }
 570
 571        $tooltip_t conf -state disabled
 572        _position_tooltip $this
 573}
 574
 575method _reflog_last {name} {
 576        if {[info exists reflog_last($name)]} {
 577                return reflog_last($name)
 578        }
 579
 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
 587                        }
 588                }
 589                close $g
 590        }
 591
 592        if {$last ne {}} {
 593                set last [format_date $last]
 594        }
 595        set reflog_last($name) $last
 596        return $last
 597}
 598
 599method _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}
 605        }
 606        $tooltip_t conf -width $max_w -height $max_h
 607
 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}]
 612
 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
 618
 619        wm geometry $tooltip_wm $g
 620        raise $tooltip_wm
 621}
 622
 623method _hide_tooltip {} {
 624        if {$tooltip_wm ne {}} {
 625                destroy $tooltip_wm
 626                set tooltip_wm {}
 627        }
 628        if {$tooltip_timer ne {}} {
 629                after cancel $tooltip_timer
 630                set tooltip_timer {}
 631        }
 632}
 633
 634}