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