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