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