Andrew's git / gitweb.git / lib/choose_rev.tcl
?
lib / choose_rev.tclon commit git-gui: Don't bother showing OS error message about hardlinks (40f86af)
   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
  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
 237method 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
 248method 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
 268method pick_tracking_branch {} {
 269        set revtype trck
 270}
 271
 272method focus_filter {} {
 273        if {[$w_filter cget -state] eq {normal}} {
 274                focus $w_filter
 275        }
 276}
 277
 278method bind_listbox {event script}  {
 279        bind $w_list $event $script
 280}
 281
 282method get_local_branch {} {
 283        if {$revtype eq {head}} {
 284                return [_expr $this]
 285        } else {
 286                return {}
 287        }
 288}
 289
 290method 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
 298method get_commit {} {
 299        set e [_expr $this]
 300        if {$e eq {}} {
 301                return {}
 302        }
 303        return [git rev-parse --verify "$e^0"]
 304}
 305
 306method 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
 329method _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
 355method _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
 367method _filter {P} {
 368        if {[regexp {\s} $P]} {
 369                return 0
 370        }
 371        _rebuild $this $P
 372        return 1
 373}
 374
 375method _select {args} {
 376        _rebuild $this $filter
 377        focus_filter $this
 378}
 379
 380method _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
 421method _delete {current} {
 422        if {$current eq $w} {
 423                delete_this
 424        }
 425}
 426
 427method _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        $sb set $first $last
 455}
 456
 457method _show_tooltip {pos} {
 458        if {$tooltip_wm ne {}} {
 459                _open_tooltip $this
 460        } elseif {$tooltip_timer eq {}} {
 461                set tooltip_timer [after 1000 [cb _open_tooltip]]
 462        }
 463}
 464
 465method _open_tooltip {} {
 466        global remote_url
 467
 468        set tooltip_timer {}
 469        set pos_x [winfo pointerx $w_list]
 470        set pos_y [winfo pointery $w_list]
 471        if {[winfo containing $pos_x $pos_y] ne $w_list} {
 472                _hide_tooltip $this
 473                return
 474        }
 475
 476        set pos @[join [list \
 477                [expr {$pos_x - [winfo rootx $w_list]}] \
 478                [expr {$pos_y - [winfo rooty $w_list]}]] ,]
 479        set lno [$w_list index $pos]
 480        if {$lno eq {}} {
 481                _hide_tooltip $this
 482                return
 483        }
 484
 485        set spec [lindex $cur_specs $lno]
 486        set refn [lindex $spec 1]
 487        if {$refn eq {}} {
 488                _hide_tooltip $this
 489                return
 490        }
 491
 492        if {$tooltip_wm eq {}} {
 493                set tooltip_wm [toplevel $w_list.tooltip -borderwidth 1]
 494                wm overrideredirect $tooltip_wm 1
 495                wm transient $tooltip_wm [winfo toplevel $w_list]
 496                set tooltip_t $tooltip_wm.label
 497                text $tooltip_t \
 498                        -takefocus 0 \
 499                        -highlightthickness 0 \
 500                        -relief flat \
 501                        -borderwidth 0 \
 502                        -wrap none \
 503                        -background lightyellow \
 504                        -foreground black
 505                $tooltip_t tag conf section_header -font font_uibold
 506                bind $tooltip_wm <Escape> [cb _hide_tooltip]
 507                pack $tooltip_t
 508        } else {
 509                $tooltip_t conf -state normal
 510                $tooltip_t delete 0.0 end
 511        }
 512
 513        set data $tip_data($refn)
 514        if {[lindex $data 0 0] eq {tag}} {
 515                set tag  [lindex $data 0]
 516                if {[lindex $data 1 0] eq {commit}} {
 517                        set cmit [lindex $data 1]
 518                } else {
 519                        set cmit {}
 520                }
 521        } elseif {[lindex $data 0 0] eq {commit}} {
 522                set tag  {}
 523                set cmit [lindex $data 0]
 524        }
 525
 526        $tooltip_t insert end [lindex $spec 0]
 527        set last [_reflog_last $this [lindex $spec 1]]
 528        if {$last ne {}} {
 529                $tooltip_t insert end "\n"
 530                $tooltip_t insert end [mc "Updated"]
 531                $tooltip_t insert end " $last"
 532        }
 533        $tooltip_t insert end "\n"
 534
 535        if {$tag ne {}} {
 536                $tooltip_t insert end "\n"
 537                $tooltip_t insert end [mc "Tag"] section_header
 538                $tooltip_t insert end "  [lindex $tag 1]\n"
 539                $tooltip_t insert end [lindex $tag 2]
 540                $tooltip_t insert end " ([lindex $tag 3])\n"
 541                $tooltip_t insert end [lindex $tag 4]
 542                $tooltip_t insert end "\n"
 543        }
 544
 545        if {$cmit ne {}} {
 546                $tooltip_t insert end "\n"
 547                $tooltip_t insert end [mc "Commit@@noun"] section_header
 548                $tooltip_t insert end "  [lindex $cmit 1]\n"
 549                $tooltip_t insert end [lindex $cmit 2]
 550                $tooltip_t insert end " ([lindex $cmit 3])\n"
 551                $tooltip_t insert end [lindex $cmit 4]
 552        }
 553
 554        if {[llength $spec] > 2} {
 555                $tooltip_t insert end "\n"
 556                $tooltip_t insert end [mc "Remote"] section_header
 557                $tooltip_t insert end "  [lindex $spec 2]\n"
 558                $tooltip_t insert end [mc "URL"]
 559                $tooltip_t insert end " $remote_url([lindex $spec 2])\n"
 560                $tooltip_t insert end [mc "Branch"]
 561                $tooltip_t insert end " [lindex $spec 3]"
 562        }
 563
 564        $tooltip_t conf -state disabled
 565        _position_tooltip $this
 566}
 567
 568method _reflog_last {name} {
 569        if {[info exists reflog_last($name)]} {
 570                return reflog_last($name)
 571        }
 572
 573        set last {}
 574        if {[catch {set last [file mtime [gitdir $name]]}]
 575        && ![catch {set g [open [gitdir logs $name] r]}]} {
 576                fconfigure $g -translation binary
 577                while {[gets $g line] >= 0} {
 578                        if {[regexp {> ([1-9][0-9]*) } $line line when]} {
 579                                set last $when
 580                        }
 581                }
 582                close $g
 583        }
 584
 585        if {$last ne {}} {
 586                set last [format_date $last]
 587        }
 588        set reflog_last($name) $last
 589        return $last
 590}
 591
 592method _position_tooltip {} {
 593        set max_h [lindex [split [$tooltip_t index end] .] 0]
 594        set max_w 0
 595        for {set i 1} {$i <= $max_h} {incr i} {
 596                set c [lindex [split [$tooltip_t index "$i.0 lineend"] .] 1]
 597                if {$c > $max_w} {set max_w $c}
 598        }
 599        $tooltip_t conf -width $max_w -height $max_h
 600
 601        set req_w [winfo reqwidth  $tooltip_t]
 602        set req_h [winfo reqheight $tooltip_t]
 603        set pos_x [expr {[winfo pointerx .] +  5}]
 604        set pos_y [expr {[winfo pointery .] + 10}]
 605
 606        set g "${req_w}x${req_h}"
 607        if {$pos_x >= 0} {append g +}
 608        append g $pos_x
 609        if {$pos_y >= 0} {append g +}
 610        append g $pos_y
 611
 612        wm geometry $tooltip_wm $g
 613        raise $tooltip_wm
 614}
 615
 616method _hide_tooltip {} {
 617        if {$tooltip_wm ne {}} {
 618                destroy $tooltip_wm
 619                set tooltip_wm {}
 620        }
 621        if {$tooltip_timer ne {}} {
 622                after cancel $tooltip_timer
 623                set tooltip_timer {}
 624        }
 625}
 626
 627}