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