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