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