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