git.oblomov.eu Git - git/blob - lib/choose_rev.tcl

   1 # git-gui revision chooser
   2 # Copyright (C) 2006, 2007 Shawn Pearce
   3
   4 class choose_rev {
   5
   6 image create photo ::choose_rev::img_find -data {R0lGODlhEAAQAIYAAPwCBCQmJDw+PBQSFAQCBMza3NTm5MTW1HyChOT29Ozq7MTq7Kze5Kzm7Oz6/NTy9Iza5GzGzKzS1Nzy9Nz29Kzq9HTGzHTK1Lza3AwKDLzu9JTi7HTW5GTCzITO1Mzq7Hza5FTK1ESyvHzKzKzW3DQyNDyqtDw6PIzW5HzGzAT+/Dw+RKyurNTOzMTGxMS+tJSGdATCxHRydLSqpLymnLSijBweHERCRNze3Pz69PTy9Oze1OTSxOTGrMSqlLy+vPTu5OzSvMymjNTGvNS+tMy2pMyunMSefAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAAAALAAAAAAQABAAAAe4gACCAAECA4OIiAIEBQYHBAKJgwIICQoLDA0IkZIECQ4PCxARCwSSAxITFA8VEBYXGBmJAQYLGhUbHB0eH7KIGRIMEBAgISIjJKaIJQQLFxERIialkieUGigpKRoIBCqJKyyLBwvJAioEyoICLS4v6QQwMQQyLuqLli8zNDU2BCf1lN3AkUPHDh49fAQAAEnGD1MCCALZEaSHkIUMBQS8wWMIkSJGhBzBmFEGgRsBUqpMiSgdAD+BAAAh/mhDcmVhdGVkIGJ5IEJNUFRvR0lGIFBybyB2ZXJzaW9uIDIuNQ0KqSBEZXZlbENvciAxOTk3LDE5OTguIEFsbCByaWdodHMgcmVzZXJ2ZWQuDQpodHRwOi8vd3d3LmRldmVsY29yLmNvbQA7}
   7
   8 field w               ; # our megawidget path
   9 field w_list          ; # list of currently filtered specs
  10 field w_filter        ; # filter entry for $w_list
  11
  12 field c_expr        {}; # current revision expression
  13 field filter          ; # current filter string
  14 field revtype     head; # type of revision chosen
  15 field cur_specs [list]; # list of specs for $revtype
  16 field spec_head       ; # list of all head specs
  17 field spec_trck       ; # list of all tracking branch specs
  18 field spec_tag        ; # list of all tag specs
  19 field tip_data        ; # array of tip commit info by refname
  20 field log_last        ; # array of reflog date by refname
  21
  22 field tooltip_wm        {} ; # Current tooltip toplevel, if open
  23 field tooltip_t         {} ; # Text widget in $tooltip_wm
  24 field tooltip_timer     {} ; # Current timer event for our tooltip
  25
  26 proc new {path {title {}}} {
  27         return [_new $path 0 $title]
  28 }
  29
  30 proc new_unmerged {path {title {}}} {
  31         return [_new $path 1 $title]
  32 }
  33
  34 constructor _new {path unmerged_only title} {
  35         global current_branch is_detached
  36
  37         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
 233 method 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
 244 method 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
 264 method pick_tracking_branch {} {
 265         set revtype trck
 266 }
 267
 268 method focus_filter {} {
 269         if {[$w_filter cget -state] eq {normal}} {
 270                 focus $w_filter
 271         }
 272 }
 273
 274 method bind_listbox {event script}  {
 275         bind $w_list $event $script
 276 }
 277
 278 method get_local_branch {} {
 279         if {$revtype eq {head}} {
 280                 return [_expr $this]
 281         } else {
 282                 return {}
 283         }
 284 }
 285
 286 method 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
 294 method get_commit {} {
 295         set e [_expr $this]
 296         if {$e eq {}} {
 297                 return {}
 298         }
 299         return [git rev-parse --verify "$e^0"]
 300 }
 301
 302 method 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
 325 method _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
 351 method _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
 363 method _filter {P} {
 364         if {[regexp {\s} $P]} {
 365                 return 0
 366         }
 367         _rebuild $this $P
 368         return 1
 369 }
 370
 371 method _select {args} {
 372         _rebuild $this $filter
 373         focus_filter $this
 374 }
 375
 376 method _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
 417 method _delete {current} {
 418         if {$current eq $w} {
 419                 delete_this
 420         }
 421 }
 422
 423 method _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
 453 method _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
 461 method _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
 564 method _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
 588 method _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
 612 method _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 }