4bc7946aeef65f919f638cedcd0263874d8c11bd
   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 headids
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    } elseif {[info exists headids($sha1string)]} {
2858        set id $headids($sha1string)
2859    } else {
2860        set id [string tolower $sha1string]
2861        if {[regexp {^[0-9a-f]{4,39}$} $id]} {
2862            set matches {}
2863            foreach i $displayorder {
2864                if {[string match $id* $i]} {
2865                    lappend matches $i
2866                }
2867            }
2868            if {$matches ne {}} {
2869                if {[llength $matches] > 1} {
2870                    error_popup "Short SHA1 id $id is ambiguous"
2871                    return
2872                }
2873                set id [lindex $matches 0]
2874            }
2875        }
2876    }
2877    if {[info exists commitrow($id)]} {
2878        selectline $commitrow($id) 1
2879        return
2880    }
2881    if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
2882        set type "SHA1 id"
2883    } else {
2884        set type "Tag/Head"
2885    }
2886    error_popup "$type $sha1string is not known"
2887}
2888
2889proc lineenter {x y id} {
2890    global hoverx hovery hoverid hovertimer
2891    global commitinfo canv
2892
2893    if {![info exists commitinfo($id)] && ![getcommit $id]} return
2894    set hoverx $x
2895    set hovery $y
2896    set hoverid $id
2897    if {[info exists hovertimer]} {
2898        after cancel $hovertimer
2899    }
2900    set hovertimer [after 500 linehover]
2901    $canv delete hover
2902}
2903
2904proc linemotion {x y id} {
2905    global hoverx hovery hoverid hovertimer
2906
2907    if {[info exists hoverid] && $id == $hoverid} {
2908        set hoverx $x
2909        set hovery $y
2910        if {[info exists hovertimer]} {
2911            after cancel $hovertimer
2912        }
2913        set hovertimer [after 500 linehover]
2914    }
2915}
2916
2917proc lineleave {id} {
2918    global hoverid hovertimer canv
2919
2920    if {[info exists hoverid] && $id == $hoverid} {
2921        $canv delete hover
2922        if {[info exists hovertimer]} {
2923            after cancel $hovertimer
2924            unset hovertimer
2925        }
2926        unset hoverid
2927    }
2928}
2929
2930proc linehover {} {
2931    global hoverx hovery hoverid hovertimer
2932    global canv linespc lthickness
2933    global commitinfo mainfont
2934
2935    set text [lindex $commitinfo($hoverid) 0]
2936    set ymax [lindex [$canv cget -scrollregion] 3]
2937    if {$ymax == {}} return
2938    set yfrac [lindex [$canv yview] 0]
2939    set x [expr {$hoverx + 2 * $linespc}]
2940    set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
2941    set x0 [expr {$x - 2 * $lthickness}]
2942    set y0 [expr {$y - 2 * $lthickness}]
2943    set x1 [expr {$x + [font measure $mainfont $text] + 2 * $lthickness}]
2944    set y1 [expr {$y + $linespc + 2 * $lthickness}]
2945    set t [$canv create rectangle $x0 $y0 $x1 $y1 \
2946               -fill \#ffff80 -outline black -width 1 -tags hover]
2947    $canv raise $t
2948    set t [$canv create text $x $y -anchor nw -text $text -tags hover -font $mainfont]
2949    $canv raise $t
2950}
2951
2952proc clickisonarrow {id y} {
2953    global lthickness idrowranges
2954
2955    set thresh [expr {2 * $lthickness + 6}]
2956    set n [expr {[llength $idrowranges($id)] - 1}]
2957    for {set i 1} {$i < $n} {incr i} {
2958        set row [lindex $idrowranges($id) $i]
2959        if {abs([yc $row] - $y) < $thresh} {
2960            return $i
2961        }
2962    }
2963    return {}
2964}
2965
2966proc arrowjump {id n y} {
2967    global idrowranges canv
2968
2969    # 1 <-> 2, 3 <-> 4, etc...
2970    set n [expr {(($n - 1) ^ 1) + 1}]
2971    set row [lindex $idrowranges($id) $n]
2972    set yt [yc $row]
2973    set ymax [lindex [$canv cget -scrollregion] 3]
2974    if {$ymax eq {} || $ymax <= 0} return
2975    set view [$canv yview]
2976    set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
2977    set yfrac [expr {$yt / $ymax - $yspan / 2}]
2978    if {$yfrac < 0} {
2979        set yfrac 0
2980    }
2981    allcanvs yview moveto $yfrac
2982}
2983
2984proc lineclick {x y id isnew} {
2985    global ctext commitinfo childlist commitrow cflist canv thickerline
2986
2987    if {![info exists commitinfo($id)] && ![getcommit $id]} return
2988    unmarkmatches
2989    unselectline
2990    normalline
2991    $canv delete hover
2992    # draw this line thicker than normal
2993    set thickerline $id
2994    drawlines $id
2995    if {$isnew} {
2996        set ymax [lindex [$canv cget -scrollregion] 3]
2997        if {$ymax eq {}} return
2998        set yfrac [lindex [$canv yview] 0]
2999        set y [expr {$y + $yfrac * $ymax}]
3000    }
3001    set dirn [clickisonarrow $id $y]
3002    if {$dirn ne {}} {
3003        arrowjump $id $dirn $y
3004        return
3005    }
3006
3007    if {$isnew} {
3008        addtohistory [list lineclick $x $y $id 0]
3009    }
3010    # fill the details pane with info about this line
3011    $ctext conf -state normal
3012    $ctext delete 0.0 end
3013    $ctext tag conf link -foreground blue -underline 1
3014    $ctext tag bind link <Enter> { %W configure -cursor hand2 }
3015    $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
3016    $ctext insert end "Parent:\t"
3017    $ctext insert end $id [list link link0]
3018    $ctext tag bind link0 <1> [list selbyid $id]
3019    set info $commitinfo($id)
3020    $ctext insert end "\n\t[lindex $info 0]\n"
3021    $ctext insert end "\tAuthor:\t[lindex $info 1]\n"
3022    set date [formatdate [lindex $info 2]]
3023    $ctext insert end "\tDate:\t$date\n"
3024    set kids [lindex $childlist $commitrow($id)]
3025    if {$kids ne {}} {
3026        $ctext insert end "\nChildren:"
3027        set i 0
3028        foreach child $kids {
3029            incr i
3030            if {![info exists commitinfo($child)] && ![getcommit $child]} continue
3031            set info $commitinfo($child)
3032            $ctext insert end "\n\t"
3033            $ctext insert end $child [list link link$i]
3034            $ctext tag bind link$i <1> [list selbyid $child]
3035            $ctext insert end "\n\t[lindex $info 0]"
3036            $ctext insert end "\n\tAuthor:\t[lindex $info 1]"
3037            set date [formatdate [lindex $info 2]]
3038            $ctext insert end "\n\tDate:\t$date\n"
3039        }
3040    }
3041    $ctext conf -state disabled
3042
3043    $cflist delete 0 end
3044}
3045
3046proc normalline {} {
3047    global thickerline
3048    if {[info exists thickerline]} {
3049        set id $thickerline
3050        unset thickerline
3051        drawlines $id
3052    }
3053}
3054
3055proc selbyid {id} {
3056    global commitrow
3057    if {[info exists commitrow($id)]} {
3058        selectline $commitrow($id) 1
3059    }
3060}
3061
3062proc mstime {} {
3063    global startmstime
3064    if {![info exists startmstime]} {
3065        set startmstime [clock clicks -milliseconds]
3066    }
3067    return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
3068}
3069
3070proc rowmenu {x y id} {
3071    global rowctxmenu commitrow selectedline rowmenuid
3072
3073    if {![info exists selectedline] || $commitrow($id) eq $selectedline} {
3074        set state disabled
3075    } else {
3076        set state normal
3077    }
3078    $rowctxmenu entryconfigure 0 -state $state
3079    $rowctxmenu entryconfigure 1 -state $state
3080    $rowctxmenu entryconfigure 2 -state $state
3081    set rowmenuid $id
3082    tk_popup $rowctxmenu $x $y
3083}
3084
3085proc diffvssel {dirn} {
3086    global rowmenuid selectedline displayorder
3087
3088    if {![info exists selectedline]} return
3089    if {$dirn} {
3090        set oldid [lindex $displayorder $selectedline]
3091        set newid $rowmenuid
3092    } else {
3093        set oldid $rowmenuid
3094        set newid [lindex $displayorder $selectedline]
3095    }
3096    addtohistory [list doseldiff $oldid $newid]
3097    doseldiff $oldid $newid
3098}
3099
3100proc doseldiff {oldid newid} {
3101    global ctext cflist
3102    global commitinfo
3103
3104    $ctext conf -state normal
3105    $ctext delete 0.0 end
3106    $ctext mark set fmark.0 0.0
3107    $ctext mark gravity fmark.0 left
3108    $cflist delete 0 end
3109    $cflist insert end "Top"
3110    $ctext insert end "From "
3111    $ctext tag conf link -foreground blue -underline 1
3112    $ctext tag bind link <Enter> { %W configure -cursor hand2 }
3113    $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
3114    $ctext tag bind link0 <1> [list selbyid $oldid]
3115    $ctext insert end $oldid [list link link0]
3116    $ctext insert end "\n     "
3117    $ctext insert end [lindex $commitinfo($oldid) 0]
3118    $ctext insert end "\n\nTo   "
3119    $ctext tag bind link1 <1> [list selbyid $newid]
3120    $ctext insert end $newid [list link link1]
3121    $ctext insert end "\n     "
3122    $ctext insert end [lindex $commitinfo($newid) 0]
3123    $ctext insert end "\n"
3124    $ctext conf -state disabled
3125    $ctext tag delete Comments
3126    $ctext tag remove found 1.0 end
3127    startdiff [list $oldid $newid]
3128}
3129
3130proc mkpatch {} {
3131    global rowmenuid currentid commitinfo patchtop patchnum
3132
3133    if {![info exists currentid]} return
3134    set oldid $currentid
3135    set oldhead [lindex $commitinfo($oldid) 0]
3136    set newid $rowmenuid
3137    set newhead [lindex $commitinfo($newid) 0]
3138    set top .patch
3139    set patchtop $top
3140    catch {destroy $top}
3141    toplevel $top
3142    label $top.title -text "Generate patch"
3143    grid $top.title - -pady 10
3144    label $top.from -text "From:"
3145    entry $top.fromsha1 -width 40 -relief flat
3146    $top.fromsha1 insert 0 $oldid
3147    $top.fromsha1 conf -state readonly
3148    grid $top.from $top.fromsha1 -sticky w
3149    entry $top.fromhead -width 60 -relief flat
3150    $top.fromhead insert 0 $oldhead
3151    $top.fromhead conf -state readonly
3152    grid x $top.fromhead -sticky w
3153    label $top.to -text "To:"
3154    entry $top.tosha1 -width 40 -relief flat
3155    $top.tosha1 insert 0 $newid
3156    $top.tosha1 conf -state readonly
3157    grid $top.to $top.tosha1 -sticky w
3158    entry $top.tohead -width 60 -relief flat
3159    $top.tohead insert 0 $newhead
3160    $top.tohead conf -state readonly
3161    grid x $top.tohead -sticky w
3162    button $top.rev -text "Reverse" -command mkpatchrev -padx 5
3163    grid $top.rev x -pady 10
3164    label $top.flab -text "Output file:"
3165    entry $top.fname -width 60
3166    $top.fname insert 0 [file normalize "patch$patchnum.patch"]
3167    incr patchnum
3168    grid $top.flab $top.fname -sticky w
3169    frame $top.buts
3170    button $top.buts.gen -text "Generate" -command mkpatchgo
3171    button $top.buts.can -text "Cancel" -command mkpatchcan
3172    grid $top.buts.gen $top.buts.can
3173    grid columnconfigure $top.buts 0 -weight 1 -uniform a
3174    grid columnconfigure $top.buts 1 -weight 1 -uniform a
3175    grid $top.buts - -pady 10 -sticky ew
3176    focus $top.fname
3177}
3178
3179proc mkpatchrev {} {
3180    global patchtop
3181
3182    set oldid [$patchtop.fromsha1 get]
3183    set oldhead [$patchtop.fromhead get]
3184    set newid [$patchtop.tosha1 get]
3185    set newhead [$patchtop.tohead get]
3186    foreach e [list fromsha1 fromhead tosha1 tohead] \
3187            v [list $newid $newhead $oldid $oldhead] {
3188        $patchtop.$e conf -state normal
3189        $patchtop.$e delete 0 end
3190        $patchtop.$e insert 0 $v
3191        $patchtop.$e conf -state readonly
3192    }
3193}
3194
3195proc mkpatchgo {} {
3196    global patchtop
3197
3198    set oldid [$patchtop.fromsha1 get]
3199    set newid [$patchtop.tosha1 get]
3200    set fname [$patchtop.fname get]
3201    if {[catch {exec git-diff-tree -p $oldid $newid >$fname &} err]} {
3202        error_popup "Error creating patch: $err"
3203    }
3204    catch {destroy $patchtop}
3205    unset patchtop
3206}
3207
3208proc mkpatchcan {} {
3209    global patchtop
3210
3211    catch {destroy $patchtop}
3212    unset patchtop
3213}
3214
3215proc mktag {} {
3216    global rowmenuid mktagtop commitinfo
3217
3218    set top .maketag
3219    set mktagtop $top
3220    catch {destroy $top}
3221    toplevel $top
3222    label $top.title -text "Create tag"
3223    grid $top.title - -pady 10
3224    label $top.id -text "ID:"
3225    entry $top.sha1 -width 40 -relief flat
3226    $top.sha1 insert 0 $rowmenuid
3227    $top.sha1 conf -state readonly
3228    grid $top.id $top.sha1 -sticky w
3229    entry $top.head -width 60 -relief flat
3230    $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
3231    $top.head conf -state readonly
3232    grid x $top.head -sticky w
3233    label $top.tlab -text "Tag name:"
3234    entry $top.tag -width 60
3235    grid $top.tlab $top.tag -sticky w
3236    frame $top.buts
3237    button $top.buts.gen -text "Create" -command mktaggo
3238    button $top.buts.can -text "Cancel" -command mktagcan
3239    grid $top.buts.gen $top.buts.can
3240    grid columnconfigure $top.buts 0 -weight 1 -uniform a
3241    grid columnconfigure $top.buts 1 -weight 1 -uniform a
3242    grid $top.buts - -pady 10 -sticky ew
3243    focus $top.tag
3244}
3245
3246proc domktag {} {
3247    global mktagtop env tagids idtags
3248
3249    set id [$mktagtop.sha1 get]
3250    set tag [$mktagtop.tag get]
3251    if {$tag == {}} {
3252        error_popup "No tag name specified"
3253        return
3254    }
3255    if {[info exists tagids($tag)]} {
3256        error_popup "Tag \"$tag\" already exists"
3257        return
3258    }
3259    if {[catch {
3260        set dir [gitdir]
3261        set fname [file join $dir "refs/tags" $tag]
3262        set f [open $fname w]
3263        puts $f $id
3264        close $f
3265    } err]} {
3266        error_popup "Error creating tag: $err"
3267        return
3268    }
3269
3270    set tagids($tag) $id
3271    lappend idtags($id) $tag
3272    redrawtags $id
3273}
3274
3275proc redrawtags {id} {
3276    global canv linehtag commitrow idpos selectedline
3277
3278    if {![info exists commitrow($id)]} return
3279    drawcmitrow $commitrow($id)
3280    $canv delete tag.$id
3281    set xt [eval drawtags $id $idpos($id)]
3282    $canv coords $linehtag($commitrow($id)) $xt [lindex $idpos($id) 2]
3283    if {[info exists selectedline] && $selectedline == $commitrow($id)} {
3284        selectline $selectedline 0
3285    }
3286}
3287
3288proc mktagcan {} {
3289    global mktagtop
3290
3291    catch {destroy $mktagtop}
3292    unset mktagtop
3293}
3294
3295proc mktaggo {} {
3296    domktag
3297    mktagcan
3298}
3299
3300proc writecommit {} {
3301    global rowmenuid wrcomtop commitinfo wrcomcmd
3302
3303    set top .writecommit
3304    set wrcomtop $top
3305    catch {destroy $top}
3306    toplevel $top
3307    label $top.title -text "Write commit to file"
3308    grid $top.title - -pady 10
3309    label $top.id -text "ID:"
3310    entry $top.sha1 -width 40 -relief flat
3311    $top.sha1 insert 0 $rowmenuid
3312    $top.sha1 conf -state readonly
3313    grid $top.id $top.sha1 -sticky w
3314    entry $top.head -width 60 -relief flat
3315    $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
3316    $top.head conf -state readonly
3317    grid x $top.head -sticky w
3318    label $top.clab -text "Command:"
3319    entry $top.cmd -width 60 -textvariable wrcomcmd
3320    grid $top.clab $top.cmd -sticky w -pady 10
3321    label $top.flab -text "Output file:"
3322    entry $top.fname -width 60
3323    $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
3324    grid $top.flab $top.fname -sticky w
3325    frame $top.buts
3326    button $top.buts.gen -text "Write" -command wrcomgo
3327    button $top.buts.can -text "Cancel" -command wrcomcan
3328    grid $top.buts.gen $top.buts.can
3329    grid columnconfigure $top.buts 0 -weight 1 -uniform a
3330    grid columnconfigure $top.buts 1 -weight 1 -uniform a
3331    grid $top.buts - -pady 10 -sticky ew
3332    focus $top.fname
3333}
3334
3335proc wrcomgo {} {
3336    global wrcomtop
3337
3338    set id [$wrcomtop.sha1 get]
3339    set cmd "echo $id | [$wrcomtop.cmd get]"
3340    set fname [$wrcomtop.fname get]
3341    if {[catch {exec sh -c $cmd >$fname &} err]} {
3342        error_popup "Error writing commit: $err"
3343    }
3344    catch {destroy $wrcomtop}
3345    unset wrcomtop
3346}
3347
3348proc wrcomcan {} {
3349    global wrcomtop
3350
3351    catch {destroy $wrcomtop}
3352    unset wrcomtop
3353}
3354
3355proc listrefs {id} {
3356    global idtags idheads idotherrefs
3357
3358    set x {}
3359    if {[info exists idtags($id)]} {
3360        set x $idtags($id)
3361    }
3362    set y {}
3363    if {[info exists idheads($id)]} {
3364        set y $idheads($id)
3365    }
3366    set z {}
3367    if {[info exists idotherrefs($id)]} {
3368        set z $idotherrefs($id)
3369    }
3370    return [list $x $y $z]
3371}
3372
3373proc rereadrefs {} {
3374    global idtags idheads idotherrefs
3375
3376    set refids [concat [array names idtags] \
3377                    [array names idheads] [array names idotherrefs]]
3378    foreach id $refids {
3379        if {![info exists ref($id)]} {
3380            set ref($id) [listrefs $id]
3381        }
3382    }
3383    readrefs
3384    set refids [lsort -unique [concat $refids [array names idtags] \
3385                        [array names idheads] [array names idotherrefs]]]
3386    foreach id $refids {
3387        set v [listrefs $id]
3388        if {![info exists ref($id)] || $ref($id) != $v} {
3389            redrawtags $id
3390        }
3391    }
3392}
3393
3394proc showtag {tag isnew} {
3395    global ctext cflist tagcontents tagids linknum
3396
3397    if {$isnew} {
3398        addtohistory [list showtag $tag 0]
3399    }
3400    $ctext conf -state normal
3401    $ctext delete 0.0 end
3402    set linknum 0
3403    if {[info exists tagcontents($tag)]} {
3404        set text $tagcontents($tag)
3405    } else {
3406        set text "Tag: $tag\nId:  $tagids($tag)"
3407    }
3408    appendwithlinks $text
3409    $ctext conf -state disabled
3410    $cflist delete 0 end
3411}
3412
3413proc doquit {} {
3414    global stopped
3415    set stopped 100
3416    destroy .
3417}
3418
3419proc doprefs {} {
3420    global maxwidth maxgraphpct diffopts findmergefiles
3421    global oldprefs prefstop
3422
3423    set top .gitkprefs
3424    set prefstop $top
3425    if {[winfo exists $top]} {
3426        raise $top
3427        return
3428    }
3429    foreach v {maxwidth maxgraphpct diffopts findmergefiles} {
3430        set oldprefs($v) [set $v]
3431    }
3432    toplevel $top
3433    wm title $top "Gitk preferences"
3434    label $top.ldisp -text "Commit list display options"
3435    grid $top.ldisp - -sticky w -pady 10
3436    label $top.spacer -text " "
3437    label $top.maxwidthl -text "Maximum graph width (lines)" \
3438        -font optionfont
3439    spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
3440    grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
3441    label $top.maxpctl -text "Maximum graph width (% of pane)" \
3442        -font optionfont
3443    spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
3444    grid x $top.maxpctl $top.maxpct -sticky w
3445    checkbutton $top.findm -variable findmergefiles
3446    label $top.findml -text "Include merges for \"Find\" in \"Files\"" \
3447        -font optionfont
3448    grid $top.findm $top.findml - -sticky w
3449    label $top.ddisp -text "Diff display options"
3450    grid $top.ddisp - -sticky w -pady 10
3451    label $top.diffoptl -text "Options for diff program" \
3452        -font optionfont
3453    entry $top.diffopt -width 20 -textvariable diffopts
3454    grid x $top.diffoptl $top.diffopt -sticky w
3455    frame $top.buts
3456    button $top.buts.ok -text "OK" -command prefsok
3457    button $top.buts.can -text "Cancel" -command prefscan
3458    grid $top.buts.ok $top.buts.can
3459    grid columnconfigure $top.buts 0 -weight 1 -uniform a
3460    grid columnconfigure $top.buts 1 -weight 1 -uniform a
3461    grid $top.buts - - -pady 10 -sticky ew
3462}
3463
3464proc prefscan {} {
3465    global maxwidth maxgraphpct diffopts findmergefiles
3466    global oldprefs prefstop
3467
3468    foreach v {maxwidth maxgraphpct diffopts findmergefiles} {
3469        set $v $oldprefs($v)
3470    }
3471    catch {destroy $prefstop}
3472    unset prefstop
3473}
3474
3475proc prefsok {} {
3476    global maxwidth maxgraphpct
3477    global oldprefs prefstop
3478
3479    catch {destroy $prefstop}
3480    unset prefstop
3481    if {$maxwidth != $oldprefs(maxwidth)
3482        || $maxgraphpct != $oldprefs(maxgraphpct)} {
3483        redisplay
3484    }
3485}
3486
3487proc formatdate {d} {
3488    return [clock format $d -format "%Y-%m-%d %H:%M:%S"]
3489}
3490
3491# This list of encoding names and aliases is distilled from
3492# http://www.iana.org/assignments/character-sets.
3493# Not all of them are supported by Tcl.
3494set encoding_aliases {
3495    { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
3496      ISO646-US US-ASCII us IBM367 cp367 csASCII }
3497    { ISO-10646-UTF-1 csISO10646UTF1 }
3498    { ISO_646.basic:1983 ref csISO646basic1983 }
3499    { INVARIANT csINVARIANT }
3500    { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
3501    { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
3502    { NATS-SEFI iso-ir-8-1 csNATSSEFI }
3503    { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
3504    { NATS-DANO iso-ir-9-1 csNATSDANO }
3505    { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
3506    { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
3507    { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
3508    { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
3509    { ISO-2022-KR csISO2022KR }
3510    { EUC-KR csEUCKR }
3511    { ISO-2022-JP csISO2022JP }
3512    { ISO-2022-JP-2 csISO2022JP2 }
3513    { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
3514      csISO13JISC6220jp }
3515    { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
3516    { IT iso-ir-15 ISO646-IT csISO15Italian }
3517    { PT iso-ir-16 ISO646-PT csISO16Portuguese }
3518    { ES iso-ir-17 ISO646-ES csISO17Spanish }
3519    { greek7-old iso-ir-18 csISO18Greek7Old }
3520    { latin-greek iso-ir-19 csISO19LatinGreek }
3521    { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
3522    { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
3523    { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
3524    { ISO_5427 iso-ir-37 csISO5427Cyrillic }
3525    { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
3526    { BS_viewdata iso-ir-47 csISO47BSViewdata }
3527    { INIS iso-ir-49 csISO49INIS }
3528    { INIS-8 iso-ir-50 csISO50INIS8 }
3529    { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
3530    { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
3531    { ISO_5428:1980 iso-ir-55 csISO5428Greek }
3532    { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
3533    { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
3534    { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
3535      csISO60Norwegian1 }
3536    { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
3537    { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
3538    { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
3539    { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
3540    { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
3541    { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
3542    { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
3543    { greek7 iso-ir-88 csISO88Greek7 }
3544    { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
3545    { iso-ir-90 csISO90 }
3546    { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
3547    { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
3548      csISO92JISC62991984b }
3549    { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
3550    { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
3551    { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
3552      csISO95JIS62291984handadd }
3553    { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
3554    { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
3555    { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
3556    { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
3557      CP819 csISOLatin1 }
3558    { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
3559    { T.61-7bit iso-ir-102 csISO102T617bit }
3560    { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
3561    { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
3562    { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
3563    { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
3564    { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
3565    { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
3566    { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
3567    { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
3568      arabic csISOLatinArabic }
3569    { ISO_8859-6-E csISO88596E ISO-8859-6-E }
3570    { ISO_8859-6-I csISO88596I ISO-8859-6-I }
3571    { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
3572      greek greek8 csISOLatinGreek }
3573    { T.101-G2 iso-ir-128 csISO128T101G2 }
3574    { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
3575      csISOLatinHebrew }
3576    { ISO_8859-8-E csISO88598E ISO-8859-8-E }
3577    { ISO_8859-8-I csISO88598I ISO-8859-8-I }
3578    { CSN_369103 iso-ir-139 csISO139CSN369103 }
3579    { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
3580    { ISO_6937-2-add iso-ir-142 csISOTextComm }
3581    { IEC_P27-1 iso-ir-143 csISO143IECP271 }
3582    { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
3583      csISOLatinCyrillic }
3584    { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
3585    { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
3586    { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
3587    { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
3588    { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
3589    { ISO_6937-2-25 iso-ir-152 csISO6937Add }
3590    { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
3591    { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
3592    { ISO_10367-box iso-ir-155 csISO10367Box }
3593    { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
3594    { latin-lap lap iso-ir-158 csISO158Lap }
3595    { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
3596    { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
3597    { us-dk csUSDK }
3598    { dk-us csDKUS }
3599    { JIS_X0201 X0201 csHalfWidthKatakana }
3600    { KSC5636 ISO646-KR csKSC5636 }
3601    { ISO-10646-UCS-2 csUnicode }
3602    { ISO-10646-UCS-4 csUCS4 }
3603    { DEC-MCS dec csDECMCS }
3604    { hp-roman8 roman8 r8 csHPRoman8 }
3605    { macintosh mac csMacintosh }
3606    { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
3607      csIBM037 }
3608    { IBM038 EBCDIC-INT cp038 csIBM038 }
3609    { IBM273 CP273 csIBM273 }
3610    { IBM274 EBCDIC-BE CP274 csIBM274 }
3611    { IBM275 EBCDIC-BR cp275 csIBM275 }
3612    { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
3613    { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
3614    { IBM280 CP280 ebcdic-cp-it csIBM280 }
3615    { IBM281 EBCDIC-JP-E cp281 csIBM281 }
3616    { IBM284 CP284 ebcdic-cp-es csIBM284 }
3617    { IBM285 CP285 ebcdic-cp-gb csIBM285 }
3618    { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
3619    { IBM297 cp297 ebcdic-cp-fr csIBM297 }
3620    { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
3621    { IBM423 cp423 ebcdic-cp-gr csIBM423 }
3622    { IBM424 cp424 ebcdic-cp-he csIBM424 }
3623    { IBM437 cp437 437 csPC8CodePage437 }
3624    { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
3625    { IBM775 cp775 csPC775Baltic }
3626    { IBM850 cp850 850 csPC850Multilingual }
3627    { IBM851 cp851 851 csIBM851 }
3628    { IBM852 cp852 852 csPCp852 }
3629    { IBM855 cp855 855 csIBM855 }
3630    { IBM857 cp857 857 csIBM857 }
3631    { IBM860 cp860 860 csIBM860 }
3632    { IBM861 cp861 861 cp-is csIBM861 }
3633    { IBM862 cp862 862 csPC862LatinHebrew }
3634    { IBM863 cp863 863 csIBM863 }
3635    { IBM864 cp864 csIBM864 }
3636    { IBM865 cp865 865 csIBM865 }
3637    { IBM866 cp866 866 csIBM866 }
3638    { IBM868 CP868 cp-ar csIBM868 }
3639    { IBM869 cp869 869 cp-gr csIBM869 }
3640    { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
3641    { IBM871 CP871 ebcdic-cp-is csIBM871 }
3642    { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
3643    { IBM891 cp891 csIBM891 }
3644    { IBM903 cp903 csIBM903 }
3645    { IBM904 cp904 904 csIBBM904 }
3646    { IBM905 CP905 ebcdic-cp-tr csIBM905 }
3647    { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
3648    { IBM1026 CP1026 csIBM1026 }
3649    { EBCDIC-AT-DE csIBMEBCDICATDE }
3650    { EBCDIC-AT-DE-A csEBCDICATDEA }
3651    { EBCDIC-CA-FR csEBCDICCAFR }
3652    { EBCDIC-DK-NO csEBCDICDKNO }
3653    { EBCDIC-DK-NO-A csEBCDICDKNOA }
3654    { EBCDIC-FI-SE csEBCDICFISE }
3655    { EBCDIC-FI-SE-A csEBCDICFISEA }
3656    { EBCDIC-FR csEBCDICFR }
3657    { EBCDIC-IT csEBCDICIT }
3658    { EBCDIC-PT csEBCDICPT }
3659    { EBCDIC-ES csEBCDICES }
3660    { EBCDIC-ES-A csEBCDICESA }
3661    { EBCDIC-ES-S csEBCDICESS }
3662    { EBCDIC-UK csEBCDICUK }
3663    { EBCDIC-US csEBCDICUS }
3664    { UNKNOWN-8BIT csUnknown8BiT }
3665    { MNEMONIC csMnemonic }
3666    { MNEM csMnem }
3667    { VISCII csVISCII }
3668    { VIQR csVIQR }
3669    { KOI8-R csKOI8R }
3670    { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
3671    { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
3672    { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
3673    { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
3674    { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
3675    { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
3676    { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
3677    { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
3678    { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
3679    { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
3680    { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
3681    { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
3682    { IBM1047 IBM-1047 }
3683    { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
3684    { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
3685    { UNICODE-1-1 csUnicode11 }
3686    { CESU-8 csCESU-8 }
3687    { BOCU-1 csBOCU-1 }
3688    { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
3689    { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
3690      l8 }
3691    { ISO-8859-15 ISO_8859-15 Latin-9 }
3692    { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
3693    { GBK CP936 MS936 windows-936 }
3694    { JIS_Encoding csJISEncoding }
3695    { Shift_JIS MS_Kanji csShiftJIS }
3696    { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
3697      EUC-JP }
3698    { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
3699    { ISO-10646-UCS-Basic csUnicodeASCII }
3700    { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
3701    { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
3702    { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
3703    { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
3704    { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
3705    { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
3706    { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
3707    { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
3708    { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
3709    { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
3710    { Adobe-Standard-Encoding csAdobeStandardEncoding }
3711    { Ventura-US csVenturaUS }
3712    { Ventura-International csVenturaInternational }
3713    { PC8-Danish-Norwegian csPC8DanishNorwegian }
3714    { PC8-Turkish csPC8Turkish }
3715    { IBM-Symbols csIBMSymbols }
3716    { IBM-Thai csIBMThai }
3717    { HP-Legal csHPLegal }
3718    { HP-Pi-font csHPPiFont }
3719    { HP-Math8 csHPMath8 }
3720    { Adobe-Symbol-Encoding csHPPSMath }
3721    { HP-DeskTop csHPDesktop }
3722    { Ventura-Math csVenturaMath }
3723    { Microsoft-Publishing csMicrosoftPublishing }
3724    { Windows-31J csWindows31J }
3725    { GB2312 csGB2312 }
3726    { Big5 csBig5 }
3727}
3728
3729proc tcl_encoding {enc} {
3730    global encoding_aliases
3731    set names [encoding names]
3732    set lcnames [string tolower $names]
3733    set enc [string tolower $enc]
3734    set i [lsearch -exact $lcnames $enc]
3735    if {$i < 0} {
3736        # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
3737        if {[regsub {^iso[-_]} $enc iso encx]} {
3738            set i [lsearch -exact $lcnames $encx]
3739        }
3740    }
3741    if {$i < 0} {
3742        foreach l $encoding_aliases {
3743            set ll [string tolower $l]
3744            if {[lsearch -exact $ll $enc] < 0} continue
3745            # look through the aliases for one that tcl knows about
3746            foreach e $ll {
3747                set i [lsearch -exact $lcnames $e]
3748                if {$i < 0} {
3749                    if {[regsub {^iso[-_]} $e iso ex]} {
3750                        set i [lsearch -exact $lcnames $ex]
3751                    }
3752                }
3753                if {$i >= 0} break
3754            }
3755            break
3756        }
3757    }
3758    if {$i >= 0} {
3759        return [lindex $names $i]
3760    }
3761    return {}
3762}
3763
3764# defaults...
3765set datemode 0
3766set diffopts "-U 5 -p"
3767set wrcomcmd "git-diff-tree --stdin -p --pretty"
3768
3769set gitencoding {}
3770catch {
3771    set gitencoding [exec git-repo-config --get i18n.commitencoding]
3772}
3773if {$gitencoding == ""} {
3774    set gitencoding "utf-8"
3775}
3776set tclencoding [tcl_encoding $gitencoding]
3777if {$tclencoding == {}} {
3778    puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
3779}
3780
3781set mainfont {Helvetica 9}
3782set textfont {Courier 9}
3783set findmergefiles 0
3784set maxgraphpct 50
3785set maxwidth 16
3786set revlistorder 0
3787set fastdate 0
3788set uparrowlen 7
3789set downarrowlen 7
3790set mingaplen 30
3791
3792set colors {green red blue magenta darkgrey brown orange}
3793
3794catch {source ~/.gitk}
3795
3796set namefont $mainfont
3797
3798font create optionfont -family sans-serif -size -12
3799
3800set revtreeargs {}
3801foreach arg $argv {
3802    switch -regexp -- $arg {
3803        "^$" { }
3804        "^-d" { set datemode 1 }
3805        default {
3806            lappend revtreeargs $arg
3807        }
3808    }
3809}
3810
3811# check that we can find a .git directory somewhere...
3812set gitdir [gitdir]
3813if {![file isdirectory $gitdir]} {
3814    error_popup "Cannot find the git directory \"$gitdir\"."
3815    exit 1
3816}
3817
3818set history {}
3819set historyindex 0
3820
3821set optim_delay 16
3822
3823set stopped 0
3824set stuffsaved 0
3825set patchnum 0
3826setcoords
3827makewindow $revtreeargs
3828readrefs
3829getcommits $revtreeargs