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