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