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