Andrew's git / gitweb.git / lib/choose_rev.tcl
?
lib / choose_rev.tclon commit git-gui: Cleanup bindings within merge dialog (9feefbd)
   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        set w $path
  38
  39        if {$title ne {}} {
  40                labelframe $w -text $title
  41        } else {
  42                frame $w
  43        }
  44        bind $w <Destroy> [cb _delete %W]
  45
  46        if {$is_detached} {
  47                radiobutton $w.detachedhead_r \
  48                        -anchor w \
  49                        -text {This Detached Checkout} \
  50                        -value HEAD \
  51                        -variable @revtype
  52                grid $w.detachedhead_r -sticky we -padx {0 5} -columnspan 2
  53        }
  54
  55        radiobutton $w.expr_r \
  56                -text {Revision Expression:} \
  57                -value expr \
  58                -variable @revtype
  59        entry $w.expr_t \
  60                -borderwidth 1 \
  61                -relief sunken \
  62                -width 50 \
  63                -textvariable @c_expr \
  64                -validate key \
  65                -validatecommand [cb _validate %d %S]
  66        grid $w.expr_r $w.expr_t -sticky we -padx {0 5}
  67
  68        frame $w.types
  69        radiobutton $w.types.head_r \
  70                -text {Local Branch} \
  71                -value head \
  72                -variable @revtype
  73        pack $w.types.head_r -side left
  74        radiobutton $w.types.trck_r \
  75                -text {Tracking Branch} \
  76                -value trck \
  77                -variable @revtype
  78        pack $w.types.trck_r -side left
  79        radiobutton $w.types.tag_r \
  80                -text {Tag} \
  81                -value tag \
  82                -variable @revtype
  83        pack $w.types.tag_r -side left
  84        set w_filter $w.types.filter
  85        entry $w_filter \
  86                -borderwidth 1 \
  87                -relief sunken \
  88                -width 12 \
  89                -textvariable @filter \
  90                -validate key \
  91                -validatecommand [cb _filter %P]
  92        pack $w_filter -side right
  93        pack [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        frame $w.list
  99        set w_list $w.list.l
 100        listbox $w_list \
 101                -font font_diff \
 102                -width 50 \
 103                -height 10 \
 104                -selectmode browse \
 105                -exportselection false \
 106                -xscrollcommand [cb _sb_set $w.list.sbx h] \
 107                -yscrollcommand [cb _sb_set $w.list.sby v]
 108        pack $w_list -fill both -expand 1
 109        grid $w.list -sticky nswe -padx {20 5} -columnspan 2
 110        bind $w_list <Any-Motion>  [cb _show_tooltip @%x,%y]
 111        bind $w_list <Any-Enter>   [cb _hide_tooltip]
 112        bind $w_list <Any-Leave>   [cb _hide_tooltip]
 113        bind $w_list <Destroy>     [cb _hide_tooltip]
 114
 115        grid columnconfigure $w 1 -weight 1
 116        if {$is_detached} {
 117                grid rowconfigure $w 3 -weight 1
 118        } else {
 119                grid rowconfigure $w 2 -weight 1
 120        }
 121
 122        trace add variable @revtype write [cb _select]
 123        bind $w_filter <Key-Return> [list focus $w_list]\;break
 124        bind $w_filter <Key-Down>   [list focus $w_list]
 125
 126        set fmt list
 127        append fmt { %(refname)}
 128        append fmt { [list}
 129        append fmt { %(objecttype)}
 130        append fmt { %(objectname)}
 131        append fmt { [concat %(taggername) %(authorname)]}
 132        append fmt { [concat %(taggerdate) %(authordate)]}
 133        append fmt { %(subject)}
 134        append fmt {] [list}
 135        append fmt { %(*objecttype)}
 136        append fmt { %(*objectname)}
 137        append fmt { %(*authorname)}
 138        append fmt { %(*authordate)}
 139        append fmt { %(*subject)}
 140        append fmt {]}
 141        set all_refn [list]
 142        set fr_fd [git_read for-each-ref \
 143                --tcl \
 144                --sort=-taggerdate \
 145                --format=$fmt \
 146                refs/heads \
 147                refs/remotes \
 148                refs/tags \
 149                ]
 150        fconfigure $fr_fd -translation lf -encoding utf-8
 151        while {[gets $fr_fd line] > 0} {
 152                set line [eval $line]
 153                if {[lindex $line 1 0] eq {tag}} {
 154                        if {[lindex $line 2 0] eq {commit}} {
 155                                set sha1 [lindex $line 2 1]
 156                        } else {
 157                                continue
 158                        }
 159                } elseif {[lindex $line 1 0] eq {commit}} {
 160                        set sha1 [lindex $line 1 1]
 161                } else {
 162                        continue
 163                }
 164                set refn [lindex $line 0]
 165                set tip_data($refn) [lrange $line 1 end]
 166                lappend cmt_refn($sha1) $refn
 167                lappend all_refn $refn
 168        }
 169        close $fr_fd
 170
 171        if {$unmerged_only} {
 172                set fr_fd [git_read rev-list --all ^$::HEAD]
 173                while {[gets $fr_fd sha1] > 0} {
 174                        if {[catch {set rlst $cmt_refn($sha1)}]} continue
 175                        foreach refn $rlst {
 176                                set inc($refn) 1
 177                        }
 178                }
 179                close $fr_fd
 180        } else {
 181                foreach refn $all_refn {
 182                        set inc($refn) 1
 183                }
 184        }
 185
 186        set spec_head [list]
 187        foreach name [load_all_heads] {
 188                set refn refs/heads/$name
 189                if {[info exists inc($refn)]} {
 190                        lappend spec_head [list $name $refn]
 191                }
 192        }
 193
 194        set spec_trck [list]
 195        foreach spec [all_tracking_branches] {
 196                set refn [lindex $spec 0]
 197                if {[info exists inc($refn)]} {
 198                        regsub ^refs/(heads|remotes)/ $refn {} name
 199                        lappend spec_trck [concat $name $spec]
 200                }
 201        }
 202
 203        set spec_tag [list]
 204        foreach name [load_all_tags] {
 205                set refn refs/tags/$name
 206                if {[info exists inc($refn)]} {
 207                        lappend spec_tag [list $name $refn]
 208                }
 209        }
 210
 211                  if {$is_detached}             { set revtype HEAD
 212        } elseif {[llength $spec_head] > 0} { set revtype head
 213        } elseif {[llength $spec_trck] > 0} { set revtype trck
 214        } elseif {[llength $spec_tag ] > 0} { set revtype tag
 215        } else {                              set revtype expr
 216        }
 217
 218        if {$revtype eq {head} && $current_branch ne {}} {
 219                set i 0
 220                foreach spec $spec_head {
 221                        if {[lindex $spec 0] eq $current_branch} {
 222                                $w_list selection clear 0 end
 223                                $w_list selection set $i
 224                                break
 225                        }
 226                        incr i
 227                }
 228        }
 229
 230        return $this
 231}
 232
 233method none {text} {
 234        if {![winfo exists $w.none_r]} {
 235                radiobutton $w.none_r \
 236                        -anchor w \
 237                        -value none \
 238                        -variable @revtype
 239                grid $w.none_r -sticky we -padx {0 5} -columnspan 2
 240        }
 241        $w.none_r configure -text $text
 242}
 243
 244method get {} {
 245        switch -- $revtype {
 246        head -
 247        trck -
 248        tag  {
 249                set i [$w_list curselection]
 250                if {$i ne {}} {
 251                        return [lindex $cur_specs $i 0]
 252                } else {
 253                        return {}
 254                }
 255        }
 256
 257        HEAD { return HEAD                     }
 258        expr { return $c_expr                  }
 259        none { return {}                       }
 260        default { error "unknown type of revision" }
 261        }
 262}
 263
 264method pick_tracking_branch {} {
 265        set revtype trck
 266}
 267
 268method focus_filter {} {
 269        if {[$w_filter cget -state] eq {normal}} {
 270                focus $w_filter
 271        }
 272}
 273
 274method bind_listbox {event script}  {
 275        bind $w_list $event $script
 276}
 277
 278method get_local_branch {} {
 279        if {$revtype eq {head}} {
 280                return [_expr $this]
 281        } else {
 282                return {}
 283        }
 284}
 285
 286method get_tracking_branch {} {
 287        set i [$w_list curselection]
 288        if {$i eq {} || $revtype ne {trck}} {
 289                return {}
 290        }
 291        return [lrange [lindex $cur_specs $i] 1 end]
 292}
 293
 294method get_commit {} {
 295        set e [_expr $this]
 296        if {$e eq {}} {
 297                return {}
 298        }
 299        return [git rev-parse --verify "$e^0"]
 300}
 301
 302method commit_or_die {} {
 303        if {[catch {set new [get_commit $this]} err]} {
 304
 305                # Cleanup the not-so-friendly error from rev-parse.
 306                #
 307                regsub {^fatal:\s*} $err {} err
 308                if {$err eq {Needed a single revision}} {
 309                        set err {}
 310                }
 311
 312                set top [winfo toplevel $w]
 313                set msg "Invalid revision: [get $this]\n\n$err"
 314                tk_messageBox \
 315                        -icon error \
 316                        -type ok \
 317                        -title [wm title $top] \
 318                        -parent $top \
 319                        -message $msg
 320                error $msg
 321        }
 322        return $new
 323}
 324
 325method _expr {} {
 326        switch -- $revtype {
 327        head -
 328        trck -
 329        tag  {
 330                set i [$w_list curselection]
 331                if {$i ne {}} {
 332                        return [lindex $cur_specs $i 1]
 333                } else {
 334                        error "No revision selected."
 335                }
 336        }
 337
 338        expr {
 339                if {$c_expr ne {}} {
 340                        return $c_expr
 341                } else {
 342                        error "Revision expression is empty."
 343                }
 344        }
 345        HEAD { return HEAD                     }
 346        none { return {}                       }
 347        default { error "unknown type of revision"      }
 348        }
 349}
 350
 351method _validate {d S} {
 352        if {$d == 1} {
 353                if {[regexp {\s} $S]} {
 354                        return 0
 355                }
 356                if {[string length $S] > 0} {
 357                        set revtype expr
 358                }
 359        }
 360        return 1
 361}
 362
 363method _filter {P} {
 364        if {[regexp {\s} $P]} {
 365                return 0
 366        }
 367        _rebuild $this $P
 368        return 1
 369}
 370
 371method _select {args} {
 372        _rebuild $this $filter
 373        focus_filter $this
 374}
 375
 376method _rebuild {pat} {
 377        set ste normal
 378        switch -- $revtype {
 379        head { set new $spec_head }
 380        trck { set new $spec_trck }
 381        tag  { set new $spec_tag  }
 382        expr -
 383        HEAD -
 384        none {
 385                set new [list]
 386                set ste disabled
 387        }
 388        }
 389
 390        if {[$w_list cget -state] eq {disabled}} {
 391                $w_list configure -state normal
 392        }
 393        $w_list delete 0 end
 394
 395        if {$pat ne {}} {
 396                set pat *${pat}*
 397        }
 398        set cur_specs [list]
 399        foreach spec $new {
 400                set txt [lindex $spec 0]
 401                if {$pat eq {} || [string match $pat $txt]} {
 402                        lappend cur_specs $spec
 403                        $w_list insert end $txt
 404                }
 405        }
 406        if {$cur_specs ne {}} {
 407                $w_list selection clear 0 end
 408                $w_list selection set 0
 409        }
 410
 411        if {[$w_filter cget -state] ne $ste} {
 412                $w_list   configure -state $ste
 413                $w_filter configure -state $ste
 414        }
 415}
 416
 417method _delete {current} {
 418        if {$current eq $w} {
 419                delete_this
 420        }
 421}
 422
 423method _sb_set {sb orient first last} {
 424        set old_focus [focus -lastfor $w]
 425
 426        if {$first == 0 && $last == 1} {
 427                if {[winfo exists $sb]} {
 428                        destroy $sb
 429                        if {$old_focus ne {}} {
 430                                update
 431                                focus $old_focus
 432                        }
 433                }
 434                return
 435        }
 436
 437        if {![winfo exists $sb]} {
 438                if {$orient eq {h}} {
 439                        scrollbar $sb -orient h -command [list $w_list xview]
 440                        pack $sb -fill x -side bottom -before $w_list
 441                } else {
 442                        scrollbar $sb -orient v -command [list $w_list yview]
 443                        pack $sb -fill y -side right -before $w_list
 444                }
 445                if {$old_focus ne {}} {
 446                        update
 447                        focus $old_focus
 448                }
 449        }
 450        $sb set $first $last
 451}
 452
 453method _show_tooltip {pos} {
 454        if {$tooltip_wm ne {}} {
 455                _open_tooltip $this
 456        } elseif {$tooltip_timer eq {}} {
 457                set tooltip_timer [after 1000 [cb _open_tooltip]]
 458        }
 459}
 460
 461method _open_tooltip {} {
 462        global remote_url
 463
 464        set tooltip_timer {}
 465        set pos_x [winfo pointerx $w_list]
 466        set pos_y [winfo pointery $w_list]
 467        if {[winfo containing $pos_x $pos_y] ne $w_list} {
 468                _hide_tooltip $this
 469                return
 470        }
 471
 472        set pos @[join [list \
 473                [expr {$pos_x - [winfo rootx $w_list]}] \
 474                [expr {$pos_y - [winfo rooty $w_list]}]] ,]
 475        set lno [$w_list index $pos]
 476        if {$lno eq {}} {
 477                _hide_tooltip $this
 478                return
 479        }
 480
 481        set spec [lindex $cur_specs $lno]
 482        set refn [lindex $spec 1]
 483        if {$refn eq {}} {
 484                _hide_tooltip $this
 485                return
 486        }
 487
 488        if {$tooltip_wm eq {}} {
 489                set tooltip_wm [toplevel $w_list.tooltip -borderwidth 1]
 490                wm overrideredirect $tooltip_wm 1
 491                wm transient $tooltip_wm [winfo toplevel $w_list]
 492                set tooltip_t $tooltip_wm.label
 493                text $tooltip_t \
 494                        -takefocus 0 \
 495                        -highlightthickness 0 \
 496                        -relief flat \
 497                        -borderwidth 0 \
 498                        -wrap none \
 499                        -background lightyellow \
 500                        -foreground black
 501                $tooltip_t tag conf section_header -font font_uibold
 502                bind $tooltip_wm <Escape> [cb _hide_tooltip]
 503                pack $tooltip_t
 504        } else {
 505                $tooltip_t conf -state normal
 506                $tooltip_t delete 0.0 end
 507        }
 508
 509        set data $tip_data($refn)
 510        if {[lindex $data 0 0] eq {tag}} {
 511                set tag  [lindex $data 0]
 512                if {[lindex $data 1 0] eq {commit}} {
 513                        set cmit [lindex $data 1]
 514                } else {
 515                        set cmit {}
 516                }
 517        } elseif {[lindex $data 0 0] eq {commit}} {
 518                set tag  {}
 519                set cmit [lindex $data 0]
 520        }
 521
 522        $tooltip_t insert end [lindex $spec 0]
 523        set last [_reflog_last $this [lindex $spec 1]]
 524        if {$last ne {}} {
 525                $tooltip_t insert end "\n"
 526                $tooltip_t insert end "updated"
 527                $tooltip_t insert end " $last"
 528        }
 529        $tooltip_t insert end "\n"
 530
 531        if {$tag ne {}} {
 532                $tooltip_t insert end "\n"
 533                $tooltip_t insert end "tag" section_header
 534                $tooltip_t insert end "  [lindex $tag 1]\n"
 535                $tooltip_t insert end [lindex $tag 2]
 536                $tooltip_t insert end " ([lindex $tag 3])\n"
 537                $tooltip_t insert end [lindex $tag 4]
 538                $tooltip_t insert end "\n"
 539        }
 540
 541        if {$cmit ne {}} {
 542                $tooltip_t insert end "\n"
 543                $tooltip_t insert end "commit" section_header
 544                $tooltip_t insert end "  [lindex $cmit 1]\n"
 545                $tooltip_t insert end [lindex $cmit 2]
 546                $tooltip_t insert end " ([lindex $cmit 3])\n"
 547                $tooltip_t insert end [lindex $cmit 4]
 548        }
 549
 550        if {[llength $spec] > 2} {
 551                $tooltip_t insert end "\n"
 552                $tooltip_t insert end "remote" section_header
 553                $tooltip_t insert end "  [lindex $spec 2]\n"
 554                $tooltip_t insert end "url"
 555                $tooltip_t insert end " $remote_url([lindex $spec 2])\n"
 556                $tooltip_t insert end "branch"
 557                $tooltip_t insert end " [lindex $spec 3]"
 558        }
 559
 560        $tooltip_t conf -state disabled
 561        _position_tooltip $this
 562}
 563
 564method _reflog_last {name} {
 565        if {[info exists reflog_last($name)]} {
 566                return reflog_last($name)
 567        }
 568
 569        set last {}
 570        if {[catch {set last [file mtime [gitdir $name]]}]
 571        && ![catch {set g [open [gitdir logs $name] r]}]} {
 572                fconfigure $g -translation binary
 573                while {[gets $g line] >= 0} {
 574                        if {[regexp {> ([1-9][0-9]*) } $line line when]} {
 575                                set last $when
 576                        }
 577                }
 578                close $g
 579        }
 580
 581        if {$last ne {}} {
 582                set last [clock format $last -format {%a %b %e %H:%M:%S %Y}]
 583        }
 584        set reflog_last($name) $last
 585        return $last
 586}
 587
 588method _position_tooltip {} {
 589        set max_h [lindex [split [$tooltip_t index end] .] 0]
 590        set max_w 0
 591        for {set i 1} {$i <= $max_h} {incr i} {
 592                set c [lindex [split [$tooltip_t index "$i.0 lineend"] .] 1]
 593                if {$c > $max_w} {set max_w $c}
 594        }
 595        $tooltip_t conf -width $max_w -height $max_h
 596
 597        set req_w [winfo reqwidth  $tooltip_t]
 598        set req_h [winfo reqheight $tooltip_t]
 599        set pos_x [expr {[winfo pointerx .] +  5}]
 600        set pos_y [expr {[winfo pointery .] + 10}]
 601
 602        set g "${req_w}x${req_h}"
 603        if {$pos_x >= 0} {append g +}
 604        append g $pos_x
 605        if {$pos_y >= 0} {append g +}
 606        append g $pos_y
 607
 608        wm geometry $tooltip_wm $g
 609        raise $tooltip_wm
 610}
 611
 612method _hide_tooltip {} {
 613        if {$tooltip_wm ne {}} {
 614                destroy $tooltip_wm
 615                set tooltip_wm {}
 616        }
 617        if {$tooltip_timer ne {}} {
 618                after cancel $tooltip_timer
 619                set tooltip_timer {}
 620        }
 621}
 622
 623}