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