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