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