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