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