gitkon commit gitk: Use a text widget for the file list (7fcceed)
   1#!/bin/sh
   2# Tcl ignores the next line -*- tcl -*- \
   3exec wish "$0" -- "$@"
   4
   5# Copyright (C) 2005 Paul Mackerras.  All rights reserved.
   6# This program is free software; it may be used, copied, modified
   7# and distributed under the terms of the GNU General Public Licence,
   8# either version 2, or (at your option) any later version.
   9
  10proc gitdir {} {
  11    global env
  12    if {[info exists env(GIT_DIR)]} {
  13        return $env(GIT_DIR)
  14    } else {
  15        return ".git"
  16    }
  17}
  18
  19proc start_rev_list {} {
  20    global startmsecs nextupdate ncmupdate
  21    global commfd leftover tclencoding datemode
  22    global revtreeargs curview viewfiles
  23
  24    set startmsecs [clock clicks -milliseconds]
  25    set nextupdate [expr {$startmsecs + 100}]
  26    set ncmupdate 1
  27    initlayout
  28    set args $revtreeargs
  29    if {$viewfiles($curview) ne {}} {
  30        set args [concat $args "--" $viewfiles($curview)]
  31    }
  32    set order "--topo-order"
  33    if {$datemode} {
  34        set order "--date-order"
  35    }
  36    if {[catch {
  37        set commfd [open [concat | git-rev-list --header $order \
  38                              --parents --boundary --default HEAD $args] r]
  39    } err]} {
  40        puts stderr "Error executing git-rev-list: $err"
  41        exit 1
  42    }
  43    set leftover {}
  44    fconfigure $commfd -blocking 0 -translation lf
  45    if {$tclencoding != {}} {
  46        fconfigure $commfd -encoding $tclencoding
  47    }
  48    fileevent $commfd readable [list getcommitlines $commfd]
  49    . config -cursor watch
  50    settextcursor watch
  51}
  52
  53proc stop_rev_list {} {
  54    global commfd
  55
  56    if {![info exists commfd]} return
  57    catch {
  58        set pid [pid $commfd]
  59        exec kill $pid
  60    }
  61    catch {close $commfd}
  62    unset commfd
  63}
  64
  65proc getcommits {} {
  66    global phase canv mainfont
  67
  68    set phase getcommits
  69    start_rev_list
  70    $canv delete all
  71    $canv create text 3 3 -anchor nw -text "Reading commits..." \
  72        -font $mainfont -tags textitems
  73}
  74
  75proc getcommitlines {commfd}  {
  76    global commitlisted nextupdate
  77    global leftover
  78    global displayorder commitidx commitrow commitdata
  79    global parentlist childlist children
  80
  81    set stuff [read $commfd]
  82    if {$stuff == {}} {
  83        if {![eof $commfd]} return
  84        # set it blocking so we wait for the process to terminate
  85        fconfigure $commfd -blocking 1
  86        if {![catch {close $commfd} err]} {
  87            after idle finishcommits
  88            return
  89        }
  90        if {[string range $err 0 4] == "usage"} {
  91            set err \
  92                "Gitk: error reading commits: bad arguments to git-rev-list.\
  93                (Note: arguments to gitk are passed to git-rev-list\
  94                to allow selection of commits to be displayed.)"
  95        } else {
  96            set err "Error reading commits: $err"
  97        }
  98        error_popup $err
  99        exit 1
 100    }
 101    set start 0
 102    set gotsome 0
 103    while 1 {
 104        set i [string first "\0" $stuff $start]
 105        if {$i < 0} {
 106            append leftover [string range $stuff $start end]
 107            break
 108        }
 109        if {$start == 0} {
 110            set cmit $leftover
 111            append cmit [string range $stuff 0 [expr {$i - 1}]]
 112            set leftover {}
 113        } else {
 114            set cmit [string range $stuff $start [expr {$i - 1}]]
 115        }
 116        set start [expr {$i + 1}]
 117        set j [string first "\n" $cmit]
 118        set ok 0
 119        set listed 1
 120        if {$j >= 0} {
 121            set ids [string range $cmit 0 [expr {$j - 1}]]
 122            if {[string range $ids 0 0] == "-"} {
 123                set listed 0
 124                set ids [string range $ids 1 end]
 125            }
 126            set ok 1
 127            foreach id $ids {
 128                if {[string length $id] != 40} {
 129                    set ok 0
 130                    break
 131                }
 132            }
 133        }
 134        if {!$ok} {
 135            set shortcmit $cmit
 136            if {[string length $shortcmit] > 80} {
 137                set shortcmit "[string range $shortcmit 0 80]..."
 138            }
 139            error_popup "Can't parse git-rev-list output: {$shortcmit}"
 140            exit 1
 141        }
 142        set id [lindex $ids 0]
 143        if {$listed} {
 144            set olds [lrange $ids 1 end]
 145            set i 0
 146            foreach p $olds {
 147                if {$i == 0 || [lsearch -exact $olds $p] >= $i} {
 148                    lappend children($p) $id
 149                }
 150                incr i
 151            }
 152        } else {
 153            set olds {}
 154        }
 155        lappend parentlist $olds
 156        if {[info exists children($id)]} {
 157            lappend childlist $children($id)
 158            unset children($id)
 159        } else {
 160            lappend childlist {}
 161        }
 162        set commitdata($id) [string range $cmit [expr {$j + 1}] end]
 163        set commitrow($id) $commitidx
 164        incr commitidx
 165        lappend displayorder $id
 166        lappend commitlisted $listed
 167        set gotsome 1
 168    }
 169    if {$gotsome} {
 170        layoutmore
 171    }
 172    if {[clock clicks -milliseconds] >= $nextupdate} {
 173        doupdate 1
 174    }
 175}
 176
 177proc doupdate {reading} {
 178    global commfd nextupdate numcommits ncmupdate
 179
 180    if {$reading} {
 181        fileevent $commfd readable {}
 182    }
 183    update
 184    set nextupdate [expr {[clock clicks -milliseconds] + 100}]
 185    if {$numcommits < 100} {
 186        set ncmupdate [expr {$numcommits + 1}]
 187    } elseif {$numcommits < 10000} {
 188        set ncmupdate [expr {$numcommits + 10}]
 189    } else {
 190        set ncmupdate [expr {$numcommits + 100}]
 191    }
 192    if {$reading} {
 193        fileevent $commfd readable [list getcommitlines $commfd]
 194    }
 195}
 196
 197proc readcommit {id} {
 198    if {[catch {set contents [exec git-cat-file commit $id]}]} return
 199    parsecommit $id $contents 0
 200}
 201
 202proc updatecommits {} {
 203    global viewdata curview revtreeargs phase
 204
 205    if {$phase ne {}} {
 206        stop_rev_list
 207        set phase {}
 208    }
 209    set n $curview
 210    set curview -1
 211    catch {unset viewdata($n)}
 212    readrefs
 213    showview $n
 214}
 215
 216proc parsecommit {id contents listed} {
 217    global commitinfo cdate
 218
 219    set inhdr 1
 220    set comment {}
 221    set headline {}
 222    set auname {}
 223    set audate {}
 224    set comname {}
 225    set comdate {}
 226    set hdrend [string first "\n\n" $contents]
 227    if {$hdrend < 0} {
 228        # should never happen...
 229        set hdrend [string length $contents]
 230    }
 231    set header [string range $contents 0 [expr {$hdrend - 1}]]
 232    set comment [string range $contents [expr {$hdrend + 2}] end]
 233    foreach line [split $header "\n"] {
 234        set tag [lindex $line 0]
 235        if {$tag == "author"} {
 236            set audate [lindex $line end-1]
 237            set auname [lrange $line 1 end-2]
 238        } elseif {$tag == "committer"} {
 239            set comdate [lindex $line end-1]
 240            set comname [lrange $line 1 end-2]
 241        }
 242    }
 243    set headline {}
 244    # take the first line of the comment as the headline
 245    set i [string first "\n" $comment]
 246    if {$i >= 0} {
 247        set headline [string trim [string range $comment 0 $i]]
 248    } else {
 249        set headline $comment
 250    }
 251    if {!$listed} {
 252        # git-rev-list indents the comment by 4 spaces;
 253        # if we got this via git-cat-file, add the indentation
 254        set newcomment {}
 255        foreach line [split $comment "\n"] {
 256            append newcomment "    "
 257            append newcomment $line
 258            append newcomment "\n"
 259        }
 260        set comment $newcomment
 261    }
 262    if {$comdate != {}} {
 263        set cdate($id) $comdate
 264    }
 265    set commitinfo($id) [list $headline $auname $audate \
 266                             $comname $comdate $comment]
 267}
 268
 269proc getcommit {id} {
 270    global commitdata commitinfo
 271
 272    if {[info exists commitdata($id)]} {
 273        parsecommit $id $commitdata($id) 1
 274    } else {
 275        readcommit $id
 276        if {![info exists commitinfo($id)]} {
 277            set commitinfo($id) {"No commit information available"}
 278        }
 279    }
 280    return 1
 281}
 282
 283proc readrefs {} {
 284    global tagids idtags headids idheads tagcontents
 285    global otherrefids idotherrefs
 286
 287    foreach v {tagids idtags headids idheads otherrefids idotherrefs} {
 288        catch {unset $v}
 289    }
 290    set refd [open [list | git ls-remote [gitdir]] r]
 291    while {0 <= [set n [gets $refd line]]} {
 292        if {![regexp {^([0-9a-f]{40})   refs/([^^]*)$} $line \
 293            match id path]} {
 294            continue
 295        }
 296        if {[regexp {^remotes/.*/HEAD$} $path match]} {
 297            continue
 298        }
 299        if {![regexp {^(tags|heads)/(.*)$} $path match type name]} {
 300            set type others
 301            set name $path
 302        }
 303        if {[regexp {^remotes/} $path match]} {
 304            set type heads
 305        }
 306        if {$type == "tags"} {
 307            set tagids($name) $id
 308            lappend idtags($id) $name
 309            set obj {}
 310            set type {}
 311            set tag {}
 312            catch {
 313                set commit [exec git-rev-parse "$id^0"]
 314                if {"$commit" != "$id"} {
 315                    set tagids($name) $commit
 316                    lappend idtags($commit) $name
 317                }
 318            }           
 319            catch {
 320                set tagcontents($name) [exec git-cat-file tag "$id"]
 321            }
 322        } elseif { $type == "heads" } {
 323            set headids($name) $id
 324            lappend idheads($id) $name
 325        } else {
 326            set otherrefids($name) $id
 327            lappend idotherrefs($id) $name
 328        }
 329    }
 330    close $refd
 331}
 332
 333proc error_popup msg {
 334    set w .error
 335    toplevel $w
 336    wm transient $w .
 337    message $w.m -text $msg -justify center -aspect 400
 338    pack $w.m -side top -fill x -padx 20 -pady 20
 339    button $w.ok -text OK -command "destroy $w"
 340    pack $w.ok -side bottom -fill x
 341    bind $w <Visibility> "grab $w; focus $w"
 342    bind $w <Key-Return> "destroy $w"
 343    tkwait window $w
 344}
 345
 346proc makewindow {} {
 347    global canv canv2 canv3 linespc charspc ctext cflist
 348    global textfont mainfont uifont
 349    global findtype findtypemenu findloc findstring fstring geometry
 350    global entries sha1entry sha1string sha1but
 351    global maincursor textcursor curtextcursor
 352    global rowctxmenu mergemax
 353
 354    menu .bar
 355    .bar add cascade -label "File" -menu .bar.file
 356    .bar configure -font $uifont
 357    menu .bar.file
 358    .bar.file add command -label "Update" -command updatecommits
 359    .bar.file add command -label "Reread references" -command rereadrefs
 360    .bar.file add command -label "Quit" -command doquit
 361    .bar.file configure -font $uifont
 362    menu .bar.edit
 363    .bar add cascade -label "Edit" -menu .bar.edit
 364    .bar.edit add command -label "Preferences" -command doprefs
 365    .bar.edit configure -font $uifont
 366    menu .bar.view -font $uifont
 367    .bar add cascade -label "View" -menu .bar.view
 368    .bar.view add command -label "New view..." -command newview
 369    .bar.view add command -label "Edit view..." -command editview
 370    .bar.view add command -label "Delete view" -command delview -state disabled
 371    .bar.view add separator
 372    .bar.view add radiobutton -label "All files" -command {showview 0} \
 373        -variable selectedview -value 0
 374    menu .bar.help
 375    .bar add cascade -label "Help" -menu .bar.help
 376    .bar.help add command -label "About gitk" -command about
 377    .bar.help add command -label "Key bindings" -command keys
 378    .bar.help configure -font $uifont
 379    . configure -menu .bar
 380
 381    if {![info exists geometry(canv1)]} {
 382        set geometry(canv1) [expr {45 * $charspc}]
 383        set geometry(canv2) [expr {30 * $charspc}]
 384        set geometry(canv3) [expr {15 * $charspc}]
 385        set geometry(canvh) [expr {25 * $linespc + 4}]
 386        set geometry(ctextw) 80
 387        set geometry(ctexth) 30
 388        set geometry(cflistw) 30
 389    }
 390    panedwindow .ctop -orient vertical
 391    if {[info exists geometry(width)]} {
 392        .ctop conf -width $geometry(width) -height $geometry(height)
 393        set texth [expr {$geometry(height) - $geometry(canvh) - 56}]
 394        set geometry(ctexth) [expr {($texth - 8) /
 395                                    [font metrics $textfont -linespace]}]
 396    }
 397    frame .ctop.top
 398    frame .ctop.top.bar
 399    pack .ctop.top.bar -side bottom -fill x
 400    set cscroll .ctop.top.csb
 401    scrollbar $cscroll -command {allcanvs yview} -highlightthickness 0
 402    pack $cscroll -side right -fill y
 403    panedwindow .ctop.top.clist -orient horizontal -sashpad 0 -handlesize 4
 404    pack .ctop.top.clist -side top -fill both -expand 1
 405    .ctop add .ctop.top
 406    set canv .ctop.top.clist.canv
 407    canvas $canv -height $geometry(canvh) -width $geometry(canv1) \
 408        -bg white -bd 0 \
 409        -yscrollincr $linespc -yscrollcommand "scrollcanv $cscroll"
 410    .ctop.top.clist add $canv
 411    set canv2 .ctop.top.clist.canv2
 412    canvas $canv2 -height $geometry(canvh) -width $geometry(canv2) \
 413        -bg white -bd 0 -yscrollincr $linespc
 414    .ctop.top.clist add $canv2
 415    set canv3 .ctop.top.clist.canv3
 416    canvas $canv3 -height $geometry(canvh) -width $geometry(canv3) \
 417        -bg white -bd 0 -yscrollincr $linespc
 418    .ctop.top.clist add $canv3
 419    bind .ctop.top.clist <Configure> {resizeclistpanes %W %w}
 420
 421    set sha1entry .ctop.top.bar.sha1
 422    set entries $sha1entry
 423    set sha1but .ctop.top.bar.sha1label
 424    button $sha1but -text "SHA1 ID: " -state disabled -relief flat \
 425        -command gotocommit -width 8 -font $uifont
 426    $sha1but conf -disabledforeground [$sha1but cget -foreground]
 427    pack .ctop.top.bar.sha1label -side left
 428    entry $sha1entry -width 40 -font $textfont -textvariable sha1string
 429    trace add variable sha1string write sha1change
 430    pack $sha1entry -side left -pady 2
 431
 432    image create bitmap bm-left -data {
 433        #define left_width 16
 434        #define left_height 16
 435        static unsigned char left_bits[] = {
 436        0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,
 437        0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,
 438        0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};
 439    }
 440    image create bitmap bm-right -data {
 441        #define right_width 16
 442        #define right_height 16
 443        static unsigned char right_bits[] = {
 444        0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
 445        0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
 446        0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
 447    }
 448    button .ctop.top.bar.leftbut -image bm-left -command goback \
 449        -state disabled -width 26
 450    pack .ctop.top.bar.leftbut -side left -fill y
 451    button .ctop.top.bar.rightbut -image bm-right -command goforw \
 452        -state disabled -width 26
 453    pack .ctop.top.bar.rightbut -side left -fill y
 454
 455    button .ctop.top.bar.findbut -text "Find" -command dofind -font $uifont
 456    pack .ctop.top.bar.findbut -side left
 457    set findstring {}
 458    set fstring .ctop.top.bar.findstring
 459    lappend entries $fstring
 460    entry $fstring -width 30 -font $textfont -textvariable findstring -font $textfont
 461    pack $fstring -side left -expand 1 -fill x
 462    set findtype Exact
 463    set findtypemenu [tk_optionMenu .ctop.top.bar.findtype \
 464                          findtype Exact IgnCase Regexp]
 465    .ctop.top.bar.findtype configure -font $uifont
 466    .ctop.top.bar.findtype.menu configure -font $uifont
 467    set findloc "All fields"
 468    tk_optionMenu .ctop.top.bar.findloc findloc "All fields" Headline \
 469        Comments Author Committer Files Pickaxe
 470    .ctop.top.bar.findloc configure -font $uifont
 471    .ctop.top.bar.findloc.menu configure -font $uifont
 472
 473    pack .ctop.top.bar.findloc -side right
 474    pack .ctop.top.bar.findtype -side right
 475    # for making sure type==Exact whenever loc==Pickaxe
 476    trace add variable findloc write findlocchange
 477
 478    panedwindow .ctop.cdet -orient horizontal
 479    .ctop add .ctop.cdet
 480    frame .ctop.cdet.left
 481    set ctext .ctop.cdet.left.ctext
 482    text $ctext -bg white -state disabled -font $textfont \
 483        -width $geometry(ctextw) -height $geometry(ctexth) \
 484        -yscrollcommand scrolltext -wrap none
 485    scrollbar .ctop.cdet.left.sb -command "$ctext yview"
 486    pack .ctop.cdet.left.sb -side right -fill y
 487    pack $ctext -side left -fill both -expand 1
 488    .ctop.cdet add .ctop.cdet.left
 489
 490    $ctext tag conf filesep -font [concat $textfont bold] -back "#aaaaaa"
 491    $ctext tag conf hunksep -fore blue
 492    $ctext tag conf d0 -fore red
 493    $ctext tag conf d1 -fore "#00a000"
 494    $ctext tag conf m0 -fore red
 495    $ctext tag conf m1 -fore blue
 496    $ctext tag conf m2 -fore green
 497    $ctext tag conf m3 -fore purple
 498    $ctext tag conf m4 -fore brown
 499    $ctext tag conf m5 -fore "#009090"
 500    $ctext tag conf m6 -fore magenta
 501    $ctext tag conf m7 -fore "#808000"
 502    $ctext tag conf m8 -fore "#009000"
 503    $ctext tag conf m9 -fore "#ff0080"
 504    $ctext tag conf m10 -fore cyan
 505    $ctext tag conf m11 -fore "#b07070"
 506    $ctext tag conf m12 -fore "#70b0f0"
 507    $ctext tag conf m13 -fore "#70f0b0"
 508    $ctext tag conf m14 -fore "#f0b070"
 509    $ctext tag conf m15 -fore "#ff70b0"
 510    $ctext tag conf mmax -fore darkgrey
 511    set mergemax 16
 512    $ctext tag conf mresult -font [concat $textfont bold]
 513    $ctext tag conf msep -font [concat $textfont bold]
 514    $ctext tag conf found -back yellow
 515
 516    frame .ctop.cdet.right
 517    set cflist .ctop.cdet.right.cfiles
 518    set indent [font measure $mainfont "nn"]
 519    text $cflist -width $geometry(cflistw) -background white -font $mainfont \
 520        -tabs [list $indent [expr {2 * $indent}]] \
 521        -yscrollcommand ".ctop.cdet.right.sb set" \
 522        -cursor [. cget -cursor] \
 523        -spacing1 1 -spacing3 1
 524    scrollbar .ctop.cdet.right.sb -command "$cflist yview"
 525    pack .ctop.cdet.right.sb -side right -fill y
 526    pack $cflist -side left -fill both -expand 1
 527    $cflist tag configure highlight -background yellow
 528    .ctop.cdet add .ctop.cdet.right
 529    bind .ctop.cdet <Configure> {resizecdetpanes %W %w}
 530
 531    pack .ctop -side top -fill both -expand 1
 532
 533    bindall <1> {selcanvline %W %x %y}
 534    #bindall <B1-Motion> {selcanvline %W %x %y}
 535    bindall <ButtonRelease-4> "allcanvs yview scroll -5 units"
 536    bindall <ButtonRelease-5> "allcanvs yview scroll 5 units"
 537    bindall <2> "canvscan mark %W %x %y"
 538    bindall <B2-Motion> "canvscan dragto %W %x %y"
 539    bindkey <Home> selfirstline
 540    bindkey <End> sellastline
 541    bind . <Key-Up> "selnextline -1"
 542    bind . <Key-Down> "selnextline 1"
 543    bindkey <Key-Right> "goforw"
 544    bindkey <Key-Left> "goback"
 545    bind . <Key-Prior> "selnextpage -1"
 546    bind . <Key-Next> "selnextpage 1"
 547    bind . <Control-Home> "allcanvs yview moveto 0.0"
 548    bind . <Control-End> "allcanvs yview moveto 1.0"
 549    bind . <Control-Key-Up> "allcanvs yview scroll -1 units"
 550    bind . <Control-Key-Down> "allcanvs yview scroll 1 units"
 551    bind . <Control-Key-Prior> "allcanvs yview scroll -1 pages"
 552    bind . <Control-Key-Next> "allcanvs yview scroll 1 pages"
 553    bindkey <Key-Delete> "$ctext yview scroll -1 pages"
 554    bindkey <Key-BackSpace> "$ctext yview scroll -1 pages"
 555    bindkey <Key-space> "$ctext yview scroll 1 pages"
 556    bindkey p "selnextline -1"
 557    bindkey n "selnextline 1"
 558    bindkey z "goback"
 559    bindkey x "goforw"
 560    bindkey i "selnextline -1"
 561    bindkey k "selnextline 1"
 562    bindkey j "goback"
 563    bindkey l "goforw"
 564    bindkey b "$ctext yview scroll -1 pages"
 565    bindkey d "$ctext yview scroll 18 units"
 566    bindkey u "$ctext yview scroll -18 units"
 567    bindkey / {findnext 1}
 568    bindkey <Key-Return> {findnext 0}
 569    bindkey ? findprev
 570    bindkey f nextfile
 571    bind . <Control-q> doquit
 572    bind . <Control-f> dofind
 573    bind . <Control-g> {findnext 0}
 574    bind . <Control-r> findprev
 575    bind . <Control-equal> {incrfont 1}
 576    bind . <Control-KP_Add> {incrfont 1}
 577    bind . <Control-minus> {incrfont -1}
 578    bind . <Control-KP_Subtract> {incrfont -1}
 579    bind . <Destroy> {savestuff %W}
 580    bind . <Button-1> "click %W"
 581    bind $fstring <Key-Return> dofind
 582    bind $sha1entry <Key-Return> gotocommit
 583    bind $sha1entry <<PasteSelection>> clearsha1
 584    bind $cflist <1> {sel_flist %W %x %y; break}
 585    bind $cflist <B1-Motion> {sel_flist %W %x %y; break}
 586
 587    set maincursor [. cget -cursor]
 588    set textcursor [$ctext cget -cursor]
 589    set curtextcursor $textcursor
 590
 591    set rowctxmenu .rowctxmenu
 592    menu $rowctxmenu -tearoff 0
 593    $rowctxmenu add command -label "Diff this -> selected" \
 594        -command {diffvssel 0}
 595    $rowctxmenu add command -label "Diff selected -> this" \
 596        -command {diffvssel 1}
 597    $rowctxmenu add command -label "Make patch" -command mkpatch
 598    $rowctxmenu add command -label "Create tag" -command mktag
 599    $rowctxmenu add command -label "Write commit to file" -command writecommit
 600}
 601
 602# mouse-2 makes all windows scan vertically, but only the one
 603# the cursor is in scans horizontally
 604proc canvscan {op w x y} {
 605    global canv canv2 canv3
 606    foreach c [list $canv $canv2 $canv3] {
 607        if {$c == $w} {
 608            $c scan $op $x $y
 609        } else {
 610            $c scan $op 0 $y
 611        }
 612    }
 613}
 614
 615proc scrollcanv {cscroll f0 f1} {
 616    $cscroll set $f0 $f1
 617    drawfrac $f0 $f1
 618}
 619
 620# when we make a key binding for the toplevel, make sure
 621# it doesn't get triggered when that key is pressed in the
 622# find string entry widget.
 623proc bindkey {ev script} {
 624    global entries
 625    bind . $ev $script
 626    set escript [bind Entry $ev]
 627    if {$escript == {}} {
 628        set escript [bind Entry <Key>]
 629    }
 630    foreach e $entries {
 631        bind $e $ev "$escript; break"
 632    }
 633}
 634
 635# set the focus back to the toplevel for any click outside
 636# the entry widgets
 637proc click {w} {
 638    global entries
 639    foreach e $entries {
 640        if {$w == $e} return
 641    }
 642    focus .
 643}
 644
 645proc savestuff {w} {
 646    global canv canv2 canv3 ctext cflist mainfont textfont uifont
 647    global stuffsaved findmergefiles maxgraphpct
 648    global maxwidth
 649    global viewname viewfiles viewperm nextviewnum
 650
 651    if {$stuffsaved} return
 652    if {![winfo viewable .]} return
 653    catch {
 654        set f [open "~/.gitk-new" w]
 655        puts $f [list set mainfont $mainfont]
 656        puts $f [list set textfont $textfont]
 657        puts $f [list set uifont $uifont]
 658        puts $f [list set findmergefiles $findmergefiles]
 659        puts $f [list set maxgraphpct $maxgraphpct]
 660        puts $f [list set maxwidth $maxwidth]
 661        puts $f "set geometry(width) [winfo width .ctop]"
 662        puts $f "set geometry(height) [winfo height .ctop]"
 663        puts $f "set geometry(canv1) [expr {[winfo width $canv]-2}]"
 664        puts $f "set geometry(canv2) [expr {[winfo width $canv2]-2}]"
 665        puts $f "set geometry(canv3) [expr {[winfo width $canv3]-2}]"
 666        puts $f "set geometry(canvh) [expr {[winfo height $canv]-2}]"
 667        set wid [expr {([winfo width $ctext] - 8) \
 668                           / [font measure $textfont "0"]}]
 669        puts $f "set geometry(ctextw) $wid"
 670        set wid [expr {([winfo width $cflist] - 11) \
 671                           / [font measure [$cflist cget -font] "0"]}]
 672        puts $f "set geometry(cflistw) $wid"
 673        puts -nonewline $f "set permviews {"
 674        for {set v 0} {$v < $nextviewnum} {incr v} {
 675            if {$viewperm($v)} {
 676                puts $f "{[list $viewname($v) $viewfiles($v)]}"
 677            }
 678        }
 679        puts $f "}"
 680        close $f
 681        file rename -force "~/.gitk-new" "~/.gitk"
 682    }
 683    set stuffsaved 1
 684}
 685
 686proc resizeclistpanes {win w} {
 687    global oldwidth
 688    if {[info exists oldwidth($win)]} {
 689        set s0 [$win sash coord 0]
 690        set s1 [$win sash coord 1]
 691        if {$w < 60} {
 692            set sash0 [expr {int($w/2 - 2)}]
 693            set sash1 [expr {int($w*5/6 - 2)}]
 694        } else {
 695            set factor [expr {1.0 * $w / $oldwidth($win)}]
 696            set sash0 [expr {int($factor * [lindex $s0 0])}]
 697            set sash1 [expr {int($factor * [lindex $s1 0])}]
 698            if {$sash0 < 30} {
 699                set sash0 30
 700            }
 701            if {$sash1 < $sash0 + 20} {
 702                set sash1 [expr {$sash0 + 20}]
 703            }
 704            if {$sash1 > $w - 10} {
 705                set sash1 [expr {$w - 10}]
 706                if {$sash0 > $sash1 - 20} {
 707                    set sash0 [expr {$sash1 - 20}]
 708                }
 709            }
 710        }
 711        $win sash place 0 $sash0 [lindex $s0 1]
 712        $win sash place 1 $sash1 [lindex $s1 1]
 713    }
 714    set oldwidth($win) $w
 715}
 716
 717proc resizecdetpanes {win w} {
 718    global oldwidth
 719    if {[info exists oldwidth($win)]} {
 720        set s0 [$win sash coord 0]
 721        if {$w < 60} {
 722            set sash0 [expr {int($w*3/4 - 2)}]
 723        } else {
 724            set factor [expr {1.0 * $w / $oldwidth($win)}]
 725            set sash0 [expr {int($factor * [lindex $s0 0])}]
 726            if {$sash0 < 45} {
 727                set sash0 45
 728            }
 729            if {$sash0 > $w - 15} {
 730                set sash0 [expr {$w - 15}]
 731            }
 732        }
 733        $win sash place 0 $sash0 [lindex $s0 1]
 734    }
 735    set oldwidth($win) $w
 736}
 737
 738proc allcanvs args {
 739    global canv canv2 canv3
 740    eval $canv $args
 741    eval $canv2 $args
 742    eval $canv3 $args
 743}
 744
 745proc bindall {event action} {
 746    global canv canv2 canv3
 747    bind $canv $event $action
 748    bind $canv2 $event $action
 749    bind $canv3 $event $action
 750}
 751
 752proc about {} {
 753    set w .about
 754    if {[winfo exists $w]} {
 755        raise $w
 756        return
 757    }
 758    toplevel $w
 759    wm title $w "About gitk"
 760    message $w.m -text {
 761Gitk - a commit viewer for git
 762
 763Copyright © 2005-2006 Paul Mackerras
 764
 765Use and redistribute under the terms of the GNU General Public License} \
 766            -justify center -aspect 400
 767    pack $w.m -side top -fill x -padx 20 -pady 20
 768    button $w.ok -text Close -command "destroy $w"
 769    pack $w.ok -side bottom
 770}
 771
 772proc keys {} {
 773    set w .keys
 774    if {[winfo exists $w]} {
 775        raise $w
 776        return
 777    }
 778    toplevel $w
 779    wm title $w "Gitk key bindings"
 780    message $w.m -text {
 781Gitk key bindings:
 782
 783<Ctrl-Q>                Quit
 784<Home>          Move to first commit
 785<End>           Move to last commit
 786<Up>, p, i      Move up one commit
 787<Down>, n, k    Move down one commit
 788<Left>, z, j    Go back in history list
 789<Right>, x, l   Go forward in history list
 790<PageUp>        Move up one page in commit list
 791<PageDown>      Move down one page in commit list
 792<Ctrl-Home>     Scroll to top of commit list
 793<Ctrl-End>      Scroll to bottom of commit list
 794<Ctrl-Up>       Scroll commit list up one line
 795<Ctrl-Down>     Scroll commit list down one line
 796<Ctrl-PageUp>   Scroll commit list up one page
 797<Ctrl-PageDown> Scroll commit list down one page
 798<Delete>, b     Scroll diff view up one page
 799<Backspace>     Scroll diff view up one page
 800<Space>         Scroll diff view down one page
 801u               Scroll diff view up 18 lines
 802d               Scroll diff view down 18 lines
 803<Ctrl-F>                Find
 804<Ctrl-G>                Move to next find hit
 805<Ctrl-R>                Move to previous find hit
 806<Return>        Move to next find hit
 807/               Move to next find hit, or redo find
 808?               Move to previous find hit
 809f               Scroll diff view to next file
 810<Ctrl-KP+>      Increase font size
 811<Ctrl-plus>     Increase font size
 812<Ctrl-KP->      Decrease font size
 813<Ctrl-minus>    Decrease font size
 814} \
 815            -justify left -bg white -border 2 -relief sunken
 816    pack $w.m -side top -fill both
 817    button $w.ok -text Close -command "destroy $w"
 818    pack $w.ok -side bottom
 819}
 820
 821# Procedures for manipulating the file list window at the
 822# bottom right of the overall window.
 823proc init_flist {first} {
 824    global cflist cflist_top cflist_bot selectedline difffilestart
 825
 826    $cflist conf -state normal
 827    $cflist delete 0.0 end
 828    if {$first ne {}} {
 829        $cflist insert end $first
 830        set cflist_top 1
 831        set cflist_bot 1
 832        $cflist tag add highlight 1.0 "1.0 lineend"
 833    } else {
 834        catch {unset cflist_top}
 835    }
 836    $cflist conf -state disabled
 837    set difffilestart {}
 838}
 839
 840proc add_flist {f} {
 841    global flistmode cflist
 842
 843    $cflist conf -state normal
 844    if {$flistmode eq "flat"} {
 845        $cflist insert end "\n$f"
 846    }
 847    $cflist conf -state disabled
 848}
 849
 850proc sel_flist {w x y} {
 851    global flistmode ctext difffilestart cflist cflist_top
 852
 853    if {![info exists cflist_top]} return
 854    set l [lindex [split [$w index "@$x,$y"] "."] 0]
 855    if {$flistmode eq "flat"} {
 856        if {$l == 1} {
 857            $ctext yview 1.0
 858        } else {
 859            catch {$ctext yview [lindex $difffilestart [expr {$l - 2}]]}
 860        }
 861        highlight_flist $l
 862    }
 863}
 864
 865proc scrolltext {f0 f1} {
 866    global cflist_top
 867
 868    .ctop.cdet.left.sb set $f0 $f1
 869    if {[info exists cflist_top]} {
 870        highlight_flist $cflist_top
 871    }
 872}
 873
 874# Given an index $tl in the $ctext window, this works out which line
 875# of the $cflist window displays the filename whose patch is shown
 876# at the given point in the $ctext window.  $ll is a hint about which
 877# line it might be, and is used as the starting point of the search.
 878proc ctext_index {tl ll} {
 879    global ctext difffilestart
 880
 881    while {$ll >= 2 && [$ctext compare $tl < \
 882                            [lindex $difffilestart [expr {$ll - 2}]]]} {
 883        incr ll -1
 884    }
 885    set nfiles [llength $difffilestart]
 886    while {$ll - 1 < $nfiles && [$ctext compare $tl >= \
 887                            [lindex $difffilestart [expr {$ll - 1}]]]} {
 888        incr ll
 889    }
 890    return $ll
 891}
 892
 893proc highlight_flist {ll} {
 894    global ctext cflist cflist_top cflist_bot difffilestart
 895
 896    if {![info exists difffilestart] || [llength $difffilestart] == 0} return
 897    set ll [ctext_index [$ctext index @0,1] $ll]
 898    set lb $cflist_bot
 899    if {$lb < $ll} {
 900        set lb $ll
 901    }
 902    set y [expr {[winfo height $ctext] - 2}]
 903    set lb [ctext_index [$ctext index @0,$y] $lb]
 904    if {$ll != $cflist_top || $lb != $cflist_bot} {
 905        $cflist tag remove highlight $cflist_top.0 "$cflist_bot.0 lineend"
 906        for {set l $ll} {$l <= $lb} {incr l} {
 907            $cflist tag add highlight $l.0 "$l.0 lineend"
 908        }
 909        set cflist_top $ll
 910        set cflist_bot $lb
 911    }
 912}
 913
 914# Code to implement multiple views
 915
 916proc newview {} {
 917    global nextviewnum newviewname newviewperm uifont
 918
 919    set top .gitkview
 920    if {[winfo exists $top]} {
 921        raise $top
 922        return
 923    }
 924    set newviewname($nextviewnum) "View $nextviewnum"
 925    set newviewperm($nextviewnum) 0
 926    vieweditor $top $nextviewnum "Gitk view definition" 
 927}
 928
 929proc editview {} {
 930    global curview
 931    global viewname viewperm newviewname newviewperm
 932
 933    set top .gitkvedit-$curview
 934    if {[winfo exists $top]} {
 935        raise $top
 936        return
 937    }
 938    set newviewname($curview) $viewname($curview)
 939    set newviewperm($curview) $viewperm($curview)
 940    vieweditor $top $curview "Gitk: edit view $viewname($curview)"
 941}
 942
 943proc vieweditor {top n title} {
 944    global newviewname newviewperm viewfiles
 945    global uifont
 946
 947    toplevel $top
 948    wm title $top $title
 949    label $top.nl -text "Name" -font $uifont
 950    entry $top.name -width 20 -textvariable newviewname($n)
 951    grid $top.nl $top.name -sticky w -pady 5
 952    checkbutton $top.perm -text "Remember this view" -variable newviewperm($n)
 953    grid $top.perm - -pady 5 -sticky w
 954    message $top.l -aspect 500 -font $uifont \
 955        -text "Enter files and directories to include, one per line:"
 956    grid $top.l - -sticky w
 957    text $top.t -width 40 -height 10 -background white
 958    if {[info exists viewfiles($n)]} {
 959        foreach f $viewfiles($n) {
 960            $top.t insert end $f
 961            $top.t insert end "\n"
 962        }
 963        $top.t delete {end - 1c} end
 964        $top.t mark set insert 0.0
 965    }
 966    grid $top.t - -sticky w -padx 5
 967    frame $top.buts
 968    button $top.buts.ok -text "OK" -command [list newviewok $top $n]
 969    button $top.buts.can -text "Cancel" -command [list destroy $top]
 970    grid $top.buts.ok $top.buts.can
 971    grid columnconfigure $top.buts 0 -weight 1 -uniform a
 972    grid columnconfigure $top.buts 1 -weight 1 -uniform a
 973    grid $top.buts - -pady 10 -sticky ew
 974    focus $top.t
 975}
 976
 977proc viewmenuitem {n} {
 978    set nmenu [.bar.view index end]
 979    set targetcmd [list showview $n]
 980    for {set i 6} {$i <= $nmenu} {incr i} {
 981        if {[.bar.view entrycget $i -command] eq $targetcmd} {
 982            return $i
 983        }
 984    }
 985    return {}
 986}
 987
 988proc newviewok {top n} {
 989    global nextviewnum newviewperm newviewname
 990    global viewname viewfiles viewperm selectedview curview
 991
 992    set files {}
 993    foreach f [split [$top.t get 0.0 end] "\n"] {
 994        set ft [string trim $f]
 995        if {$ft ne {}} {
 996            lappend files $ft
 997        }
 998    }
 999    if {![info exists viewfiles($n)]} {
1000        # creating a new view
1001        incr nextviewnum
1002        set viewname($n) $newviewname($n)
1003        set viewperm($n) $newviewperm($n)
1004        set viewfiles($n) $files
1005        .bar.view add radiobutton -label $viewname($n) \
1006            -command [list showview $n] -variable selectedview -value $n
1007        after idle showview $n
1008    } else {
1009        # editing an existing view
1010        set viewperm($n) $newviewperm($n)
1011        if {$newviewname($n) ne $viewname($n)} {
1012            set viewname($n) $newviewname($n)
1013            set i [viewmenuitem $n]
1014            if {$i ne {}} {
1015                .bar.view entryconf $i -label $viewname($n)
1016            }
1017        }
1018        if {$files ne $viewfiles($n)} {
1019            set viewfiles($n) $files
1020            if {$curview == $n} {
1021                after idle updatecommits
1022            }
1023        }
1024    }
1025    catch {destroy $top}
1026}
1027
1028proc delview {} {
1029    global curview viewdata viewperm
1030
1031    if {$curview == 0} return
1032    set i [viewmenuitem $curview]
1033    if {$i ne {}} {
1034        .bar.view delete $i
1035    }
1036    set viewdata($curview) {}
1037    set viewperm($curview) 0
1038    showview 0
1039}
1040
1041proc flatten {var} {
1042    global $var
1043
1044    set ret {}
1045    foreach i [array names $var] {
1046        lappend ret $i [set $var\($i\)]
1047    }
1048    return $ret
1049}
1050
1051proc unflatten {var l} {
1052    global $var
1053
1054    catch {unset $var}
1055    foreach {i v} $l {
1056        set $var\($i\) $v
1057    }
1058}
1059
1060proc showview {n} {
1061    global curview viewdata viewfiles
1062    global displayorder parentlist childlist rowidlist rowoffsets
1063    global colormap rowtextx commitrow
1064    global numcommits rowrangelist commitlisted idrowranges
1065    global selectedline currentid canv canvy0
1066    global matchinglines treediffs
1067    global pending_select phase
1068    global commitidx rowlaidout rowoptim linesegends leftover
1069    global commfd nextupdate
1070    global selectedview
1071
1072    if {$n == $curview} return
1073    set selid {}
1074    if {[info exists selectedline]} {
1075        set selid $currentid
1076        set y [yc $selectedline]
1077        set ymax [lindex [$canv cget -scrollregion] 3]
1078        set span [$canv yview]
1079        set ytop [expr {[lindex $span 0] * $ymax}]
1080        set ybot [expr {[lindex $span 1] * $ymax}]
1081        if {$ytop < $y && $y < $ybot} {
1082            set yscreen [expr {$y - $ytop}]
1083        } else {
1084            set yscreen [expr {($ybot - $ytop) / 2}]
1085        }
1086    }
1087    unselectline
1088    normalline
1089    stopfindproc
1090    if {$curview >= 0} {
1091        if {$phase ne {}} {
1092            set viewdata($curview) \
1093                [list $phase $displayorder $parentlist $childlist $rowidlist \
1094                     $rowoffsets $rowrangelist $commitlisted \
1095                     [flatten children] [flatten idrowranges] \
1096                     [flatten idinlist] \
1097                     $commitidx $rowlaidout $rowoptim $numcommits \
1098                     $linesegends $leftover $commfd]
1099            fileevent $commfd readable {}
1100        } elseif {![info exists viewdata($curview)]
1101                  || [lindex $viewdata($curview) 0] ne {}} {
1102            set viewdata($curview) \
1103                [list {} $displayorder $parentlist $childlist $rowidlist \
1104                     $rowoffsets $rowrangelist $commitlisted]
1105        }
1106    }
1107    catch {unset matchinglines}
1108    catch {unset treediffs}
1109    clear_display
1110
1111    set curview $n
1112    set selectedview $n
1113    .bar.view entryconf 2 -state [expr {$n == 0? "disabled": "normal"}]
1114    .bar.view entryconf 3 -state [expr {$n == 0? "disabled": "normal"}]
1115
1116    if {![info exists viewdata($n)]} {
1117        set pending_select $selid
1118        getcommits
1119        return
1120    }
1121
1122    set v $viewdata($n)
1123    set phase [lindex $v 0]
1124    set displayorder [lindex $v 1]
1125    set parentlist [lindex $v 2]
1126    set childlist [lindex $v 3]
1127    set rowidlist [lindex $v 4]
1128    set rowoffsets [lindex $v 5]
1129    set rowrangelist [lindex $v 6]
1130    set commitlisted [lindex $v 7]
1131    if {$phase eq {}} {
1132        set numcommits [llength $displayorder]
1133        catch {unset idrowranges}
1134        catch {unset children}
1135    } else {
1136        unflatten children [lindex $v 8]
1137        unflatten idrowranges [lindex $v 9]
1138        unflatten idinlist [lindex $v 10]
1139        set commitidx [lindex $v 11]
1140        set rowlaidout [lindex $v 12]
1141        set rowoptim [lindex $v 13]
1142        set numcommits [lindex $v 14]
1143        set linesegends [lindex $v 15]
1144        set leftover [lindex $v 16]
1145        set commfd [lindex $v 17]
1146        fileevent $commfd readable [list getcommitlines $commfd]
1147        set nextupdate [expr {[clock clicks -milliseconds] + 100}]
1148    }
1149
1150    catch {unset colormap}
1151    catch {unset rowtextx}
1152    catch {unset commitrow}
1153    set curview $n
1154    set row 0
1155    foreach id $displayorder {
1156        set commitrow($id) $row
1157        incr row
1158    }
1159    setcanvscroll
1160    set yf 0
1161    set row 0
1162    if {$selid ne {} && [info exists commitrow($selid)]} {
1163        set row $commitrow($selid)
1164        # try to get the selected row in the same position on the screen
1165        set ymax [lindex [$canv cget -scrollregion] 3]
1166        set ytop [expr {[yc $row] - $yscreen}]
1167        if {$ytop < 0} {
1168            set ytop 0
1169        }
1170        set yf [expr {$ytop * 1.0 / $ymax}]
1171    }
1172    allcanvs yview moveto $yf
1173    drawvisible
1174    selectline $row 0
1175    if {$phase eq {}} {
1176        global maincursor textcursor
1177        . config -cursor $maincursor
1178        settextcursor $textcursor
1179    } else {
1180        . config -cursor watch
1181        settextcursor watch
1182        if {$phase eq "getcommits"} {
1183            global mainfont
1184            $canv create text 3 3 -anchor nw -text "Reading commits..." \
1185                -font $mainfont -tags textitems
1186        }
1187    }
1188}
1189
1190proc shortids {ids} {
1191    set res {}
1192    foreach id $ids {
1193        if {[llength $id] > 1} {
1194            lappend res [shortids $id]
1195        } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
1196            lappend res [string range $id 0 7]
1197        } else {
1198            lappend res $id
1199        }
1200    }
1201    return $res
1202}
1203
1204proc incrange {l x o} {
1205    set n [llength $l]
1206    while {$x < $n} {
1207        set e [lindex $l $x]
1208        if {$e ne {}} {
1209            lset l $x [expr {$e + $o}]
1210        }
1211        incr x
1212    }
1213    return $l
1214}
1215
1216proc ntimes {n o} {
1217    set ret {}
1218    for {} {$n > 0} {incr n -1} {
1219        lappend ret $o
1220    }
1221    return $ret
1222}
1223
1224proc usedinrange {id l1 l2} {
1225    global children commitrow childlist
1226
1227    if {[info exists commitrow($id)]} {
1228        set r $commitrow($id)
1229        if {$l1 <= $r && $r <= $l2} {
1230            return [expr {$r - $l1 + 1}]
1231        }
1232        set kids [lindex $childlist $r]
1233    } else {
1234        set kids $children($id)
1235    }
1236    foreach c $kids {
1237        set r $commitrow($c)
1238        if {$l1 <= $r && $r <= $l2} {
1239            return [expr {$r - $l1 + 1}]
1240        }
1241    }
1242    return 0
1243}
1244
1245proc sanity {row {full 0}} {
1246    global rowidlist rowoffsets
1247
1248    set col -1
1249    set ids [lindex $rowidlist $row]
1250    foreach id $ids {
1251        incr col
1252        if {$id eq {}} continue
1253        if {$col < [llength $ids] - 1 &&
1254            [lsearch -exact -start [expr {$col+1}] $ids $id] >= 0} {
1255            puts "oops: [shortids $id] repeated in row $row col $col: {[shortids [lindex $rowidlist $row]]}"
1256        }
1257        set o [lindex $rowoffsets $row $col]
1258        set y $row
1259        set x $col
1260        while {$o ne {}} {
1261            incr y -1
1262            incr x $o
1263            if {[lindex $rowidlist $y $x] != $id} {
1264                puts "oops: rowoffsets wrong at row [expr {$y+1}] col [expr {$x-$o}]"
1265                puts "  id=[shortids $id] check started at row $row"
1266                for {set i $row} {$i >= $y} {incr i -1} {
1267                    puts "  row $i ids={[shortids [lindex $rowidlist $i]]} offs={[lindex $rowoffsets $i]}"
1268                }
1269                break
1270            }
1271            if {!$full} break
1272            set o [lindex $rowoffsets $y $x]
1273        }
1274    }
1275}
1276
1277proc makeuparrow {oid x y z} {
1278    global rowidlist rowoffsets uparrowlen idrowranges
1279
1280    for {set i 1} {$i < $uparrowlen && $y > 1} {incr i} {
1281        incr y -1
1282        incr x $z
1283        set off0 [lindex $rowoffsets $y]
1284        for {set x0 $x} {1} {incr x0} {
1285            if {$x0 >= [llength $off0]} {
1286                set x0 [llength [lindex $rowoffsets [expr {$y-1}]]]
1287                break
1288            }
1289            set z [lindex $off0 $x0]
1290            if {$z ne {}} {
1291                incr x0 $z
1292                break
1293            }
1294        }
1295        set z [expr {$x0 - $x}]
1296        lset rowidlist $y [linsert [lindex $rowidlist $y] $x $oid]
1297        lset rowoffsets $y [linsert [lindex $rowoffsets $y] $x $z]
1298    }
1299    set tmp [lreplace [lindex $rowoffsets $y] $x $x {}]
1300    lset rowoffsets $y [incrange $tmp [expr {$x+1}] -1]
1301    lappend idrowranges($oid) $y
1302}
1303
1304proc initlayout {} {
1305    global rowidlist rowoffsets displayorder commitlisted
1306    global rowlaidout rowoptim
1307    global idinlist rowchk rowrangelist idrowranges
1308    global commitidx numcommits canvxmax canv
1309    global nextcolor
1310    global parentlist childlist children
1311    global colormap rowtextx commitrow
1312    global linesegends
1313
1314    set commitidx 0
1315    set numcommits 0
1316    set displayorder {}
1317    set commitlisted {}
1318    set parentlist {}
1319    set childlist {}
1320    set rowrangelist {}
1321    catch {unset children}
1322    set nextcolor 0
1323    set rowidlist {{}}
1324    set rowoffsets {{}}
1325    catch {unset idinlist}
1326    catch {unset rowchk}
1327    set rowlaidout 0
1328    set rowoptim 0
1329    set canvxmax [$canv cget -width]
1330    catch {unset colormap}
1331    catch {unset rowtextx}
1332    catch {unset commitrow}
1333    catch {unset idrowranges}
1334    set linesegends {}
1335}
1336
1337proc setcanvscroll {} {
1338    global canv canv2 canv3 numcommits linespc canvxmax canvy0
1339
1340    set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
1341    $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
1342    $canv2 conf -scrollregion [list 0 0 0 $ymax]
1343    $canv3 conf -scrollregion [list 0 0 0 $ymax]
1344}
1345
1346proc visiblerows {} {
1347    global canv numcommits linespc
1348
1349    set ymax [lindex [$canv cget -scrollregion] 3]
1350    if {$ymax eq {} || $ymax == 0} return
1351    set f [$canv yview]
1352    set y0 [expr {int([lindex $f 0] * $ymax)}]
1353    set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
1354    if {$r0 < 0} {
1355        set r0 0
1356    }
1357    set y1 [expr {int([lindex $f 1] * $ymax)}]
1358    set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
1359    if {$r1 >= $numcommits} {
1360        set r1 [expr {$numcommits - 1}]
1361    }
1362    return [list $r0 $r1]
1363}
1364
1365proc layoutmore {} {
1366    global rowlaidout rowoptim commitidx numcommits optim_delay
1367    global uparrowlen
1368
1369    set row $rowlaidout
1370    set rowlaidout [layoutrows $row $commitidx 0]
1371    set orow [expr {$rowlaidout - $uparrowlen - 1}]
1372    if {$orow > $rowoptim} {
1373        optimize_rows $rowoptim 0 $orow
1374        set rowoptim $orow
1375    }
1376    set canshow [expr {$rowoptim - $optim_delay}]
1377    if {$canshow > $numcommits} {
1378        showstuff $canshow
1379    }
1380}
1381
1382proc showstuff {canshow} {
1383    global numcommits commitrow pending_select selectedline
1384    global linesegends idrowranges idrangedrawn
1385
1386    if {$numcommits == 0} {
1387        global phase
1388        set phase "incrdraw"
1389        allcanvs delete all
1390    }
1391    set row $numcommits
1392    set numcommits $canshow
1393    setcanvscroll
1394    set rows [visiblerows]
1395    set r0 [lindex $rows 0]
1396    set r1 [lindex $rows 1]
1397    set selrow -1
1398    for {set r $row} {$r < $canshow} {incr r} {
1399        foreach id [lindex $linesegends [expr {$r+1}]] {
1400            set i -1
1401            foreach {s e} [rowranges $id] {
1402                incr i
1403                if {$e ne {} && $e < $numcommits && $s <= $r1 && $e >= $r0
1404                    && ![info exists idrangedrawn($id,$i)]} {
1405                    drawlineseg $id $i
1406                    set idrangedrawn($id,$i) 1
1407                }
1408            }
1409        }
1410    }
1411    if {$canshow > $r1} {
1412        set canshow $r1
1413    }
1414    while {$row < $canshow} {
1415        drawcmitrow $row
1416        incr row
1417    }
1418    if {[info exists pending_select] &&
1419        [info exists commitrow($pending_select)] &&
1420        $commitrow($pending_select) < $numcommits} {
1421        selectline $commitrow($pending_select) 1
1422    }
1423    if {![info exists selectedline] && ![info exists pending_select]} {
1424        selectline 0 1
1425    }
1426}
1427
1428proc layoutrows {row endrow last} {
1429    global rowidlist rowoffsets displayorder
1430    global uparrowlen downarrowlen maxwidth mingaplen
1431    global childlist parentlist
1432    global idrowranges linesegends
1433    global commitidx
1434    global idinlist rowchk rowrangelist
1435
1436    set idlist [lindex $rowidlist $row]
1437    set offs [lindex $rowoffsets $row]
1438    while {$row < $endrow} {
1439        set id [lindex $displayorder $row]
1440        set oldolds {}
1441        set newolds {}
1442        foreach p [lindex $parentlist $row] {
1443            if {![info exists idinlist($p)]} {
1444                lappend newolds $p
1445            } elseif {!$idinlist($p)} {
1446                lappend oldolds $p
1447            }
1448        }
1449        set lse {}
1450        set nev [expr {[llength $idlist] + [llength $newolds]
1451                       + [llength $oldolds] - $maxwidth + 1}]
1452        if {$nev > 0} {
1453            if {!$last && $row + $uparrowlen + $mingaplen >= $commitidx} break
1454            for {set x [llength $idlist]} {[incr x -1] >= 0} {} {
1455                set i [lindex $idlist $x]
1456                if {![info exists rowchk($i)] || $row >= $rowchk($i)} {
1457                    set r [usedinrange $i [expr {$row - $downarrowlen}] \
1458                               [expr {$row + $uparrowlen + $mingaplen}]]
1459                    if {$r == 0} {
1460                        set idlist [lreplace $idlist $x $x]
1461                        set offs [lreplace $offs $x $x]
1462                        set offs [incrange $offs $x 1]
1463                        set idinlist($i) 0
1464                        set rm1 [expr {$row - 1}]
1465                        lappend lse $i
1466                        lappend idrowranges($i) $rm1
1467                        if {[incr nev -1] <= 0} break
1468                        continue
1469                    }
1470                    set rowchk($id) [expr {$row + $r}]
1471                }
1472            }
1473            lset rowidlist $row $idlist
1474            lset rowoffsets $row $offs
1475        }
1476        lappend linesegends $lse
1477        set col [lsearch -exact $idlist $id]
1478        if {$col < 0} {
1479            set col [llength $idlist]
1480            lappend idlist $id
1481            lset rowidlist $row $idlist
1482            set z {}
1483            if {[lindex $childlist $row] ne {}} {
1484                set z [expr {[llength [lindex $rowidlist [expr {$row-1}]]] - $col}]
1485                unset idinlist($id)
1486            }
1487            lappend offs $z
1488            lset rowoffsets $row $offs
1489            if {$z ne {}} {
1490                makeuparrow $id $col $row $z
1491            }
1492        } else {
1493            unset idinlist($id)
1494        }
1495        set ranges {}
1496        if {[info exists idrowranges($id)]} {
1497            set ranges $idrowranges($id)
1498            lappend ranges $row
1499            unset idrowranges($id)
1500        }
1501        lappend rowrangelist $ranges
1502        incr row
1503        set offs [ntimes [llength $idlist] 0]
1504        set l [llength $newolds]
1505        set idlist [eval lreplace \$idlist $col $col $newolds]
1506        set o 0
1507        if {$l != 1} {
1508            set offs [lrange $offs 0 [expr {$col - 1}]]
1509            foreach x $newolds {
1510                lappend offs {}
1511                incr o -1
1512            }
1513            incr o
1514            set tmp [expr {[llength $idlist] - [llength $offs]}]
1515            if {$tmp > 0} {
1516                set offs [concat $offs [ntimes $tmp $o]]
1517            }
1518        } else {
1519            lset offs $col {}
1520        }
1521        foreach i $newolds {
1522            set idinlist($i) 1
1523            set idrowranges($i) $row
1524        }
1525        incr col $l
1526        foreach oid $oldolds {
1527            set idinlist($oid) 1
1528            set idlist [linsert $idlist $col $oid]
1529            set offs [linsert $offs $col $o]
1530            makeuparrow $oid $col $row $o
1531            incr col
1532        }
1533        lappend rowidlist $idlist
1534        lappend rowoffsets $offs
1535    }
1536    return $row
1537}
1538
1539proc addextraid {id row} {
1540    global displayorder commitrow commitinfo
1541    global commitidx commitlisted
1542    global parentlist childlist children
1543
1544    incr commitidx
1545    lappend displayorder $id
1546    lappend commitlisted 0
1547    lappend parentlist {}
1548    set commitrow($id) $row
1549    readcommit $id
1550    if {![info exists commitinfo($id)]} {
1551        set commitinfo($id) {"No commit information available"}
1552    }
1553    if {[info exists children($id)]} {
1554        lappend childlist $children($id)
1555        unset children($id)
1556    } else {
1557        lappend childlist {}
1558    }
1559}
1560
1561proc layouttail {} {
1562    global rowidlist rowoffsets idinlist commitidx
1563    global idrowranges rowrangelist
1564
1565    set row $commitidx
1566    set idlist [lindex $rowidlist $row]
1567    while {$idlist ne {}} {
1568        set col [expr {[llength $idlist] - 1}]
1569        set id [lindex $idlist $col]
1570        addextraid $id $row
1571        unset idinlist($id)
1572        lappend idrowranges($id) $row
1573        lappend rowrangelist $idrowranges($id)
1574        unset idrowranges($id)
1575        incr row
1576        set offs [ntimes $col 0]
1577        set idlist [lreplace $idlist $col $col]
1578        lappend rowidlist $idlist
1579        lappend rowoffsets $offs
1580    }
1581
1582    foreach id [array names idinlist] {
1583        addextraid $id $row
1584        lset rowidlist $row [list $id]
1585        lset rowoffsets $row 0
1586        makeuparrow $id 0 $row 0
1587        lappend idrowranges($id) $row
1588        lappend rowrangelist $idrowranges($id)
1589        unset idrowranges($id)
1590        incr row
1591        lappend rowidlist {}
1592        lappend rowoffsets {}
1593    }
1594}
1595
1596proc insert_pad {row col npad} {
1597    global rowidlist rowoffsets
1598
1599    set pad [ntimes $npad {}]
1600    lset rowidlist $row [eval linsert [list [lindex $rowidlist $row]] $col $pad]
1601    set tmp [eval linsert [list [lindex $rowoffsets $row]] $col $pad]
1602    lset rowoffsets $row [incrange $tmp [expr {$col + $npad}] [expr {-$npad}]]
1603}
1604
1605proc optimize_rows {row col endrow} {
1606    global rowidlist rowoffsets idrowranges displayorder
1607
1608    for {} {$row < $endrow} {incr row} {
1609        set idlist [lindex $rowidlist $row]
1610        set offs [lindex $rowoffsets $row]
1611        set haspad 0
1612        for {} {$col < [llength $offs]} {incr col} {
1613            if {[lindex $idlist $col] eq {}} {
1614                set haspad 1
1615                continue
1616            }
1617            set z [lindex $offs $col]
1618            if {$z eq {}} continue
1619            set isarrow 0
1620            set x0 [expr {$col + $z}]
1621            set y0 [expr {$row - 1}]
1622            set z0 [lindex $rowoffsets $y0 $x0]
1623            if {$z0 eq {}} {
1624                set id [lindex $idlist $col]
1625                set ranges [rowranges $id]
1626                if {$ranges ne {} && $y0 > [lindex $ranges 0]} {
1627                    set isarrow 1
1628                }
1629            }
1630            if {$z < -1 || ($z < 0 && $isarrow)} {
1631                set npad [expr {-1 - $z + $isarrow}]
1632                set offs [incrange $offs $col $npad]
1633                insert_pad $y0 $x0 $npad
1634                if {$y0 > 0} {
1635                    optimize_rows $y0 $x0 $row
1636                }
1637                set z [lindex $offs $col]
1638                set x0 [expr {$col + $z}]
1639                set z0 [lindex $rowoffsets $y0 $x0]
1640            } elseif {$z > 1 || ($z > 0 && $isarrow)} {
1641                set npad [expr {$z - 1 + $isarrow}]
1642                set y1 [expr {$row + 1}]
1643                set offs2 [lindex $rowoffsets $y1]
1644                set x1 -1
1645                foreach z $offs2 {
1646                    incr x1
1647                    if {$z eq {} || $x1 + $z < $col} continue
1648                    if {$x1 + $z > $col} {
1649                        incr npad
1650                    }
1651                    lset rowoffsets $y1 [incrange $offs2 $x1 $npad]
1652                    break
1653                }
1654                set pad [ntimes $npad {}]
1655                set idlist [eval linsert \$idlist $col $pad]
1656                set tmp [eval linsert \$offs $col $pad]
1657                incr col $npad
1658                set offs [incrange $tmp $col [expr {-$npad}]]
1659                set z [lindex $offs $col]
1660                set haspad 1
1661            }
1662            if {$z0 eq {} && !$isarrow} {
1663                # this line links to its first child on row $row-2
1664                set rm2 [expr {$row - 2}]
1665                set id [lindex $displayorder $rm2]
1666                set xc [lsearch -exact [lindex $rowidlist $rm2] $id]
1667                if {$xc >= 0} {
1668                    set z0 [expr {$xc - $x0}]
1669                }
1670            }
1671            if {$z0 ne {} && $z < 0 && $z0 > 0} {
1672                insert_pad $y0 $x0 1
1673                set offs [incrange $offs $col 1]
1674                optimize_rows $y0 [expr {$x0 + 1}] $row
1675            }
1676        }
1677        if {!$haspad} {
1678            set o {}
1679            for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
1680                set o [lindex $offs $col]
1681                if {$o eq {}} {
1682                    # check if this is the link to the first child
1683                    set id [lindex $idlist $col]
1684                    set ranges [rowranges $id]
1685                    if {$ranges ne {} && $row == [lindex $ranges 0]} {
1686                        # it is, work out offset to child
1687                        set y0 [expr {$row - 1}]
1688                        set id [lindex $displayorder $y0]
1689                        set x0 [lsearch -exact [lindex $rowidlist $y0] $id]
1690                        if {$x0 >= 0} {
1691                            set o [expr {$x0 - $col}]
1692                        }
1693                    }
1694                }
1695                if {$o eq {} || $o <= 0} break
1696            }
1697            if {$o ne {} && [incr col] < [llength $idlist]} {
1698                set y1 [expr {$row + 1}]
1699                set offs2 [lindex $rowoffsets $y1]
1700                set x1 -1
1701                foreach z $offs2 {
1702                    incr x1
1703                    if {$z eq {} || $x1 + $z < $col} continue
1704                    lset rowoffsets $y1 [incrange $offs2 $x1 1]
1705                    break
1706                }
1707                set idlist [linsert $idlist $col {}]
1708                set tmp [linsert $offs $col {}]
1709                incr col
1710                set offs [incrange $tmp $col -1]
1711            }
1712        }
1713        lset rowidlist $row $idlist
1714        lset rowoffsets $row $offs
1715        set col 0
1716    }
1717}
1718
1719proc xc {row col} {
1720    global canvx0 linespc
1721    return [expr {$canvx0 + $col * $linespc}]
1722}
1723
1724proc yc {row} {
1725    global canvy0 linespc
1726    return [expr {$canvy0 + $row * $linespc}]
1727}
1728
1729proc linewidth {id} {
1730    global thickerline lthickness
1731
1732    set wid $lthickness
1733    if {[info exists thickerline] && $id eq $thickerline} {
1734        set wid [expr {2 * $lthickness}]
1735    }
1736    return $wid
1737}
1738
1739proc rowranges {id} {
1740    global phase idrowranges commitrow rowlaidout rowrangelist
1741
1742    set ranges {}
1743    if {$phase eq {} ||
1744        ([info exists commitrow($id)] && $commitrow($id) < $rowlaidout)} {
1745        set ranges [lindex $rowrangelist $commitrow($id)]
1746    } elseif {[info exists idrowranges($id)]} {
1747        set ranges $idrowranges($id)
1748    }
1749    return $ranges
1750}
1751
1752proc drawlineseg {id i} {
1753    global rowoffsets rowidlist
1754    global displayorder
1755    global canv colormap linespc
1756    global numcommits commitrow
1757
1758    set ranges [rowranges $id]
1759    set downarrow 1
1760    if {[info exists commitrow($id)] && $commitrow($id) < $numcommits} {
1761        set downarrow [expr {$i < [llength $ranges] / 2 - 1}]
1762    } else {
1763        set downarrow 1
1764    }
1765    set startrow [lindex $ranges [expr {2 * $i}]]
1766    set row [lindex $ranges [expr {2 * $i + 1}]]
1767    if {$startrow == $row} return
1768    assigncolor $id
1769    set coords {}
1770    set col [lsearch -exact [lindex $rowidlist $row] $id]
1771    if {$col < 0} {
1772        puts "oops: drawline: id $id not on row $row"
1773        return
1774    }
1775    set lasto {}
1776    set ns 0
1777    while {1} {
1778        set o [lindex $rowoffsets $row $col]
1779        if {$o eq {}} break
1780        if {$o ne $lasto} {
1781            # changing direction
1782            set x [xc $row $col]
1783            set y [yc $row]
1784            lappend coords $x $y
1785            set lasto $o
1786        }
1787        incr col $o
1788        incr row -1
1789    }
1790    set x [xc $row $col]
1791    set y [yc $row]
1792    lappend coords $x $y
1793    if {$i == 0} {
1794        # draw the link to the first child as part of this line
1795        incr row -1
1796        set child [lindex $displayorder $row]
1797        set ccol [lsearch -exact [lindex $rowidlist $row] $child]
1798        if {$ccol >= 0} {
1799            set x [xc $row $ccol]
1800            set y [yc $row]
1801            if {$ccol < $col - 1} {
1802                lappend coords [xc $row [expr {$col - 1}]] [yc $row]
1803            } elseif {$ccol > $col + 1} {
1804                lappend coords [xc $row [expr {$col + 1}]] [yc $row]
1805            }
1806            lappend coords $x $y
1807        }
1808    }
1809    if {[llength $coords] < 4} return
1810    if {$downarrow} {
1811        # This line has an arrow at the lower end: check if the arrow is
1812        # on a diagonal segment, and if so, work around the Tk 8.4
1813        # refusal to draw arrows on diagonal lines.
1814        set x0 [lindex $coords 0]
1815        set x1 [lindex $coords 2]
1816        if {$x0 != $x1} {
1817            set y0 [lindex $coords 1]
1818            set y1 [lindex $coords 3]
1819            if {$y0 - $y1 <= 2 * $linespc && $x1 == [lindex $coords 4]} {
1820                # we have a nearby vertical segment, just trim off the diag bit
1821                set coords [lrange $coords 2 end]
1822            } else {
1823                set slope [expr {($x0 - $x1) / ($y0 - $y1)}]
1824                set xi [expr {$x0 - $slope * $linespc / 2}]
1825                set yi [expr {$y0 - $linespc / 2}]
1826                set coords [lreplace $coords 0 1 $xi $y0 $xi $yi]
1827            }
1828        }
1829    }
1830    set arrow [expr {2 * ($i > 0) + $downarrow}]
1831    set arrow [lindex {none first last both} $arrow]
1832    set t [$canv create line $coords -width [linewidth $id] \
1833               -fill $colormap($id) -tags lines.$id -arrow $arrow]
1834    $canv lower $t
1835    bindline $t $id
1836}
1837
1838proc drawparentlinks {id row col olds} {
1839    global rowidlist canv colormap
1840
1841    set row2 [expr {$row + 1}]
1842    set x [xc $row $col]
1843    set y [yc $row]
1844    set y2 [yc $row2]
1845    set ids [lindex $rowidlist $row2]
1846    # rmx = right-most X coord used
1847    set rmx 0
1848    foreach p $olds {
1849        set i [lsearch -exact $ids $p]
1850        if {$i < 0} {
1851            puts "oops, parent $p of $id not in list"
1852            continue
1853        }
1854        set x2 [xc $row2 $i]
1855        if {$x2 > $rmx} {
1856            set rmx $x2
1857        }
1858        set ranges [rowranges $p]
1859        if {$ranges ne {} && $row2 == [lindex $ranges 0]
1860            && $row2 < [lindex $ranges 1]} {
1861            # drawlineseg will do this one for us
1862            continue
1863        }
1864        assigncolor $p
1865        # should handle duplicated parents here...
1866        set coords [list $x $y]
1867        if {$i < $col - 1} {
1868            lappend coords [xc $row [expr {$i + 1}]] $y
1869        } elseif {$i > $col + 1} {
1870            lappend coords [xc $row [expr {$i - 1}]] $y
1871        }
1872        lappend coords $x2 $y2
1873        set t [$canv create line $coords -width [linewidth $p] \
1874                   -fill $colormap($p) -tags lines.$p]
1875        $canv lower $t
1876        bindline $t $p
1877    }
1878    return $rmx
1879}
1880
1881proc drawlines {id} {
1882    global colormap canv
1883    global idrangedrawn
1884    global childlist iddrawn commitrow rowidlist
1885
1886    $canv delete lines.$id
1887    set nr [expr {[llength [rowranges $id]] / 2}]
1888    for {set i 0} {$i < $nr} {incr i} {
1889        if {[info exists idrangedrawn($id,$i)]} {
1890            drawlineseg $id $i
1891        }
1892    }
1893    foreach child [lindex $childlist $commitrow($id)] {
1894        if {[info exists iddrawn($child)]} {
1895            set row $commitrow($child)
1896            set col [lsearch -exact [lindex $rowidlist $row] $child]
1897            if {$col >= 0} {
1898                drawparentlinks $child $row $col [list $id]
1899            }
1900        }
1901    }
1902}
1903
1904proc drawcmittext {id row col rmx} {
1905    global linespc canv canv2 canv3 canvy0
1906    global commitlisted commitinfo rowidlist
1907    global rowtextx idpos idtags idheads idotherrefs
1908    global linehtag linentag linedtag
1909    global mainfont namefont canvxmax
1910
1911    set ofill [expr {[lindex $commitlisted $row]? "blue": "white"}]
1912    set x [xc $row $col]
1913    set y [yc $row]
1914    set orad [expr {$linespc / 3}]
1915    set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
1916               [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
1917               -fill $ofill -outline black -width 1]
1918    $canv raise $t
1919    $canv bind $t <1> {selcanvline {} %x %y}
1920    set xt [xc $row [llength [lindex $rowidlist $row]]]
1921    if {$xt < $rmx} {
1922        set xt $rmx
1923    }
1924    set rowtextx($row) $xt
1925    set idpos($id) [list $x $xt $y]
1926    if {[info exists idtags($id)] || [info exists idheads($id)]
1927        || [info exists idotherrefs($id)]} {
1928        set xt [drawtags $id $x $xt $y]
1929    }
1930    set headline [lindex $commitinfo($id) 0]
1931    set name [lindex $commitinfo($id) 1]
1932    set date [lindex $commitinfo($id) 2]
1933    set date [formatdate $date]
1934    set linehtag($row) [$canv create text $xt $y -anchor w \
1935                            -text $headline -font $mainfont ]
1936    $canv bind $linehtag($row) <Button-3> "rowmenu %X %Y $id"
1937    set linentag($row) [$canv2 create text 3 $y -anchor w \
1938                            -text $name -font $namefont]
1939    set linedtag($row) [$canv3 create text 3 $y -anchor w \
1940                            -text $date -font $mainfont]
1941    set xr [expr {$xt + [font measure $mainfont $headline]}]
1942    if {$xr > $canvxmax} {
1943        set canvxmax $xr
1944        setcanvscroll
1945    }
1946}
1947
1948proc drawcmitrow {row} {
1949    global displayorder rowidlist
1950    global idrangedrawn iddrawn
1951    global commitinfo parentlist numcommits
1952
1953    if {$row >= $numcommits} return
1954    foreach id [lindex $rowidlist $row] {
1955        if {$id eq {}} continue
1956        set i -1
1957        foreach {s e} [rowranges $id] {
1958            incr i
1959            if {$row < $s} continue
1960            if {$e eq {}} break
1961            if {$row <= $e} {
1962                if {$e < $numcommits && ![info exists idrangedrawn($id,$i)]} {
1963                    drawlineseg $id $i
1964                    set idrangedrawn($id,$i) 1
1965                }
1966                break
1967            }
1968        }
1969    }
1970
1971    set id [lindex $displayorder $row]
1972    if {[info exists iddrawn($id)]} return
1973    set col [lsearch -exact [lindex $rowidlist $row] $id]
1974    if {$col < 0} {
1975        puts "oops, row $row id $id not in list"
1976        return
1977    }
1978    if {![info exists commitinfo($id)]} {
1979        getcommit $id
1980    }
1981    assigncolor $id
1982    set olds [lindex $parentlist $row]
1983    if {$olds ne {}} {
1984        set rmx [drawparentlinks $id $row $col $olds]
1985    } else {
1986        set rmx 0
1987    }
1988    drawcmittext $id $row $col $rmx
1989    set iddrawn($id) 1
1990}
1991
1992proc drawfrac {f0 f1} {
1993    global numcommits canv
1994    global linespc
1995
1996    set ymax [lindex [$canv cget -scrollregion] 3]
1997    if {$ymax eq {} || $ymax == 0} return
1998    set y0 [expr {int($f0 * $ymax)}]
1999    set row [expr {int(($y0 - 3) / $linespc) - 1}]
2000    if {$row < 0} {
2001        set row 0
2002    }
2003    set y1 [expr {int($f1 * $ymax)}]
2004    set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
2005    if {$endrow >= $numcommits} {
2006        set endrow [expr {$numcommits - 1}]
2007    }
2008    for {} {$row <= $endrow} {incr row} {
2009        drawcmitrow $row
2010    }
2011}
2012
2013proc drawvisible {} {
2014    global canv
2015    eval drawfrac [$canv yview]
2016}
2017
2018proc clear_display {} {
2019    global iddrawn idrangedrawn
2020
2021    allcanvs delete all
2022    catch {unset iddrawn}
2023    catch {unset idrangedrawn}
2024}
2025
2026proc findcrossings {id} {
2027    global rowidlist parentlist numcommits rowoffsets displayorder
2028
2029    set cross {}
2030    set ccross {}
2031    foreach {s e} [rowranges $id] {
2032        if {$e >= $numcommits} {
2033            set e [expr {$numcommits - 1}]
2034        }
2035        if {$e <= $s} continue
2036        set x [lsearch -exact [lindex $rowidlist $e] $id]
2037        if {$x < 0} {
2038            puts "findcrossings: oops, no [shortids $id] in row $e"
2039            continue
2040        }
2041        for {set row $e} {[incr row -1] >= $s} {} {
2042            set olds [lindex $parentlist $row]
2043            set kid [lindex $displayorder $row]
2044            set kidx [lsearch -exact [lindex $rowidlist $row] $kid]
2045            if {$kidx < 0} continue
2046            set nextrow [lindex $rowidlist [expr {$row + 1}]]
2047            foreach p $olds {
2048                set px [lsearch -exact $nextrow $p]
2049                if {$px < 0} continue
2050                if {($kidx < $x && $x < $px) || ($px < $x && $x < $kidx)} {
2051                    if {[lsearch -exact $ccross $p] >= 0} continue
2052                    if {$x == $px + ($kidx < $px? -1: 1)} {
2053                        lappend ccross $p
2054                    } elseif {[lsearch -exact $cross $p] < 0} {
2055                        lappend cross $p
2056                    }
2057                }
2058            }
2059            set inc [lindex $rowoffsets $row $x]
2060            if {$inc eq {}} break
2061            incr x $inc
2062        }
2063    }
2064    return [concat $ccross {{}} $cross]
2065}
2066
2067proc assigncolor {id} {
2068    global colormap colors nextcolor
2069    global commitrow parentlist children childlist
2070
2071    if {[info exists colormap($id)]} return
2072    set ncolors [llength $colors]
2073    if {[info exists commitrow($id)]} {
2074        set kids [lindex $childlist $commitrow($id)]
2075    } elseif {[info exists children($id)]} {
2076        set kids $children($id)
2077    } else {
2078        set kids {}
2079    }
2080    if {[llength $kids] == 1} {
2081        set child [lindex $kids 0]
2082        if {[info exists colormap($child)]
2083            && [llength [lindex $parentlist $commitrow($child)]] == 1} {
2084            set colormap($id) $colormap($child)
2085            return
2086        }
2087    }
2088    set badcolors {}
2089    set origbad {}
2090    foreach x [findcrossings $id] {
2091        if {$x eq {}} {
2092            # delimiter between corner crossings and other crossings
2093            if {[llength $badcolors] >= $ncolors - 1} break
2094            set origbad $badcolors
2095        }
2096        if {[info exists colormap($x)]
2097            && [lsearch -exact $badcolors $colormap($x)] < 0} {
2098            lappend badcolors $colormap($x)
2099        }
2100    }
2101    if {[llength $badcolors] >= $ncolors} {
2102        set badcolors $origbad
2103    }
2104    set origbad $badcolors
2105    if {[llength $badcolors] < $ncolors - 1} {
2106        foreach child $kids {
2107            if {[info exists colormap($child)]
2108                && [lsearch -exact $badcolors $colormap($child)] < 0} {
2109                lappend badcolors $colormap($child)
2110            }
2111            foreach p [lindex $parentlist $commitrow($child)] {
2112                if {[info exists colormap($p)]
2113                    && [lsearch -exact $badcolors $colormap($p)] < 0} {
2114                    lappend badcolors $colormap($p)
2115                }
2116            }
2117        }
2118        if {[llength $badcolors] >= $ncolors} {
2119            set badcolors $origbad
2120        }
2121    }
2122    for {set i 0} {$i <= $ncolors} {incr i} {
2123        set c [lindex $colors $nextcolor]
2124        if {[incr nextcolor] >= $ncolors} {
2125            set nextcolor 0
2126        }
2127        if {[lsearch -exact $badcolors $c]} break
2128    }
2129    set colormap($id) $c
2130}
2131
2132proc bindline {t id} {
2133    global canv
2134
2135    $canv bind $t <Enter> "lineenter %x %y $id"
2136    $canv bind $t <Motion> "linemotion %x %y $id"
2137    $canv bind $t <Leave> "lineleave $id"
2138    $canv bind $t <Button-1> "lineclick %x %y $id 1"
2139}
2140
2141proc drawtags {id x xt y1} {
2142    global idtags idheads idotherrefs
2143    global linespc lthickness
2144    global canv mainfont commitrow rowtextx
2145
2146    set marks {}
2147    set ntags 0
2148    set nheads 0
2149    if {[info exists idtags($id)]} {
2150        set marks $idtags($id)
2151        set ntags [llength $marks]
2152    }
2153    if {[info exists idheads($id)]} {
2154        set marks [concat $marks $idheads($id)]
2155        set nheads [llength $idheads($id)]
2156    }
2157    if {[info exists idotherrefs($id)]} {
2158        set marks [concat $marks $idotherrefs($id)]
2159    }
2160    if {$marks eq {}} {
2161        return $xt
2162    }
2163
2164    set delta [expr {int(0.5 * ($linespc - $lthickness))}]
2165    set yt [expr {$y1 - 0.5 * $linespc}]
2166    set yb [expr {$yt + $linespc - 1}]
2167    set xvals {}
2168    set wvals {}
2169    foreach tag $marks {
2170        set wid [font measure $mainfont $tag]
2171        lappend xvals $xt
2172        lappend wvals $wid
2173        set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
2174    }
2175    set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
2176               -width $lthickness -fill black -tags tag.$id]
2177    $canv lower $t
2178    foreach tag $marks x $xvals wid $wvals {
2179        set xl [expr {$x + $delta}]
2180        set xr [expr {$x + $delta + $wid + $lthickness}]
2181        if {[incr ntags -1] >= 0} {
2182            # draw a tag
2183            set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
2184                       $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
2185                       -width 1 -outline black -fill yellow -tags tag.$id]
2186            $canv bind $t <1> [list showtag $tag 1]
2187            set rowtextx($commitrow($id)) [expr {$xr + $linespc}]
2188        } else {
2189            # draw a head or other ref
2190            if {[incr nheads -1] >= 0} {
2191                set col green
2192            } else {
2193                set col "#ddddff"
2194            }
2195            set xl [expr {$xl - $delta/2}]
2196            $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
2197                -width 1 -outline black -fill $col -tags tag.$id
2198            if {[regexp {^(remotes/.*/|remotes/)} $tag match remoteprefix]} {
2199                set rwid [font measure $mainfont $remoteprefix]
2200                set xi [expr {$x + 1}]
2201                set yti [expr {$yt + 1}]
2202                set xri [expr {$x + $rwid}]
2203                $canv create polygon $xi $yti $xri $yti $xri $yb $xi $yb \
2204                        -width 0 -fill "#ffddaa" -tags tag.$id
2205            }
2206        }
2207        set t [$canv create text $xl $y1 -anchor w -text $tag \
2208                   -font $mainfont -tags tag.$id]
2209        if {$ntags >= 0} {
2210            $canv bind $t <1> [list showtag $tag 1]
2211        }
2212    }
2213    return $xt
2214}
2215
2216proc xcoord {i level ln} {
2217    global canvx0 xspc1 xspc2
2218
2219    set x [expr {$canvx0 + $i * $xspc1($ln)}]
2220    if {$i > 0 && $i == $level} {
2221        set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
2222    } elseif {$i > $level} {
2223        set x [expr {$x + $xspc2 - $xspc1($ln)}]
2224    }
2225    return $x
2226}
2227
2228proc finishcommits {} {
2229    global commitidx phase
2230    global canv mainfont ctext maincursor textcursor
2231    global findinprogress pending_select
2232
2233    if {$commitidx > 0} {
2234        drawrest
2235    } else {
2236        $canv delete all
2237        $canv create text 3 3 -anchor nw -text "No commits selected" \
2238            -font $mainfont -tags textitems
2239    }
2240    if {![info exists findinprogress]} {
2241        . config -cursor $maincursor
2242        settextcursor $textcursor
2243    }
2244    set phase {}
2245    catch {unset pending_select}
2246}
2247
2248# Don't change the text pane cursor if it is currently the hand cursor,
2249# showing that we are over a sha1 ID link.
2250proc settextcursor {c} {
2251    global ctext curtextcursor
2252
2253    if {[$ctext cget -cursor] == $curtextcursor} {
2254        $ctext config -cursor $c
2255    }
2256    set curtextcursor $c
2257}
2258
2259proc drawrest {} {
2260    global numcommits
2261    global startmsecs
2262    global canvy0 numcommits linespc
2263    global rowlaidout commitidx
2264    global pending_select
2265
2266    set row $rowlaidout
2267    layoutrows $rowlaidout $commitidx 1
2268    layouttail
2269    optimize_rows $row 0 $commitidx
2270    showstuff $commitidx
2271    if {[info exists pending_select]} {
2272        selectline 0 1
2273    }
2274
2275    set drawmsecs [expr {[clock clicks -milliseconds] - $startmsecs}]
2276    #puts "overall $drawmsecs ms for $numcommits commits"
2277}
2278
2279proc findmatches {f} {
2280    global findtype foundstring foundstrlen
2281    if {$findtype == "Regexp"} {
2282        set matches [regexp -indices -all -inline $foundstring $f]
2283    } else {
2284        if {$findtype == "IgnCase"} {
2285            set str [string tolower $f]
2286        } else {
2287            set str $f
2288        }
2289        set matches {}
2290        set i 0
2291        while {[set j [string first $foundstring $str $i]] >= 0} {
2292            lappend matches [list $j [expr {$j+$foundstrlen-1}]]
2293            set i [expr {$j + $foundstrlen}]
2294        }
2295    }
2296    return $matches
2297}
2298
2299proc dofind {} {
2300    global findtype findloc findstring markedmatches commitinfo
2301    global numcommits displayorder linehtag linentag linedtag
2302    global mainfont namefont canv canv2 canv3 selectedline
2303    global matchinglines foundstring foundstrlen matchstring
2304    global commitdata
2305
2306    stopfindproc
2307    unmarkmatches
2308    focus .
2309    set matchinglines {}
2310    if {$findloc == "Pickaxe"} {
2311        findpatches
2312        return
2313    }
2314    if {$findtype == "IgnCase"} {
2315        set foundstring [string tolower $findstring]
2316    } else {
2317        set foundstring $findstring
2318    }
2319    set foundstrlen [string length $findstring]
2320    if {$foundstrlen == 0} return
2321    regsub -all {[*?\[\\]} $foundstring {\\&} matchstring
2322    set matchstring "*$matchstring*"
2323    if {$findloc == "Files"} {
2324        findfiles
2325        return
2326    }
2327    if {![info exists selectedline]} {
2328        set oldsel -1
2329    } else {
2330        set oldsel $selectedline
2331    }
2332    set didsel 0
2333    set fldtypes {Headline Author Date Committer CDate Comment}
2334    set l -1
2335    foreach id $displayorder {
2336        set d $commitdata($id)
2337        incr l
2338        if {$findtype == "Regexp"} {
2339            set doesmatch [regexp $foundstring $d]
2340        } elseif {$findtype == "IgnCase"} {
2341            set doesmatch [string match -nocase $matchstring $d]
2342        } else {
2343            set doesmatch [string match $matchstring $d]
2344        }
2345        if {!$doesmatch} continue
2346        if {![info exists commitinfo($id)]} {
2347            getcommit $id
2348        }
2349        set info $commitinfo($id)
2350        set doesmatch 0
2351        foreach f $info ty $fldtypes {
2352            if {$findloc != "All fields" && $findloc != $ty} {
2353                continue
2354            }
2355            set matches [findmatches $f]
2356            if {$matches == {}} continue
2357            set doesmatch 1
2358            if {$ty == "Headline"} {
2359                drawcmitrow $l
2360                markmatches $canv $l $f $linehtag($l) $matches $mainfont
2361            } elseif {$ty == "Author"} {
2362                drawcmitrow $l
2363                markmatches $canv2 $l $f $linentag($l) $matches $namefont
2364            } elseif {$ty == "Date"} {
2365                drawcmitrow $l
2366                markmatches $canv3 $l $f $linedtag($l) $matches $mainfont
2367            }
2368        }
2369        if {$doesmatch} {
2370            lappend matchinglines $l
2371            if {!$didsel && $l > $oldsel} {
2372                findselectline $l
2373                set didsel 1
2374            }
2375        }
2376    }
2377    if {$matchinglines == {}} {
2378        bell
2379    } elseif {!$didsel} {
2380        findselectline [lindex $matchinglines 0]
2381    }
2382}
2383
2384proc findselectline {l} {
2385    global findloc commentend ctext
2386    selectline $l 1
2387    if {$findloc == "All fields" || $findloc == "Comments"} {
2388        # highlight the matches in the comments
2389        set f [$ctext get 1.0 $commentend]
2390        set matches [findmatches $f]
2391        foreach match $matches {
2392            set start [lindex $match 0]
2393            set end [expr {[lindex $match 1] + 1}]
2394            $ctext tag add found "1.0 + $start c" "1.0 + $end c"
2395        }
2396    }
2397}
2398
2399proc findnext {restart} {
2400    global matchinglines selectedline
2401    if {![info exists matchinglines]} {
2402        if {$restart} {
2403            dofind
2404        }
2405        return
2406    }
2407    if {![info exists selectedline]} return
2408    foreach l $matchinglines {
2409        if {$l > $selectedline} {
2410            findselectline $l
2411            return
2412        }
2413    }
2414    bell
2415}
2416
2417proc findprev {} {
2418    global matchinglines selectedline
2419    if {![info exists matchinglines]} {
2420        dofind
2421        return
2422    }
2423    if {![info exists selectedline]} return
2424    set prev {}
2425    foreach l $matchinglines {
2426        if {$l >= $selectedline} break
2427        set prev $l
2428    }
2429    if {$prev != {}} {
2430        findselectline $prev
2431    } else {
2432        bell
2433    }
2434}
2435
2436proc findlocchange {name ix op} {
2437    global findloc findtype findtypemenu
2438    if {$findloc == "Pickaxe"} {
2439        set findtype Exact
2440        set state disabled
2441    } else {
2442        set state normal
2443    }
2444    $findtypemenu entryconf 1 -state $state
2445    $findtypemenu entryconf 2 -state $state
2446}
2447
2448proc stopfindproc {{done 0}} {
2449    global findprocpid findprocfile findids
2450    global ctext findoldcursor phase maincursor textcursor
2451    global findinprogress
2452
2453    catch {unset findids}
2454    if {[info exists findprocpid]} {
2455        if {!$done} {
2456            catch {exec kill $findprocpid}
2457        }
2458        catch {close $findprocfile}
2459        unset findprocpid
2460    }
2461    if {[info exists findinprogress]} {
2462        unset findinprogress
2463        if {$phase eq {}} {
2464            . config -cursor $maincursor
2465            settextcursor $textcursor
2466        }
2467    }
2468}
2469
2470proc findpatches {} {
2471    global findstring selectedline numcommits
2472    global findprocpid findprocfile
2473    global finddidsel ctext displayorder findinprogress
2474    global findinsertpos
2475
2476    if {$numcommits == 0} return
2477
2478    # make a list of all the ids to search, starting at the one
2479    # after the selected line (if any)
2480    if {[info exists selectedline]} {
2481        set l $selectedline
2482    } else {
2483        set l -1
2484    }
2485    set inputids {}
2486    for {set i 0} {$i < $numcommits} {incr i} {
2487        if {[incr l] >= $numcommits} {
2488            set l 0
2489        }
2490        append inputids [lindex $displayorder $l] "\n"
2491    }
2492
2493    if {[catch {
2494        set f [open [list | git-diff-tree --stdin -s -r -S$findstring \
2495                         << $inputids] r]
2496    } err]} {
2497        error_popup "Error starting search process: $err"
2498        return
2499    }
2500
2501    set findinsertpos end
2502    set findprocfile $f
2503    set findprocpid [pid $f]
2504    fconfigure $f -blocking 0
2505    fileevent $f readable readfindproc
2506    set finddidsel 0
2507    . config -cursor watch
2508    settextcursor watch
2509    set findinprogress 1
2510}
2511
2512proc readfindproc {} {
2513    global findprocfile finddidsel
2514    global commitrow matchinglines findinsertpos
2515
2516    set n [gets $findprocfile line]
2517    if {$n < 0} {
2518        if {[eof $findprocfile]} {
2519            stopfindproc 1
2520            if {!$finddidsel} {
2521                bell
2522            }
2523        }
2524        return
2525    }
2526    if {![regexp {^[0-9a-f]{40}} $line id]} {
2527        error_popup "Can't parse git-diff-tree output: $line"
2528        stopfindproc
2529        return
2530    }
2531    if {![info exists commitrow($id)]} {
2532        puts stderr "spurious id: $id"
2533        return
2534    }
2535    set l $commitrow($id)
2536    insertmatch $l $id
2537}
2538
2539proc insertmatch {l id} {
2540    global matchinglines findinsertpos finddidsel
2541
2542    if {$findinsertpos == "end"} {
2543        if {$matchinglines != {} && $l < [lindex $matchinglines 0]} {
2544            set matchinglines [linsert $matchinglines 0 $l]
2545            set findinsertpos 1
2546        } else {
2547            lappend matchinglines $l
2548        }
2549    } else {
2550        set matchinglines [linsert $matchinglines $findinsertpos $l]
2551        incr findinsertpos
2552    }
2553    markheadline $l $id
2554    if {!$finddidsel} {
2555        findselectline $l
2556        set finddidsel 1
2557    }
2558}
2559
2560proc findfiles {} {
2561    global selectedline numcommits displayorder ctext
2562    global ffileline finddidsel parentlist
2563    global findinprogress findstartline findinsertpos
2564    global treediffs fdiffid fdiffsneeded fdiffpos
2565    global findmergefiles
2566
2567    if {$numcommits == 0} return
2568
2569    if {[info exists selectedline]} {
2570        set l [expr {$selectedline + 1}]
2571    } else {
2572        set l 0
2573    }
2574    set ffileline $l
2575    set findstartline $l
2576    set diffsneeded {}
2577    set fdiffsneeded {}
2578    while 1 {
2579        set id [lindex $displayorder $l]
2580        if {$findmergefiles || [llength [lindex $parentlist $l]] == 1} {
2581            if {![info exists treediffs($id)]} {
2582                append diffsneeded "$id\n"
2583                lappend fdiffsneeded $id
2584            }
2585        }
2586        if {[incr l] >= $numcommits} {
2587            set l 0
2588        }
2589        if {$l == $findstartline} break
2590    }
2591
2592    # start off a git-diff-tree process if needed
2593    if {$diffsneeded ne {}} {
2594        if {[catch {
2595            set df [open [list | git-diff-tree -r --stdin << $diffsneeded] r]
2596        } err ]} {
2597            error_popup "Error starting search process: $err"
2598            return
2599        }
2600        catch {unset fdiffid}
2601        set fdiffpos 0
2602        fconfigure $df -blocking 0
2603        fileevent $df readable [list readfilediffs $df]
2604    }
2605
2606    set finddidsel 0
2607    set findinsertpos end
2608    set id [lindex $displayorder $l]
2609    . config -cursor watch
2610    settextcursor watch
2611    set findinprogress 1
2612    findcont
2613    update
2614}
2615
2616proc readfilediffs {df} {
2617    global findid fdiffid fdiffs
2618
2619    set n [gets $df line]
2620    if {$n < 0} {
2621        if {[eof $df]} {
2622            donefilediff
2623            if {[catch {close $df} err]} {
2624                stopfindproc
2625                bell
2626                error_popup "Error in git-diff-tree: $err"
2627            } elseif {[info exists findid]} {
2628                set id $findid
2629                stopfindproc
2630                bell
2631                error_popup "Couldn't find diffs for $id"
2632            }
2633        }
2634        return
2635    }
2636    if {[regexp {^([0-9a-f]{40})$} $line match id]} {
2637        # start of a new string of diffs
2638        donefilediff
2639        set fdiffid $id
2640        set fdiffs {}
2641    } elseif {[string match ":*" $line]} {
2642        lappend fdiffs [lindex $line 5]
2643    }
2644}
2645
2646proc donefilediff {} {
2647    global fdiffid fdiffs treediffs findid
2648    global fdiffsneeded fdiffpos
2649
2650    if {[info exists fdiffid]} {
2651        while {[lindex $fdiffsneeded $fdiffpos] ne $fdiffid
2652               && $fdiffpos < [llength $fdiffsneeded]} {
2653            # git-diff-tree doesn't output anything for a commit
2654            # which doesn't change anything
2655            set nullid [lindex $fdiffsneeded $fdiffpos]
2656            set treediffs($nullid) {}
2657            if {[info exists findid] && $nullid eq $findid} {
2658                unset findid
2659                findcont
2660            }
2661            incr fdiffpos
2662        }
2663        incr fdiffpos
2664
2665        if {![info exists treediffs($fdiffid)]} {
2666            set treediffs($fdiffid) $fdiffs
2667        }
2668        if {[info exists findid] && $fdiffid eq $findid} {
2669            unset findid
2670            findcont
2671        }
2672    }
2673}
2674
2675proc findcont {} {
2676    global findid treediffs parentlist
2677    global ffileline findstartline finddidsel
2678    global displayorder numcommits matchinglines findinprogress
2679    global findmergefiles
2680
2681    set l $ffileline
2682    while {1} {
2683        set id [lindex $displayorder $l]
2684        if {$findmergefiles || [llength [lindex $parentlist $l]] == 1} {
2685            if {![info exists treediffs($id)]} {
2686                set findid $id
2687                set ffileline $l
2688                return
2689            }
2690            set doesmatch 0
2691            foreach f $treediffs($id) {
2692                set x [findmatches $f]
2693                if {$x != {}} {
2694                    set doesmatch 1
2695                    break
2696                }
2697            }
2698            if {$doesmatch} {
2699                insertmatch $l $id
2700            }
2701        }
2702        if {[incr l] >= $numcommits} {
2703            set l 0
2704        }
2705        if {$l == $findstartline} break
2706    }
2707    stopfindproc
2708    if {!$finddidsel} {
2709        bell
2710    }
2711}
2712
2713# mark a commit as matching by putting a yellow background
2714# behind the headline
2715proc markheadline {l id} {
2716    global canv mainfont linehtag
2717
2718    drawcmitrow $l
2719    set bbox [$canv bbox $linehtag($l)]
2720    set t [$canv create rect $bbox -outline {} -tags matches -fill yellow]
2721    $canv lower $t
2722}
2723
2724# mark the bits of a headline, author or date that match a find string
2725proc markmatches {canv l str tag matches font} {
2726    set bbox [$canv bbox $tag]
2727    set x0 [lindex $bbox 0]
2728    set y0 [lindex $bbox 1]
2729    set y1 [lindex $bbox 3]
2730    foreach match $matches {
2731        set start [lindex $match 0]
2732        set end [lindex $match 1]
2733        if {$start > $end} continue
2734        set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
2735        set xlen [font measure $font [string range $str 0 [expr {$end}]]]
2736        set t [$canv create rect [expr {$x0+$xoff}] $y0 \
2737                   [expr {$x0+$xlen+2}] $y1 \
2738                   -outline {} -tags matches -fill yellow]
2739        $canv lower $t
2740    }
2741}
2742
2743proc unmarkmatches {} {
2744    global matchinglines findids
2745    allcanvs delete matches
2746    catch {unset matchinglines}
2747    catch {unset findids}
2748}
2749
2750proc selcanvline {w x y} {
2751    global canv canvy0 ctext linespc
2752    global rowtextx
2753    set ymax [lindex [$canv cget -scrollregion] 3]
2754    if {$ymax == {}} return
2755    set yfrac [lindex [$canv yview] 0]
2756    set y [expr {$y + $yfrac * $ymax}]
2757    set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
2758    if {$l < 0} {
2759        set l 0
2760    }
2761    if {$w eq $canv} {
2762        if {![info exists rowtextx($l)] || $x < $rowtextx($l)} return
2763    }
2764    unmarkmatches
2765    selectline $l 1
2766}
2767
2768proc commit_descriptor {p} {
2769    global commitinfo
2770    set l "..."
2771    if {[info exists commitinfo($p)]} {
2772        set l [lindex $commitinfo($p) 0]
2773    }
2774    return "$p ($l)"
2775}
2776
2777# append some text to the ctext widget, and make any SHA1 ID
2778# that we know about be a clickable link.
2779proc appendwithlinks {text} {
2780    global ctext commitrow linknum
2781
2782    set start [$ctext index "end - 1c"]
2783    $ctext insert end $text
2784    $ctext insert end "\n"
2785    set links [regexp -indices -all -inline {[0-9a-f]{40}} $text]
2786    foreach l $links {
2787        set s [lindex $l 0]
2788        set e [lindex $l 1]
2789        set linkid [string range $text $s $e]
2790        if {![info exists commitrow($linkid)]} continue
2791        incr e
2792        $ctext tag add link "$start + $s c" "$start + $e c"
2793        $ctext tag add link$linknum "$start + $s c" "$start + $e c"
2794        $ctext tag bind link$linknum <1> [list selectline $commitrow($linkid) 1]
2795        incr linknum
2796    }
2797    $ctext tag conf link -foreground blue -underline 1
2798    $ctext tag bind link <Enter> { %W configure -cursor hand2 }
2799    $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
2800}
2801
2802proc viewnextline {dir} {
2803    global canv linespc
2804
2805    $canv delete hover
2806    set ymax [lindex [$canv cget -scrollregion] 3]
2807    set wnow [$canv yview]
2808    set wtop [expr {[lindex $wnow 0] * $ymax}]
2809    set newtop [expr {$wtop + $dir * $linespc}]
2810    if {$newtop < 0} {
2811        set newtop 0
2812    } elseif {$newtop > $ymax} {
2813        set newtop $ymax
2814    }
2815    allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
2816}
2817
2818proc selectline {l isnew} {
2819    global canv canv2 canv3 ctext commitinfo selectedline
2820    global displayorder linehtag linentag linedtag
2821    global canvy0 linespc parentlist childlist
2822    global currentid sha1entry
2823    global commentend idtags linknum
2824    global mergemax numcommits pending_select
2825
2826    catch {unset pending_select}
2827    $canv delete hover
2828    normalline
2829    if {$l < 0 || $l >= $numcommits} return
2830    set y [expr {$canvy0 + $l * $linespc}]
2831    set ymax [lindex [$canv cget -scrollregion] 3]
2832    set ytop [expr {$y - $linespc - 1}]
2833    set ybot [expr {$y + $linespc + 1}]
2834    set wnow [$canv yview]
2835    set wtop [expr {[lindex $wnow 0] * $ymax}]
2836    set wbot [expr {[lindex $wnow 1] * $ymax}]
2837    set wh [expr {$wbot - $wtop}]
2838    set newtop $wtop
2839    if {$ytop < $wtop} {
2840        if {$ybot < $wtop} {
2841            set newtop [expr {$y - $wh / 2.0}]
2842        } else {
2843            set newtop $ytop
2844            if {$newtop > $wtop - $linespc} {
2845                set newtop [expr {$wtop - $linespc}]
2846            }
2847        }
2848    } elseif {$ybot > $wbot} {
2849        if {$ytop > $wbot} {
2850            set newtop [expr {$y - $wh / 2.0}]
2851        } else {
2852            set newtop [expr {$ybot - $wh}]
2853            if {$newtop < $wtop + $linespc} {
2854                set newtop [expr {$wtop + $linespc}]
2855            }
2856        }
2857    }
2858    if {$newtop != $wtop} {
2859        if {$newtop < 0} {
2860            set newtop 0
2861        }
2862        allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
2863        drawvisible
2864    }
2865
2866    if {![info exists linehtag($l)]} return
2867    $canv delete secsel
2868    set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
2869               -tags secsel -fill [$canv cget -selectbackground]]
2870    $canv lower $t
2871    $canv2 delete secsel
2872    set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
2873               -tags secsel -fill [$canv2 cget -selectbackground]]
2874    $canv2 lower $t
2875    $canv3 delete secsel
2876    set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
2877               -tags secsel -fill [$canv3 cget -selectbackground]]
2878    $canv3 lower $t
2879
2880    if {$isnew} {
2881        addtohistory [list selectline $l 0]
2882    }
2883
2884    set selectedline $l
2885
2886    set id [lindex $displayorder $l]
2887    set currentid $id
2888    $sha1entry delete 0 end
2889    $sha1entry insert 0 $id
2890    $sha1entry selection from 0
2891    $sha1entry selection to end
2892
2893    $ctext conf -state normal
2894    $ctext delete 0.0 end
2895    set linknum 0
2896    $ctext mark set fmark.0 0.0
2897    $ctext mark gravity fmark.0 left
2898    set info $commitinfo($id)
2899    set date [formatdate [lindex $info 2]]
2900    $ctext insert end "Author: [lindex $info 1]  $date\n"
2901    set date [formatdate [lindex $info 4]]
2902    $ctext insert end "Committer: [lindex $info 3]  $date\n"
2903    if {[info exists idtags($id)]} {
2904        $ctext insert end "Tags:"
2905        foreach tag $idtags($id) {
2906            $ctext insert end " $tag"
2907        }
2908        $ctext insert end "\n"
2909    }
2910 
2911    set comment {}
2912    set olds [lindex $parentlist $l]
2913    if {[llength $olds] > 1} {
2914        set np 0
2915        foreach p $olds {
2916            if {$np >= $mergemax} {
2917                set tag mmax
2918            } else {
2919                set tag m$np
2920            }
2921            $ctext insert end "Parent: " $tag
2922            appendwithlinks [commit_descriptor $p]
2923            incr np
2924        }
2925    } else {
2926        foreach p $olds {
2927            append comment "Parent: [commit_descriptor $p]\n"
2928        }
2929    }
2930
2931    foreach c [lindex $childlist $l] {
2932        append comment "Child:  [commit_descriptor $c]\n"
2933    }
2934    append comment "\n"
2935    append comment [lindex $info 5]
2936
2937    # make anything that looks like a SHA1 ID be a clickable link
2938    appendwithlinks $comment
2939
2940    $ctext tag delete Comments
2941    $ctext tag remove found 1.0 end
2942    $ctext conf -state disabled
2943    set commentend [$ctext index "end - 1c"]
2944
2945    init_flist "Comments"
2946    if {[llength $olds] <= 1} {
2947        startdiff $id
2948    } else {
2949        mergediff $id $l
2950    }
2951}
2952
2953proc selfirstline {} {
2954    unmarkmatches
2955    selectline 0 1
2956}
2957
2958proc sellastline {} {
2959    global numcommits
2960    unmarkmatches
2961    set l [expr {$numcommits - 1}]
2962    selectline $l 1
2963}
2964
2965proc selnextline {dir} {
2966    global selectedline
2967    if {![info exists selectedline]} return
2968    set l [expr {$selectedline + $dir}]
2969    unmarkmatches
2970    selectline $l 1
2971}
2972
2973proc selnextpage {dir} {
2974    global canv linespc selectedline numcommits
2975
2976    set lpp [expr {([winfo height $canv] - 2) / $linespc}]
2977    if {$lpp < 1} {
2978        set lpp 1
2979    }
2980    allcanvs yview scroll [expr {$dir * $lpp}] units
2981    if {![info exists selectedline]} return
2982    set l [expr {$selectedline + $dir * $lpp}]
2983    if {$l < 0} {
2984        set l 0
2985    } elseif {$l >= $numcommits} {
2986        set l [expr $numcommits - 1]
2987    }
2988    unmarkmatches
2989    selectline $l 1    
2990}
2991
2992proc unselectline {} {
2993    global selectedline currentid
2994
2995    catch {unset selectedline}
2996    catch {unset currentid}
2997    allcanvs delete secsel
2998}
2999
3000proc addtohistory {cmd} {
3001    global history historyindex curview
3002
3003    set elt [list $curview $cmd]
3004    if {$historyindex > 0
3005        && [lindex $history [expr {$historyindex - 1}]] == $elt} {
3006        return
3007    }
3008
3009    if {$historyindex < [llength $history]} {
3010        set history [lreplace $history $historyindex end $elt]
3011    } else {
3012        lappend history $elt
3013    }
3014    incr historyindex
3015    if {$historyindex > 1} {
3016        .ctop.top.bar.leftbut conf -state normal
3017    } else {
3018        .ctop.top.bar.leftbut conf -state disabled
3019    }
3020    .ctop.top.bar.rightbut conf -state disabled
3021}
3022
3023proc godo {elt} {
3024    global curview
3025
3026    set view [lindex $elt 0]
3027    set cmd [lindex $elt 1]
3028    if {$curview != $view} {
3029        showview $view
3030    }
3031    eval $cmd
3032}
3033
3034proc goback {} {
3035    global history historyindex
3036
3037    if {$historyindex > 1} {
3038        incr historyindex -1
3039        godo [lindex $history [expr {$historyindex - 1}]]
3040        .ctop.top.bar.rightbut conf -state normal
3041    }
3042    if {$historyindex <= 1} {
3043        .ctop.top.bar.leftbut conf -state disabled
3044    }
3045}
3046
3047proc goforw {} {
3048    global history historyindex
3049
3050    if {$historyindex < [llength $history]} {
3051        set cmd [lindex $history $historyindex]
3052        incr historyindex
3053        godo $cmd
3054        .ctop.top.bar.leftbut conf -state normal
3055    }
3056    if {$historyindex >= [llength $history]} {
3057        .ctop.top.bar.rightbut conf -state disabled
3058    }
3059}
3060
3061proc mergediff {id l} {
3062    global diffmergeid diffopts mdifffd
3063    global diffids
3064    global parentlist
3065
3066    set diffmergeid $id
3067    set diffids $id
3068    # this doesn't seem to actually affect anything...
3069    set env(GIT_DIFF_OPTS) $diffopts
3070    set cmd [concat | git-diff-tree --no-commit-id --cc $id]
3071    if {[catch {set mdf [open $cmd r]} err]} {
3072        error_popup "Error getting merge diffs: $err"
3073        return
3074    }
3075    fconfigure $mdf -blocking 0
3076    set mdifffd($id) $mdf
3077    set np [llength [lindex $parentlist $l]]
3078    fileevent $mdf readable [list getmergediffline $mdf $id $np]
3079    set nextupdate [expr {[clock clicks -milliseconds] + 100}]
3080}
3081
3082proc getmergediffline {mdf id np} {
3083    global diffmergeid ctext cflist nextupdate mergemax
3084    global difffilestart mdifffd
3085
3086    set n [gets $mdf line]
3087    if {$n < 0} {
3088        if {[eof $mdf]} {
3089            close $mdf
3090        }
3091        return
3092    }
3093    if {![info exists diffmergeid] || $id != $diffmergeid
3094        || $mdf != $mdifffd($id)} {
3095        return
3096    }
3097    $ctext conf -state normal
3098    if {[regexp {^diff --cc (.*)} $line match fname]} {
3099        # start of a new file
3100        $ctext insert end "\n"
3101        set here [$ctext index "end - 1c"]
3102        $ctext mark set f:$fname $here
3103        $ctext mark gravity f:$fname left
3104        lappend difffilestart $here
3105        add_flist $fname
3106        set l [expr {(78 - [string length $fname]) / 2}]
3107        set pad [string range "----------------------------------------" 1 $l]
3108        $ctext insert end "$pad $fname $pad\n" filesep
3109    } elseif {[regexp {^@@} $line]} {
3110        $ctext insert end "$line\n" hunksep
3111    } elseif {[regexp {^[0-9a-f]{40}$} $line] || [regexp {^index} $line]} {
3112        # do nothing
3113    } else {
3114        # parse the prefix - one ' ', '-' or '+' for each parent
3115        set spaces {}
3116        set minuses {}
3117        set pluses {}
3118        set isbad 0
3119        for {set j 0} {$j < $np} {incr j} {
3120            set c [string range $line $j $j]
3121            if {$c == " "} {
3122                lappend spaces $j
3123            } elseif {$c == "-"} {
3124                lappend minuses $j
3125            } elseif {$c == "+"} {
3126                lappend pluses $j
3127            } else {
3128                set isbad 1
3129                break
3130            }
3131        }
3132        set tags {}
3133        set num {}
3134        if {!$isbad && $minuses ne {} && $pluses eq {}} {
3135            # line doesn't appear in result, parents in $minuses have the line
3136            set num [lindex $minuses 0]
3137        } elseif {!$isbad && $pluses ne {} && $minuses eq {}} {
3138            # line appears in result, parents in $pluses don't have the line
3139            lappend tags mresult
3140            set num [lindex $spaces 0]
3141        }
3142        if {$num ne {}} {
3143            if {$num >= $mergemax} {
3144                set num "max"
3145            }
3146            lappend tags m$num
3147        }
3148        $ctext insert end "$line\n" $tags
3149    }
3150    $ctext conf -state disabled
3151    if {[clock clicks -milliseconds] >= $nextupdate} {
3152        incr nextupdate 100
3153        fileevent $mdf readable {}
3154        update
3155        fileevent $mdf readable [list getmergediffline $mdf $id $np]
3156    }
3157}
3158
3159proc startdiff {ids} {
3160    global treediffs diffids treepending diffmergeid
3161
3162    set diffids $ids
3163    catch {unset diffmergeid}
3164    if {![info exists treediffs($ids)]} {
3165        if {![info exists treepending]} {
3166            gettreediffs $ids
3167        }
3168    } else {
3169        addtocflist $ids
3170    }
3171}
3172
3173proc addtocflist {ids} {
3174    global treediffs cflist
3175    foreach f $treediffs($ids) {
3176        add_flist $f
3177    }
3178    getblobdiffs $ids
3179}
3180
3181proc gettreediffs {ids} {
3182    global treediff treepending
3183    set treepending $ids
3184    set treediff {}
3185    if {[catch \
3186         {set gdtf [open [concat | git-diff-tree --no-commit-id -r $ids] r]} \
3187        ]} return
3188    fconfigure $gdtf -blocking 0
3189    fileevent $gdtf readable [list gettreediffline $gdtf $ids]
3190}
3191
3192proc gettreediffline {gdtf ids} {
3193    global treediff treediffs treepending diffids diffmergeid
3194
3195    set n [gets $gdtf line]
3196    if {$n < 0} {
3197        if {![eof $gdtf]} return
3198        close $gdtf
3199        set treediffs($ids) $treediff
3200        unset treepending
3201        if {$ids != $diffids} {
3202            if {![info exists diffmergeid]} {
3203                gettreediffs $diffids
3204            }
3205        } else {
3206            addtocflist $ids
3207        }
3208        return
3209    }
3210    set file [lindex $line 5]
3211    lappend treediff $file
3212}
3213
3214proc getblobdiffs {ids} {
3215    global diffopts blobdifffd diffids env curdifftag curtagstart
3216    global nextupdate diffinhdr treediffs
3217
3218    set env(GIT_DIFF_OPTS) $diffopts
3219    set cmd [concat | git-diff-tree --no-commit-id -r -p -C $ids]
3220    if {[catch {set bdf [open $cmd r]} err]} {
3221        puts "error getting diffs: $err"
3222        return
3223    }
3224    set diffinhdr 0
3225    fconfigure $bdf -blocking 0
3226    set blobdifffd($ids) $bdf
3227    set curdifftag Comments
3228    set curtagstart 0.0
3229    fileevent $bdf readable [list getblobdiffline $bdf $diffids]
3230    set nextupdate [expr {[clock clicks -milliseconds] + 100}]
3231}
3232
3233proc getblobdiffline {bdf ids} {
3234    global diffids blobdifffd ctext curdifftag curtagstart
3235    global diffnexthead diffnextnote difffilestart
3236    global nextupdate diffinhdr treediffs
3237
3238    set n [gets $bdf line]
3239    if {$n < 0} {
3240        if {[eof $bdf]} {
3241            close $bdf
3242            if {$ids == $diffids && $bdf == $blobdifffd($ids)} {
3243                $ctext tag add $curdifftag $curtagstart end
3244            }
3245        }
3246        return
3247    }
3248    if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
3249        return
3250    }
3251    $ctext conf -state normal
3252    if {[regexp {^diff --git a/(.*) b/(.*)} $line match fname newname]} {
3253        # start of a new file
3254        $ctext insert end "\n"
3255        $ctext tag add $curdifftag $curtagstart end
3256        set here [$ctext index "end - 1c"]
3257        set curtagstart $here
3258        set header $newname
3259        lappend difffilestart $here
3260        $ctext mark set f:$fname $here
3261        $ctext mark gravity f:$fname left
3262        if {$newname != $fname} {
3263            $ctext mark set f:$newfname $here
3264            $ctext mark gravity f:$newfname left
3265        }
3266        set curdifftag "f:$fname"
3267        $ctext tag delete $curdifftag
3268        set l [expr {(78 - [string length $header]) / 2}]
3269        set pad [string range "----------------------------------------" 1 $l]
3270        $ctext insert end "$pad $header $pad\n" filesep
3271        set diffinhdr 1
3272    } elseif {$diffinhdr && [string compare -length 3 $line "---"] == 0} {
3273        # do nothing
3274    } elseif {$diffinhdr && [string compare -length 3 $line "+++"] == 0} {
3275        set diffinhdr 0
3276    } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \
3277                   $line match f1l f1c f2l f2c rest]} {
3278        $ctext insert end "$line\n" hunksep
3279        set diffinhdr 0
3280    } else {
3281        set x [string range $line 0 0]
3282        if {$x == "-" || $x == "+"} {
3283            set tag [expr {$x == "+"}]
3284            $ctext insert end "$line\n" d$tag
3285        } elseif {$x == " "} {
3286            $ctext insert end "$line\n"
3287        } elseif {$diffinhdr || $x == "\\"} {
3288            # e.g. "\ No newline at end of file"
3289            $ctext insert end "$line\n" filesep
3290        } else {
3291            # Something else we don't recognize
3292            if {$curdifftag != "Comments"} {
3293                $ctext insert end "\n"
3294                $ctext tag add $curdifftag $curtagstart end
3295                set curtagstart [$ctext index "end - 1c"]
3296                set curdifftag Comments
3297            }
3298            $ctext insert end "$line\n" filesep
3299        }
3300    }
3301    $ctext conf -state disabled
3302    if {[clock clicks -milliseconds] >= $nextupdate} {
3303        incr nextupdate 100
3304        fileevent $bdf readable {}
3305        update
3306        fileevent $bdf readable "getblobdiffline $bdf {$ids}"
3307    }
3308}
3309
3310proc nextfile {} {
3311    global difffilestart ctext
3312    set here [$ctext index @0,0]
3313    foreach loc $difffilestart {
3314        if {[$ctext compare $loc > $here]} {
3315            $ctext yview $loc
3316        }
3317    }
3318}
3319
3320proc setcoords {} {
3321    global linespc charspc canvx0 canvy0 mainfont
3322    global xspc1 xspc2 lthickness
3323
3324    set linespc [font metrics $mainfont -linespace]
3325    set charspc [font measure $mainfont "m"]
3326    set canvy0 [expr {int(3 + 0.5 * $linespc)}]
3327    set canvx0 [expr {int(3 + 0.5 * $linespc)}]
3328    set lthickness [expr {int($linespc / 9) + 1}]
3329    set xspc1(0) $linespc
3330    set xspc2 $linespc
3331}
3332
3333proc redisplay {} {
3334    global canv
3335    global selectedline
3336
3337    set ymax [lindex [$canv cget -scrollregion] 3]
3338    if {$ymax eq {} || $ymax == 0} return
3339    set span [$canv yview]
3340    clear_display
3341    setcanvscroll
3342    allcanvs yview moveto [lindex $span 0]
3343    drawvisible
3344    if {[info exists selectedline]} {
3345        selectline $selectedline 0
3346    }
3347}
3348
3349proc incrfont {inc} {
3350    global mainfont namefont textfont ctext canv phase
3351    global stopped entries
3352    unmarkmatches
3353    set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
3354    set namefont [lreplace $namefont 1 1 [expr {[lindex $namefont 1] + $inc}]]
3355    set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
3356    setcoords
3357    $ctext conf -font $textfont
3358    $ctext tag conf filesep -font [concat $textfont bold]
3359    foreach e $entries {
3360        $e conf -font $mainfont
3361    }
3362    if {$phase eq "getcommits"} {
3363        $canv itemconf textitems -font $mainfont
3364    }
3365    redisplay
3366}
3367
3368proc clearsha1 {} {
3369    global sha1entry sha1string
3370    if {[string length $sha1string] == 40} {
3371        $sha1entry delete 0 end
3372    }
3373}
3374
3375proc sha1change {n1 n2 op} {
3376    global sha1string currentid sha1but
3377    if {$sha1string == {}
3378        || ([info exists currentid] && $sha1string == $currentid)} {
3379        set state disabled
3380    } else {
3381        set state normal
3382    }
3383    if {[$sha1but cget -state] == $state} return
3384    if {$state == "normal"} {
3385        $sha1but conf -state normal -relief raised -text "Goto: "
3386    } else {
3387        $sha1but conf -state disabled -relief flat -text "SHA1 ID: "
3388    }
3389}
3390
3391proc gotocommit {} {
3392    global sha1string currentid commitrow tagids headids
3393    global displayorder numcommits
3394
3395    if {$sha1string == {}
3396        || ([info exists currentid] && $sha1string == $currentid)} return
3397    if {[info exists tagids($sha1string)]} {
3398        set id $tagids($sha1string)
3399    } elseif {[info exists headids($sha1string)]} {
3400        set id $headids($sha1string)
3401    } else {
3402        set id [string tolower $sha1string]
3403        if {[regexp {^[0-9a-f]{4,39}$} $id]} {
3404            set matches {}
3405            foreach i $displayorder {
3406                if {[string match $id* $i]} {
3407                    lappend matches $i
3408                }
3409            }
3410            if {$matches ne {}} {
3411                if {[llength $matches] > 1} {
3412                    error_popup "Short SHA1 id $id is ambiguous"
3413                    return
3414                }
3415                set id [lindex $matches 0]
3416            }
3417        }
3418    }
3419    if {[info exists commitrow($id)]} {
3420        selectline $commitrow($id) 1
3421        return
3422    }
3423    if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
3424        set type "SHA1 id"
3425    } else {
3426        set type "Tag/Head"
3427    }
3428    error_popup "$type $sha1string is not known"
3429}
3430
3431proc lineenter {x y id} {
3432    global hoverx hovery hoverid hovertimer
3433    global commitinfo canv
3434
3435    if {![info exists commitinfo($id)] && ![getcommit $id]} return
3436    set hoverx $x
3437    set hovery $y
3438    set hoverid $id
3439    if {[info exists hovertimer]} {
3440        after cancel $hovertimer
3441    }
3442    set hovertimer [after 500 linehover]
3443    $canv delete hover
3444}
3445
3446proc linemotion {x y id} {
3447    global hoverx hovery hoverid hovertimer
3448
3449    if {[info exists hoverid] && $id == $hoverid} {
3450        set hoverx $x
3451        set hovery $y
3452        if {[info exists hovertimer]} {
3453            after cancel $hovertimer
3454        }
3455        set hovertimer [after 500 linehover]
3456    }
3457}
3458
3459proc lineleave {id} {
3460    global hoverid hovertimer canv
3461
3462    if {[info exists hoverid] && $id == $hoverid} {
3463        $canv delete hover
3464        if {[info exists hovertimer]} {
3465            after cancel $hovertimer
3466            unset hovertimer
3467        }
3468        unset hoverid
3469    }
3470}
3471
3472proc linehover {} {
3473    global hoverx hovery hoverid hovertimer
3474    global canv linespc lthickness
3475    global commitinfo mainfont
3476
3477    set text [lindex $commitinfo($hoverid) 0]
3478    set ymax [lindex [$canv cget -scrollregion] 3]
3479    if {$ymax == {}} return
3480    set yfrac [lindex [$canv yview] 0]
3481    set x [expr {$hoverx + 2 * $linespc}]
3482    set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
3483    set x0 [expr {$x - 2 * $lthickness}]
3484    set y0 [expr {$y - 2 * $lthickness}]
3485    set x1 [expr {$x + [font measure $mainfont $text] + 2 * $lthickness}]
3486    set y1 [expr {$y + $linespc + 2 * $lthickness}]
3487    set t [$canv create rectangle $x0 $y0 $x1 $y1 \
3488               -fill \#ffff80 -outline black -width 1 -tags hover]
3489    $canv raise $t
3490    set t [$canv create text $x $y -anchor nw -text $text -tags hover -font $mainfont]
3491    $canv raise $t
3492}
3493
3494proc clickisonarrow {id y} {
3495    global lthickness
3496
3497    set ranges [rowranges $id]
3498    set thresh [expr {2 * $lthickness + 6}]
3499    set n [expr {[llength $ranges] - 1}]
3500    for {set i 1} {$i < $n} {incr i} {
3501        set row [lindex $ranges $i]
3502        if {abs([yc $row] - $y) < $thresh} {
3503            return $i
3504        }
3505    }
3506    return {}
3507}
3508
3509proc arrowjump {id n y} {
3510    global canv
3511
3512    # 1 <-> 2, 3 <-> 4, etc...
3513    set n [expr {(($n - 1) ^ 1) + 1}]
3514    set row [lindex [rowranges $id] $n]
3515    set yt [yc $row]
3516    set ymax [lindex [$canv cget -scrollregion] 3]
3517    if {$ymax eq {} || $ymax <= 0} return
3518    set view [$canv yview]
3519    set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
3520    set yfrac [expr {$yt / $ymax - $yspan / 2}]
3521    if {$yfrac < 0} {
3522        set yfrac 0
3523    }
3524    allcanvs yview moveto $yfrac
3525}
3526
3527proc lineclick {x y id isnew} {
3528    global ctext commitinfo childlist commitrow canv thickerline
3529
3530    if {![info exists commitinfo($id)] && ![getcommit $id]} return
3531    unmarkmatches
3532    unselectline
3533    normalline
3534    $canv delete hover
3535    # draw this line thicker than normal
3536    set thickerline $id
3537    drawlines $id
3538    if {$isnew} {
3539        set ymax [lindex [$canv cget -scrollregion] 3]
3540        if {$ymax eq {}} return
3541        set yfrac [lindex [$canv yview] 0]
3542        set y [expr {$y + $yfrac * $ymax}]
3543    }
3544    set dirn [clickisonarrow $id $y]
3545    if {$dirn ne {}} {
3546        arrowjump $id $dirn $y
3547        return
3548    }
3549
3550    if {$isnew} {
3551        addtohistory [list lineclick $x $y $id 0]
3552    }
3553    # fill the details pane with info about this line
3554    $ctext conf -state normal
3555    $ctext delete 0.0 end
3556    $ctext tag conf link -foreground blue -underline 1
3557    $ctext tag bind link <Enter> { %W configure -cursor hand2 }
3558    $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
3559    $ctext insert end "Parent:\t"
3560    $ctext insert end $id [list link link0]
3561    $ctext tag bind link0 <1> [list selbyid $id]
3562    set info $commitinfo($id)
3563    $ctext insert end "\n\t[lindex $info 0]\n"
3564    $ctext insert end "\tAuthor:\t[lindex $info 1]\n"
3565    set date [formatdate [lindex $info 2]]
3566    $ctext insert end "\tDate:\t$date\n"
3567    set kids [lindex $childlist $commitrow($id)]
3568    if {$kids ne {}} {
3569        $ctext insert end "\nChildren:"
3570        set i 0
3571        foreach child $kids {
3572            incr i
3573            if {![info exists commitinfo($child)] && ![getcommit $child]} continue
3574            set info $commitinfo($child)
3575            $ctext insert end "\n\t"
3576            $ctext insert end $child [list link link$i]
3577            $ctext tag bind link$i <1> [list selbyid $child]
3578            $ctext insert end "\n\t[lindex $info 0]"
3579            $ctext insert end "\n\tAuthor:\t[lindex $info 1]"
3580            set date [formatdate [lindex $info 2]]
3581            $ctext insert end "\n\tDate:\t$date\n"
3582        }
3583    }
3584    $ctext conf -state disabled
3585    init_flist {}
3586}
3587
3588proc normalline {} {
3589    global thickerline
3590    if {[info exists thickerline]} {
3591        set id $thickerline
3592        unset thickerline
3593        drawlines $id
3594    }
3595}
3596
3597proc selbyid {id} {
3598    global commitrow
3599    if {[info exists commitrow($id)]} {
3600        selectline $commitrow($id) 1
3601    }
3602}
3603
3604proc mstime {} {
3605    global startmstime
3606    if {![info exists startmstime]} {
3607        set startmstime [clock clicks -milliseconds]
3608    }
3609    return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
3610}
3611
3612proc rowmenu {x y id} {
3613    global rowctxmenu commitrow selectedline rowmenuid
3614
3615    if {![info exists selectedline] || $commitrow($id) eq $selectedline} {
3616        set state disabled
3617    } else {
3618        set state normal
3619    }
3620    $rowctxmenu entryconfigure 0 -state $state
3621    $rowctxmenu entryconfigure 1 -state $state
3622    $rowctxmenu entryconfigure 2 -state $state
3623    set rowmenuid $id
3624    tk_popup $rowctxmenu $x $y
3625}
3626
3627proc diffvssel {dirn} {
3628    global rowmenuid selectedline displayorder
3629
3630    if {![info exists selectedline]} return
3631    if {$dirn} {
3632        set oldid [lindex $displayorder $selectedline]
3633        set newid $rowmenuid
3634    } else {
3635        set oldid $rowmenuid
3636        set newid [lindex $displayorder $selectedline]
3637    }
3638    addtohistory [list doseldiff $oldid $newid]
3639    doseldiff $oldid $newid
3640}
3641
3642proc doseldiff {oldid newid} {
3643    global ctext
3644    global commitinfo
3645
3646    $ctext conf -state normal
3647    $ctext delete 0.0 end
3648    $ctext mark set fmark.0 0.0
3649    $ctext mark gravity fmark.0 left
3650    init_flist "Top"
3651    $ctext insert end "From "
3652    $ctext tag conf link -foreground blue -underline 1
3653    $ctext tag bind link <Enter> { %W configure -cursor hand2 }
3654    $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
3655    $ctext tag bind link0 <1> [list selbyid $oldid]
3656    $ctext insert end $oldid [list link link0]
3657    $ctext insert end "\n     "
3658    $ctext insert end [lindex $commitinfo($oldid) 0]
3659    $ctext insert end "\n\nTo   "
3660    $ctext tag bind link1 <1> [list selbyid $newid]
3661    $ctext insert end $newid [list link link1]
3662    $ctext insert end "\n     "
3663    $ctext insert end [lindex $commitinfo($newid) 0]
3664    $ctext insert end "\n"
3665    $ctext conf -state disabled
3666    $ctext tag delete Comments
3667    $ctext tag remove found 1.0 end
3668    startdiff [list $oldid $newid]
3669}
3670
3671proc mkpatch {} {
3672    global rowmenuid currentid commitinfo patchtop patchnum
3673
3674    if {![info exists currentid]} return
3675    set oldid $currentid
3676    set oldhead [lindex $commitinfo($oldid) 0]
3677    set newid $rowmenuid
3678    set newhead [lindex $commitinfo($newid) 0]
3679    set top .patch
3680    set patchtop $top
3681    catch {destroy $top}
3682    toplevel $top
3683    label $top.title -text "Generate patch"
3684    grid $top.title - -pady 10
3685    label $top.from -text "From:"
3686    entry $top.fromsha1 -width 40 -relief flat
3687    $top.fromsha1 insert 0 $oldid
3688    $top.fromsha1 conf -state readonly
3689    grid $top.from $top.fromsha1 -sticky w
3690    entry $top.fromhead -width 60 -relief flat
3691    $top.fromhead insert 0 $oldhead
3692    $top.fromhead conf -state readonly
3693    grid x $top.fromhead -sticky w
3694    label $top.to -text "To:"
3695    entry $top.tosha1 -width 40 -relief flat
3696    $top.tosha1 insert 0 $newid
3697    $top.tosha1 conf -state readonly
3698    grid $top.to $top.tosha1 -sticky w
3699    entry $top.tohead -width 60 -relief flat
3700    $top.tohead insert 0 $newhead
3701    $top.tohead conf -state readonly
3702    grid x $top.tohead -sticky w
3703    button $top.rev -text "Reverse" -command mkpatchrev -padx 5
3704    grid $top.rev x -pady 10
3705    label $top.flab -text "Output file:"
3706    entry $top.fname -width 60
3707    $top.fname insert 0 [file normalize "patch$patchnum.patch"]
3708    incr patchnum
3709    grid $top.flab $top.fname -sticky w
3710    frame $top.buts
3711    button $top.buts.gen -text "Generate" -command mkpatchgo
3712    button $top.buts.can -text "Cancel" -command mkpatchcan
3713    grid $top.buts.gen $top.buts.can
3714    grid columnconfigure $top.buts 0 -weight 1 -uniform a
3715    grid columnconfigure $top.buts 1 -weight 1 -uniform a
3716    grid $top.buts - -pady 10 -sticky ew
3717    focus $top.fname
3718}
3719
3720proc mkpatchrev {} {
3721    global patchtop
3722
3723    set oldid [$patchtop.fromsha1 get]
3724    set oldhead [$patchtop.fromhead get]
3725    set newid [$patchtop.tosha1 get]
3726    set newhead [$patchtop.tohead get]
3727    foreach e [list fromsha1 fromhead tosha1 tohead] \
3728            v [list $newid $newhead $oldid $oldhead] {
3729        $patchtop.$e conf -state normal
3730        $patchtop.$e delete 0 end
3731        $patchtop.$e insert 0 $v
3732        $patchtop.$e conf -state readonly
3733    }
3734}
3735
3736proc mkpatchgo {} {
3737    global patchtop
3738
3739    set oldid [$patchtop.fromsha1 get]
3740    set newid [$patchtop.tosha1 get]
3741    set fname [$patchtop.fname get]
3742    if {[catch {exec git-diff-tree -p $oldid $newid >$fname &} err]} {
3743        error_popup "Error creating patch: $err"
3744    }
3745    catch {destroy $patchtop}
3746    unset patchtop
3747}
3748
3749proc mkpatchcan {} {
3750    global patchtop
3751
3752    catch {destroy $patchtop}
3753    unset patchtop
3754}
3755
3756proc mktag {} {
3757    global rowmenuid mktagtop commitinfo
3758
3759    set top .maketag
3760    set mktagtop $top
3761    catch {destroy $top}
3762    toplevel $top
3763    label $top.title -text "Create tag"
3764    grid $top.title - -pady 10
3765    label $top.id -text "ID:"
3766    entry $top.sha1 -width 40 -relief flat
3767    $top.sha1 insert 0 $rowmenuid
3768    $top.sha1 conf -state readonly
3769    grid $top.id $top.sha1 -sticky w
3770    entry $top.head -width 60 -relief flat
3771    $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
3772    $top.head conf -state readonly
3773    grid x $top.head -sticky w
3774    label $top.tlab -text "Tag name:"
3775    entry $top.tag -width 60
3776    grid $top.tlab $top.tag -sticky w
3777    frame $top.buts
3778    button $top.buts.gen -text "Create" -command mktaggo
3779    button $top.buts.can -text "Cancel" -command mktagcan
3780    grid $top.buts.gen $top.buts.can
3781    grid columnconfigure $top.buts 0 -weight 1 -uniform a
3782    grid columnconfigure $top.buts 1 -weight 1 -uniform a
3783    grid $top.buts - -pady 10 -sticky ew
3784    focus $top.tag
3785}
3786
3787proc domktag {} {
3788    global mktagtop env tagids idtags
3789
3790    set id [$mktagtop.sha1 get]
3791    set tag [$mktagtop.tag get]
3792    if {$tag == {}} {
3793        error_popup "No tag name specified"
3794        return
3795    }
3796    if {[info exists tagids($tag)]} {
3797        error_popup "Tag \"$tag\" already exists"
3798        return
3799    }
3800    if {[catch {
3801        set dir [gitdir]
3802        set fname [file join $dir "refs/tags" $tag]
3803        set f [open $fname w]
3804        puts $f $id
3805        close $f
3806    } err]} {
3807        error_popup "Error creating tag: $err"
3808        return
3809    }
3810
3811    set tagids($tag) $id
3812    lappend idtags($id) $tag
3813    redrawtags $id
3814}
3815
3816proc redrawtags {id} {
3817    global canv linehtag commitrow idpos selectedline
3818
3819    if {![info exists commitrow($id)]} return
3820    drawcmitrow $commitrow($id)
3821    $canv delete tag.$id
3822    set xt [eval drawtags $id $idpos($id)]
3823    $canv coords $linehtag($commitrow($id)) $xt [lindex $idpos($id) 2]
3824    if {[info exists selectedline] && $selectedline == $commitrow($id)} {
3825        selectline $selectedline 0
3826    }
3827}
3828
3829proc mktagcan {} {
3830    global mktagtop
3831
3832    catch {destroy $mktagtop}
3833    unset mktagtop
3834}
3835
3836proc mktaggo {} {
3837    domktag
3838    mktagcan
3839}
3840
3841proc writecommit {} {
3842    global rowmenuid wrcomtop commitinfo wrcomcmd
3843
3844    set top .writecommit
3845    set wrcomtop $top
3846    catch {destroy $top}
3847    toplevel $top
3848    label $top.title -text "Write commit to file"
3849    grid $top.title - -pady 10
3850    label $top.id -text "ID:"
3851    entry $top.sha1 -width 40 -relief flat
3852    $top.sha1 insert 0 $rowmenuid
3853    $top.sha1 conf -state readonly
3854    grid $top.id $top.sha1 -sticky w
3855    entry $top.head -width 60 -relief flat
3856    $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
3857    $top.head conf -state readonly
3858    grid x $top.head -sticky w
3859    label $top.clab -text "Command:"
3860    entry $top.cmd -width 60 -textvariable wrcomcmd
3861    grid $top.clab $top.cmd -sticky w -pady 10
3862    label $top.flab -text "Output file:"
3863    entry $top.fname -width 60
3864    $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
3865    grid $top.flab $top.fname -sticky w
3866    frame $top.buts
3867    button $top.buts.gen -text "Write" -command wrcomgo
3868    button $top.buts.can -text "Cancel" -command wrcomcan
3869    grid $top.buts.gen $top.buts.can
3870    grid columnconfigure $top.buts 0 -weight 1 -uniform a
3871    grid columnconfigure $top.buts 1 -weight 1 -uniform a
3872    grid $top.buts - -pady 10 -sticky ew
3873    focus $top.fname
3874}
3875
3876proc wrcomgo {} {
3877    global wrcomtop
3878
3879    set id [$wrcomtop.sha1 get]
3880    set cmd "echo $id | [$wrcomtop.cmd get]"
3881    set fname [$wrcomtop.fname get]
3882    if {[catch {exec sh -c $cmd >$fname &} err]} {
3883        error_popup "Error writing commit: $err"
3884    }
3885    catch {destroy $wrcomtop}
3886    unset wrcomtop
3887}
3888
3889proc wrcomcan {} {
3890    global wrcomtop
3891
3892    catch {destroy $wrcomtop}
3893    unset wrcomtop
3894}
3895
3896proc listrefs {id} {
3897    global idtags idheads idotherrefs
3898
3899    set x {}
3900    if {[info exists idtags($id)]} {
3901        set x $idtags($id)
3902    }
3903    set y {}
3904    if {[info exists idheads($id)]} {
3905        set y $idheads($id)
3906    }
3907    set z {}
3908    if {[info exists idotherrefs($id)]} {
3909        set z $idotherrefs($id)
3910    }
3911    return [list $x $y $z]
3912}
3913
3914proc rereadrefs {} {
3915    global idtags idheads idotherrefs
3916
3917    set refids [concat [array names idtags] \
3918                    [array names idheads] [array names idotherrefs]]
3919    foreach id $refids {
3920        if {![info exists ref($id)]} {
3921            set ref($id) [listrefs $id]
3922        }
3923    }
3924    readrefs
3925    set refids [lsort -unique [concat $refids [array names idtags] \
3926                        [array names idheads] [array names idotherrefs]]]
3927    foreach id $refids {
3928        set v [listrefs $id]
3929        if {![info exists ref($id)] || $ref($id) != $v} {
3930            redrawtags $id
3931        }
3932    }
3933}
3934
3935proc showtag {tag isnew} {
3936    global ctext tagcontents tagids linknum
3937
3938    if {$isnew} {
3939        addtohistory [list showtag $tag 0]
3940    }
3941    $ctext conf -state normal
3942    $ctext delete 0.0 end
3943    set linknum 0
3944    if {[info exists tagcontents($tag)]} {
3945        set text $tagcontents($tag)
3946    } else {
3947        set text "Tag: $tag\nId:  $tagids($tag)"
3948    }
3949    appendwithlinks $text
3950    $ctext conf -state disabled
3951    init_flist {}
3952}
3953
3954proc doquit {} {
3955    global stopped
3956    set stopped 100
3957    destroy .
3958}
3959
3960proc doprefs {} {
3961    global maxwidth maxgraphpct diffopts findmergefiles
3962    global oldprefs prefstop
3963
3964    set top .gitkprefs
3965    set prefstop $top
3966    if {[winfo exists $top]} {
3967        raise $top
3968        return
3969    }
3970    foreach v {maxwidth maxgraphpct diffopts findmergefiles} {
3971        set oldprefs($v) [set $v]
3972    }
3973    toplevel $top
3974    wm title $top "Gitk preferences"
3975    label $top.ldisp -text "Commit list display options"
3976    grid $top.ldisp - -sticky w -pady 10
3977    label $top.spacer -text " "
3978    label $top.maxwidthl -text "Maximum graph width (lines)" \
3979        -font optionfont
3980    spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
3981    grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
3982    label $top.maxpctl -text "Maximum graph width (% of pane)" \
3983        -font optionfont
3984    spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
3985    grid x $top.maxpctl $top.maxpct -sticky w
3986    checkbutton $top.findm -variable findmergefiles
3987    label $top.findml -text "Include merges for \"Find\" in \"Files\"" \
3988        -font optionfont
3989    grid $top.findm $top.findml - -sticky w
3990    label $top.ddisp -text "Diff display options"
3991    grid $top.ddisp - -sticky w -pady 10
3992    label $top.diffoptl -text "Options for diff program" \
3993        -font optionfont
3994    entry $top.diffopt -width 20 -textvariable diffopts
3995    grid x $top.diffoptl $top.diffopt -sticky w
3996    frame $top.buts
3997    button $top.buts.ok -text "OK" -command prefsok
3998    button $top.buts.can -text "Cancel" -command prefscan
3999    grid $top.buts.ok $top.buts.can
4000    grid columnconfigure $top.buts 0 -weight 1 -uniform a
4001    grid columnconfigure $top.buts 1 -weight 1 -uniform a
4002    grid $top.buts - - -pady 10 -sticky ew
4003}
4004
4005proc prefscan {} {
4006    global maxwidth maxgraphpct diffopts findmergefiles
4007    global oldprefs prefstop
4008
4009    foreach v {maxwidth maxgraphpct diffopts findmergefiles} {
4010        set $v $oldprefs($v)
4011    }
4012    catch {destroy $prefstop}
4013    unset prefstop
4014}
4015
4016proc prefsok {} {
4017    global maxwidth maxgraphpct
4018    global oldprefs prefstop
4019
4020    catch {destroy $prefstop}
4021    unset prefstop
4022    if {$maxwidth != $oldprefs(maxwidth)
4023        || $maxgraphpct != $oldprefs(maxgraphpct)} {
4024        redisplay
4025    }
4026}
4027
4028proc formatdate {d} {
4029    return [clock format $d -format "%Y-%m-%d %H:%M:%S"]
4030}
4031
4032# This list of encoding names and aliases is distilled from
4033# http://www.iana.org/assignments/character-sets.
4034# Not all of them are supported by Tcl.
4035set encoding_aliases {
4036    { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
4037      ISO646-US US-ASCII us IBM367 cp367 csASCII }
4038    { ISO-10646-UTF-1 csISO10646UTF1 }
4039    { ISO_646.basic:1983 ref csISO646basic1983 }
4040    { INVARIANT csINVARIANT }
4041    { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
4042    { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
4043    { NATS-SEFI iso-ir-8-1 csNATSSEFI }
4044    { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
4045    { NATS-DANO iso-ir-9-1 csNATSDANO }
4046    { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
4047    { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
4048    { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
4049    { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
4050    { ISO-2022-KR csISO2022KR }
4051    { EUC-KR csEUCKR }
4052    { ISO-2022-JP csISO2022JP }
4053    { ISO-2022-JP-2 csISO2022JP2 }
4054    { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
4055      csISO13JISC6220jp }
4056    { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
4057    { IT iso-ir-15 ISO646-IT csISO15Italian }
4058    { PT iso-ir-16 ISO646-PT csISO16Portuguese }
4059    { ES iso-ir-17 ISO646-ES csISO17Spanish }
4060    { greek7-old iso-ir-18 csISO18Greek7Old }
4061    { latin-greek iso-ir-19 csISO19LatinGreek }
4062    { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
4063    { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
4064    { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
4065    { ISO_5427 iso-ir-37 csISO5427Cyrillic }
4066    { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
4067    { BS_viewdata iso-ir-47 csISO47BSViewdata }
4068    { INIS iso-ir-49 csISO49INIS }
4069    { INIS-8 iso-ir-50 csISO50INIS8 }
4070    { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
4071    { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
4072    { ISO_5428:1980 iso-ir-55 csISO5428Greek }
4073    { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
4074    { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
4075    { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
4076      csISO60Norwegian1 }
4077    { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
4078    { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
4079    { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
4080    { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
4081    { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
4082    { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
4083    { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
4084    { greek7 iso-ir-88 csISO88Greek7 }
4085    { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
4086    { iso-ir-90 csISO90 }
4087    { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
4088    { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
4089      csISO92JISC62991984b }
4090    { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
4091    { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
4092    { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
4093      csISO95JIS62291984handadd }
4094    { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
4095    { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
4096    { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
4097    { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
4098      CP819 csISOLatin1 }
4099    { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
4100    { T.61-7bit iso-ir-102 csISO102T617bit }
4101    { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
4102    { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
4103    { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
4104    { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
4105    { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
4106    { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
4107    { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
4108    { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
4109      arabic csISOLatinArabic }
4110    { ISO_8859-6-E csISO88596E ISO-8859-6-E }
4111    { ISO_8859-6-I csISO88596I ISO-8859-6-I }
4112    { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
4113      greek greek8 csISOLatinGreek }
4114    { T.101-G2 iso-ir-128 csISO128T101G2 }
4115    { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
4116      csISOLatinHebrew }
4117    { ISO_8859-8-E csISO88598E ISO-8859-8-E }
4118    { ISO_8859-8-I csISO88598I ISO-8859-8-I }
4119    { CSN_369103 iso-ir-139 csISO139CSN369103 }
4120    { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
4121    { ISO_6937-2-add iso-ir-142 csISOTextComm }
4122    { IEC_P27-1 iso-ir-143 csISO143IECP271 }
4123    { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
4124      csISOLatinCyrillic }
4125    { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
4126    { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
4127    { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
4128    { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
4129    { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
4130    { ISO_6937-2-25 iso-ir-152 csISO6937Add }
4131    { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
4132    { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
4133    { ISO_10367-box iso-ir-155 csISO10367Box }
4134    { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
4135    { latin-lap lap iso-ir-158 csISO158Lap }
4136    { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
4137    { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
4138    { us-dk csUSDK }
4139    { dk-us csDKUS }
4140    { JIS_X0201 X0201 csHalfWidthKatakana }
4141    { KSC5636 ISO646-KR csKSC5636 }
4142    { ISO-10646-UCS-2 csUnicode }
4143    { ISO-10646-UCS-4 csUCS4 }
4144    { DEC-MCS dec csDECMCS }
4145    { hp-roman8 roman8 r8 csHPRoman8 }
4146    { macintosh mac csMacintosh }
4147    { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
4148      csIBM037 }
4149    { IBM038 EBCDIC-INT cp038 csIBM038 }
4150    { IBM273 CP273 csIBM273 }
4151    { IBM274 EBCDIC-BE CP274 csIBM274 }
4152    { IBM275 EBCDIC-BR cp275 csIBM275 }
4153    { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
4154    { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
4155    { IBM280 CP280 ebcdic-cp-it csIBM280 }
4156    { IBM281 EBCDIC-JP-E cp281 csIBM281 }
4157    { IBM284 CP284 ebcdic-cp-es csIBM284 }
4158    { IBM285 CP285 ebcdic-cp-gb csIBM285 }
4159    { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
4160    { IBM297 cp297 ebcdic-cp-fr csIBM297 }
4161    { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
4162    { IBM423 cp423 ebcdic-cp-gr csIBM423 }
4163    { IBM424 cp424 ebcdic-cp-he csIBM424 }
4164    { IBM437 cp437 437 csPC8CodePage437 }
4165    { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
4166    { IBM775 cp775 csPC775Baltic }
4167    { IBM850 cp850 850 csPC850Multilingual }
4168    { IBM851 cp851 851 csIBM851 }
4169    { IBM852 cp852 852 csPCp852 }
4170    { IBM855 cp855 855 csIBM855 }
4171    { IBM857 cp857 857 csIBM857 }
4172    { IBM860 cp860 860 csIBM860 }
4173    { IBM861 cp861 861 cp-is csIBM861 }
4174    { IBM862 cp862 862 csPC862LatinHebrew }
4175    { IBM863 cp863 863 csIBM863 }
4176    { IBM864 cp864 csIBM864 }
4177    { IBM865 cp865 865 csIBM865 }
4178    { IBM866 cp866 866 csIBM866 }
4179    { IBM868 CP868 cp-ar csIBM868 }
4180    { IBM869 cp869 869 cp-gr csIBM869 }
4181    { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
4182    { IBM871 CP871 ebcdic-cp-is csIBM871 }
4183    { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
4184    { IBM891 cp891 csIBM891 }
4185    { IBM903 cp903 csIBM903 }
4186    { IBM904 cp904 904 csIBBM904 }
4187    { IBM905 CP905 ebcdic-cp-tr csIBM905 }
4188    { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
4189    { IBM1026 CP1026 csIBM1026 }
4190    { EBCDIC-AT-DE csIBMEBCDICATDE }
4191    { EBCDIC-AT-DE-A csEBCDICATDEA }
4192    { EBCDIC-CA-FR csEBCDICCAFR }
4193    { EBCDIC-DK-NO csEBCDICDKNO }
4194    { EBCDIC-DK-NO-A csEBCDICDKNOA }
4195    { EBCDIC-FI-SE csEBCDICFISE }
4196    { EBCDIC-FI-SE-A csEBCDICFISEA }
4197    { EBCDIC-FR csEBCDICFR }
4198    { EBCDIC-IT csEBCDICIT }
4199    { EBCDIC-PT csEBCDICPT }
4200    { EBCDIC-ES csEBCDICES }
4201    { EBCDIC-ES-A csEBCDICESA }
4202    { EBCDIC-ES-S csEBCDICESS }
4203    { EBCDIC-UK csEBCDICUK }
4204    { EBCDIC-US csEBCDICUS }
4205    { UNKNOWN-8BIT csUnknown8BiT }
4206    { MNEMONIC csMnemonic }
4207    { MNEM csMnem }
4208    { VISCII csVISCII }
4209    { VIQR csVIQR }
4210    { KOI8-R csKOI8R }
4211    { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
4212    { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
4213    { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
4214    { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
4215    { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
4216    { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
4217    { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
4218    { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
4219    { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
4220    { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
4221    { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
4222    { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
4223    { IBM1047 IBM-1047 }
4224    { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
4225    { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
4226    { UNICODE-1-1 csUnicode11 }
4227    { CESU-8 csCESU-8 }
4228    { BOCU-1 csBOCU-1 }
4229    { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
4230    { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
4231      l8 }
4232    { ISO-8859-15 ISO_8859-15 Latin-9 }
4233    { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
4234    { GBK CP936 MS936 windows-936 }
4235    { JIS_Encoding csJISEncoding }
4236    { Shift_JIS MS_Kanji csShiftJIS }
4237    { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
4238      EUC-JP }
4239    { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
4240    { ISO-10646-UCS-Basic csUnicodeASCII }
4241    { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
4242    { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
4243    { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
4244    { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
4245    { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
4246    { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
4247    { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
4248    { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
4249    { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
4250    { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
4251    { Adobe-Standard-Encoding csAdobeStandardEncoding }
4252    { Ventura-US csVenturaUS }
4253    { Ventura-International csVenturaInternational }
4254    { PC8-Danish-Norwegian csPC8DanishNorwegian }
4255    { PC8-Turkish csPC8Turkish }
4256    { IBM-Symbols csIBMSymbols }
4257    { IBM-Thai csIBMThai }
4258    { HP-Legal csHPLegal }
4259    { HP-Pi-font csHPPiFont }
4260    { HP-Math8 csHPMath8 }
4261    { Adobe-Symbol-Encoding csHPPSMath }
4262    { HP-DeskTop csHPDesktop }
4263    { Ventura-Math csVenturaMath }
4264    { Microsoft-Publishing csMicrosoftPublishing }
4265    { Windows-31J csWindows31J }
4266    { GB2312 csGB2312 }
4267    { Big5 csBig5 }
4268}
4269
4270proc tcl_encoding {enc} {
4271    global encoding_aliases
4272    set names [encoding names]
4273    set lcnames [string tolower $names]
4274    set enc [string tolower $enc]
4275    set i [lsearch -exact $lcnames $enc]
4276    if {$i < 0} {
4277        # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
4278        if {[regsub {^iso[-_]} $enc iso encx]} {
4279            set i [lsearch -exact $lcnames $encx]
4280        }
4281    }
4282    if {$i < 0} {
4283        foreach l $encoding_aliases {
4284            set ll [string tolower $l]
4285            if {[lsearch -exact $ll $enc] < 0} continue
4286            # look through the aliases for one that tcl knows about
4287            foreach e $ll {
4288                set i [lsearch -exact $lcnames $e]
4289                if {$i < 0} {
4290                    if {[regsub {^iso[-_]} $e iso ex]} {
4291                        set i [lsearch -exact $lcnames $ex]
4292                    }
4293                }
4294                if {$i >= 0} break
4295            }
4296            break
4297        }
4298    }
4299    if {$i >= 0} {
4300        return [lindex $names $i]
4301    }
4302    return {}
4303}
4304
4305# defaults...
4306set datemode 0
4307set diffopts "-U 5 -p"
4308set wrcomcmd "git-diff-tree --stdin -p --pretty"
4309
4310set gitencoding {}
4311catch {
4312    set gitencoding [exec git-repo-config --get i18n.commitencoding]
4313}
4314if {$gitencoding == ""} {
4315    set gitencoding "utf-8"
4316}
4317set tclencoding [tcl_encoding $gitencoding]
4318if {$tclencoding == {}} {
4319    puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
4320}
4321
4322set mainfont {Helvetica 9}
4323set textfont {Courier 9}
4324set uifont {Helvetica 9 bold}
4325set findmergefiles 0
4326set maxgraphpct 50
4327set maxwidth 16
4328set revlistorder 0
4329set fastdate 0
4330set uparrowlen 7
4331set downarrowlen 7
4332set mingaplen 30
4333set flistmode "flat"
4334
4335set colors {green red blue magenta darkgrey brown orange}
4336
4337catch {source ~/.gitk}
4338
4339set namefont $mainfont
4340
4341font create optionfont -family sans-serif -size -12
4342
4343set revtreeargs {}
4344foreach arg $argv {
4345    switch -regexp -- $arg {
4346        "^$" { }
4347        "^-d" { set datemode 1 }
4348        default {
4349            lappend revtreeargs $arg
4350        }
4351    }
4352}
4353
4354# check that we can find a .git directory somewhere...
4355set gitdir [gitdir]
4356if {![file isdirectory $gitdir]} {
4357    error_popup "Cannot find the git directory \"$gitdir\"."
4358    exit 1
4359}
4360
4361set history {}
4362set historyindex 0
4363
4364set optim_delay 16
4365
4366set nextviewnum 1
4367set curview 0
4368set selectedview 0
4369set viewfiles(0) {}
4370set viewperm(0) 0
4371
4372set stopped 0
4373set stuffsaved 0
4374set patchnum 0
4375setcoords
4376makewindow
4377readrefs
4378
4379set cmdline_files {}
4380catch {
4381    set fileargs [eval exec git-rev-parse --no-revs --no-flags $revtreeargs]
4382    set cmdline_files [split $fileargs "\n"]
4383    set n [llength $cmdline_files]
4384    set revtreeargs [lrange $revtreeargs 0 end-$n]
4385}
4386if {[lindex $revtreeargs end] eq "--"} {
4387    set revtreeargs [lrange $revtreeargs 0 end-1]
4388}
4389
4390if {$cmdline_files ne {}} {
4391    # create a view for the files/dirs specified on the command line
4392    set curview 1
4393    set selectedview 1
4394    set nextviewnum 2
4395    set viewname(1) "Command line"
4396    set viewfiles(1) $cmdline_files
4397    set viewperm(1) 0
4398    .bar.view add radiobutton -label $viewname(1) -command {showview 1} \
4399        -variable selectedview -value 1
4400    .bar.view entryconf 2 -state normal
4401    .bar.view entryconf 3 -state normal
4402}
4403
4404if {[info exists permviews]} {
4405    foreach v $permviews {
4406        set n $nextviewnum
4407        incr nextviewnum
4408        set viewname($n) [lindex $v 0]
4409        set viewfiles($n) [lindex $v 1]
4410        set viewperm($n) 1
4411        .bar.view add radiobutton -label $viewname($n) \
4412            -command [list showview $n] -variable selectedview -value $n
4413    }
4414}
4415getcommits