gitkon commit gitk: Fix bug in assigning row numbers to arcs (38dfe93)
   1#!/bin/sh
   2# Tcl ignores the next line -*- tcl -*- \
   3exec wish "$0" -- "$@"
   4
   5# Copyright (C) 2005-2006 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 [exec git rev-parse --git-dir]
  16    }
  17}
  18
  19# A simple scheduler for compute-intensive stuff.
  20# The aim is to make sure that event handlers for GUI actions can
  21# run at least every 50-100 ms.  Unfortunately fileevent handlers are
  22# run before X event handlers, so reading from a fast source can
  23# make the GUI completely unresponsive.
  24proc run args {
  25    global isonrunq runq
  26
  27    set script $args
  28    if {[info exists isonrunq($script)]} return
  29    if {$runq eq {}} {
  30        after idle dorunq
  31    }
  32    lappend runq [list {} $script]
  33    set isonrunq($script) 1
  34}
  35
  36proc filerun {fd script} {
  37    fileevent $fd readable [list filereadable $fd $script]
  38}
  39
  40proc filereadable {fd script} {
  41    global runq
  42
  43    fileevent $fd readable {}
  44    if {$runq eq {}} {
  45        after idle dorunq
  46    }
  47    lappend runq [list $fd $script]
  48}
  49
  50proc nukefile {fd} {
  51    global runq
  52
  53    for {set i 0} {$i < [llength $runq]} {} {
  54        if {[lindex $runq $i 0] eq $fd} {
  55            set runq [lreplace $runq $i $i]
  56        } else {
  57            incr i
  58        }
  59    }
  60}
  61
  62proc dorunq {} {
  63    global isonrunq runq
  64
  65    set tstart [clock clicks -milliseconds]
  66    set t0 $tstart
  67    while {[llength $runq] > 0} {
  68        set fd [lindex $runq 0 0]
  69        set script [lindex $runq 0 1]
  70        set repeat [eval $script]
  71        set t1 [clock clicks -milliseconds]
  72        set t [expr {$t1 - $t0}]
  73        set runq [lrange $runq 1 end]
  74        if {$repeat ne {} && $repeat} {
  75            if {$fd eq {} || $repeat == 2} {
  76                # script returns 1 if it wants to be readded
  77                # file readers return 2 if they could do more straight away
  78                lappend runq [list $fd $script]
  79            } else {
  80                fileevent $fd readable [list filereadable $fd $script]
  81            }
  82        } elseif {$fd eq {}} {
  83            unset isonrunq($script)
  84        }
  85        set t0 $t1
  86        if {$t1 - $tstart >= 80} break
  87    }
  88    if {$runq ne {}} {
  89        after idle dorunq
  90    }
  91}
  92
  93# Start off a git rev-list process and arrange to read its output
  94proc start_rev_list {view} {
  95    global startmsecs
  96    global commfd leftover tclencoding datemode
  97    global viewargs viewfiles commitidx viewcomplete vnextroot
  98    global showlocalchanges commitinterest mainheadid
  99    global progressdirn progresscoords proglastnc curview
 100    global viewincl viewactive loginstance viewinstances
 101
 102    set startmsecs [clock clicks -milliseconds]
 103    set commitidx($view) 0
 104    set viewcomplete($view) 0
 105    set viewactive($view) 1
 106    set vnextroot($view) 0
 107    varcinit $view
 108
 109    set commits [exec git rev-parse --default HEAD --revs-only \
 110                     $viewargs($view)]
 111    set viewincl($view) {}
 112    foreach c $commits {
 113        if {![string match "^*" $c]} {
 114            lappend viewincl($view) $c
 115        }
 116    }
 117    if {[catch {
 118        set fd [open [concat | git log --no-color -z --pretty=raw --parents \
 119                         --boundary $commits "--" $viewfiles($view)] r]
 120    } err]} {
 121        error_popup "Error executing git log: $err"
 122        exit 1
 123    }
 124    set i [incr loginstance]
 125    set viewinstances($view) [list $i]
 126    set commfd($i) $fd
 127    set leftover($i) {}
 128    if {$showlocalchanges} {
 129        lappend commitinterest($mainheadid) {dodiffindex}
 130    }
 131    fconfigure $fd -blocking 0 -translation lf -eofchar {}
 132    if {$tclencoding != {}} {
 133        fconfigure $fd -encoding $tclencoding
 134    }
 135    filerun $fd [list getcommitlines $fd $i $view]
 136    nowbusy $view "Reading"
 137    if {$view == $curview} {
 138        set progressdirn 1
 139        set progresscoords {0 0}
 140        set proglastnc 0
 141    }
 142}
 143
 144proc stop_rev_list {view} {
 145    global commfd viewinstances leftover
 146
 147    foreach inst $viewinstances($view) {
 148        set fd $commfd($inst)
 149        catch {
 150            set pid [pid $fd]
 151            exec kill $pid
 152        }
 153        catch {close $fd}
 154        nukefile $fd
 155        unset commfd($inst)
 156        unset leftover($inst)
 157    }
 158    set viewinstances($view) {}
 159}
 160
 161proc getcommits {} {
 162    global canv curview
 163
 164    initlayout
 165    start_rev_list $curview
 166    show_status "Reading commits..."
 167}
 168
 169proc updatecommits {} {
 170    global curview viewargs viewfiles viewincl viewinstances
 171    global viewactive viewcomplete loginstance tclencoding
 172    global varcid startmsecs commfd getdbg showneartags leftover
 173
 174    set getdbg 1
 175    set view $curview
 176    set commits [exec git rev-parse --default HEAD --revs-only \
 177                     $viewargs($view)]
 178    set pos {}
 179    set neg {}
 180    foreach c $commits {
 181        if {[string match "^*" $c]} {
 182            lappend neg $c
 183        } else {
 184            if {!([info exists varcid($view,$c)] ||
 185                  [lsearch -exact $viewincl($view) $c] >= 0)} {
 186                lappend pos $c
 187            }
 188        }
 189    }
 190    if {$pos eq {}} {
 191        return
 192    }
 193    foreach id $viewincl($view) {
 194        lappend neg "^$id"
 195    }
 196    set viewincl($view) [concat $viewincl($view) $pos]
 197    if {[catch {
 198        set fd [open [concat | git log --no-color -z --pretty=raw --parents \
 199                         --boundary $pos $neg "--" $viewfiles($view)] r]
 200    } err]} {
 201        error_popup "Error executing git log: $err"
 202        exit 1
 203    }
 204    if {$viewactive($view) == 0} {
 205        set startmsecs [clock clicks -milliseconds]
 206    }
 207    set i [incr loginstance]
 208    lappend viewinstances($view) $i
 209    set commfd($i) $fd
 210    set leftover($i) {}
 211    fconfigure $fd -blocking 0 -translation lf -eofchar {}
 212    if {$tclencoding != {}} {
 213        fconfigure $fd -encoding $tclencoding
 214    }
 215    filerun $fd [list getcommitlines $fd $i $view]
 216    incr viewactive($view)
 217    set viewcomplete($view) 0
 218    nowbusy $view "Reading"
 219    readrefs
 220    changedrefs
 221    if {$showneartags} {
 222        getallcommits
 223    }
 224}
 225
 226proc reloadcommits {} {
 227    global curview viewcomplete selectedline currentid thickerline
 228    global showneartags treediffs commitinterest cached_commitrow
 229    global progresscoords
 230
 231    if {!$viewcomplete($curview)} {
 232        stop_rev_list $curview
 233        set progresscoords {0 0}
 234        adjustprogress
 235    }
 236    resetvarcs $curview
 237    catch {unset selectedline}
 238    catch {unset currentid}
 239    catch {unset thickerline}
 240    catch {unset treediffs}
 241    readrefs
 242    changedrefs
 243    if {$showneartags} {
 244        getallcommits
 245    }
 246    clear_display
 247    catch {unset commitinterest}
 248    catch {unset cached_commitrow}
 249    setcanvscroll
 250    getcommits
 251}
 252
 253# This makes a string representation of a positive integer which
 254# sorts as a string in numerical order
 255proc strrep {n} {
 256    if {$n < 16} {
 257        return [format "%x" $n]
 258    } elseif {$n < 256} {
 259        return [format "x%.2x" $n]
 260    } elseif {$n < 65536} {
 261        return [format "y%.4x" $n]
 262    }
 263    return [format "z%.8x" $n]
 264}
 265
 266# Procedures used in reordering commits from git log (without
 267# --topo-order) into the order for display.
 268
 269proc varcinit {view} {
 270    global vseeds varcstart vupptr vdownptr vleftptr varctok varcrow
 271    global vtokmod varcmod varcix uat
 272
 273    set vseeds($view) {}
 274    set varcstart($view) {{}}
 275    set vupptr($view) {0}
 276    set vdownptr($view) {0}
 277    set vleftptr($view) {0}
 278    set varctok($view) {{}}
 279    set varcrow($view) {{}}
 280    set vtokmod($view) {}
 281    set varcmod($view) 0
 282    set varcix($view) {{}}
 283    set uat 0
 284}
 285
 286proc resetvarcs {view} {
 287    global varcid varccommits parents children vseedcount ordertok
 288
 289    foreach vid [array names varcid $view,*] {
 290        unset varcid($vid)
 291        unset children($vid)
 292        unset parents($vid)
 293    }
 294    # some commits might have children but haven't been seen yet
 295    foreach vid [array names children $view,*] {
 296        unset children($vid)
 297    }
 298    foreach va [array names varccommits $view,*] {
 299        unset varccommits($va)
 300    }
 301    foreach vd [array names vseedcount $view,*] {
 302        unset vseedcount($vd)
 303    }
 304    foreach vid [array names ordertok $view,*] {
 305        unset ordertok($vid)
 306    }
 307}
 308
 309proc newvarc {view id} {
 310    global varcid varctok parents children vseeds
 311    global vupptr vdownptr vleftptr varcrow varcix varcstart
 312    global commitdata commitinfo vseedcount
 313
 314    set a [llength $varctok($view)]
 315    set vid $view,$id
 316    if {[llength $children($vid)] == 0} {
 317        if {![info exists commitinfo($id)]} {
 318            parsecommit $id $commitdata($id) 1
 319        }
 320        set cdate [lindex $commitinfo($id) 4]
 321        if {![string is integer -strict $cdate]} {
 322            set cdate 0
 323        }
 324        if {![info exists vseedcount($view,$cdate)]} {
 325            set vseedcount($view,$cdate) -1
 326        }
 327        set c [incr vseedcount($view,$cdate)]
 328        set cdate [expr {$cdate ^ 0xffffffff}]
 329        set tok "s[strrep $cdate][strrep $c]"
 330        lappend vseeds($view) $id
 331        lappend vupptr($view) 0
 332        set ka [lindex $vdownptr($view) 0]
 333        if {$ka == 0 ||
 334            [string compare $tok [lindex $varctok($view) $ka]] < 0} {
 335            lset vdownptr($view) 0 $a
 336            lappend vleftptr($view) $ka
 337        } else {
 338            while {[set b [lindex $vleftptr($view) $ka]] != 0 &&
 339                   [string compare $tok [lindex $varctok($view) $b]] >= 0} {
 340                set ka $b
 341            }
 342            lset vleftptr($view) $ka $a
 343            lappend vleftptr($view) $b
 344        }
 345    } else {
 346        set tok {}
 347        foreach k $children($vid) {
 348            set ka $varcid($view,$k)
 349            if {[string compare [lindex $varctok($view) $ka] $tok] > 0} {
 350                set ki $k
 351                set tok [lindex $varctok($view) $ka]
 352            }
 353        }
 354        set ka $varcid($view,$ki)
 355        lappend vupptr($view) $ka
 356        set i [lsearch -exact $parents($view,$ki) $id]
 357        set j [expr {[llength $parents($view,$ki)] - 1 - $i}]
 358        set rsib 0
 359        while {[incr i] < [llength $parents($view,$ki)]} {
 360            set bi [lindex $parents($view,$ki) $i]
 361            if {[info exists varcid($view,$bi)]} {
 362                set b $varcid($view,$bi)
 363                if {[lindex $vupptr($view) $b] == $ka} {
 364                    set rsib $b
 365                    lappend vleftptr($view) [lindex $vleftptr($view) $b]
 366                    lset vleftptr($view) $b $a
 367                    break
 368                }
 369            }
 370        }
 371        if {$rsib == 0} {
 372            lappend vleftptr($view) [lindex $vdownptr($view) $ka]
 373            lset vdownptr($view) $ka $a
 374        }
 375        append tok [strrep $j]
 376    }
 377    lappend varctok($view) $tok
 378    lappend varcstart($view) $id
 379    lappend vdownptr($view) 0
 380    lappend varcrow($view) {}
 381    lappend varcix($view) {}
 382    return $a
 383}
 384
 385proc splitvarc {p v} {
 386    global varcid varcstart varccommits varctok
 387    global vupptr vdownptr vleftptr varcix varcrow
 388
 389    set oa $varcid($v,$p)
 390    set ac $varccommits($v,$oa)
 391    set i [lsearch -exact $varccommits($v,$oa) $p]
 392    if {$i <= 0} return
 393    set na [llength $varctok($v)]
 394    # "%" sorts before "0"...
 395    set tok "[lindex $varctok($v) $oa]%[strrep $i]"
 396    lappend varctok($v) $tok
 397    lappend varcrow($v) {}
 398    lappend varcix($v) {}
 399    set varccommits($v,$oa) [lrange $ac 0 [expr {$i - 1}]]
 400    set varccommits($v,$na) [lrange $ac $i end]
 401    lappend varcstart($v) $p
 402    foreach id $varccommits($v,$na) {
 403        set varcid($v,$id) $na
 404    }
 405    lappend vdownptr($v) [lindex $vdownptr($v) $oa]
 406    lset vdownptr($v) $oa $na
 407    lappend vupptr($v) $oa
 408    lappend vleftptr($v) 0
 409    for {set b [lindex $vdownptr($v) $na]} {$b != 0} {set b [lindex $vleftptr($v) $b]} {
 410        lset vupptr($v) $b $na
 411    }
 412}
 413
 414proc renumbervarc {a v} {
 415    global parents children varctok varcstart varccommits
 416    global vupptr vdownptr vleftptr varcid vtokmod varcmod
 417
 418    set t1 [clock clicks -milliseconds]
 419    set todo {}
 420    set isrelated($a) 1
 421    set ntot 0
 422    while {$a != 0} {
 423        if {[info exists isrelated($a)]} {
 424            lappend todo $a
 425            set id [lindex $varccommits($v,$a) end]
 426            foreach p $parents($v,$id) {
 427                if {[info exists varcid($v,$p)]} {
 428                    set isrelated($varcid($v,$p)) 1
 429                }
 430            }
 431        }
 432        incr ntot
 433        set b [lindex $vdownptr($v) $a]
 434        if {$b == 0} {
 435            while {$a != 0} {
 436                set b [lindex $vleftptr($v) $a]
 437                if {$b != 0} break
 438                set a [lindex $vupptr($v) $a]
 439            }
 440        }
 441        set a $b
 442    }
 443    foreach a $todo {
 444        set id [lindex $varcstart($v) $a]
 445        set tok {}
 446        foreach k $children($v,$id) {
 447            set ka $varcid($v,$k)
 448            if {[string compare [lindex $varctok($v) $ka] $tok] > 0} {
 449                set ki $k
 450                set tok [lindex $varctok($v) $ka]
 451            }
 452        }
 453        if {$tok ne {}} {
 454            set ka $varcid($v,$ki)
 455            set i [lsearch -exact $parents($v,$ki) $id]
 456            set j [expr {[llength $parents($v,$ki)] - 1 - $i}]
 457            append tok [strrep $j]
 458            set oldtok [lindex $varctok($v) $a]
 459            if {$tok eq $oldtok} continue
 460            lset varctok($v) $a $tok
 461        } else {
 462            set ka 0
 463        }
 464        set b [lindex $vupptr($v) $a]
 465        if {$b != $ka} {
 466            set tok [lindex $varctok($v) $ka]
 467            if {[string compare $tok $vtokmod($v)] < 0} {
 468                set vtokmod($v) $tok
 469                set varcmod($v) $ka
 470            }
 471            set tok [lindex $varctok($v) $b]
 472            if {[string compare $tok $vtokmod($v)] < 0} {
 473                set vtokmod($v) $tok
 474                set varcmod($v) $b
 475            }
 476            set c [lindex $vdownptr($v) $b]
 477            if {$c == $a} {
 478                lset vdownptr($v) $b [lindex $vleftptr($v) $a]
 479            } else {
 480                set b $c
 481                while {$b != 0 && [lindex $vleftptr($v) $b] != $a} {
 482                    set b [lindex $vleftptr($v) $b]
 483                }
 484                if {$b != 0} {
 485                    lset vleftptr($v) $b [lindex $vleftptr($v) $a]
 486                } else {
 487                    puts "oops couldn't find $a in chain for [lindex $vupptr($v) $a]"
 488                }
 489            }
 490            lset vupptr($v) $a $ka
 491            set rsib 0
 492            while {[incr i] < [llength $parents($v,$ki)]} {
 493                set bi [lindex $parents($v,$ki) $i]
 494                if {[info exists varcid($v,$bi)]} {
 495                    set b $varcid($v,$bi)
 496                    if {[lindex $vupptr($v) $b] == $ka} {
 497                        set rsib $b
 498                        lset vleftptr($v) $a [lindex $vleftptr($v) $b]
 499                        lset vleftptr($v) $b $a
 500                        break
 501                    }
 502                }
 503            }
 504            if {$rsib == 0} {
 505                lset vleftptr($v) $a [lindex $vdownptr($v) $ka]
 506                lset vdownptr($v) $ka $a
 507            }
 508        }
 509    }
 510    set t2 [clock clicks -milliseconds]
 511    #puts "renumbervarc did [llength $todo] of $ntot arcs in [expr {$t2-$t1}]ms"
 512}
 513
 514proc fix_reversal {p a v} {
 515    global varcid varcstart varctok vupptr vseeds
 516
 517    set pa $varcid($v,$p)
 518    if {$p ne [lindex $varcstart($v) $pa]} {
 519        splitvarc $p $v
 520        set pa $varcid($v,$p)
 521    }
 522    # seeds always need to be renumbered (and taken out of the seeds list)
 523    if {[lindex $vupptr($v) $pa] == 0} {
 524        set i [lsearch -exact $vseeds($v) $p]
 525        if {$i >= 0} {
 526            set vseeds($v) [lreplace $vseeds($v) $i $i]
 527        } else {
 528            puts "oops couldn't find [shortids $p] in seeds"
 529        }
 530        renumbervarc $pa $v
 531    } elseif {[string compare [lindex $varctok($v) $a] \
 532                   [lindex $varctok($v) $pa]] > 0} {
 533        renumbervarc $pa $v
 534    }
 535}
 536
 537proc insertrow {id p v} {
 538    global varcid varccommits parents children cmitlisted ordertok
 539    global commitidx varctok vtokmod varcmod
 540
 541    set a $varcid($v,$p)
 542    set i [lsearch -exact $varccommits($v,$a) $p]
 543    if {$i < 0} {
 544        puts "oops: insertrow can't find [shortids $p] on arc $a"
 545        return
 546    }
 547    set children($v,$id) {}
 548    set parents($v,$id) [list $p]
 549    set varcid($v,$id) $a
 550    if {[llength [lappend children($v,$p) $id]] > 1 &&
 551        [vtokcmp $v [lindex $children($v,$p) end-1] $id] > 0} {
 552        set children($v,$p) [lsort -command [list vtokcmp $v] $children($v,$p)]
 553    }
 554    set cmitlisted($v,$id) 1
 555    incr commitidx($v)
 556    set ordertok($v,$id) $ordertok($v,$p)
 557    # note we deliberately don't update varcstart($v) even if $i == 0
 558    set varccommits($v,$a) [linsert $varccommits($v,$a) $i $id]
 559    set tok [lindex $varctok($v) $a]
 560    if {[string compare $tok $vtokmod($v)] < 0} {
 561        set vtokmod($v) $tok
 562        set varcmod($v) $a
 563    }
 564    update_arcrows $v
 565}
 566
 567proc removerow {id v} {
 568    global varcid varccommits parents children commitidx ordertok
 569    global varctok vtokmod varcmod
 570
 571    if {[llength $parents($v,$id)] != 1} {
 572        puts "oops: removerow [shortids $id] has [llength $parents($v,$id)] parents"
 573        return
 574    }
 575    set p [lindex $parents($v,$id) 0]
 576    set a $varcid($v,$id)
 577    set i [lsearch -exact $varccommits($v,$a) $id]
 578    if {$i < 0} {
 579        puts "oops: removerow can't find [shortids $id] on arc $a"
 580        return
 581    }
 582    unset varcid($v,$id)
 583    set varccommits($v,$a) [lreplace $varccommits($v,$a) $i $i]
 584    unset parents($v,$id)
 585    unset children($v,$id)
 586    unset cmitlisted($v,$id)
 587    unset ordertok($v,$id)
 588    incr commitidx($v) -1
 589    set j [lsearch -exact $children($v,$p) $id]
 590    if {$j >= 0} {
 591        set children($v,$p) [lreplace $children($v,$p) $j $j]
 592    }
 593    set tok [lindex $varctok($v) $a]
 594    if {[string compare $tok $vtokmod($v)] < 0} {
 595        set vtokmod($v) $tok
 596        set varcmod($v) $a
 597    }
 598    update_arcrows $v
 599}
 600
 601proc vtokcmp {v a b} {
 602    global varctok varcid
 603
 604    return [string compare [lindex $varctok($v) $varcid($v,$a)] \
 605                [lindex $varctok($v) $varcid($v,$b)]]
 606}
 607
 608proc update_arcrows {v} {
 609    global vtokmod varcmod varcrow commitidx currentid selectedline
 610    global varcid vseeds vrownum varcorder varcix varccommits
 611    global vupptr vdownptr vleftptr varctok
 612    global uat displayorder parentlist curview cached_commitrow
 613
 614    set t1 [clock clicks -milliseconds]
 615    set narctot [expr {[llength $varctok($v)] - 1}]
 616    set a $varcmod($v)
 617    while {$a != 0 && [lindex $varcix($v) $a] eq {}} {
 618        # go up the tree until we find something that has a row number,
 619        # or we get to a seed
 620        set a [lindex $vupptr($v) $a]
 621    }
 622    if {$a == 0} {
 623        set a [lindex $vdownptr($v) 0]
 624        if {$a == 0} return
 625        set vrownum($v) {0}
 626        set varcorder($v) [list $a]
 627        lset varcix($v) $a 0
 628        lset varcrow($v) $a 0
 629        set arcn 0
 630        set row 0
 631    } else {
 632        set arcn [lindex $varcix($v) $a]
 633        # see if a is the last arc; if so, nothing to do
 634        if {$arcn == $narctot - 1} {
 635            return
 636        }
 637        if {[llength $vrownum($v)] > $arcn + 1} {
 638            set vrownum($v) [lrange $vrownum($v) 0 $arcn]
 639            set varcorder($v) [lrange $varcorder($v) 0 $arcn]
 640        }
 641        set row [lindex $varcrow($v) $a]
 642    }
 643    if {[llength $displayorder] > $row} {
 644        set displayorder [lrange $displayorder 0 [expr {$row - 1}]]
 645        set parentlist [lrange $parentlist 0 [expr {$row - 1}]]
 646    }
 647    if {$v == $curview} {
 648        catch {unset cached_commitrow}
 649    }
 650    set startrow $row
 651    while {1} {
 652        set p $a
 653        incr row [llength $varccommits($v,$a)]
 654        # go down if possible
 655        set b [lindex $vdownptr($v) $a]
 656        if {$b == 0} {
 657            # if not, go left, or go up until we can go left
 658            while {$a != 0} {
 659                set b [lindex $vleftptr($v) $a]
 660                if {$b != 0} break
 661                set a [lindex $vupptr($v) $a]
 662            }
 663            if {$a == 0} break
 664        }
 665        set a $b
 666        incr arcn
 667        lappend vrownum($v) $row
 668        lappend varcorder($v) $a
 669        lset varcix($v) $a $arcn
 670        lset varcrow($v) $a $row
 671    }
 672    if {[info exists currentid]} {
 673        set selectedline [rowofcommit $currentid]
 674    }
 675    undolayout $startrow
 676    if {$row != $commitidx($v)} {
 677        puts "oops update_arcrows got to row $row out of $commitidx($v)"
 678        set vtokmod($v) {}
 679        set varcmod($v) 0
 680    } else {
 681        set vtokmod($v) [lindex $varctok($v) $p]
 682        set varcmod($v) $p
 683    }
 684    set t2 [clock clicks -milliseconds]
 685    incr uat [expr {$t2-$t1}]
 686}
 687
 688# Test whether view $v contains commit $id
 689proc commitinview {id v} {
 690    global varcid
 691
 692    return [info exists varcid($v,$id)]
 693}
 694
 695# Return the row number for commit $id in the current view
 696proc rowofcommit {id} {
 697    global varcid varccommits varcrow curview cached_commitrow
 698
 699    if {[info exists cached_commitrow($id)]} {
 700        return $cached_commitrow($id)
 701    }
 702    set v $curview
 703    if {![info exists varcid($v,$id)]} {
 704        puts "oops rowofcommit no arc for [shortids $id]"
 705        return {}
 706    }
 707    set a $varcid($v,$id)
 708    set i [lsearch -exact $varccommits($v,$a) $id]
 709    if {$i < 0} {
 710        puts "oops didn't find commit [shortids $id] in arc $a"
 711        return {}
 712    }
 713    incr i [lindex $varcrow($v) $a]
 714    set cached_commitrow($id) $i
 715    return $i
 716}
 717
 718proc bsearch {l elt} {
 719    if {[llength $l] == 0 || $elt <= [lindex $l 0]} {
 720        return 0
 721    }
 722    set lo 0
 723    set hi [llength $l]
 724    while {$hi - $lo > 1} {
 725        set mid [expr {int(($lo + $hi) / 2)}]
 726        set t [lindex $l $mid]
 727        if {$elt < $t} {
 728            set hi $mid
 729        } elseif {$elt > $t} {
 730            set lo $mid
 731        } else {
 732            return $mid
 733        }
 734    }
 735    return $lo
 736}
 737
 738# Make sure rows $start..$end-1 are valid in displayorder and parentlist
 739proc make_disporder {start end} {
 740    global vrownum curview commitidx displayorder parentlist
 741    global varccommits varcorder parents
 742    global d_valid_start d_valid_end
 743
 744    set ai [bsearch $vrownum($curview) $start]
 745    set start [lindex $vrownum($curview) $ai]
 746    set narc [llength $vrownum($curview)]
 747    for {set r $start} {$ai < $narc && $r < $end} {incr ai} {
 748        set a [lindex $varcorder($curview) $ai]
 749        set l [llength $displayorder]
 750        set al [llength $varccommits($curview,$a)]
 751        if {$l < $r + $al} {
 752            if {$l < $r} {
 753                set pad [ntimes [expr {$r - $l}] {}]
 754                set displayorder [concat $displayorder $pad]
 755                set parentlist [concat $parentlist $pad]
 756            } elseif {$l > $r} {
 757                set displayorder [lrange $displayorder 0 [expr {$r - 1}]]
 758                set parentlist [lrange $parentlist 0 [expr {$r - 1}]]
 759            }
 760            foreach id $varccommits($curview,$a) {
 761                lappend displayorder $id
 762                lappend parentlist $parents($curview,$id)
 763            }
 764        } elseif {[lindex $displayorder $r] eq {}} {
 765            set i $r
 766            foreach id $varccommits($curview,$a) {
 767                lset displayorder $i $id
 768                lset parentlist $i $parents($curview,$id)
 769                incr i
 770            }
 771        }
 772        incr r $al
 773    }
 774}
 775
 776proc commitonrow {row} {
 777    global displayorder
 778
 779    set id [lindex $displayorder $row]
 780    if {$id eq {}} {
 781        make_disporder $row [expr {$row + 1}]
 782        set id [lindex $displayorder $row]
 783    }
 784    return $id
 785}
 786
 787proc closevarcs {v} {
 788    global varctok varccommits varcid parents children
 789    global cmitlisted commitidx commitinterest vtokmod varcmod
 790
 791    set missing_parents 0
 792    set scripts {}
 793    set narcs [llength $varctok($v)]
 794    for {set a 1} {$a < $narcs} {incr a} {
 795        set id [lindex $varccommits($v,$a) end]
 796        foreach p $parents($v,$id) {
 797            if {[info exists varcid($v,$p)]} continue
 798            # add p as a new commit
 799            incr missing_parents
 800            set cmitlisted($v,$p) 0
 801            set parents($v,$p) {}
 802            if {[llength $children($v,$p)] == 1 &&
 803                [llength $parents($v,$id)] == 1} {
 804                set b $a
 805            } else {
 806                set b [newvarc $v $p]
 807            }
 808            set varcid($v,$p) $b
 809            lappend varccommits($v,$b) $p
 810            set tok [lindex $varctok($v) $b]
 811            if {[string compare $tok $vtokmod($v)] < 0} {
 812                set vtokmod($v) $tok
 813                set varcmod($v) $b
 814            }
 815            incr commitidx($v)
 816            if {[info exists commitinterest($p)]} {
 817                foreach script $commitinterest($p) {
 818                    lappend scripts [string map [list "%I" $p] $script]
 819                }
 820                unset commitinterest($id)
 821            }
 822        }
 823    }
 824    if {$missing_parents > 0} {
 825        update_arcrows $v
 826        foreach s $scripts {
 827            eval $s
 828        }
 829    }
 830}
 831
 832proc getcommitlines {fd inst view}  {
 833    global cmitlisted commitinterest leftover getdbg
 834    global commitidx commitdata
 835    global parents children curview hlview
 836    global ordertok vnextroot idpending
 837    global varccommits varcid varctok vtokmod varcmod
 838
 839    set stuff [read $fd 500000]
 840    # git log doesn't terminate the last commit with a null...
 841    if {$stuff == {} && $leftover($inst) ne {} && [eof $fd]} {
 842        set stuff "\0"
 843    }
 844    if {$stuff == {}} {
 845        if {![eof $fd]} {
 846            return 1
 847        }
 848        global commfd viewcomplete viewactive viewname progresscoords
 849        global viewinstances
 850        unset commfd($inst)
 851        set i [lsearch -exact $viewinstances($view) $inst]
 852        if {$i >= 0} {
 853            set viewinstances($view) [lreplace $viewinstances($view) $i $i]
 854        }
 855        # set it blocking so we wait for the process to terminate
 856        fconfigure $fd -blocking 1
 857        if {[catch {close $fd} err]} {
 858            set fv {}
 859            if {$view != $curview} {
 860                set fv " for the \"$viewname($view)\" view"
 861            }
 862            if {[string range $err 0 4] == "usage"} {
 863                set err "Gitk: error reading commits$fv:\
 864                        bad arguments to git rev-list."
 865                if {$viewname($view) eq "Command line"} {
 866                    append err \
 867                        "  (Note: arguments to gitk are passed to git rev-list\
 868                         to allow selection of commits to be displayed.)"
 869                }
 870            } else {
 871                set err "Error reading commits$fv: $err"
 872            }
 873            error_popup $err
 874        }
 875        if {[incr viewactive($view) -1] <= 0} {
 876            set viewcomplete($view) 1
 877            # Check if we have seen any ids listed as parents that haven't
 878            # appeared in the list
 879            closevarcs $view
 880            notbusy $view
 881            set progresscoords {0 0}
 882            adjustprogress
 883        }
 884        if {$view == $curview} {
 885            run chewcommits $view
 886        }
 887        return 0
 888    }
 889    set start 0
 890    set gotsome 0
 891    set scripts {}
 892    while 1 {
 893        set i [string first "\0" $stuff $start]
 894        if {$i < 0} {
 895            append leftover($inst) [string range $stuff $start end]
 896            break
 897        }
 898        if {$start == 0} {
 899            set cmit $leftover($inst)
 900            append cmit [string range $stuff 0 [expr {$i - 1}]]
 901            set leftover($inst) {}
 902        } else {
 903            set cmit [string range $stuff $start [expr {$i - 1}]]
 904        }
 905        set start [expr {$i + 1}]
 906        set j [string first "\n" $cmit]
 907        set ok 0
 908        set listed 1
 909        if {$j >= 0 && [string match "commit *" $cmit]} {
 910            set ids [string range $cmit 7 [expr {$j - 1}]]
 911            if {[string match {[-<>]*} $ids]} {
 912                switch -- [string index $ids 0] {
 913                    "-" {set listed 0}
 914                    "<" {set listed 2}
 915                    ">" {set listed 3}
 916                }
 917                set ids [string range $ids 1 end]
 918            }
 919            set ok 1
 920            foreach id $ids {
 921                if {[string length $id] != 40} {
 922                    set ok 0
 923                    break
 924                }
 925            }
 926        }
 927        if {!$ok} {
 928            set shortcmit $cmit
 929            if {[string length $shortcmit] > 80} {
 930                set shortcmit "[string range $shortcmit 0 80]..."
 931            }
 932            error_popup "Can't parse git log output: {$shortcmit}"
 933            exit 1
 934        }
 935        set id [lindex $ids 0]
 936        set vid $view,$id
 937        if {!$listed && [info exists parents($vid)]} continue
 938        if {![info exists ordertok($vid)]} {
 939            set otok "o[strrep $vnextroot($view)]"
 940            incr vnextroot($view)
 941            set ordertok($vid) $otok
 942        } else {
 943            set otok $ordertok($vid)
 944        }
 945        if {$listed} {
 946            set olds [lrange $ids 1 end]
 947            if {[llength $olds] == 1} {
 948                set p [lindex $olds 0]
 949                if {![info exists ordertok($view,$p)]} {
 950                    set ordertok($view,$p) $ordertok($vid)
 951                }
 952            } else {
 953                set i 0
 954                foreach p $olds {
 955                    if {![info exists ordertok($view,$p)]} {
 956                        set ordertok($view,$p) "$otok[strrep $i]]"
 957                    }
 958                    incr i
 959                }
 960            }
 961        } else {
 962            set olds {}
 963        }
 964        set commitdata($id) [string range $cmit [expr {$j + 1}] end]
 965        set cmitlisted($vid) $listed
 966        set parents($vid) $olds
 967        set a 0
 968        if {![info exists children($vid)]} {
 969            set children($vid) {}
 970        } else {
 971            if {[llength $children($vid)] == 1} {
 972                set k [lindex $children($vid) 0]
 973                if {[llength $parents($view,$k)] == 1} {
 974                    set a $varcid($view,$k)
 975                }
 976            }
 977        }
 978        if {$a == 0} {
 979            # new arc
 980            set a [newvarc $view $id]
 981        }
 982        set varcid($vid) $a
 983        lappend varccommits($view,$a) $id
 984        set tok [lindex $varctok($view) $a]
 985        set i 0
 986        foreach p $olds {
 987            if {$i == 0 || [lsearch -exact $olds $p] >= $i} {
 988                set vp $view,$p
 989                if {[llength [lappend children($vp) $id]] > 1 &&
 990                    [vtokcmp $view [lindex $children($vp) end-1] $id] > 0} {
 991                    set children($vp) [lsort -command [list vtokcmp $view] \
 992                                           $children($vp)]
 993                }
 994            }
 995            if {[info exists varcid($view,$p)]} {
 996                fix_reversal $p $a $view
 997            }
 998            incr i
 999        }
1000        if {[string compare $tok $vtokmod($view)] < 0} {
1001            set vtokmod($view) $tok
1002            set varcmod($view) $a
1003        }
1004
1005        incr commitidx($view)
1006        if {[info exists commitinterest($id)]} {
1007            foreach script $commitinterest($id) {
1008                lappend scripts [string map [list "%I" $id] $script]
1009            }
1010            unset commitinterest($id)
1011        }
1012        set gotsome 1
1013    }
1014    if {$gotsome} {
1015        update_arcrows $view
1016        run chewcommits $view
1017        foreach s $scripts {
1018            eval $s
1019        }
1020        if {$view == $curview} {
1021            # update progress bar
1022            global progressdirn progresscoords proglastnc
1023            set inc [expr {($commitidx($view) - $proglastnc) * 0.0002}]
1024            set proglastnc $commitidx($view)
1025            set l [lindex $progresscoords 0]
1026            set r [lindex $progresscoords 1]
1027            if {$progressdirn} {
1028                set r [expr {$r + $inc}]
1029                if {$r >= 1.0} {
1030                    set r 1.0
1031                    set progressdirn 0
1032                }
1033                if {$r > 0.2} {
1034                    set l [expr {$r - 0.2}]
1035                }
1036            } else {
1037                set l [expr {$l - $inc}]
1038                if {$l <= 0.0} {
1039                    set l 0.0
1040                    set progressdirn 1
1041                }
1042                set r [expr {$l + 0.2}]
1043            }
1044            set progresscoords [list $l $r]
1045            adjustprogress
1046        }
1047    }
1048    return 2
1049}
1050
1051proc chewcommits {view} {
1052    global curview hlview viewcomplete
1053    global pending_select
1054
1055    if {$view == $curview} {
1056        layoutmore
1057        if {$viewcomplete($view)} {
1058            global commitidx
1059            global numcommits startmsecs
1060            global mainheadid commitinfo nullid
1061
1062            if {[info exists pending_select]} {
1063                set row [first_real_row]
1064                selectline $row 1
1065            }
1066            if {$commitidx($curview) > 0} {
1067                #set ms [expr {[clock clicks -milliseconds] - $startmsecs}]
1068                #puts "overall $ms ms for $numcommits commits"
1069                #global uat
1070                #puts "${uat}ms in update_arcrows"
1071            } else {
1072                show_status "No commits selected"
1073            }
1074            notbusy layout
1075        }
1076    }
1077    if {[info exists hlview] && $view == $hlview} {
1078        vhighlightmore
1079    }
1080    return 0
1081}
1082
1083proc readcommit {id} {
1084    if {[catch {set contents [exec git cat-file commit $id]}]} return
1085    parsecommit $id $contents 0
1086}
1087
1088proc parsecommit {id contents listed} {
1089    global commitinfo cdate
1090
1091    set inhdr 1
1092    set comment {}
1093    set headline {}
1094    set auname {}
1095    set audate {}
1096    set comname {}
1097    set comdate {}
1098    set hdrend [string first "\n\n" $contents]
1099    if {$hdrend < 0} {
1100        # should never happen...
1101        set hdrend [string length $contents]
1102    }
1103    set header [string range $contents 0 [expr {$hdrend - 1}]]
1104    set comment [string range $contents [expr {$hdrend + 2}] end]
1105    foreach line [split $header "\n"] {
1106        set tag [lindex $line 0]
1107        if {$tag == "author"} {
1108            set audate [lindex $line end-1]
1109            set auname [lrange $line 1 end-2]
1110        } elseif {$tag == "committer"} {
1111            set comdate [lindex $line end-1]
1112            set comname [lrange $line 1 end-2]
1113        }
1114    }
1115    set headline {}
1116    # take the first non-blank line of the comment as the headline
1117    set headline [string trimleft $comment]
1118    set i [string first "\n" $headline]
1119    if {$i >= 0} {
1120        set headline [string range $headline 0 $i]
1121    }
1122    set headline [string trimright $headline]
1123    set i [string first "\r" $headline]
1124    if {$i >= 0} {
1125        set headline [string trimright [string range $headline 0 $i]]
1126    }
1127    if {!$listed} {
1128        # git rev-list indents the comment by 4 spaces;
1129        # if we got this via git cat-file, add the indentation
1130        set newcomment {}
1131        foreach line [split $comment "\n"] {
1132            append newcomment "    "
1133            append newcomment $line
1134            append newcomment "\n"
1135        }
1136        set comment $newcomment
1137    }
1138    if {$comdate != {}} {
1139        set cdate($id) $comdate
1140    }
1141    set commitinfo($id) [list $headline $auname $audate \
1142                             $comname $comdate $comment]
1143}
1144
1145proc getcommit {id} {
1146    global commitdata commitinfo
1147
1148    if {[info exists commitdata($id)]} {
1149        parsecommit $id $commitdata($id) 1
1150    } else {
1151        readcommit $id
1152        if {![info exists commitinfo($id)]} {
1153            set commitinfo($id) {"No commit information available"}
1154        }
1155    }
1156    return 1
1157}
1158
1159proc readrefs {} {
1160    global tagids idtags headids idheads tagobjid
1161    global otherrefids idotherrefs mainhead mainheadid
1162
1163    foreach v {tagids idtags headids idheads otherrefids idotherrefs} {
1164        catch {unset $v}
1165    }
1166    set refd [open [list | git show-ref -d] r]
1167    while {[gets $refd line] >= 0} {
1168        if {[string index $line 40] ne " "} continue
1169        set id [string range $line 0 39]
1170        set ref [string range $line 41 end]
1171        if {![string match "refs/*" $ref]} continue
1172        set name [string range $ref 5 end]
1173        if {[string match "remotes/*" $name]} {
1174            if {![string match "*/HEAD" $name]} {
1175                set headids($name) $id
1176                lappend idheads($id) $name
1177            }
1178        } elseif {[string match "heads/*" $name]} {
1179            set name [string range $name 6 end]
1180            set headids($name) $id
1181            lappend idheads($id) $name
1182        } elseif {[string match "tags/*" $name]} {
1183            # this lets refs/tags/foo^{} overwrite refs/tags/foo,
1184            # which is what we want since the former is the commit ID
1185            set name [string range $name 5 end]
1186            if {[string match "*^{}" $name]} {
1187                set name [string range $name 0 end-3]
1188            } else {
1189                set tagobjid($name) $id
1190            }
1191            set tagids($name) $id
1192            lappend idtags($id) $name
1193        } else {
1194            set otherrefids($name) $id
1195            lappend idotherrefs($id) $name
1196        }
1197    }
1198    catch {close $refd}
1199    set mainhead {}
1200    set mainheadid {}
1201    catch {
1202        set thehead [exec git symbolic-ref HEAD]
1203        if {[string match "refs/heads/*" $thehead]} {
1204            set mainhead [string range $thehead 11 end]
1205            if {[info exists headids($mainhead)]} {
1206                set mainheadid $headids($mainhead)
1207            }
1208        }
1209    }
1210}
1211
1212# skip over fake commits
1213proc first_real_row {} {
1214    global nullid nullid2 numcommits
1215
1216    for {set row 0} {$row < $numcommits} {incr row} {
1217        set id [commitonrow $row]
1218        if {$id ne $nullid && $id ne $nullid2} {
1219            break
1220        }
1221    }
1222    return $row
1223}
1224
1225# update things for a head moved to a child of its previous location
1226proc movehead {id name} {
1227    global headids idheads
1228
1229    removehead $headids($name) $name
1230    set headids($name) $id
1231    lappend idheads($id) $name
1232}
1233
1234# update things when a head has been removed
1235proc removehead {id name} {
1236    global headids idheads
1237
1238    if {$idheads($id) eq $name} {
1239        unset idheads($id)
1240    } else {
1241        set i [lsearch -exact $idheads($id) $name]
1242        if {$i >= 0} {
1243            set idheads($id) [lreplace $idheads($id) $i $i]
1244        }
1245    }
1246    unset headids($name)
1247}
1248
1249proc show_error {w top msg} {
1250    message $w.m -text $msg -justify center -aspect 400
1251    pack $w.m -side top -fill x -padx 20 -pady 20
1252    button $w.ok -text OK -command "destroy $top"
1253    pack $w.ok -side bottom -fill x
1254    bind $top <Visibility> "grab $top; focus $top"
1255    bind $top <Key-Return> "destroy $top"
1256    tkwait window $top
1257}
1258
1259proc error_popup msg {
1260    set w .error
1261    toplevel $w
1262    wm transient $w .
1263    show_error $w $w $msg
1264}
1265
1266proc confirm_popup msg {
1267    global confirm_ok
1268    set confirm_ok 0
1269    set w .confirm
1270    toplevel $w
1271    wm transient $w .
1272    message $w.m -text $msg -justify center -aspect 400
1273    pack $w.m -side top -fill x -padx 20 -pady 20
1274    button $w.ok -text OK -command "set confirm_ok 1; destroy $w"
1275    pack $w.ok -side left -fill x
1276    button $w.cancel -text Cancel -command "destroy $w"
1277    pack $w.cancel -side right -fill x
1278    bind $w <Visibility> "grab $w; focus $w"
1279    tkwait window $w
1280    return $confirm_ok
1281}
1282
1283proc makewindow {} {
1284    global canv canv2 canv3 linespc charspc ctext cflist
1285    global tabstop
1286    global findtype findtypemenu findloc findstring fstring geometry
1287    global entries sha1entry sha1string sha1but
1288    global diffcontextstring diffcontext
1289    global maincursor textcursor curtextcursor
1290    global rowctxmenu fakerowmenu mergemax wrapcomment
1291    global highlight_files gdttype
1292    global searchstring sstring
1293    global bgcolor fgcolor bglist fglist diffcolors selectbgcolor
1294    global headctxmenu progresscanv progressitem progresscoords statusw
1295    global fprogitem fprogcoord lastprogupdate progupdatepending
1296    global rprogitem rprogcoord
1297    global have_tk85
1298
1299    menu .bar
1300    .bar add cascade -label "File" -menu .bar.file
1301    .bar configure -font uifont
1302    menu .bar.file
1303    .bar.file add command -label "Update" -command updatecommits
1304    .bar.file add command -label "Reload" -command reloadcommits
1305    .bar.file add command -label "Reread references" -command rereadrefs
1306    .bar.file add command -label "List references" -command showrefs
1307    .bar.file add command -label "Quit" -command doquit
1308    .bar.file configure -font uifont
1309    menu .bar.edit
1310    .bar add cascade -label "Edit" -menu .bar.edit
1311    .bar.edit add command -label "Preferences" -command doprefs
1312    .bar.edit configure -font uifont
1313
1314    menu .bar.view -font uifont
1315    .bar add cascade -label "View" -menu .bar.view
1316    .bar.view add command -label "New view..." -command {newview 0}
1317    .bar.view add command -label "Edit view..." -command editview \
1318        -state disabled
1319    .bar.view add command -label "Delete view" -command delview -state disabled
1320    .bar.view add separator
1321    .bar.view add radiobutton -label "All files" -command {showview 0} \
1322        -variable selectedview -value 0
1323
1324    menu .bar.help
1325    .bar add cascade -label "Help" -menu .bar.help
1326    .bar.help add command -label "About gitk" -command about
1327    .bar.help add command -label "Key bindings" -command keys
1328    .bar.help configure -font uifont
1329    . configure -menu .bar
1330
1331    # the gui has upper and lower half, parts of a paned window.
1332    panedwindow .ctop -orient vertical
1333
1334    # possibly use assumed geometry
1335    if {![info exists geometry(pwsash0)]} {
1336        set geometry(topheight) [expr {15 * $linespc}]
1337        set geometry(topwidth) [expr {80 * $charspc}]
1338        set geometry(botheight) [expr {15 * $linespc}]
1339        set geometry(botwidth) [expr {50 * $charspc}]
1340        set geometry(pwsash0) "[expr {40 * $charspc}] 2"
1341        set geometry(pwsash1) "[expr {60 * $charspc}] 2"
1342    }
1343
1344    # the upper half will have a paned window, a scroll bar to the right, and some stuff below
1345    frame .tf -height $geometry(topheight) -width $geometry(topwidth)
1346    frame .tf.histframe
1347    panedwindow .tf.histframe.pwclist -orient horizontal -sashpad 0 -handlesize 4
1348
1349    # create three canvases
1350    set cscroll .tf.histframe.csb
1351    set canv .tf.histframe.pwclist.canv
1352    canvas $canv \
1353        -selectbackground $selectbgcolor \
1354        -background $bgcolor -bd 0 \
1355        -yscrollincr $linespc -yscrollcommand "scrollcanv $cscroll"
1356    .tf.histframe.pwclist add $canv
1357    set canv2 .tf.histframe.pwclist.canv2
1358    canvas $canv2 \
1359        -selectbackground $selectbgcolor \
1360        -background $bgcolor -bd 0 -yscrollincr $linespc
1361    .tf.histframe.pwclist add $canv2
1362    set canv3 .tf.histframe.pwclist.canv3
1363    canvas $canv3 \
1364        -selectbackground $selectbgcolor \
1365        -background $bgcolor -bd 0 -yscrollincr $linespc
1366    .tf.histframe.pwclist add $canv3
1367    eval .tf.histframe.pwclist sash place 0 $geometry(pwsash0)
1368    eval .tf.histframe.pwclist sash place 1 $geometry(pwsash1)
1369
1370    # a scroll bar to rule them
1371    scrollbar $cscroll -command {allcanvs yview} -highlightthickness 0
1372    pack $cscroll -side right -fill y
1373    bind .tf.histframe.pwclist <Configure> {resizeclistpanes %W %w}
1374    lappend bglist $canv $canv2 $canv3
1375    pack .tf.histframe.pwclist -fill both -expand 1 -side left
1376
1377    # we have two button bars at bottom of top frame. Bar 1
1378    frame .tf.bar
1379    frame .tf.lbar -height 15
1380
1381    set sha1entry .tf.bar.sha1
1382    set entries $sha1entry
1383    set sha1but .tf.bar.sha1label
1384    button $sha1but -text "SHA1 ID: " -state disabled -relief flat \
1385        -command gotocommit -width 8 -font uifont
1386    $sha1but conf -disabledforeground [$sha1but cget -foreground]
1387    pack .tf.bar.sha1label -side left
1388    entry $sha1entry -width 40 -font textfont -textvariable sha1string
1389    trace add variable sha1string write sha1change
1390    pack $sha1entry -side left -pady 2
1391
1392    image create bitmap bm-left -data {
1393        #define left_width 16
1394        #define left_height 16
1395        static unsigned char left_bits[] = {
1396        0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,
1397        0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,
1398        0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};
1399    }
1400    image create bitmap bm-right -data {
1401        #define right_width 16
1402        #define right_height 16
1403        static unsigned char right_bits[] = {
1404        0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
1405        0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
1406        0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
1407    }
1408    button .tf.bar.leftbut -image bm-left -command goback \
1409        -state disabled -width 26
1410    pack .tf.bar.leftbut -side left -fill y
1411    button .tf.bar.rightbut -image bm-right -command goforw \
1412        -state disabled -width 26
1413    pack .tf.bar.rightbut -side left -fill y
1414
1415    # Status label and progress bar
1416    set statusw .tf.bar.status
1417    label $statusw -width 15 -relief sunken -font uifont
1418    pack $statusw -side left -padx 5
1419    set h [expr {[font metrics uifont -linespace] + 2}]
1420    set progresscanv .tf.bar.progress
1421    canvas $progresscanv -relief sunken -height $h -borderwidth 2
1422    set progressitem [$progresscanv create rect -1 0 0 $h -fill green]
1423    set fprogitem [$progresscanv create rect -1 0 0 $h -fill yellow]
1424    set rprogitem [$progresscanv create rect -1 0 0 $h -fill red]
1425    pack $progresscanv -side right -expand 1 -fill x
1426    set progresscoords {0 0}
1427    set fprogcoord 0
1428    set rprogcoord 0
1429    bind $progresscanv <Configure> adjustprogress
1430    set lastprogupdate [clock clicks -milliseconds]
1431    set progupdatepending 0
1432
1433    # build up the bottom bar of upper window
1434    label .tf.lbar.flabel -text "Find " -font uifont
1435    button .tf.lbar.fnext -text "next" -command {dofind 1 1} -font uifont
1436    button .tf.lbar.fprev -text "prev" -command {dofind -1 1} -font uifont
1437    label .tf.lbar.flab2 -text " commit " -font uifont
1438    pack .tf.lbar.flabel .tf.lbar.fnext .tf.lbar.fprev .tf.lbar.flab2 \
1439        -side left -fill y
1440    set gdttype "containing:"
1441    set gm [tk_optionMenu .tf.lbar.gdttype gdttype \
1442                "containing:" \
1443                "touching paths:" \
1444                "adding/removing string:"]
1445    trace add variable gdttype write gdttype_change
1446    $gm conf -font uifont
1447    .tf.lbar.gdttype conf -font uifont
1448    pack .tf.lbar.gdttype -side left -fill y
1449
1450    set findstring {}
1451    set fstring .tf.lbar.findstring
1452    lappend entries $fstring
1453    entry $fstring -width 30 -font textfont -textvariable findstring
1454    trace add variable findstring write find_change
1455    set findtype Exact
1456    set findtypemenu [tk_optionMenu .tf.lbar.findtype \
1457                      findtype Exact IgnCase Regexp]
1458    trace add variable findtype write findcom_change
1459    .tf.lbar.findtype configure -font uifont
1460    .tf.lbar.findtype.menu configure -font uifont
1461    set findloc "All fields"
1462    tk_optionMenu .tf.lbar.findloc findloc "All fields" Headline \
1463        Comments Author Committer
1464    trace add variable findloc write find_change
1465    .tf.lbar.findloc configure -font uifont
1466    .tf.lbar.findloc.menu configure -font uifont
1467    pack .tf.lbar.findloc -side right
1468    pack .tf.lbar.findtype -side right
1469    pack $fstring -side left -expand 1 -fill x
1470
1471    # Finish putting the upper half of the viewer together
1472    pack .tf.lbar -in .tf -side bottom -fill x
1473    pack .tf.bar -in .tf -side bottom -fill x
1474    pack .tf.histframe -fill both -side top -expand 1
1475    .ctop add .tf
1476    .ctop paneconfigure .tf -height $geometry(topheight)
1477    .ctop paneconfigure .tf -width $geometry(topwidth)
1478
1479    # now build up the bottom
1480    panedwindow .pwbottom -orient horizontal
1481
1482    # lower left, a text box over search bar, scroll bar to the right
1483    # if we know window height, then that will set the lower text height, otherwise
1484    # we set lower text height which will drive window height
1485    if {[info exists geometry(main)]} {
1486        frame .bleft -width $geometry(botwidth)
1487    } else {
1488        frame .bleft -width $geometry(botwidth) -height $geometry(botheight)
1489    }
1490    frame .bleft.top
1491    frame .bleft.mid
1492
1493    button .bleft.top.search -text "Search" -command dosearch \
1494        -font uifont
1495    pack .bleft.top.search -side left -padx 5
1496    set sstring .bleft.top.sstring
1497    entry $sstring -width 20 -font textfont -textvariable searchstring
1498    lappend entries $sstring
1499    trace add variable searchstring write incrsearch
1500    pack $sstring -side left -expand 1 -fill x
1501    radiobutton .bleft.mid.diff -text "Diff" -font uifont \
1502        -command changediffdisp -variable diffelide -value {0 0}
1503    radiobutton .bleft.mid.old -text "Old version" -font uifont \
1504        -command changediffdisp -variable diffelide -value {0 1}
1505    radiobutton .bleft.mid.new -text "New version" -font uifont \
1506        -command changediffdisp -variable diffelide -value {1 0}
1507    label .bleft.mid.labeldiffcontext -text "      Lines of context: " \
1508        -font uifont
1509    pack .bleft.mid.diff .bleft.mid.old .bleft.mid.new -side left
1510    spinbox .bleft.mid.diffcontext -width 5 -font textfont \
1511        -from 1 -increment 1 -to 10000000 \
1512        -validate all -validatecommand "diffcontextvalidate %P" \
1513        -textvariable diffcontextstring
1514    .bleft.mid.diffcontext set $diffcontext
1515    trace add variable diffcontextstring write diffcontextchange
1516    lappend entries .bleft.mid.diffcontext
1517    pack .bleft.mid.labeldiffcontext .bleft.mid.diffcontext -side left
1518    set ctext .bleft.ctext
1519    text $ctext -background $bgcolor -foreground $fgcolor \
1520        -state disabled -font textfont \
1521        -yscrollcommand scrolltext -wrap none
1522    if {$have_tk85} {
1523        $ctext conf -tabstyle wordprocessor
1524    }
1525    scrollbar .bleft.sb -command "$ctext yview"
1526    pack .bleft.top -side top -fill x
1527    pack .bleft.mid -side top -fill x
1528    pack .bleft.sb -side right -fill y
1529    pack $ctext -side left -fill both -expand 1
1530    lappend bglist $ctext
1531    lappend fglist $ctext
1532
1533    $ctext tag conf comment -wrap $wrapcomment
1534    $ctext tag conf filesep -font textfontbold -back "#aaaaaa"
1535    $ctext tag conf hunksep -fore [lindex $diffcolors 2]
1536    $ctext tag conf d0 -fore [lindex $diffcolors 0]
1537    $ctext tag conf d1 -fore [lindex $diffcolors 1]
1538    $ctext tag conf m0 -fore red
1539    $ctext tag conf m1 -fore blue
1540    $ctext tag conf m2 -fore green
1541    $ctext tag conf m3 -fore purple
1542    $ctext tag conf m4 -fore brown
1543    $ctext tag conf m5 -fore "#009090"
1544    $ctext tag conf m6 -fore magenta
1545    $ctext tag conf m7 -fore "#808000"
1546    $ctext tag conf m8 -fore "#009000"
1547    $ctext tag conf m9 -fore "#ff0080"
1548    $ctext tag conf m10 -fore cyan
1549    $ctext tag conf m11 -fore "#b07070"
1550    $ctext tag conf m12 -fore "#70b0f0"
1551    $ctext tag conf m13 -fore "#70f0b0"
1552    $ctext tag conf m14 -fore "#f0b070"
1553    $ctext tag conf m15 -fore "#ff70b0"
1554    $ctext tag conf mmax -fore darkgrey
1555    set mergemax 16
1556    $ctext tag conf mresult -font textfontbold
1557    $ctext tag conf msep -font textfontbold
1558    $ctext tag conf found -back yellow
1559
1560    .pwbottom add .bleft
1561    .pwbottom paneconfigure .bleft -width $geometry(botwidth)
1562
1563    # lower right
1564    frame .bright
1565    frame .bright.mode
1566    radiobutton .bright.mode.patch -text "Patch" \
1567        -command reselectline -variable cmitmode -value "patch"
1568    .bright.mode.patch configure -font uifont
1569    radiobutton .bright.mode.tree -text "Tree" \
1570        -command reselectline -variable cmitmode -value "tree"
1571    .bright.mode.tree configure -font uifont
1572    grid .bright.mode.patch .bright.mode.tree -sticky ew
1573    pack .bright.mode -side top -fill x
1574    set cflist .bright.cfiles
1575    set indent [font measure mainfont "nn"]
1576    text $cflist \
1577        -selectbackground $selectbgcolor \
1578        -background $bgcolor -foreground $fgcolor \
1579        -font mainfont \
1580        -tabs [list $indent [expr {2 * $indent}]] \
1581        -yscrollcommand ".bright.sb set" \
1582        -cursor [. cget -cursor] \
1583        -spacing1 1 -spacing3 1
1584    lappend bglist $cflist
1585    lappend fglist $cflist
1586    scrollbar .bright.sb -command "$cflist yview"
1587    pack .bright.sb -side right -fill y
1588    pack $cflist -side left -fill both -expand 1
1589    $cflist tag configure highlight \
1590        -background [$cflist cget -selectbackground]
1591    $cflist tag configure bold -font mainfontbold
1592
1593    .pwbottom add .bright
1594    .ctop add .pwbottom
1595
1596    # restore window position if known
1597    if {[info exists geometry(main)]} {
1598        wm geometry . "$geometry(main)"
1599    }
1600
1601    if {[tk windowingsystem] eq {aqua}} {
1602        set M1B M1
1603    } else {
1604        set M1B Control
1605    }
1606
1607    bind .pwbottom <Configure> {resizecdetpanes %W %w}
1608    pack .ctop -fill both -expand 1
1609    bindall <1> {selcanvline %W %x %y}
1610    #bindall <B1-Motion> {selcanvline %W %x %y}
1611    if {[tk windowingsystem] == "win32"} {
1612        bind . <MouseWheel> { windows_mousewheel_redirector %W %X %Y %D }
1613        bind $ctext <MouseWheel> { windows_mousewheel_redirector %W %X %Y %D ; break }
1614    } else {
1615        bindall <ButtonRelease-4> "allcanvs yview scroll -5 units"
1616        bindall <ButtonRelease-5> "allcanvs yview scroll 5 units"
1617        if {[tk windowingsystem] eq "aqua"} {
1618            bindall <MouseWheel> {
1619                set delta [expr {- (%D)}]
1620                allcanvs yview scroll $delta units
1621            }
1622        }
1623    }
1624    bindall <2> "canvscan mark %W %x %y"
1625    bindall <B2-Motion> "canvscan dragto %W %x %y"
1626    bindkey <Home> selfirstline
1627    bindkey <End> sellastline
1628    bind . <Key-Up> "selnextline -1"
1629    bind . <Key-Down> "selnextline 1"
1630    bind . <Shift-Key-Up> "dofind -1 0"
1631    bind . <Shift-Key-Down> "dofind 1 0"
1632    bindkey <Key-Right> "goforw"
1633    bindkey <Key-Left> "goback"
1634    bind . <Key-Prior> "selnextpage -1"
1635    bind . <Key-Next> "selnextpage 1"
1636    bind . <$M1B-Home> "allcanvs yview moveto 0.0"
1637    bind . <$M1B-End> "allcanvs yview moveto 1.0"
1638    bind . <$M1B-Key-Up> "allcanvs yview scroll -1 units"
1639    bind . <$M1B-Key-Down> "allcanvs yview scroll 1 units"
1640    bind . <$M1B-Key-Prior> "allcanvs yview scroll -1 pages"
1641    bind . <$M1B-Key-Next> "allcanvs yview scroll 1 pages"
1642    bindkey <Key-Delete> "$ctext yview scroll -1 pages"
1643    bindkey <Key-BackSpace> "$ctext yview scroll -1 pages"
1644    bindkey <Key-space> "$ctext yview scroll 1 pages"
1645    bindkey p "selnextline -1"
1646    bindkey n "selnextline 1"
1647    bindkey z "goback"
1648    bindkey x "goforw"
1649    bindkey i "selnextline -1"
1650    bindkey k "selnextline 1"
1651    bindkey j "goback"
1652    bindkey l "goforw"
1653    bindkey b "$ctext yview scroll -1 pages"
1654    bindkey d "$ctext yview scroll 18 units"
1655    bindkey u "$ctext yview scroll -18 units"
1656    bindkey / {dofind 1 1}
1657    bindkey <Key-Return> {dofind 1 1}
1658    bindkey ? {dofind -1 1}
1659    bindkey f nextfile
1660    bindkey <F5> updatecommits
1661    bind . <$M1B-q> doquit
1662    bind . <$M1B-f> {dofind 1 1}
1663    bind . <$M1B-g> {dofind 1 0}
1664    bind . <$M1B-r> dosearchback
1665    bind . <$M1B-s> dosearch
1666    bind . <$M1B-equal> {incrfont 1}
1667    bind . <$M1B-KP_Add> {incrfont 1}
1668    bind . <$M1B-minus> {incrfont -1}
1669    bind . <$M1B-KP_Subtract> {incrfont -1}
1670    wm protocol . WM_DELETE_WINDOW doquit
1671    bind . <Button-1> "click %W"
1672    bind $fstring <Key-Return> {dofind 1 1}
1673    bind $sha1entry <Key-Return> gotocommit
1674    bind $sha1entry <<PasteSelection>> clearsha1
1675    bind $cflist <1> {sel_flist %W %x %y; break}
1676    bind $cflist <B1-Motion> {sel_flist %W %x %y; break}
1677    bind $cflist <ButtonRelease-1> {treeclick %W %x %y}
1678    bind $cflist <Button-3> {pop_flist_menu %W %X %Y %x %y}
1679
1680    set maincursor [. cget -cursor]
1681    set textcursor [$ctext cget -cursor]
1682    set curtextcursor $textcursor
1683
1684    set rowctxmenu .rowctxmenu
1685    menu $rowctxmenu -tearoff 0
1686    $rowctxmenu add command -label "Diff this -> selected" \
1687        -command {diffvssel 0}
1688    $rowctxmenu add command -label "Diff selected -> this" \
1689        -command {diffvssel 1}
1690    $rowctxmenu add command -label "Make patch" -command mkpatch
1691    $rowctxmenu add command -label "Create tag" -command mktag
1692    $rowctxmenu add command -label "Write commit to file" -command writecommit
1693    $rowctxmenu add command -label "Create new branch" -command mkbranch
1694    $rowctxmenu add command -label "Cherry-pick this commit" \
1695        -command cherrypick
1696    $rowctxmenu add command -label "Reset HEAD branch to here" \
1697        -command resethead
1698
1699    set fakerowmenu .fakerowmenu
1700    menu $fakerowmenu -tearoff 0
1701    $fakerowmenu add command -label "Diff this -> selected" \
1702        -command {diffvssel 0}
1703    $fakerowmenu add command -label "Diff selected -> this" \
1704        -command {diffvssel 1}
1705    $fakerowmenu add command -label "Make patch" -command mkpatch
1706#    $fakerowmenu add command -label "Commit" -command {mkcommit 0}
1707#    $fakerowmenu add command -label "Commit all" -command {mkcommit 1}
1708#    $fakerowmenu add command -label "Revert local changes" -command revertlocal
1709
1710    set headctxmenu .headctxmenu
1711    menu $headctxmenu -tearoff 0
1712    $headctxmenu add command -label "Check out this branch" \
1713        -command cobranch
1714    $headctxmenu add command -label "Remove this branch" \
1715        -command rmbranch
1716
1717    global flist_menu
1718    set flist_menu .flistctxmenu
1719    menu $flist_menu -tearoff 0
1720    $flist_menu add command -label "Highlight this too" \
1721        -command {flist_hl 0}
1722    $flist_menu add command -label "Highlight this only" \
1723        -command {flist_hl 1}
1724}
1725
1726# Windows sends all mouse wheel events to the current focused window, not
1727# the one where the mouse hovers, so bind those events here and redirect
1728# to the correct window
1729proc windows_mousewheel_redirector {W X Y D} {
1730    global canv canv2 canv3
1731    set w [winfo containing -displayof $W $X $Y]
1732    if {$w ne ""} {
1733        set u [expr {$D < 0 ? 5 : -5}]
1734        if {$w == $canv || $w == $canv2 || $w == $canv3} {
1735            allcanvs yview scroll $u units
1736        } else {
1737            catch {
1738                $w yview scroll $u units
1739            }
1740        }
1741    }
1742}
1743
1744# mouse-2 makes all windows scan vertically, but only the one
1745# the cursor is in scans horizontally
1746proc canvscan {op w x y} {
1747    global canv canv2 canv3
1748    foreach c [list $canv $canv2 $canv3] {
1749        if {$c == $w} {
1750            $c scan $op $x $y
1751        } else {
1752            $c scan $op 0 $y
1753        }
1754    }
1755}
1756
1757proc scrollcanv {cscroll f0 f1} {
1758    $cscroll set $f0 $f1
1759    drawfrac $f0 $f1
1760    flushhighlights
1761}
1762
1763# when we make a key binding for the toplevel, make sure
1764# it doesn't get triggered when that key is pressed in the
1765# find string entry widget.
1766proc bindkey {ev script} {
1767    global entries
1768    bind . $ev $script
1769    set escript [bind Entry $ev]
1770    if {$escript == {}} {
1771        set escript [bind Entry <Key>]
1772    }
1773    foreach e $entries {
1774        bind $e $ev "$escript; break"
1775    }
1776}
1777
1778# set the focus back to the toplevel for any click outside
1779# the entry widgets
1780proc click {w} {
1781    global ctext entries
1782    foreach e [concat $entries $ctext] {
1783        if {$w == $e} return
1784    }
1785    focus .
1786}
1787
1788# Adjust the progress bar for a change in requested extent or canvas size
1789proc adjustprogress {} {
1790    global progresscanv progressitem progresscoords
1791    global fprogitem fprogcoord lastprogupdate progupdatepending
1792    global rprogitem rprogcoord
1793
1794    set w [expr {[winfo width $progresscanv] - 4}]
1795    set x0 [expr {$w * [lindex $progresscoords 0]}]
1796    set x1 [expr {$w * [lindex $progresscoords 1]}]
1797    set h [winfo height $progresscanv]
1798    $progresscanv coords $progressitem $x0 0 $x1 $h
1799    $progresscanv coords $fprogitem 0 0 [expr {$w * $fprogcoord}] $h
1800    $progresscanv coords $rprogitem 0 0 [expr {$w * $rprogcoord}] $h
1801    set now [clock clicks -milliseconds]
1802    if {$now >= $lastprogupdate + 100} {
1803        set progupdatepending 0
1804        update
1805    } elseif {!$progupdatepending} {
1806        set progupdatepending 1
1807        after [expr {$lastprogupdate + 100 - $now}] doprogupdate
1808    }
1809}
1810
1811proc doprogupdate {} {
1812    global lastprogupdate progupdatepending
1813
1814    if {$progupdatepending} {
1815        set progupdatepending 0
1816        set lastprogupdate [clock clicks -milliseconds]
1817        update
1818    }
1819}
1820
1821proc savestuff {w} {
1822    global canv canv2 canv3 mainfont textfont uifont tabstop
1823    global stuffsaved findmergefiles maxgraphpct
1824    global maxwidth showneartags showlocalchanges
1825    global viewname viewfiles viewargs viewperm nextviewnum
1826    global cmitmode wrapcomment datetimeformat limitdiffs
1827    global colors bgcolor fgcolor diffcolors diffcontext selectbgcolor
1828
1829    if {$stuffsaved} return
1830    if {![winfo viewable .]} return
1831    catch {
1832        set f [open "~/.gitk-new" w]
1833        puts $f [list set mainfont $mainfont]
1834        puts $f [list set textfont $textfont]
1835        puts $f [list set uifont $uifont]
1836        puts $f [list set tabstop $tabstop]
1837        puts $f [list set findmergefiles $findmergefiles]
1838        puts $f [list set maxgraphpct $maxgraphpct]
1839        puts $f [list set maxwidth $maxwidth]
1840        puts $f [list set cmitmode $cmitmode]
1841        puts $f [list set wrapcomment $wrapcomment]
1842        puts $f [list set showneartags $showneartags]
1843        puts $f [list set showlocalchanges $showlocalchanges]
1844        puts $f [list set datetimeformat $datetimeformat]
1845        puts $f [list set limitdiffs $limitdiffs]
1846        puts $f [list set bgcolor $bgcolor]
1847        puts $f [list set fgcolor $fgcolor]
1848        puts $f [list set colors $colors]
1849        puts $f [list set diffcolors $diffcolors]
1850        puts $f [list set diffcontext $diffcontext]
1851        puts $f [list set selectbgcolor $selectbgcolor]
1852
1853        puts $f "set geometry(main) [wm geometry .]"
1854        puts $f "set geometry(topwidth) [winfo width .tf]"
1855        puts $f "set geometry(topheight) [winfo height .tf]"
1856        puts $f "set geometry(pwsash0) \"[.tf.histframe.pwclist sash coord 0]\""
1857        puts $f "set geometry(pwsash1) \"[.tf.histframe.pwclist sash coord 1]\""
1858        puts $f "set geometry(botwidth) [winfo width .bleft]"
1859        puts $f "set geometry(botheight) [winfo height .bleft]"
1860
1861        puts -nonewline $f "set permviews {"
1862        for {set v 0} {$v < $nextviewnum} {incr v} {
1863            if {$viewperm($v)} {
1864                puts $f "{[list $viewname($v) $viewfiles($v) $viewargs($v)]}"
1865            }
1866        }
1867        puts $f "}"
1868        close $f
1869        file rename -force "~/.gitk-new" "~/.gitk"
1870    }
1871    set stuffsaved 1
1872}
1873
1874proc resizeclistpanes {win w} {
1875    global oldwidth
1876    if {[info exists oldwidth($win)]} {
1877        set s0 [$win sash coord 0]
1878        set s1 [$win sash coord 1]
1879        if {$w < 60} {
1880            set sash0 [expr {int($w/2 - 2)}]
1881            set sash1 [expr {int($w*5/6 - 2)}]
1882        } else {
1883            set factor [expr {1.0 * $w / $oldwidth($win)}]
1884            set sash0 [expr {int($factor * [lindex $s0 0])}]
1885            set sash1 [expr {int($factor * [lindex $s1 0])}]
1886            if {$sash0 < 30} {
1887                set sash0 30
1888            }
1889            if {$sash1 < $sash0 + 20} {
1890                set sash1 [expr {$sash0 + 20}]
1891            }
1892            if {$sash1 > $w - 10} {
1893                set sash1 [expr {$w - 10}]
1894                if {$sash0 > $sash1 - 20} {
1895                    set sash0 [expr {$sash1 - 20}]
1896                }
1897            }
1898        }
1899        $win sash place 0 $sash0 [lindex $s0 1]
1900        $win sash place 1 $sash1 [lindex $s1 1]
1901    }
1902    set oldwidth($win) $w
1903}
1904
1905proc resizecdetpanes {win w} {
1906    global oldwidth
1907    if {[info exists oldwidth($win)]} {
1908        set s0 [$win sash coord 0]
1909        if {$w < 60} {
1910            set sash0 [expr {int($w*3/4 - 2)}]
1911        } else {
1912            set factor [expr {1.0 * $w / $oldwidth($win)}]
1913            set sash0 [expr {int($factor * [lindex $s0 0])}]
1914            if {$sash0 < 45} {
1915                set sash0 45
1916            }
1917            if {$sash0 > $w - 15} {
1918                set sash0 [expr {$w - 15}]
1919            }
1920        }
1921        $win sash place 0 $sash0 [lindex $s0 1]
1922    }
1923    set oldwidth($win) $w
1924}
1925
1926proc allcanvs args {
1927    global canv canv2 canv3
1928    eval $canv $args
1929    eval $canv2 $args
1930    eval $canv3 $args
1931}
1932
1933proc bindall {event action} {
1934    global canv canv2 canv3
1935    bind $canv $event $action
1936    bind $canv2 $event $action
1937    bind $canv3 $event $action
1938}
1939
1940proc about {} {
1941    global uifont
1942    set w .about
1943    if {[winfo exists $w]} {
1944        raise $w
1945        return
1946    }
1947    toplevel $w
1948    wm title $w "About gitk"
1949    message $w.m -text {
1950Gitk - a commit viewer for git
1951
1952Copyright © 2005-2007 Paul Mackerras
1953
1954Use and redistribute under the terms of the GNU General Public License} \
1955            -justify center -aspect 400 -border 2 -bg white -relief groove
1956    pack $w.m -side top -fill x -padx 2 -pady 2
1957    $w.m configure -font uifont
1958    button $w.ok -text Close -command "destroy $w" -default active
1959    pack $w.ok -side bottom
1960    $w.ok configure -font uifont
1961    bind $w <Visibility> "focus $w.ok"
1962    bind $w <Key-Escape> "destroy $w"
1963    bind $w <Key-Return> "destroy $w"
1964}
1965
1966proc keys {} {
1967    global uifont
1968    set w .keys
1969    if {[winfo exists $w]} {
1970        raise $w
1971        return
1972    }
1973    if {[tk windowingsystem] eq {aqua}} {
1974        set M1T Cmd
1975    } else {
1976        set M1T Ctrl
1977    }
1978    toplevel $w
1979    wm title $w "Gitk key bindings"
1980    message $w.m -text "
1981Gitk key bindings:
1982
1983<$M1T-Q>                Quit
1984<Home>          Move to first commit
1985<End>           Move to last commit
1986<Up>, p, i      Move up one commit
1987<Down>, n, k    Move down one commit
1988<Left>, z, j    Go back in history list
1989<Right>, x, l   Go forward in history list
1990<PageUp>        Move up one page in commit list
1991<PageDown>      Move down one page in commit list
1992<$M1T-Home>     Scroll to top of commit list
1993<$M1T-End>      Scroll to bottom of commit list
1994<$M1T-Up>       Scroll commit list up one line
1995<$M1T-Down>     Scroll commit list down one line
1996<$M1T-PageUp>   Scroll commit list up one page
1997<$M1T-PageDown> Scroll commit list down one page
1998<Shift-Up>      Find backwards (upwards, later commits)
1999<Shift-Down>    Find forwards (downwards, earlier commits)
2000<Delete>, b     Scroll diff view up one page
2001<Backspace>     Scroll diff view up one page
2002<Space>         Scroll diff view down one page
2003u               Scroll diff view up 18 lines
2004d               Scroll diff view down 18 lines
2005<$M1T-F>                Find
2006<$M1T-G>                Move to next find hit
2007<Return>        Move to next find hit
2008/               Move to next find hit, or redo find
2009?               Move to previous find hit
2010f               Scroll diff view to next file
2011<$M1T-S>                Search for next hit in diff view
2012<$M1T-R>                Search for previous hit in diff view
2013<$M1T-KP+>      Increase font size
2014<$M1T-plus>     Increase font size
2015<$M1T-KP->      Decrease font size
2016<$M1T-minus>    Decrease font size
2017<F5>            Update
2018" \
2019            -justify left -bg white -border 2 -relief groove
2020    pack $w.m -side top -fill both -padx 2 -pady 2
2021    $w.m configure -font uifont
2022    button $w.ok -text Close -command "destroy $w" -default active
2023    pack $w.ok -side bottom
2024    $w.ok configure -font uifont
2025    bind $w <Visibility> "focus $w.ok"
2026    bind $w <Key-Escape> "destroy $w"
2027    bind $w <Key-Return> "destroy $w"
2028}
2029
2030# Procedures for manipulating the file list window at the
2031# bottom right of the overall window.
2032
2033proc treeview {w l openlevs} {
2034    global treecontents treediropen treeheight treeparent treeindex
2035
2036    set ix 0
2037    set treeindex() 0
2038    set lev 0
2039    set prefix {}
2040    set prefixend -1
2041    set prefendstack {}
2042    set htstack {}
2043    set ht 0
2044    set treecontents() {}
2045    $w conf -state normal
2046    foreach f $l {
2047        while {[string range $f 0 $prefixend] ne $prefix} {
2048            if {$lev <= $openlevs} {
2049                $w mark set e:$treeindex($prefix) "end -1c"
2050                $w mark gravity e:$treeindex($prefix) left
2051            }
2052            set treeheight($prefix) $ht
2053            incr ht [lindex $htstack end]
2054            set htstack [lreplace $htstack end end]
2055            set prefixend [lindex $prefendstack end]
2056            set prefendstack [lreplace $prefendstack end end]
2057            set prefix [string range $prefix 0 $prefixend]
2058            incr lev -1
2059        }
2060        set tail [string range $f [expr {$prefixend+1}] end]
2061        while {[set slash [string first "/" $tail]] >= 0} {
2062            lappend htstack $ht
2063            set ht 0
2064            lappend prefendstack $prefixend
2065            incr prefixend [expr {$slash + 1}]
2066            set d [string range $tail 0 $slash]
2067            lappend treecontents($prefix) $d
2068            set oldprefix $prefix
2069            append prefix $d
2070            set treecontents($prefix) {}
2071            set treeindex($prefix) [incr ix]
2072            set treeparent($prefix) $oldprefix
2073            set tail [string range $tail [expr {$slash+1}] end]
2074            if {$lev <= $openlevs} {
2075                set ht 1
2076                set treediropen($prefix) [expr {$lev < $openlevs}]
2077                set bm [expr {$lev == $openlevs? "tri-rt": "tri-dn"}]
2078                $w mark set d:$ix "end -1c"
2079                $w mark gravity d:$ix left
2080                set str "\n"
2081                for {set i 0} {$i < $lev} {incr i} {append str "\t"}
2082                $w insert end $str
2083                $w image create end -align center -image $bm -padx 1 \
2084                    -name a:$ix
2085                $w insert end $d [highlight_tag $prefix]
2086                $w mark set s:$ix "end -1c"
2087                $w mark gravity s:$ix left
2088            }
2089            incr lev
2090        }
2091        if {$tail ne {}} {
2092            if {$lev <= $openlevs} {
2093                incr ht
2094                set str "\n"
2095                for {set i 0} {$i < $lev} {incr i} {append str "\t"}
2096                $w insert end $str
2097                $w insert end $tail [highlight_tag $f]
2098            }
2099            lappend treecontents($prefix) $tail
2100        }
2101    }
2102    while {$htstack ne {}} {
2103        set treeheight($prefix) $ht
2104        incr ht [lindex $htstack end]
2105        set htstack [lreplace $htstack end end]
2106        set prefixend [lindex $prefendstack end]
2107        set prefendstack [lreplace $prefendstack end end]
2108        set prefix [string range $prefix 0 $prefixend]
2109    }
2110    $w conf -state disabled
2111}
2112
2113proc linetoelt {l} {
2114    global treeheight treecontents
2115
2116    set y 2
2117    set prefix {}
2118    while {1} {
2119        foreach e $treecontents($prefix) {
2120            if {$y == $l} {
2121                return "$prefix$e"
2122            }
2123            set n 1
2124            if {[string index $e end] eq "/"} {
2125                set n $treeheight($prefix$e)
2126                if {$y + $n > $l} {
2127                    append prefix $e
2128                    incr y
2129                    break
2130                }
2131            }
2132            incr y $n
2133        }
2134    }
2135}
2136
2137proc highlight_tree {y prefix} {
2138    global treeheight treecontents cflist
2139
2140    foreach e $treecontents($prefix) {
2141        set path $prefix$e
2142        if {[highlight_tag $path] ne {}} {
2143            $cflist tag add bold $y.0 "$y.0 lineend"
2144        }
2145        incr y
2146        if {[string index $e end] eq "/" && $treeheight($path) > 1} {
2147            set y [highlight_tree $y $path]
2148        }
2149    }
2150    return $y
2151}
2152
2153proc treeclosedir {w dir} {
2154    global treediropen treeheight treeparent treeindex
2155
2156    set ix $treeindex($dir)
2157    $w conf -state normal
2158    $w delete s:$ix e:$ix
2159    set treediropen($dir) 0
2160    $w image configure a:$ix -image tri-rt
2161    $w conf -state disabled
2162    set n [expr {1 - $treeheight($dir)}]
2163    while {$dir ne {}} {
2164        incr treeheight($dir) $n
2165        set dir $treeparent($dir)
2166    }
2167}
2168
2169proc treeopendir {w dir} {
2170    global treediropen treeheight treeparent treecontents treeindex
2171
2172    set ix $treeindex($dir)
2173    $w conf -state normal
2174    $w image configure a:$ix -image tri-dn
2175    $w mark set e:$ix s:$ix
2176    $w mark gravity e:$ix right
2177    set lev 0
2178    set str "\n"
2179    set n [llength $treecontents($dir)]
2180    for {set x $dir} {$x ne {}} {set x $treeparent($x)} {
2181        incr lev
2182        append str "\t"
2183        incr treeheight($x) $n
2184    }
2185    foreach e $treecontents($dir) {
2186        set de $dir$e
2187        if {[string index $e end] eq "/"} {
2188            set iy $treeindex($de)
2189            $w mark set d:$iy e:$ix
2190            $w mark gravity d:$iy left
2191            $w insert e:$ix $str
2192            set treediropen($de) 0
2193            $w image create e:$ix -align center -image tri-rt -padx 1 \
2194                -name a:$iy
2195            $w insert e:$ix $e [highlight_tag $de]
2196            $w mark set s:$iy e:$ix
2197            $w mark gravity s:$iy left
2198            set treeheight($de) 1
2199        } else {
2200            $w insert e:$ix $str
2201            $w insert e:$ix $e [highlight_tag $de]
2202        }
2203    }
2204    $w mark gravity e:$ix left
2205    $w conf -state disabled
2206    set treediropen($dir) 1
2207    set top [lindex [split [$w index @0,0] .] 0]
2208    set ht [$w cget -height]
2209    set l [lindex [split [$w index s:$ix] .] 0]
2210    if {$l < $top} {
2211        $w yview $l.0
2212    } elseif {$l + $n + 1 > $top + $ht} {
2213        set top [expr {$l + $n + 2 - $ht}]
2214        if {$l < $top} {
2215            set top $l
2216        }
2217        $w yview $top.0
2218    }
2219}
2220
2221proc treeclick {w x y} {
2222    global treediropen cmitmode ctext cflist cflist_top
2223
2224    if {$cmitmode ne "tree"} return
2225    if {![info exists cflist_top]} return
2226    set l [lindex [split [$w index "@$x,$y"] "."] 0]
2227    $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
2228    $cflist tag add highlight $l.0 "$l.0 lineend"
2229    set cflist_top $l
2230    if {$l == 1} {
2231        $ctext yview 1.0
2232        return
2233    }
2234    set e [linetoelt $l]
2235    if {[string index $e end] ne "/"} {
2236        showfile $e
2237    } elseif {$treediropen($e)} {
2238        treeclosedir $w $e
2239    } else {
2240        treeopendir $w $e
2241    }
2242}
2243
2244proc setfilelist {id} {
2245    global treefilelist cflist
2246
2247    treeview $cflist $treefilelist($id) 0
2248}
2249
2250image create bitmap tri-rt -background black -foreground blue -data {
2251    #define tri-rt_width 13
2252    #define tri-rt_height 13
2253    static unsigned char tri-rt_bits[] = {
2254       0x00, 0x00, 0x00, 0x00, 0x10, 0x00, 0x30, 0x00, 0x70, 0x00, 0xf0, 0x00,
2255       0xf0, 0x01, 0xf0, 0x00, 0x70, 0x00, 0x30, 0x00, 0x10, 0x00, 0x00, 0x00,
2256       0x00, 0x00};
2257} -maskdata {
2258    #define tri-rt-mask_width 13
2259    #define tri-rt-mask_height 13
2260    static unsigned char tri-rt-mask_bits[] = {
2261       0x08, 0x00, 0x18, 0x00, 0x38, 0x00, 0x78, 0x00, 0xf8, 0x00, 0xf8, 0x01,
2262       0xf8, 0x03, 0xf8, 0x01, 0xf8, 0x00, 0x78, 0x00, 0x38, 0x00, 0x18, 0x00,
2263       0x08, 0x00};
2264}
2265image create bitmap tri-dn -background black -foreground blue -data {
2266    #define tri-dn_width 13
2267    #define tri-dn_height 13
2268    static unsigned char tri-dn_bits[] = {
2269       0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x07, 0xf8, 0x03,
2270       0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
2271       0x00, 0x00};
2272} -maskdata {
2273    #define tri-dn-mask_width 13
2274    #define tri-dn-mask_height 13
2275    static unsigned char tri-dn-mask_bits[] = {
2276       0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0x1f, 0xfe, 0x0f, 0xfc, 0x07,
2277       0xf8, 0x03, 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00,
2278       0x00, 0x00};
2279}
2280
2281image create bitmap reficon-T -background black -foreground yellow -data {
2282    #define tagicon_width 13
2283    #define tagicon_height 9
2284    static unsigned char tagicon_bits[] = {
2285       0x00, 0x00, 0x00, 0x00, 0xf0, 0x07, 0xf8, 0x07,
2286       0xfc, 0x07, 0xf8, 0x07, 0xf0, 0x07, 0x00, 0x00, 0x00, 0x00};
2287} -maskdata {
2288    #define tagicon-mask_width 13
2289    #define tagicon-mask_height 9
2290    static unsigned char tagicon-mask_bits[] = {
2291       0x00, 0x00, 0xf0, 0x0f, 0xf8, 0x0f, 0xfc, 0x0f,
2292       0xfe, 0x0f, 0xfc, 0x0f, 0xf8, 0x0f, 0xf0, 0x0f, 0x00, 0x00};
2293}
2294set rectdata {
2295    #define headicon_width 13
2296    #define headicon_height 9
2297    static unsigned char headicon_bits[] = {
2298       0x00, 0x00, 0x00, 0x00, 0xf8, 0x07, 0xf8, 0x07,
2299       0xf8, 0x07, 0xf8, 0x07, 0xf8, 0x07, 0x00, 0x00, 0x00, 0x00};
2300}
2301set rectmask {
2302    #define headicon-mask_width 13
2303    #define headicon-mask_height 9
2304    static unsigned char headicon-mask_bits[] = {
2305       0x00, 0x00, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f,
2306       0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0x00, 0x00};
2307}
2308image create bitmap reficon-H -background black -foreground green \
2309    -data $rectdata -maskdata $rectmask
2310image create bitmap reficon-o -background black -foreground "#ddddff" \
2311    -data $rectdata -maskdata $rectmask
2312
2313proc init_flist {first} {
2314    global cflist cflist_top difffilestart
2315
2316    $cflist conf -state normal
2317    $cflist delete 0.0 end
2318    if {$first ne {}} {
2319        $cflist insert end $first
2320        set cflist_top 1
2321        $cflist tag add highlight 1.0 "1.0 lineend"
2322    } else {
2323        catch {unset cflist_top}
2324    }
2325    $cflist conf -state disabled
2326    set difffilestart {}
2327}
2328
2329proc highlight_tag {f} {
2330    global highlight_paths
2331
2332    foreach p $highlight_paths {
2333        if {[string match $p $f]} {
2334            return "bold"
2335        }
2336    }
2337    return {}
2338}
2339
2340proc highlight_filelist {} {
2341    global cmitmode cflist
2342
2343    $cflist conf -state normal
2344    if {$cmitmode ne "tree"} {
2345        set end [lindex [split [$cflist index end] .] 0]
2346        for {set l 2} {$l < $end} {incr l} {
2347            set line [$cflist get $l.0 "$l.0 lineend"]
2348            if {[highlight_tag $line] ne {}} {
2349                $cflist tag add bold $l.0 "$l.0 lineend"
2350            }
2351        }
2352    } else {
2353        highlight_tree 2 {}
2354    }
2355    $cflist conf -state disabled
2356}
2357
2358proc unhighlight_filelist {} {
2359    global cflist
2360
2361    $cflist conf -state normal
2362    $cflist tag remove bold 1.0 end
2363    $cflist conf -state disabled
2364}
2365
2366proc add_flist {fl} {
2367    global cflist
2368
2369    $cflist conf -state normal
2370    foreach f $fl {
2371        $cflist insert end "\n"
2372        $cflist insert end $f [highlight_tag $f]
2373    }
2374    $cflist conf -state disabled
2375}
2376
2377proc sel_flist {w x y} {
2378    global ctext difffilestart cflist cflist_top cmitmode
2379
2380    if {$cmitmode eq "tree"} return
2381    if {![info exists cflist_top]} return
2382    set l [lindex [split [$w index "@$x,$y"] "."] 0]
2383    $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
2384    $cflist tag add highlight $l.0 "$l.0 lineend"
2385    set cflist_top $l
2386    if {$l == 1} {
2387        $ctext yview 1.0
2388    } else {
2389        catch {$ctext yview [lindex $difffilestart [expr {$l - 2}]]}
2390    }
2391}
2392
2393proc pop_flist_menu {w X Y x y} {
2394    global ctext cflist cmitmode flist_menu flist_menu_file
2395    global treediffs diffids
2396
2397    stopfinding
2398    set l [lindex [split [$w index "@$x,$y"] "."] 0]
2399    if {$l <= 1} return
2400    if {$cmitmode eq "tree"} {
2401        set e [linetoelt $l]
2402        if {[string index $e end] eq "/"} return
2403    } else {
2404        set e [lindex $treediffs($diffids) [expr {$l-2}]]
2405    }
2406    set flist_menu_file $e
2407    tk_popup $flist_menu $X $Y
2408}
2409
2410proc flist_hl {only} {
2411    global flist_menu_file findstring gdttype
2412
2413    set x [shellquote $flist_menu_file]
2414    if {$only || $findstring eq {} || $gdttype ne "touching paths:"} {
2415        set findstring $x
2416    } else {
2417        append findstring " " $x
2418    }
2419    set gdttype "touching paths:"
2420}
2421
2422# Functions for adding and removing shell-type quoting
2423
2424proc shellquote {str} {
2425    if {![string match "*\['\"\\ \t]*" $str]} {
2426        return $str
2427    }
2428    if {![string match "*\['\"\\]*" $str]} {
2429        return "\"$str\""
2430    }
2431    if {![string match "*'*" $str]} {
2432        return "'$str'"
2433    }
2434    return "\"[string map {\" \\\" \\ \\\\} $str]\""
2435}
2436
2437proc shellarglist {l} {
2438    set str {}
2439    foreach a $l {
2440        if {$str ne {}} {
2441            append str " "
2442        }
2443        append str [shellquote $a]
2444    }
2445    return $str
2446}
2447
2448proc shelldequote {str} {
2449    set ret {}
2450    set used -1
2451    while {1} {
2452        incr used
2453        if {![regexp -start $used -indices "\['\"\\\\ \t]" $str first]} {
2454            append ret [string range $str $used end]
2455            set used [string length $str]
2456            break
2457        }
2458        set first [lindex $first 0]
2459        set ch [string index $str $first]
2460        if {$first > $used} {
2461            append ret [string range $str $used [expr {$first - 1}]]
2462            set used $first
2463        }
2464        if {$ch eq " " || $ch eq "\t"} break
2465        incr used
2466        if {$ch eq "'"} {
2467            set first [string first "'" $str $used]
2468            if {$first < 0} {
2469                error "unmatched single-quote"
2470            }
2471            append ret [string range $str $used [expr {$first - 1}]]
2472            set used $first
2473            continue
2474        }
2475        if {$ch eq "\\"} {
2476            if {$used >= [string length $str]} {
2477                error "trailing backslash"
2478            }
2479            append ret [string index $str $used]
2480            continue
2481        }
2482        # here ch == "\""
2483        while {1} {
2484            if {![regexp -start $used -indices "\[\"\\\\]" $str first]} {
2485                error "unmatched double-quote"
2486            }
2487            set first [lindex $first 0]
2488            set ch [string index $str $first]
2489            if {$first > $used} {
2490                append ret [string range $str $used [expr {$first - 1}]]
2491                set used $first
2492            }
2493            if {$ch eq "\""} break
2494            incr used
2495            append ret [string index $str $used]
2496            incr used
2497        }
2498    }
2499    return [list $used $ret]
2500}
2501
2502proc shellsplit {str} {
2503    set l {}
2504    while {1} {
2505        set str [string trimleft $str]
2506        if {$str eq {}} break
2507        set dq [shelldequote $str]
2508        set n [lindex $dq 0]
2509        set word [lindex $dq 1]
2510        set str [string range $str $n end]
2511        lappend l $word
2512    }
2513    return $l
2514}
2515
2516# Code to implement multiple views
2517
2518proc newview {ishighlight} {
2519    global nextviewnum newviewname newviewperm uifont newishighlight
2520    global newviewargs revtreeargs
2521
2522    set newishighlight $ishighlight
2523    set top .gitkview
2524    if {[winfo exists $top]} {
2525        raise $top
2526        return
2527    }
2528    set newviewname($nextviewnum) "View $nextviewnum"
2529    set newviewperm($nextviewnum) 0
2530    set newviewargs($nextviewnum) [shellarglist $revtreeargs]
2531    vieweditor $top $nextviewnum "Gitk view definition"
2532}
2533
2534proc editview {} {
2535    global curview
2536    global viewname viewperm newviewname newviewperm
2537    global viewargs newviewargs
2538
2539    set top .gitkvedit-$curview
2540    if {[winfo exists $top]} {
2541        raise $top
2542        return
2543    }
2544    set newviewname($curview) $viewname($curview)
2545    set newviewperm($curview) $viewperm($curview)
2546    set newviewargs($curview) [shellarglist $viewargs($curview)]
2547    vieweditor $top $curview "Gitk: edit view $viewname($curview)"
2548}
2549
2550proc vieweditor {top n title} {
2551    global newviewname newviewperm viewfiles
2552    global uifont
2553
2554    toplevel $top
2555    wm title $top $title
2556    label $top.nl -text "Name" -font uifont
2557    entry $top.name -width 20 -textvariable newviewname($n) -font uifont
2558    grid $top.nl $top.name -sticky w -pady 5
2559    checkbutton $top.perm -text "Remember this view" -variable newviewperm($n) \
2560        -font uifont
2561    grid $top.perm - -pady 5 -sticky w
2562    message $top.al -aspect 1000 -font uifont \
2563        -text "Commits to include (arguments to git rev-list):"
2564    grid $top.al - -sticky w -pady 5
2565    entry $top.args -width 50 -textvariable newviewargs($n) \
2566        -background white -font uifont
2567    grid $top.args - -sticky ew -padx 5
2568    message $top.l -aspect 1000 -font uifont \
2569        -text "Enter files and directories to include, one per line:"
2570    grid $top.l - -sticky w
2571    text $top.t -width 40 -height 10 -background white -font uifont
2572    if {[info exists viewfiles($n)]} {
2573        foreach f $viewfiles($n) {
2574            $top.t insert end $f
2575            $top.t insert end "\n"
2576        }
2577        $top.t delete {end - 1c} end
2578        $top.t mark set insert 0.0
2579    }
2580    grid $top.t - -sticky ew -padx 5
2581    frame $top.buts
2582    button $top.buts.ok -text "OK" -command [list newviewok $top $n] \
2583        -font uifont
2584    button $top.buts.can -text "Cancel" -command [list destroy $top] \
2585        -font uifont
2586    grid $top.buts.ok $top.buts.can
2587    grid columnconfigure $top.buts 0 -weight 1 -uniform a
2588    grid columnconfigure $top.buts 1 -weight 1 -uniform a
2589    grid $top.buts - -pady 10 -sticky ew
2590    focus $top.t
2591}
2592
2593proc doviewmenu {m first cmd op argv} {
2594    set nmenu [$m index end]
2595    for {set i $first} {$i <= $nmenu} {incr i} {
2596        if {[$m entrycget $i -command] eq $cmd} {
2597            eval $m $op $i $argv
2598            break
2599        }
2600    }
2601}
2602
2603proc allviewmenus {n op args} {
2604    # global viewhlmenu
2605
2606    doviewmenu .bar.view 5 [list showview $n] $op $args
2607    # doviewmenu $viewhlmenu 1 [list addvhighlight $n] $op $args
2608}
2609
2610proc newviewok {top n} {
2611    global nextviewnum newviewperm newviewname newishighlight
2612    global viewname viewfiles viewperm selectedview curview
2613    global viewargs newviewargs viewhlmenu
2614
2615    if {[catch {
2616        set newargs [shellsplit $newviewargs($n)]
2617    } err]} {
2618        error_popup "Error in commit selection arguments: $err"
2619        wm raise $top
2620        focus $top
2621        return
2622    }
2623    set files {}
2624    foreach f [split [$top.t get 0.0 end] "\n"] {
2625        set ft [string trim $f]
2626        if {$ft ne {}} {
2627            lappend files $ft
2628        }
2629    }
2630    if {![info exists viewfiles($n)]} {
2631        # creating a new view
2632        incr nextviewnum
2633        set viewname($n) $newviewname($n)
2634        set viewperm($n) $newviewperm($n)
2635        set viewfiles($n) $files
2636        set viewargs($n) $newargs
2637        addviewmenu $n
2638        if {!$newishighlight} {
2639            run showview $n
2640        } else {
2641            run addvhighlight $n
2642        }
2643    } else {
2644        # editing an existing view
2645        set viewperm($n) $newviewperm($n)
2646        if {$newviewname($n) ne $viewname($n)} {
2647            set viewname($n) $newviewname($n)
2648            doviewmenu .bar.view 5 [list showview $n] \
2649                entryconf [list -label $viewname($n)]
2650            # doviewmenu $viewhlmenu 1 [list addvhighlight $n] \
2651                # entryconf [list -label $viewname($n) -value $viewname($n)]
2652        }
2653        if {$files ne $viewfiles($n) || $newargs ne $viewargs($n)} {
2654            set viewfiles($n) $files
2655            set viewargs($n) $newargs
2656            if {$curview == $n} {
2657                run reloadcommits
2658            }
2659        }
2660    }
2661    catch {destroy $top}
2662}
2663
2664proc delview {} {
2665    global curview viewperm hlview selectedhlview
2666
2667    if {$curview == 0} return
2668    if {[info exists hlview] && $hlview == $curview} {
2669        set selectedhlview None
2670        unset hlview
2671    }
2672    allviewmenus $curview delete
2673    set viewperm($curview) 0
2674    showview 0
2675}
2676
2677proc addviewmenu {n} {
2678    global viewname viewhlmenu
2679
2680    .bar.view add radiobutton -label $viewname($n) \
2681        -command [list showview $n] -variable selectedview -value $n
2682    #$viewhlmenu add radiobutton -label $viewname($n) \
2683    #   -command [list addvhighlight $n] -variable selectedhlview
2684}
2685
2686proc showview {n} {
2687    global curview viewfiles cached_commitrow
2688    global displayorder parentlist rowidlist rowisopt rowfinal
2689    global colormap rowtextx nextcolor canvxmax
2690    global numcommits viewcomplete
2691    global selectedline currentid canv canvy0
2692    global treediffs
2693    global pending_select
2694    global commitidx
2695    global selectedview selectfirst
2696    global hlview selectedhlview commitinterest
2697
2698    if {$n == $curview} return
2699    set selid {}
2700    set ymax [lindex [$canv cget -scrollregion] 3]
2701    set span [$canv yview]
2702    set ytop [expr {[lindex $span 0] * $ymax}]
2703    set ybot [expr {[lindex $span 1] * $ymax}]
2704    set yscreen [expr {($ybot - $ytop) / 2}]
2705    if {[info exists selectedline]} {
2706        set selid $currentid
2707        set y [yc $selectedline]
2708        if {$ytop < $y && $y < $ybot} {
2709            set yscreen [expr {$y - $ytop}]
2710        }
2711    } elseif {[info exists pending_select]} {
2712        set selid $pending_select
2713        unset pending_select
2714    }
2715    unselectline
2716    normalline
2717    catch {unset treediffs}
2718    clear_display
2719    if {[info exists hlview] && $hlview == $n} {
2720        unset hlview
2721        set selectedhlview None
2722    }
2723    catch {unset commitinterest}
2724    catch {unset cached_commitrow}
2725
2726    set curview $n
2727    set selectedview $n
2728    .bar.view entryconf Edit* -state [expr {$n == 0? "disabled": "normal"}]
2729    .bar.view entryconf Delete* -state [expr {$n == 0? "disabled": "normal"}]
2730
2731    run refill_reflist
2732    if {![info exists viewcomplete($n)]} {
2733        if {$selid ne {}} {
2734            set pending_select $selid
2735        }
2736        getcommits
2737        return
2738    }
2739
2740    set displayorder {}
2741    set parentlist {}
2742    set rowidlist {}
2743    set rowisopt {}
2744    set rowfinal {}
2745    set numcommits $commitidx($n)
2746
2747    catch {unset colormap}
2748    catch {unset rowtextx}
2749    set nextcolor 0
2750    set canvxmax [$canv cget -width]
2751    set curview $n
2752    set row 0
2753    setcanvscroll
2754    set yf 0
2755    set row {}
2756    set selectfirst 0
2757    if {$selid ne {} && [commitinview $selid $n]} {
2758        set row [rowofcommit $selid]
2759        # try to get the selected row in the same position on the screen
2760        set ymax [lindex [$canv cget -scrollregion] 3]
2761        set ytop [expr {[yc $row] - $yscreen}]
2762        if {$ytop < 0} {
2763            set ytop 0
2764        }
2765        set yf [expr {$ytop * 1.0 / $ymax}]
2766    }
2767    allcanvs yview moveto $yf
2768    drawvisible
2769    if {$row ne {}} {
2770        selectline $row 0
2771    } elseif {$selid ne {}} {
2772        set pending_select $selid
2773    } else {
2774        set row [first_real_row]
2775        if {$row < $numcommits} {
2776            selectline $row 0
2777        } else {
2778            set selectfirst 1
2779        }
2780    }
2781    if {!$viewcomplete($n)} {
2782        if {$numcommits == 0} {
2783            show_status "Reading commits..."
2784        } else {
2785            run chewcommits $n
2786        }
2787    } elseif {$numcommits == 0} {
2788        show_status "No commits selected"
2789    }
2790}
2791
2792# Stuff relating to the highlighting facility
2793
2794proc ishighlighted {row} {
2795    global vhighlights fhighlights nhighlights rhighlights
2796
2797    if {[info exists nhighlights($row)] && $nhighlights($row) > 0} {
2798        return $nhighlights($row)
2799    }
2800    if {[info exists vhighlights($row)] && $vhighlights($row) > 0} {
2801        return $vhighlights($row)
2802    }
2803    if {[info exists fhighlights($row)] && $fhighlights($row) > 0} {
2804        return $fhighlights($row)
2805    }
2806    if {[info exists rhighlights($row)] && $rhighlights($row) > 0} {
2807        return $rhighlights($row)
2808    }
2809    return 0
2810}
2811
2812proc bolden {row font} {
2813    global canv linehtag selectedline boldrows
2814
2815    lappend boldrows $row
2816    $canv itemconf $linehtag($row) -font $font
2817    if {[info exists selectedline] && $row == $selectedline} {
2818        $canv delete secsel
2819        set t [eval $canv create rect [$canv bbox $linehtag($row)] \
2820                   -outline {{}} -tags secsel \
2821                   -fill [$canv cget -selectbackground]]
2822        $canv lower $t
2823    }
2824}
2825
2826proc bolden_name {row font} {
2827    global canv2 linentag selectedline boldnamerows
2828
2829    lappend boldnamerows $row
2830    $canv2 itemconf $linentag($row) -font $font
2831    if {[info exists selectedline] && $row == $selectedline} {
2832        $canv2 delete secsel
2833        set t [eval $canv2 create rect [$canv2 bbox $linentag($row)] \
2834                   -outline {{}} -tags secsel \
2835                   -fill [$canv2 cget -selectbackground]]
2836        $canv2 lower $t
2837    }
2838}
2839
2840proc unbolden {} {
2841    global boldrows
2842
2843    set stillbold {}
2844    foreach row $boldrows {
2845        if {![ishighlighted $row]} {
2846            bolden $row mainfont
2847        } else {
2848            lappend stillbold $row
2849        }
2850    }
2851    set boldrows $stillbold
2852}
2853
2854proc addvhighlight {n} {
2855    global hlview viewcomplete curview vhl_done vhighlights commitidx
2856
2857    if {[info exists hlview]} {
2858        delvhighlight
2859    }
2860    set hlview $n
2861    if {$n != $curview && ![info exists viewcomplete($n)]} {
2862        start_rev_list $n
2863    }
2864    set vhl_done $commitidx($hlview)
2865    if {$vhl_done > 0} {
2866        drawvisible
2867    }
2868}
2869
2870proc delvhighlight {} {
2871    global hlview vhighlights
2872
2873    if {![info exists hlview]} return
2874    unset hlview
2875    catch {unset vhighlights}
2876    unbolden
2877}
2878
2879proc vhighlightmore {} {
2880    global hlview vhl_done commitidx vhighlights curview
2881
2882    set max $commitidx($hlview)
2883    set vr [visiblerows]
2884    set r0 [lindex $vr 0]
2885    set r1 [lindex $vr 1]
2886    for {set i $vhl_done} {$i < $max} {incr i} {
2887        set id [commitonrow $i $hlview]
2888        if {[commitinview $id $curview]} {
2889            set row [rowofcommit $id]
2890            if {$r0 <= $row && $row <= $r1} {
2891                if {![highlighted $row]} {
2892                    bolden $row mainfontbold
2893                }
2894                set vhighlights($row) 1
2895            }
2896        }
2897    }
2898    set vhl_done $max
2899}
2900
2901proc askvhighlight {row id} {
2902    global hlview vhighlights iddrawn
2903
2904    if {[commitinview $id $hlview]} {
2905        if {[info exists iddrawn($id)] && ![ishighlighted $row]} {
2906            bolden $row mainfontbold
2907        }
2908        set vhighlights($row) 1
2909    } else {
2910        set vhighlights($row) 0
2911    }
2912}
2913
2914proc hfiles_change {} {
2915    global highlight_files filehighlight fhighlights fh_serial
2916    global highlight_paths gdttype
2917
2918    if {[info exists filehighlight]} {
2919        # delete previous highlights
2920        catch {close $filehighlight}
2921        unset filehighlight
2922        catch {unset fhighlights}
2923        unbolden
2924        unhighlight_filelist
2925    }
2926    set highlight_paths {}
2927    after cancel do_file_hl $fh_serial
2928    incr fh_serial
2929    if {$highlight_files ne {}} {
2930        after 300 do_file_hl $fh_serial
2931    }
2932}
2933
2934proc gdttype_change {name ix op} {
2935    global gdttype highlight_files findstring findpattern
2936
2937    stopfinding
2938    if {$findstring ne {}} {
2939        if {$gdttype eq "containing:"} {
2940            if {$highlight_files ne {}} {
2941                set highlight_files {}
2942                hfiles_change
2943            }
2944            findcom_change
2945        } else {
2946            if {$findpattern ne {}} {
2947                set findpattern {}
2948                findcom_change
2949            }
2950            set highlight_files $findstring
2951            hfiles_change
2952        }
2953        drawvisible
2954    }
2955    # enable/disable findtype/findloc menus too
2956}
2957
2958proc find_change {name ix op} {
2959    global gdttype findstring highlight_files
2960
2961    stopfinding
2962    if {$gdttype eq "containing:"} {
2963        findcom_change
2964    } else {
2965        if {$highlight_files ne $findstring} {
2966            set highlight_files $findstring
2967            hfiles_change
2968        }
2969    }
2970    drawvisible
2971}
2972
2973proc findcom_change args {
2974    global nhighlights boldnamerows
2975    global findpattern findtype findstring gdttype
2976
2977    stopfinding
2978    # delete previous highlights, if any
2979    foreach row $boldnamerows {
2980        bolden_name $row mainfont
2981    }
2982    set boldnamerows {}
2983    catch {unset nhighlights}
2984    unbolden
2985    unmarkmatches
2986    if {$gdttype ne "containing:" || $findstring eq {}} {
2987        set findpattern {}
2988    } elseif {$findtype eq "Regexp"} {
2989        set findpattern $findstring
2990    } else {
2991        set e [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} \
2992                   $findstring]
2993        set findpattern "*$e*"
2994    }
2995}
2996
2997proc makepatterns {l} {
2998    set ret {}
2999    foreach e $l {
3000        set ee [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} $e]
3001        if {[string index $ee end] eq "/"} {
3002            lappend ret "$ee*"
3003        } else {
3004            lappend ret $ee
3005            lappend ret "$ee/*"
3006        }
3007    }
3008    return $ret
3009}
3010
3011proc do_file_hl {serial} {
3012    global highlight_files filehighlight highlight_paths gdttype fhl_list
3013
3014    if {$gdttype eq "touching paths:"} {
3015        if {[catch {set paths [shellsplit $highlight_files]}]} return
3016        set highlight_paths [makepatterns $paths]
3017        highlight_filelist
3018        set gdtargs [concat -- $paths]
3019    } elseif {$gdttype eq "adding/removing string:"} {
3020        set gdtargs [list "-S$highlight_files"]
3021    } else {
3022        # must be "containing:", i.e. we're searching commit info
3023        return
3024    }
3025    set cmd [concat | git diff-tree -r -s --stdin $gdtargs]
3026    set filehighlight [open $cmd r+]
3027    fconfigure $filehighlight -blocking 0
3028    filerun $filehighlight readfhighlight
3029    set fhl_list {}
3030    drawvisible
3031    flushhighlights
3032}
3033
3034proc flushhighlights {} {
3035    global filehighlight fhl_list
3036
3037    if {[info exists filehighlight]} {
3038        lappend fhl_list {}
3039        puts $filehighlight ""
3040        flush $filehighlight
3041    }
3042}
3043
3044proc askfilehighlight {row id} {
3045    global filehighlight fhighlights fhl_list
3046
3047    lappend fhl_list $id
3048    set fhighlights($row) -1
3049    puts $filehighlight $id
3050}
3051
3052proc readfhighlight {} {
3053    global filehighlight fhighlights curview iddrawn
3054    global fhl_list find_dirn
3055
3056    if {![info exists filehighlight]} {
3057        return 0
3058    }
3059    set nr 0
3060    while {[incr nr] <= 100 && [gets $filehighlight line] >= 0} {
3061        set line [string trim $line]
3062        set i [lsearch -exact $fhl_list $line]
3063        if {$i < 0} continue
3064        for {set j 0} {$j < $i} {incr j} {
3065            set id [lindex $fhl_list $j]
3066            if {[commitinview $id $curview]} {
3067                set fhighlights([rowofcommit $id]) 0
3068            }
3069        }
3070        set fhl_list [lrange $fhl_list [expr {$i+1}] end]
3071        if {$line eq {}} continue
3072        if {![commitinview $line $curview]} continue
3073        set row [rowofcommit $line]
3074        if {[info exists iddrawn($line)] && ![ishighlighted $row]} {
3075            bolden $row mainfontbold
3076        }
3077        set fhighlights($row) 1
3078    }
3079    if {[eof $filehighlight]} {
3080        # strange...
3081        puts "oops, git diff-tree died"
3082        catch {close $filehighlight}
3083        unset filehighlight
3084        return 0
3085    }
3086    if {[info exists find_dirn]} {
3087        run findmore
3088    }
3089    return 1
3090}
3091
3092proc doesmatch {f} {
3093    global findtype findpattern
3094
3095    if {$findtype eq "Regexp"} {
3096        return [regexp $findpattern $f]
3097    } elseif {$findtype eq "IgnCase"} {
3098        return [string match -nocase $findpattern $f]
3099    } else {
3100        return [string match $findpattern $f]
3101    }
3102}
3103
3104proc askfindhighlight {row id} {
3105    global nhighlights commitinfo iddrawn
3106    global findloc
3107    global markingmatches
3108
3109    if {![info exists commitinfo($id)]} {
3110        getcommit $id
3111    }
3112    set info $commitinfo($id)
3113    set isbold 0
3114    set fldtypes {Headline Author Date Committer CDate Comments}
3115    foreach f $info ty $fldtypes {
3116        if {($findloc eq "All fields" || $findloc eq $ty) &&
3117            [doesmatch $f]} {
3118            if {$ty eq "Author"} {
3119                set isbold 2
3120                break
3121            }
3122            set isbold 1
3123        }
3124    }
3125    if {$isbold && [info exists iddrawn($id)]} {
3126        if {![ishighlighted $row]} {
3127            bolden $row mainfontbold
3128            if {$isbold > 1} {
3129                bolden_name $row mainfontbold
3130            }
3131        }
3132        if {$markingmatches} {
3133            markrowmatches $row $id
3134        }
3135    }
3136    set nhighlights($row) $isbold
3137}
3138
3139proc markrowmatches {row id} {
3140    global canv canv2 linehtag linentag commitinfo findloc
3141
3142    set headline [lindex $commitinfo($id) 0]
3143    set author [lindex $commitinfo($id) 1]
3144    $canv delete match$row
3145    $canv2 delete match$row
3146    if {$findloc eq "All fields" || $findloc eq "Headline"} {
3147        set m [findmatches $headline]
3148        if {$m ne {}} {
3149            markmatches $canv $row $headline $linehtag($row) $m \
3150                [$canv itemcget $linehtag($row) -font] $row
3151        }
3152    }
3153    if {$findloc eq "All fields" || $findloc eq "Author"} {
3154        set m [findmatches $author]
3155        if {$m ne {}} {
3156            markmatches $canv2 $row $author $linentag($row) $m \
3157                [$canv2 itemcget $linentag($row) -font] $row
3158        }
3159    }
3160}
3161
3162proc vrel_change {name ix op} {
3163    global highlight_related
3164
3165    rhighlight_none
3166    if {$highlight_related ne "None"} {
3167        run drawvisible
3168    }
3169}
3170
3171# prepare for testing whether commits are descendents or ancestors of a
3172proc rhighlight_sel {a} {
3173    global descendent desc_todo ancestor anc_todo
3174    global highlight_related rhighlights
3175
3176    catch {unset descendent}
3177    set desc_todo [list $a]
3178    catch {unset ancestor}
3179    set anc_todo [list $a]
3180    if {$highlight_related ne "None"} {
3181        rhighlight_none
3182        run drawvisible
3183    }
3184}
3185
3186proc rhighlight_none {} {
3187    global rhighlights
3188
3189    catch {unset rhighlights}
3190    unbolden
3191}
3192
3193proc is_descendent {a} {
3194    global curview children descendent desc_todo
3195
3196    set v $curview
3197    set la [rowofcommit $a]
3198    set todo $desc_todo
3199    set leftover {}
3200    set done 0
3201    for {set i 0} {$i < [llength $todo]} {incr i} {
3202        set do [lindex $todo $i]
3203        if {[rowofcommit $do] < $la} {
3204            lappend leftover $do
3205            continue
3206        }
3207        foreach nk $children($v,$do) {
3208            if {![info exists descendent($nk)]} {
3209                set descendent($nk) 1
3210                lappend todo $nk
3211                if {$nk eq $a} {
3212                    set done 1
3213                }
3214            }
3215        }
3216        if {$done} {
3217            set desc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
3218            return
3219        }
3220    }
3221    set descendent($a) 0
3222    set desc_todo $leftover
3223}
3224
3225proc is_ancestor {a} {
3226    global curview parents ancestor anc_todo
3227
3228    set v $curview
3229    set la [rowofcommit $a]
3230    set todo $anc_todo
3231    set leftover {}
3232    set done 0
3233    for {set i 0} {$i < [llength $todo]} {incr i} {
3234        set do [lindex $todo $i]
3235        if {![commitinview $do $v] || [rowofcommit $do] > $la} {
3236            lappend leftover $do
3237            continue
3238        }
3239        foreach np $parents($v,$do) {
3240            if {![info exists ancestor($np)]} {
3241                set ancestor($np) 1
3242                lappend todo $np
3243                if {$np eq $a} {
3244                    set done 1
3245                }
3246            }
3247        }
3248        if {$done} {
3249            set anc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
3250            return
3251        }
3252    }
3253    set ancestor($a) 0
3254    set anc_todo $leftover
3255}
3256
3257proc askrelhighlight {row id} {
3258    global descendent highlight_related iddrawn rhighlights
3259    global selectedline ancestor
3260
3261    if {![info exists selectedline]} return
3262    set isbold 0
3263    if {$highlight_related eq "Descendent" ||
3264        $highlight_related eq "Not descendent"} {
3265        if {![info exists descendent($id)]} {
3266            is_descendent $id
3267        }
3268        if {$descendent($id) == ($highlight_related eq "Descendent")} {
3269            set isbold 1
3270        }
3271    } elseif {$highlight_related eq "Ancestor" ||
3272              $highlight_related eq "Not ancestor"} {
3273        if {![info exists ancestor($id)]} {
3274            is_ancestor $id
3275        }
3276        if {$ancestor($id) == ($highlight_related eq "Ancestor")} {
3277            set isbold 1
3278        }
3279    }
3280    if {[info exists iddrawn($id)]} {
3281        if {$isbold && ![ishighlighted $row]} {
3282            bolden $row mainfontbold
3283        }
3284    }
3285    set rhighlights($row) $isbold
3286}
3287
3288# Graph layout functions
3289
3290proc shortids {ids} {
3291    set res {}
3292    foreach id $ids {
3293        if {[llength $id] > 1} {
3294            lappend res [shortids $id]
3295        } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
3296            lappend res [string range $id 0 7]
3297        } else {
3298            lappend res $id
3299        }
3300    }
3301    return $res
3302}
3303
3304proc ntimes {n o} {
3305    set ret {}
3306    set o [list $o]
3307    for {set mask 1} {$mask <= $n} {incr mask $mask} {
3308        if {($n & $mask) != 0} {
3309            set ret [concat $ret $o]
3310        }
3311        set o [concat $o $o]
3312    }
3313    return $ret
3314}
3315
3316# Work out where id should go in idlist so that order-token
3317# values increase from left to right
3318proc idcol {idlist id {i 0}} {
3319    global ordertok curview
3320
3321    set t $ordertok($curview,$id)
3322    if {$i >= [llength $idlist] ||
3323        $t < $ordertok($curview,[lindex $idlist $i])} {
3324        if {$i > [llength $idlist]} {
3325            set i [llength $idlist]
3326        }
3327        while {[incr i -1] >= 0 &&
3328               $t < $ordertok($curview,[lindex $idlist $i])} {}
3329        incr i
3330    } else {
3331        if {$t > $ordertok($curview,[lindex $idlist $i])} {
3332            while {[incr i] < [llength $idlist] &&
3333                   $t >= $ordertok($curview,[lindex $idlist $i])} {}
3334        }
3335    }
3336    return $i
3337}
3338
3339proc initlayout {} {
3340    global rowidlist rowisopt rowfinal displayorder parentlist
3341    global numcommits canvxmax canv
3342    global nextcolor
3343    global colormap rowtextx
3344    global selectfirst
3345
3346    set numcommits 0
3347    set displayorder {}
3348    set parentlist {}
3349    set nextcolor 0
3350    set rowidlist {}
3351    set rowisopt {}
3352    set rowfinal {}
3353    set canvxmax [$canv cget -width]
3354    catch {unset colormap}
3355    catch {unset rowtextx}
3356    set selectfirst 1
3357}
3358
3359proc setcanvscroll {} {
3360    global canv canv2 canv3 numcommits linespc canvxmax canvy0
3361
3362    set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
3363    $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
3364    $canv2 conf -scrollregion [list 0 0 0 $ymax]
3365    $canv3 conf -scrollregion [list 0 0 0 $ymax]
3366}
3367
3368proc visiblerows {} {
3369    global canv numcommits linespc
3370
3371    set ymax [lindex [$canv cget -scrollregion] 3]
3372    if {$ymax eq {} || $ymax == 0} return
3373    set f [$canv yview]
3374    set y0 [expr {int([lindex $f 0] * $ymax)}]
3375    set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
3376    if {$r0 < 0} {
3377        set r0 0
3378    }
3379    set y1 [expr {int([lindex $f 1] * $ymax)}]
3380    set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
3381    if {$r1 >= $numcommits} {
3382        set r1 [expr {$numcommits - 1}]
3383    }
3384    return [list $r0 $r1]
3385}
3386
3387proc layoutmore {} {
3388    global commitidx viewcomplete curview
3389    global numcommits pending_select selectedline curview
3390    global selectfirst lastscrollset commitinterest
3391
3392    set canshow $commitidx($curview)
3393    if {$canshow <= $numcommits && !$viewcomplete($curview)} return
3394    if {$numcommits == 0} {
3395        allcanvs delete all
3396    }
3397    set r0 $numcommits
3398    set prev $numcommits
3399    set numcommits $canshow
3400    set t [clock clicks -milliseconds]
3401    if {$prev < 100 || $viewcomplete($curview) || $t - $lastscrollset > 500} {
3402        set lastscrollset $t
3403        setcanvscroll
3404    }
3405    set rows [visiblerows]
3406    set r1 [lindex $rows 1]
3407    if {$r1 >= $canshow} {
3408        set r1 [expr {$canshow - 1}]
3409    }
3410    if {$r0 <= $r1} {
3411        drawcommits $r0 $r1
3412    }
3413    if {[info exists pending_select] &&
3414        [commitinview $pending_select $curview]} {
3415        selectline [rowofcommit $pending_select] 1
3416    }
3417    if {$selectfirst} {
3418        if {[info exists selectedline] || [info exists pending_select]} {
3419            set selectfirst 0
3420        } else {
3421            set l [first_real_row]
3422            selectline $l 1
3423            set selectfirst 0
3424        }
3425    }
3426}
3427
3428proc doshowlocalchanges {} {
3429    global curview mainheadid
3430
3431    if {[commitinview $mainheadid $curview]} {
3432        dodiffindex
3433    } else {
3434        lappend commitinterest($mainheadid) {dodiffindex}
3435    }
3436}
3437
3438proc dohidelocalchanges {} {
3439    global nullid nullid2 lserial curview
3440
3441    if {[commitinview $nullid $curview]} {
3442        removerow $nullid $curview
3443    }
3444    if {[commitinview $nullid2 $curview]} {
3445        removerow $nullid2 $curview
3446    }
3447    incr lserial
3448}
3449
3450# spawn off a process to do git diff-index --cached HEAD
3451proc dodiffindex {} {
3452    global lserial showlocalchanges
3453
3454    if {!$showlocalchanges} return
3455    incr lserial
3456    set fd [open "|git diff-index --cached HEAD" r]
3457    fconfigure $fd -blocking 0
3458    filerun $fd [list readdiffindex $fd $lserial]
3459}
3460
3461proc readdiffindex {fd serial} {
3462    global mainheadid nullid2 curview commitinfo commitdata lserial
3463
3464    set isdiff 1
3465    if {[gets $fd line] < 0} {
3466        if {![eof $fd]} {
3467            return 1
3468        }
3469        set isdiff 0
3470    }
3471    # we only need to see one line and we don't really care what it says...
3472    close $fd
3473
3474    # now see if there are any local changes not checked in to the index
3475    if {$serial == $lserial} {
3476        set fd [open "|git diff-files" r]
3477        fconfigure $fd -blocking 0
3478        filerun $fd [list readdifffiles $fd $serial]
3479    }
3480
3481    if {$isdiff && $serial == $lserial && ![commitinview $nullid2 $curview]} {
3482        # add the line for the changes in the index to the graph
3483        set hl "Local changes checked in to index but not committed"
3484        set commitinfo($nullid2) [list  $hl {} {} {} {} "    $hl\n"]
3485        set commitdata($nullid2) "\n    $hl\n"
3486        insertrow $nullid2 $mainheadid $curview
3487    }
3488    return 0
3489}
3490
3491proc readdifffiles {fd serial} {
3492    global mainheadid nullid nullid2 curview
3493    global commitinfo commitdata lserial
3494
3495    set isdiff 1
3496    if {[gets $fd line] < 0} {
3497        if {![eof $fd]} {
3498            return 1
3499        }
3500        set isdiff 0
3501    }
3502    # we only need to see one line and we don't really care what it says...
3503    close $fd
3504
3505    if {$isdiff && $serial == $lserial && ![commitinview $nullid $curview]} {
3506        # add the line for the local diff to the graph
3507        set hl "Local uncommitted changes, not checked in to index"
3508        set commitinfo($nullid) [list  $hl {} {} {} {} "    $hl\n"]
3509        set commitdata($nullid) "\n    $hl\n"
3510        if {[commitinview $nullid2 $curview]} {
3511            set p $nullid2
3512        } else {
3513            set p $mainheadid
3514        }
3515        insertrow $nullid $p $curview
3516    }
3517    return 0
3518}
3519
3520proc nextuse {id row} {
3521    global curview children
3522
3523    if {[info exists children($curview,$id)]} {
3524        foreach kid $children($curview,$id) {
3525            if {![commitinview $kid $curview]} {
3526                return -1
3527            }
3528            if {[rowofcommit $kid] > $row} {
3529                return [rowofcommit $kid]
3530            }
3531        }
3532    }
3533    if {[commitinview $id $curview]} {
3534        return [rowofcommit $id]
3535    }
3536    return -1
3537}
3538
3539proc prevuse {id row} {
3540    global curview children
3541
3542    set ret -1
3543    if {[info exists children($curview,$id)]} {
3544        foreach kid $children($curview,$id) {
3545            if {![commitinview $kid $curview]} break
3546            if {[rowofcommit $kid] < $row} {
3547                set ret [rowofcommit $kid]
3548            }
3549        }
3550    }
3551    return $ret
3552}
3553
3554proc make_idlist {row} {
3555    global displayorder parentlist uparrowlen downarrowlen mingaplen
3556    global commitidx curview ordertok children
3557
3558    set r [expr {$row - $mingaplen - $downarrowlen - 1}]
3559    if {$r < 0} {
3560        set r 0
3561    }
3562    set ra [expr {$row - $downarrowlen}]
3563    if {$ra < 0} {
3564        set ra 0
3565    }
3566    set rb [expr {$row + $uparrowlen}]
3567    if {$rb > $commitidx($curview)} {
3568        set rb $commitidx($curview)
3569    }
3570    make_disporder $r [expr {$rb + 1}]
3571    set ids {}
3572    for {} {$r < $ra} {incr r} {
3573        set nextid [lindex $displayorder [expr {$r + 1}]]
3574        foreach p [lindex $parentlist $r] {
3575            if {$p eq $nextid} continue
3576            set rn [nextuse $p $r]
3577            if {$rn >= $row &&
3578                $rn <= $r + $downarrowlen + $mingaplen + $uparrowlen} {
3579                lappend ids [list $ordertok($curview,$p) $p]
3580            }
3581        }
3582    }
3583    for {} {$r < $row} {incr r} {
3584        set nextid [lindex $displayorder [expr {$r + 1}]]
3585        foreach p [lindex $parentlist $r] {
3586            if {$p eq $nextid} continue
3587            set rn [nextuse $p $r]
3588            if {$rn < 0 || $rn >= $row} {
3589                lappend ids [list $ordertok($curview,$p) $p]
3590            }
3591        }
3592    }
3593    set id [lindex $displayorder $row]
3594    lappend ids [list $ordertok($curview,$id) $id]
3595    while {$r < $rb} {
3596        foreach p [lindex $parentlist $r] {
3597            set firstkid [lindex $children($curview,$p) 0]
3598            if {[rowofcommit $firstkid] < $row} {
3599                lappend ids [list $ordertok($curview,$p) $p]
3600            }
3601        }
3602        incr r
3603        set id [lindex $displayorder $r]
3604        if {$id ne {}} {
3605            set firstkid [lindex $children($curview,$id) 0]
3606            if {$firstkid ne {} && [rowofcommit $firstkid] < $row} {
3607                lappend ids [list $ordertok($curview,$id) $id]
3608            }
3609        }
3610    }
3611    set idlist {}
3612    foreach idx [lsort -unique $ids] {
3613        lappend idlist [lindex $idx 1]
3614    }
3615    return $idlist
3616}
3617
3618proc rowsequal {a b} {
3619    while {[set i [lsearch -exact $a {}]] >= 0} {
3620        set a [lreplace $a $i $i]
3621    }
3622    while {[set i [lsearch -exact $b {}]] >= 0} {
3623        set b [lreplace $b $i $i]
3624    }
3625    return [expr {$a eq $b}]
3626}
3627
3628proc makeupline {id row rend col} {
3629    global rowidlist uparrowlen downarrowlen mingaplen
3630
3631    for {set r $rend} {1} {set r $rstart} {
3632        set rstart [prevuse $id $r]
3633        if {$rstart < 0} return
3634        if {$rstart < $row} break
3635    }
3636    if {$rstart + $uparrowlen + $mingaplen + $downarrowlen < $rend} {
3637        set rstart [expr {$rend - $uparrowlen - 1}]
3638    }
3639    for {set r $rstart} {[incr r] <= $row} {} {
3640        set idlist [lindex $rowidlist $r]
3641        if {$idlist ne {} && [lsearch -exact $idlist $id] < 0} {
3642            set col [idcol $idlist $id $col]
3643            lset rowidlist $r [linsert $idlist $col $id]
3644            changedrow $r
3645        }
3646    }
3647}
3648
3649proc layoutrows {row endrow} {
3650    global rowidlist rowisopt rowfinal displayorder
3651    global uparrowlen downarrowlen maxwidth mingaplen
3652    global children parentlist
3653    global commitidx viewcomplete curview
3654
3655    make_disporder [expr {$row - 1}] [expr {$endrow + $uparrowlen}]
3656    set idlist {}
3657    if {$row > 0} {
3658        set rm1 [expr {$row - 1}]
3659        foreach id [lindex $rowidlist $rm1] {
3660            if {$id ne {}} {
3661                lappend idlist $id
3662            }
3663        }
3664        set final [lindex $rowfinal $rm1]
3665    }
3666    for {} {$row < $endrow} {incr row} {
3667        set rm1 [expr {$row - 1}]
3668        if {$rm1 < 0 || $idlist eq {}} {
3669            set idlist [make_idlist $row]
3670            set final 1
3671        } else {
3672            set id [lindex $displayorder $rm1]
3673            set col [lsearch -exact $idlist $id]
3674            set idlist [lreplace $idlist $col $col]
3675            foreach p [lindex $parentlist $rm1] {
3676                if {[lsearch -exact $idlist $p] < 0} {
3677                    set col [idcol $idlist $p $col]
3678                    set idlist [linsert $idlist $col $p]
3679                    # if not the first child, we have to insert a line going up
3680                    if {$id ne [lindex $children($curview,$p) 0]} {
3681                        makeupline $p $rm1 $row $col
3682                    }
3683                }
3684            }
3685            set id [lindex $displayorder $row]
3686            if {$row > $downarrowlen} {
3687                set termrow [expr {$row - $downarrowlen - 1}]
3688                foreach p [lindex $parentlist $termrow] {
3689                    set i [lsearch -exact $idlist $p]
3690                    if {$i < 0} continue
3691                    set nr [nextuse $p $termrow]
3692                    if {$nr < 0 || $nr >= $row + $mingaplen + $uparrowlen} {
3693                        set idlist [lreplace $idlist $i $i]
3694                    }
3695                }
3696            }
3697            set col [lsearch -exact $idlist $id]
3698            if {$col < 0} {
3699                set col [idcol $idlist $id]
3700                set idlist [linsert $idlist $col $id]
3701                if {$children($curview,$id) ne {}} {
3702                    makeupline $id $rm1 $row $col
3703                }
3704            }
3705            set r [expr {$row + $uparrowlen - 1}]
3706            if {$r < $commitidx($curview)} {
3707                set x $col
3708                foreach p [lindex $parentlist $r] {
3709                    if {[lsearch -exact $idlist $p] >= 0} continue
3710                    set fk [lindex $children($curview,$p) 0]
3711                    if {[rowofcommit $fk] < $row} {
3712                        set x [idcol $idlist $p $x]
3713                        set idlist [linsert $idlist $x $p]
3714                    }
3715                }
3716                if {[incr r] < $commitidx($curview)} {
3717                    set p [lindex $displayorder $r]
3718                    if {[lsearch -exact $idlist $p] < 0} {
3719                        set fk [lindex $children($curview,$p) 0]
3720                        if {$fk ne {} && [rowofcommit $fk] < $row} {
3721                            set x [idcol $idlist $p $x]
3722                            set idlist [linsert $idlist $x $p]
3723                        }
3724                    }
3725                }
3726            }
3727        }
3728        if {$final && !$viewcomplete($curview) &&
3729            $row + $uparrowlen + $mingaplen + $downarrowlen
3730                >= $commitidx($curview)} {
3731            set final 0
3732        }
3733        set l [llength $rowidlist]
3734        if {$row == $l} {
3735            lappend rowidlist $idlist
3736            lappend rowisopt 0
3737            lappend rowfinal $final
3738        } elseif {$row < $l} {
3739            if {![rowsequal $idlist [lindex $rowidlist $row]]} {
3740                lset rowidlist $row $idlist
3741                changedrow $row
3742            }
3743            lset rowfinal $row $final
3744        } else {
3745            set pad [ntimes [expr {$row - $l}] {}]
3746            set rowidlist [concat $rowidlist $pad]
3747            lappend rowidlist $idlist
3748            set rowfinal [concat $rowfinal $pad]
3749            lappend rowfinal $final
3750            set rowisopt [concat $rowisopt [ntimes [expr {$row - $l + 1}] 0]]
3751        }
3752    }
3753    return $row
3754}
3755
3756proc changedrow {row} {
3757    global displayorder iddrawn rowisopt need_redisplay
3758
3759    set l [llength $rowisopt]
3760    if {$row < $l} {
3761        lset rowisopt $row 0
3762        if {$row + 1 < $l} {
3763            lset rowisopt [expr {$row + 1}] 0
3764            if {$row + 2 < $l} {
3765                lset rowisopt [expr {$row + 2}] 0
3766            }
3767        }
3768    }
3769    set id [lindex $displayorder $row]
3770    if {[info exists iddrawn($id)]} {
3771        set need_redisplay 1
3772    }
3773}
3774
3775proc insert_pad {row col npad} {
3776    global rowidlist
3777
3778    set pad [ntimes $npad {}]
3779    set idlist [lindex $rowidlist $row]
3780    set bef [lrange $idlist 0 [expr {$col - 1}]]
3781    set aft [lrange $idlist $col end]
3782    set i [lsearch -exact $aft {}]
3783    if {$i > 0} {
3784        set aft [lreplace $aft $i $i]
3785    }
3786    lset rowidlist $row [concat $bef $pad $aft]
3787    changedrow $row
3788}
3789
3790proc optimize_rows {row col endrow} {
3791    global rowidlist rowisopt displayorder curview children
3792
3793    if {$row < 1} {
3794        set row 1
3795    }
3796    for {} {$row < $endrow} {incr row; set col 0} {
3797        if {[lindex $rowisopt $row]} continue
3798        set haspad 0
3799        set y0 [expr {$row - 1}]
3800        set ym [expr {$row - 2}]
3801        set idlist [lindex $rowidlist $row]
3802        set previdlist [lindex $rowidlist $y0]
3803        if {$idlist eq {} || $previdlist eq {}} continue
3804        if {$ym >= 0} {
3805            set pprevidlist [lindex $rowidlist $ym]
3806            if {$pprevidlist eq {}} continue
3807        } else {
3808            set pprevidlist {}
3809        }
3810        set x0 -1
3811        set xm -1
3812        for {} {$col < [llength $idlist]} {incr col} {
3813            set id [lindex $idlist $col]
3814            if {[lindex $previdlist $col] eq $id} continue
3815            if {$id eq {}} {
3816                set haspad 1
3817                continue
3818            }
3819            set x0 [lsearch -exact $previdlist $id]
3820            if {$x0 < 0} continue
3821            set z [expr {$x0 - $col}]
3822            set isarrow 0
3823            set z0 {}
3824            if {$ym >= 0} {
3825                set xm [lsearch -exact $pprevidlist $id]
3826                if {$xm >= 0} {
3827                    set z0 [expr {$xm - $x0}]
3828                }
3829            }
3830            if {$z0 eq {}} {
3831                # if row y0 is the first child of $id then it's not an arrow
3832                if {[lindex $children($curview,$id) 0] ne
3833                    [lindex $displayorder $y0]} {
3834                    set isarrow 1
3835                }
3836            }
3837            if {!$isarrow && $id ne [lindex $displayorder $row] &&
3838                [lsearch -exact [lindex $rowidlist [expr {$row+1}]] $id] < 0} {
3839                set isarrow 1
3840            }
3841            # Looking at lines from this row to the previous row,
3842            # make them go straight up if they end in an arrow on
3843            # the previous row; otherwise make them go straight up
3844            # or at 45 degrees.
3845            if {$z < -1 || ($z < 0 && $isarrow)} {
3846                # Line currently goes left too much;
3847                # insert pads in the previous row, then optimize it
3848                set npad [expr {-1 - $z + $isarrow}]
3849                insert_pad $y0 $x0 $npad
3850                if {$y0 > 0} {
3851                    optimize_rows $y0 $x0 $row
3852                }
3853                set previdlist [lindex $rowidlist $y0]
3854                set x0 [lsearch -exact $previdlist $id]
3855                set z [expr {$x0 - $col}]
3856                if {$z0 ne {}} {
3857                    set pprevidlist [lindex $rowidlist $ym]
3858                    set xm [lsearch -exact $pprevidlist $id]
3859                    set z0 [expr {$xm - $x0}]
3860                }
3861            } elseif {$z > 1 || ($z > 0 && $isarrow)} {
3862                # Line currently goes right too much;
3863                # insert pads in this line
3864                set npad [expr {$z - 1 + $isarrow}]
3865                insert_pad $row $col $npad
3866                set idlist [lindex $rowidlist $row]
3867                incr col $npad
3868                set z [expr {$x0 - $col}]
3869                set haspad 1
3870            }
3871            if {$z0 eq {} && !$isarrow && $ym >= 0} {
3872                # this line links to its first child on row $row-2
3873                set id [lindex $displayorder $ym]
3874                set xc [lsearch -exact $pprevidlist $id]
3875                if {$xc >= 0} {
3876                    set z0 [expr {$xc - $x0}]
3877                }
3878            }
3879            # avoid lines jigging left then immediately right
3880            if {$z0 ne {} && $z < 0 && $z0 > 0} {
3881                insert_pad $y0 $x0 1
3882                incr x0
3883                optimize_rows $y0 $x0 $row
3884                set previdlist [lindex $rowidlist $y0]
3885            }
3886        }
3887        if {!$haspad} {
3888            # Find the first column that doesn't have a line going right
3889            for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
3890                set id [lindex $idlist $col]
3891                if {$id eq {}} break
3892                set x0 [lsearch -exact $previdlist $id]
3893                if {$x0 < 0} {
3894                    # check if this is the link to the first child
3895                    set kid [lindex $displayorder $y0]
3896                    if {[lindex $children($curview,$id) 0] eq $kid} {
3897                        # it is, work out offset to child
3898                        set x0 [lsearch -exact $previdlist $kid]
3899                    }
3900                }
3901                if {$x0 <= $col} break
3902            }
3903            # Insert a pad at that column as long as it has a line and
3904            # isn't the last column
3905            if {$x0 >= 0 && [incr col] < [llength $idlist]} {
3906                set idlist [linsert $idlist $col {}]
3907                lset rowidlist $row $idlist
3908                changedrow $row
3909            }
3910        }
3911    }
3912}
3913
3914proc xc {row col} {
3915    global canvx0 linespc
3916    return [expr {$canvx0 + $col * $linespc}]
3917}
3918
3919proc yc {row} {
3920    global canvy0 linespc
3921    return [expr {$canvy0 + $row * $linespc}]
3922}
3923
3924proc linewidth {id} {
3925    global thickerline lthickness
3926
3927    set wid $lthickness
3928    if {[info exists thickerline] && $id eq $thickerline} {
3929        set wid [expr {2 * $lthickness}]
3930    }
3931    return $wid
3932}
3933
3934proc rowranges {id} {
3935    global curview children uparrowlen downarrowlen
3936    global rowidlist
3937
3938    set kids $children($curview,$id)
3939    if {$kids eq {}} {
3940        return {}
3941    }
3942    set ret {}
3943    lappend kids $id
3944    foreach child $kids {
3945        if {![commitinview $child $curview]} break
3946        set row [rowofcommit $child]
3947        if {![info exists prev]} {
3948            lappend ret [expr {$row + 1}]
3949        } else {
3950            if {$row <= $prevrow} {
3951                puts "oops children of [shortids $id] out of order [shortids $child] $row <= [shortids $prev] $prevrow"
3952            }
3953            # see if the line extends the whole way from prevrow to row
3954            if {$row > $prevrow + $uparrowlen + $downarrowlen &&
3955                [lsearch -exact [lindex $rowidlist \
3956                            [expr {int(($row + $prevrow) / 2)}]] $id] < 0} {
3957                # it doesn't, see where it ends
3958                set r [expr {$prevrow + $downarrowlen}]
3959                if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
3960                    while {[incr r -1] > $prevrow &&
3961                           [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
3962                } else {
3963                    while {[incr r] <= $row &&
3964                           [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
3965                    incr r -1
3966                }
3967                lappend ret $r
3968                # see where it starts up again
3969                set r [expr {$row - $uparrowlen}]
3970                if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
3971                    while {[incr r] < $row &&
3972                           [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
3973                } else {
3974                    while {[incr r -1] >= $prevrow &&
3975                           [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
3976                    incr r
3977                }
3978                lappend ret $r
3979            }
3980        }
3981        if {$child eq $id} {
3982            lappend ret $row
3983        }
3984        set prev $child
3985        set prevrow $row
3986    }
3987    return $ret
3988}
3989
3990proc drawlineseg {id row endrow arrowlow} {
3991    global rowidlist displayorder iddrawn linesegs
3992    global canv colormap linespc curview maxlinelen parentlist
3993
3994    set cols [list [lsearch -exact [lindex $rowidlist $row] $id]]
3995    set le [expr {$row + 1}]
3996    set arrowhigh 1
3997    while {1} {
3998        set c [lsearch -exact [lindex $rowidlist $le] $id]
3999        if {$c < 0} {
4000            incr le -1
4001            break
4002        }
4003        lappend cols $c
4004        set x [lindex $displayorder $le]
4005        if {$x eq $id} {
4006            set arrowhigh 0
4007            break
4008        }
4009        if {[info exists iddrawn($x)] || $le == $endrow} {
4010            set c [lsearch -exact [lindex $rowidlist [expr {$le+1}]] $id]
4011            if {$c >= 0} {
4012                lappend cols $c
4013                set arrowhigh 0
4014            }
4015            break
4016        }
4017        incr le
4018    }
4019    if {$le <= $row} {
4020        return $row
4021    }
4022
4023    set lines {}
4024    set i 0
4025    set joinhigh 0
4026    if {[info exists linesegs($id)]} {
4027        set lines $linesegs($id)
4028        foreach li $lines {
4029            set r0 [lindex $li 0]
4030            if {$r0 > $row} {
4031                if {$r0 == $le && [lindex $li 1] - $row <= $maxlinelen} {
4032                    set joinhigh 1
4033                }
4034                break
4035            }
4036            incr i
4037        }
4038    }
4039    set joinlow 0
4040    if {$i > 0} {
4041        set li [lindex $lines [expr {$i-1}]]
4042        set r1 [lindex $li 1]
4043        if {$r1 == $row && $le - [lindex $li 0] <= $maxlinelen} {
4044            set joinlow 1
4045        }
4046    }
4047
4048    set x [lindex $cols [expr {$le - $row}]]
4049    set xp [lindex $cols [expr {$le - 1 - $row}]]
4050    set dir [expr {$xp - $x}]
4051    if {$joinhigh} {
4052        set ith [lindex $lines $i 2]
4053        set coords [$canv coords $ith]
4054        set ah [$canv itemcget $ith -arrow]
4055        set arrowhigh [expr {$ah eq "first" || $ah eq "both"}]
4056        set x2 [lindex $cols [expr {$le + 1 - $row}]]
4057        if {$x2 ne {} && $x - $x2 == $dir} {
4058            set coords [lrange $coords 0 end-2]
4059        }
4060    } else {
4061        set coords [list [xc $le $x] [yc $le]]
4062    }
4063    if {$joinlow} {
4064        set itl [lindex $lines [expr {$i-1}] 2]
4065        set al [$canv itemcget $itl -arrow]
4066        set arrowlow [expr {$al eq "last" || $al eq "both"}]
4067    } elseif {$arrowlow} {
4068        if {[lsearch -exact [lindex $rowidlist [expr {$row-1}]] $id] >= 0 ||
4069            [lsearch -exact [lindex $parentlist [expr {$row-1}]] $id] >= 0} {
4070            set arrowlow 0
4071        }
4072    }
4073    set arrow [lindex {none first last both} [expr {$arrowhigh + 2*$arrowlow}]]
4074    for {set y $le} {[incr y -1] > $row} {} {
4075        set x $xp
4076        set xp [lindex $cols [expr {$y - 1 - $row}]]
4077        set ndir [expr {$xp - $x}]
4078        if {$dir != $ndir || $xp < 0} {
4079            lappend coords [xc $y $x] [yc $y]
4080        }
4081        set dir $ndir
4082    }
4083    if {!$joinlow} {
4084        if {$xp < 0} {
4085            # join parent line to first child
4086            set ch [lindex $displayorder $row]
4087            set xc [lsearch -exact [lindex $rowidlist $row] $ch]
4088            if {$xc < 0} {
4089                puts "oops: drawlineseg: child $ch not on row $row"
4090            } elseif {$xc != $x} {
4091                if {($arrowhigh && $le == $row + 1) || $dir == 0} {
4092                    set d [expr {int(0.5 * $linespc)}]
4093                    set x1 [xc $row $x]
4094                    if {$xc < $x} {
4095                        set x2 [expr {$x1 - $d}]
4096                    } else {
4097                        set x2 [expr {$x1 + $d}]
4098                    }
4099                    set y2 [yc $row]
4100                    set y1 [expr {$y2 + $d}]
4101                    lappend coords $x1 $y1 $x2 $y2
4102                } elseif {$xc < $x - 1} {
4103                    lappend coords [xc $row [expr {$x-1}]] [yc $row]
4104                } elseif {$xc > $x + 1} {
4105                    lappend coords [xc $row [expr {$x+1}]] [yc $row]
4106                }
4107                set x $xc
4108            }
4109            lappend coords [xc $row $x] [yc $row]
4110        } else {
4111            set xn [xc $row $xp]
4112            set yn [yc $row]
4113            lappend coords $xn $yn
4114        }
4115        if {!$joinhigh} {
4116            assigncolor $id
4117            set t [$canv create line $coords -width [linewidth $id] \
4118                       -fill $colormap($id) -tags lines.$id -arrow $arrow]
4119            $canv lower $t
4120            bindline $t $id
4121            set lines [linsert $lines $i [list $row $le $t]]
4122        } else {
4123            $canv coords $ith $coords
4124            if {$arrow ne $ah} {
4125                $canv itemconf $ith -arrow $arrow
4126            }
4127            lset lines $i 0 $row
4128        }
4129    } else {
4130        set xo [lsearch -exact [lindex $rowidlist [expr {$row - 1}]] $id]
4131        set ndir [expr {$xo - $xp}]
4132        set clow [$canv coords $itl]
4133        if {$dir == $ndir} {
4134            set clow [lrange $clow 2 end]
4135        }
4136        set coords [concat $coords $clow]
4137        if {!$joinhigh} {
4138            lset lines [expr {$i-1}] 1 $le
4139        } else {
4140            # coalesce two pieces
4141            $canv delete $ith
4142            set b [lindex $lines [expr {$i-1}] 0]
4143            set e [lindex $lines $i 1]
4144            set lines [lreplace $lines [expr {$i-1}] $i [list $b $e $itl]]
4145        }
4146        $canv coords $itl $coords
4147        if {$arrow ne $al} {
4148            $canv itemconf $itl -arrow $arrow
4149        }
4150    }
4151
4152    set linesegs($id) $lines
4153    return $le
4154}
4155
4156proc drawparentlinks {id row} {
4157    global rowidlist canv colormap curview parentlist
4158    global idpos linespc
4159
4160    set rowids [lindex $rowidlist $row]
4161    set col [lsearch -exact $rowids $id]
4162    if {$col < 0} return
4163    set olds [lindex $parentlist $row]
4164    set row2 [expr {$row + 1}]
4165    set x [xc $row $col]
4166    set y [yc $row]
4167    set y2 [yc $row2]
4168    set d [expr {int(0.5 * $linespc)}]
4169    set ymid [expr {$y + $d}]
4170    set ids [lindex $rowidlist $row2]
4171    # rmx = right-most X coord used
4172    set rmx 0
4173    foreach p $olds {
4174        set i [lsearch -exact $ids $p]
4175        if {$i < 0} {
4176            puts "oops, parent $p of $id not in list"
4177            continue
4178        }
4179        set x2 [xc $row2 $i]
4180        if {$x2 > $rmx} {
4181            set rmx $x2
4182        }
4183        set j [lsearch -exact $rowids $p]
4184        if {$j < 0} {
4185            # drawlineseg will do this one for us
4186            continue
4187        }
4188        assigncolor $p
4189        # should handle duplicated parents here...
4190        set coords [list $x $y]
4191        if {$i != $col} {
4192            # if attaching to a vertical segment, draw a smaller
4193            # slant for visual distinctness
4194            if {$i == $j} {
4195                if {$i < $col} {
4196                    lappend coords [expr {$x2 + $d}] $y $x2 $ymid
4197                } else {
4198                    lappend coords [expr {$x2 - $d}] $y $x2 $ymid
4199                }
4200            } elseif {$i < $col && $i < $j} {
4201                # segment slants towards us already
4202                lappend coords [xc $row $j] $y
4203            } else {
4204                if {$i < $col - 1} {
4205                    lappend coords [expr {$x2 + $linespc}] $y
4206                } elseif {$i > $col + 1} {
4207                    lappend coords [expr {$x2 - $linespc}] $y
4208                }
4209                lappend coords $x2 $y2
4210            }
4211        } else {
4212            lappend coords $x2 $y2
4213        }
4214        set t [$canv create line $coords -width [linewidth $p] \
4215                   -fill $colormap($p) -tags lines.$p]
4216        $canv lower $t
4217        bindline $t $p
4218    }
4219    if {$rmx > [lindex $idpos($id) 1]} {
4220        lset idpos($id) 1 $rmx
4221        redrawtags $id
4222    }
4223}
4224
4225proc drawlines {id} {
4226    global canv
4227
4228    $canv itemconf lines.$id -width [linewidth $id]
4229}
4230
4231proc drawcmittext {id row col} {
4232    global linespc canv canv2 canv3 fgcolor curview
4233    global cmitlisted commitinfo rowidlist parentlist
4234    global rowtextx idpos idtags idheads idotherrefs
4235    global linehtag linentag linedtag selectedline
4236    global canvxmax boldrows boldnamerows fgcolor nullid nullid2
4237
4238    # listed is 0 for boundary, 1 for normal, 2 for left, 3 for right
4239    set listed $cmitlisted($curview,$id)
4240    if {$id eq $nullid} {
4241        set ofill red
4242    } elseif {$id eq $nullid2} {
4243        set ofill green
4244    } else {
4245        set ofill [expr {$listed != 0? "blue": "white"}]
4246    }
4247    set x [xc $row $col]
4248    set y [yc $row]
4249    set orad [expr {$linespc / 3}]
4250    if {$listed <= 1} {
4251        set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
4252                   [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
4253                   -fill $ofill -outline $fgcolor -width 1 -tags circle]
4254    } elseif {$listed == 2} {
4255        # triangle pointing left for left-side commits
4256        set t [$canv create polygon \
4257                   [expr {$x - $orad}] $y \
4258                   [expr {$x + $orad - 1}] [expr {$y - $orad}] \
4259                   [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
4260                   -fill $ofill -outline $fgcolor -width 1 -tags circle]
4261    } else {
4262        # triangle pointing right for right-side commits
4263        set t [$canv create polygon \
4264                   [expr {$x + $orad - 1}] $y \
4265                   [expr {$x - $orad}] [expr {$y - $orad}] \
4266                   [expr {$x - $orad}] [expr {$y + $orad - 1}] \
4267                   -fill $ofill -outline $fgcolor -width 1 -tags circle]
4268    }
4269    $canv raise $t
4270    $canv bind $t <1> {selcanvline {} %x %y}
4271    set rmx [llength [lindex $rowidlist $row]]
4272    set olds [lindex $parentlist $row]
4273    if {$olds ne {}} {
4274        set nextids [lindex $rowidlist [expr {$row + 1}]]
4275        foreach p $olds {
4276            set i [lsearch -exact $nextids $p]
4277            if {$i > $rmx} {
4278                set rmx $i
4279            }
4280        }
4281    }
4282    set xt [xc $row $rmx]
4283    set rowtextx($row) $xt
4284    set idpos($id) [list $x $xt $y]
4285    if {[info exists idtags($id)] || [info exists idheads($id)]
4286        || [info exists idotherrefs($id)]} {
4287        set xt [drawtags $id $x $xt $y]
4288    }
4289    set headline [lindex $commitinfo($id) 0]
4290    set name [lindex $commitinfo($id) 1]
4291    set date [lindex $commitinfo($id) 2]
4292    set date [formatdate $date]
4293    set font mainfont
4294    set nfont mainfont
4295    set isbold [ishighlighted $row]
4296    if {$isbold > 0} {
4297        lappend boldrows $row
4298        set font mainfontbold
4299        if {$isbold > 1} {
4300            lappend boldnamerows $row
4301            set nfont mainfontbold
4302        }
4303    }
4304    set linehtag($row) [$canv create text $xt $y -anchor w -fill $fgcolor \
4305                            -text $headline -font $font -tags text]
4306    $canv bind $linehtag($row) <Button-3> "rowmenu %X %Y $id"
4307    set linentag($row) [$canv2 create text 3 $y -anchor w -fill $fgcolor \
4308                            -text $name -font $nfont -tags text]
4309    set linedtag($row) [$canv3 create text 3 $y -anchor w -fill $fgcolor \
4310                            -text $date -font mainfont -tags text]
4311    if {[info exists selectedline] && $selectedline == $row} {
4312        make_secsel $row
4313    }
4314    set xr [expr {$xt + [font measure $font $headline]}]
4315    if {$xr > $canvxmax} {
4316        set canvxmax $xr
4317        setcanvscroll
4318    }
4319}
4320
4321proc drawcmitrow {row} {
4322    global displayorder rowidlist nrows_drawn
4323    global iddrawn markingmatches
4324    global commitinfo numcommits
4325    global filehighlight fhighlights findpattern nhighlights
4326    global hlview vhighlights
4327    global highlight_related rhighlights
4328
4329    if {$row >= $numcommits} return
4330
4331    set id [lindex $displayorder $row]
4332    if {[info exists hlview] && ![info exists vhighlights($row)]} {
4333        askvhighlight $row $id
4334    }
4335    if {[info exists filehighlight] && ![info exists fhighlights($row)]} {
4336        askfilehighlight $row $id
4337    }
4338    if {$findpattern ne {} && ![info exists nhighlights($row)]} {
4339        askfindhighlight $row $id
4340    }
4341    if {$highlight_related ne "None" && ![info exists rhighlights($row)]} {
4342        askrelhighlight $row $id
4343    }
4344    if {![info exists iddrawn($id)]} {
4345        set col [lsearch -exact [lindex $rowidlist $row] $id]
4346        if {$col < 0} {
4347            puts "oops, row $row id $id not in list"
4348            return
4349        }
4350        if {![info exists commitinfo($id)]} {
4351            getcommit $id
4352        }
4353        assigncolor $id
4354        drawcmittext $id $row $col
4355        set iddrawn($id) 1
4356        incr nrows_drawn
4357    }
4358    if {$markingmatches} {
4359        markrowmatches $row $id
4360    }
4361}
4362
4363proc drawcommits {row {endrow {}}} {
4364    global numcommits iddrawn displayorder curview need_redisplay
4365    global parentlist rowidlist rowfinal uparrowlen downarrowlen nrows_drawn
4366
4367    if {$row < 0} {
4368        set row 0
4369    }
4370    if {$endrow eq {}} {
4371        set endrow $row
4372    }
4373    if {$endrow >= $numcommits} {
4374        set endrow [expr {$numcommits - 1}]
4375    }
4376
4377    set rl1 [expr {$row - $downarrowlen - 3}]
4378    if {$rl1 < 0} {
4379        set rl1 0
4380    }
4381    set ro1 [expr {$row - 3}]
4382    if {$ro1 < 0} {
4383        set ro1 0
4384    }
4385    set r2 [expr {$endrow + $uparrowlen + 3}]
4386    if {$r2 > $numcommits} {
4387        set r2 $numcommits
4388    }
4389    for {set r $rl1} {$r < $r2} {incr r} {
4390        if {[lindex $rowidlist $r] ne {} && [lindex $rowfinal $r]} {
4391            if {$rl1 < $r} {
4392                layoutrows $rl1 $r
4393            }
4394            set rl1 [expr {$r + 1}]
4395        }
4396    }
4397    if {$rl1 < $r} {
4398        layoutrows $rl1 $r
4399    }
4400    optimize_rows $ro1 0 $r2
4401    if {$need_redisplay || $nrows_drawn > 2000} {
4402        clear_display
4403        drawvisible
4404    }
4405
4406    # make the lines join to already-drawn rows either side
4407    set r [expr {$row - 1}]
4408    if {$r < 0 || ![info exists iddrawn([lindex $displayorder $r])]} {
4409        set r $row
4410    }
4411    set er [expr {$endrow + 1}]
4412    if {$er >= $numcommits ||
4413        ![info exists iddrawn([lindex $displayorder $er])]} {
4414        set er $endrow
4415    }
4416    for {} {$r <= $er} {incr r} {
4417        set id [lindex $displayorder $r]
4418        set wasdrawn [info exists iddrawn($id)]
4419        drawcmitrow $r
4420        if {$r == $er} break
4421        set nextid [lindex $displayorder [expr {$r + 1}]]
4422        if {$wasdrawn && [info exists iddrawn($nextid)]} continue
4423        drawparentlinks $id $r
4424
4425        set rowids [lindex $rowidlist $r]
4426        foreach lid $rowids {
4427            if {$lid eq {}} continue
4428            if {[info exists lineend($lid)] && $lineend($lid) > $r} continue
4429            if {$lid eq $id} {
4430                # see if this is the first child of any of its parents
4431                foreach p [lindex $parentlist $r] {
4432                    if {[lsearch -exact $rowids $p] < 0} {
4433                        # make this line extend up to the child
4434                        set lineend($p) [drawlineseg $p $r $er 0]
4435                    }
4436                }
4437            } else {
4438                set lineend($lid) [drawlineseg $lid $r $er 1]
4439            }
4440        }
4441    }
4442}
4443
4444proc undolayout {row} {
4445    global uparrowlen mingaplen downarrowlen
4446    global rowidlist rowisopt rowfinal need_redisplay
4447
4448    set r [expr {$row - ($uparrowlen + $mingaplen + $downarrowlen)}]
4449    if {$r < 0} {
4450        set r 0
4451    }
4452    if {[llength $rowidlist] > $r} {
4453        incr r -1
4454        set rowidlist [lrange $rowidlist 0 $r]
4455        set rowfinal [lrange $rowfinal 0 $r]
4456        set rowisopt [lrange $rowisopt 0 $r]
4457        set need_redisplay 1
4458        run drawvisible
4459    }
4460}
4461
4462proc drawfrac {f0 f1} {
4463    global canv linespc
4464
4465    set ymax [lindex [$canv cget -scrollregion] 3]
4466    if {$ymax eq {} || $ymax == 0} return
4467    set y0 [expr {int($f0 * $ymax)}]
4468    set row [expr {int(($y0 - 3) / $linespc) - 1}]
4469    set y1 [expr {int($f1 * $ymax)}]
4470    set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
4471    drawcommits $row $endrow
4472}
4473
4474proc drawvisible {} {
4475    global canv
4476    eval drawfrac [$canv yview]
4477}
4478
4479proc clear_display {} {
4480    global iddrawn linesegs need_redisplay nrows_drawn
4481    global vhighlights fhighlights nhighlights rhighlights
4482
4483    allcanvs delete all
4484    catch {unset iddrawn}
4485    catch {unset linesegs}
4486    catch {unset vhighlights}
4487    catch {unset fhighlights}
4488    catch {unset nhighlights}
4489    catch {unset rhighlights}
4490    set need_redisplay 0
4491    set nrows_drawn 0
4492}
4493
4494proc findcrossings {id} {
4495    global rowidlist parentlist numcommits displayorder
4496
4497    set cross {}
4498    set ccross {}
4499    foreach {s e} [rowranges $id] {
4500        if {$e >= $numcommits} {
4501            set e [expr {$numcommits - 1}]
4502        }
4503        if {$e <= $s} continue
4504        for {set row $e} {[incr row -1] >= $s} {} {
4505            set x [lsearch -exact [lindex $rowidlist $row] $id]
4506            if {$x < 0} break
4507            set olds [lindex $parentlist $row]
4508            set kid [lindex $displayorder $row]
4509            set kidx [lsearch -exact [lindex $rowidlist $row] $kid]
4510            if {$kidx < 0} continue
4511            set nextrow [lindex $rowidlist [expr {$row + 1}]]
4512            foreach p $olds {
4513                set px [lsearch -exact $nextrow $p]
4514                if {$px < 0} continue
4515                if {($kidx < $x && $x < $px) || ($px < $x && $x < $kidx)} {
4516                    if {[lsearch -exact $ccross $p] >= 0} continue
4517                    if {$x == $px + ($kidx < $px? -1: 1)} {
4518                        lappend ccross $p
4519                    } elseif {[lsearch -exact $cross $p] < 0} {
4520                        lappend cross $p
4521                    }
4522                }
4523            }
4524        }
4525    }
4526    return [concat $ccross {{}} $cross]
4527}
4528
4529proc assigncolor {id} {
4530    global colormap colors nextcolor
4531    global parents children children curview
4532
4533    if {[info exists colormap($id)]} return
4534    set ncolors [llength $colors]
4535    if {[info exists children($curview,$id)]} {
4536        set kids $children($curview,$id)
4537    } else {
4538        set kids {}
4539    }
4540    if {[llength $kids] == 1} {
4541        set child [lindex $kids 0]
4542        if {[info exists colormap($child)]
4543            && [llength $parents($curview,$child)] == 1} {
4544            set colormap($id) $colormap($child)
4545            return
4546        }
4547    }
4548    set badcolors {}
4549    set origbad {}
4550    foreach x [findcrossings $id] {
4551        if {$x eq {}} {
4552            # delimiter between corner crossings and other crossings
4553            if {[llength $badcolors] >= $ncolors - 1} break
4554            set origbad $badcolors
4555        }
4556        if {[info exists colormap($x)]
4557            && [lsearch -exact $badcolors $colormap($x)] < 0} {
4558            lappend badcolors $colormap($x)
4559        }
4560    }
4561    if {[llength $badcolors] >= $ncolors} {
4562        set badcolors $origbad
4563    }
4564    set origbad $badcolors
4565    if {[llength $badcolors] < $ncolors - 1} {
4566        foreach child $kids {
4567            if {[info exists colormap($child)]
4568                && [lsearch -exact $badcolors $colormap($child)] < 0} {
4569                lappend badcolors $colormap($child)
4570            }
4571            foreach p $parents($curview,$child) {
4572                if {[info exists colormap($p)]
4573                    && [lsearch -exact $badcolors $colormap($p)] < 0} {
4574                    lappend badcolors $colormap($p)
4575                }
4576            }
4577        }
4578        if {[llength $badcolors] >= $ncolors} {
4579            set badcolors $origbad
4580        }
4581    }
4582    for {set i 0} {$i <= $ncolors} {incr i} {
4583        set c [lindex $colors $nextcolor]
4584        if {[incr nextcolor] >= $ncolors} {
4585            set nextcolor 0
4586        }
4587        if {[lsearch -exact $badcolors $c]} break
4588    }
4589    set colormap($id) $c
4590}
4591
4592proc bindline {t id} {
4593    global canv
4594
4595    $canv bind $t <Enter> "lineenter %x %y $id"
4596    $canv bind $t <Motion> "linemotion %x %y $id"
4597    $canv bind $t <Leave> "lineleave $id"
4598    $canv bind $t <Button-1> "lineclick %x %y $id 1"
4599}
4600
4601proc drawtags {id x xt y1} {
4602    global idtags idheads idotherrefs mainhead
4603    global linespc lthickness
4604    global canv rowtextx curview fgcolor bgcolor
4605
4606    set marks {}
4607    set ntags 0
4608    set nheads 0
4609    if {[info exists idtags($id)]} {
4610        set marks $idtags($id)
4611        set ntags [llength $marks]
4612    }
4613    if {[info exists idheads($id)]} {
4614        set marks [concat $marks $idheads($id)]
4615        set nheads [llength $idheads($id)]
4616    }
4617    if {[info exists idotherrefs($id)]} {
4618        set marks [concat $marks $idotherrefs($id)]
4619    }
4620    if {$marks eq {}} {
4621        return $xt
4622    }
4623
4624    set delta [expr {int(0.5 * ($linespc - $lthickness))}]
4625    set yt [expr {$y1 - 0.5 * $linespc}]
4626    set yb [expr {$yt + $linespc - 1}]
4627    set xvals {}
4628    set wvals {}
4629    set i -1
4630    foreach tag $marks {
4631        incr i
4632        if {$i >= $ntags && $i < $ntags + $nheads && $tag eq $mainhead} {
4633            set wid [font measure mainfontbold $tag]
4634        } else {
4635            set wid [font measure mainfont $tag]
4636        }
4637        lappend xvals $xt
4638        lappend wvals $wid
4639        set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
4640    }
4641    set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
4642               -width $lthickness -fill black -tags tag.$id]
4643    $canv lower $t
4644    foreach tag $marks x $xvals wid $wvals {
4645        set xl [expr {$x + $delta}]
4646        set xr [expr {$x + $delta + $wid + $lthickness}]
4647        set font mainfont
4648        if {[incr ntags -1] >= 0} {
4649            # draw a tag
4650            set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
4651                       $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
4652                       -width 1 -outline black -fill yellow -tags tag.$id]
4653            $canv bind $t <1> [list showtag $tag 1]
4654            set rowtextx([rowofcommit $id]) [expr {$xr + $linespc}]
4655        } else {
4656            # draw a head or other ref
4657            if {[incr nheads -1] >= 0} {
4658                set col green
4659                if {$tag eq $mainhead} {
4660                    set font mainfontbold
4661                }
4662            } else {
4663                set col "#ddddff"
4664            }
4665            set xl [expr {$xl - $delta/2}]
4666            $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
4667                -width 1 -outline black -fill $col -tags tag.$id
4668            if {[regexp {^(remotes/.*/|remotes/)} $tag match remoteprefix]} {
4669                set rwid [font measure mainfont $remoteprefix]
4670                set xi [expr {$x + 1}]
4671                set yti [expr {$yt + 1}]
4672                set xri [expr {$x + $rwid}]
4673                $canv create polygon $xi $yti $xri $yti $xri $yb $xi $yb \
4674                        -width 0 -fill "#ffddaa" -tags tag.$id
4675            }
4676        }
4677        set t [$canv create text $xl $y1 -anchor w -text $tag -fill $fgcolor \
4678                   -font $font -tags [list tag.$id text]]
4679        if {$ntags >= 0} {
4680            $canv bind $t <1> [list showtag $tag 1]
4681        } elseif {$nheads >= 0} {
4682            $canv bind $t <Button-3> [list headmenu %X %Y $id $tag]
4683        }
4684    }
4685    return $xt
4686}
4687
4688proc xcoord {i level ln} {
4689    global canvx0 xspc1 xspc2
4690
4691    set x [expr {$canvx0 + $i * $xspc1($ln)}]
4692    if {$i > 0 && $i == $level} {
4693        set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
4694    } elseif {$i > $level} {
4695        set x [expr {$x + $xspc2 - $xspc1($ln)}]
4696    }
4697    return $x
4698}
4699
4700proc show_status {msg} {
4701    global canv fgcolor
4702
4703    clear_display
4704    $canv create text 3 3 -anchor nw -text $msg -font mainfont \
4705        -tags text -fill $fgcolor
4706}
4707
4708# Don't change the text pane cursor if it is currently the hand cursor,
4709# showing that we are over a sha1 ID link.
4710proc settextcursor {c} {
4711    global ctext curtextcursor
4712
4713    if {[$ctext cget -cursor] == $curtextcursor} {
4714        $ctext config -cursor $c
4715    }
4716    set curtextcursor $c
4717}
4718
4719proc nowbusy {what {name {}}} {
4720    global isbusy busyname statusw
4721
4722    if {[array names isbusy] eq {}} {
4723        . config -cursor watch
4724        settextcursor watch
4725    }
4726    set isbusy($what) 1
4727    set busyname($what) $name
4728    if {$name ne {}} {
4729        $statusw conf -text $name
4730    }
4731}
4732
4733proc notbusy {what} {
4734    global isbusy maincursor textcursor busyname statusw
4735
4736    catch {
4737        unset isbusy($what)
4738        if {$busyname($what) ne {} &&
4739            [$statusw cget -text] eq $busyname($what)} {
4740            $statusw conf -text {}
4741        }
4742    }
4743    if {[array names isbusy] eq {}} {
4744        . config -cursor $maincursor
4745        settextcursor $textcursor
4746    }
4747}
4748
4749proc findmatches {f} {
4750    global findtype findstring
4751    if {$findtype == "Regexp"} {
4752        set matches [regexp -indices -all -inline $findstring $f]
4753    } else {
4754        set fs $findstring
4755        if {$findtype == "IgnCase"} {
4756            set f [string tolower $f]
4757            set fs [string tolower $fs]
4758        }
4759        set matches {}
4760        set i 0
4761        set l [string length $fs]
4762        while {[set j [string first $fs $f $i]] >= 0} {
4763            lappend matches [list $j [expr {$j+$l-1}]]
4764            set i [expr {$j + $l}]
4765        }
4766    }
4767    return $matches
4768}
4769
4770proc dofind {{dirn 1} {wrap 1}} {
4771    global findstring findstartline findcurline selectedline numcommits
4772    global gdttype filehighlight fh_serial find_dirn findallowwrap
4773
4774    if {[info exists find_dirn]} {
4775        if {$find_dirn == $dirn} return
4776        stopfinding
4777    }
4778    focus .
4779    if {$findstring eq {} || $numcommits == 0} return
4780    if {![info exists selectedline]} {
4781        set findstartline [lindex [visiblerows] [expr {$dirn < 0}]]
4782    } else {
4783        set findstartline $selectedline
4784    }
4785    set findcurline $findstartline
4786    nowbusy finding "Searching"
4787    if {$gdttype ne "containing:" && ![info exists filehighlight]} {
4788        after cancel do_file_hl $fh_serial
4789        do_file_hl $fh_serial
4790    }
4791    set find_dirn $dirn
4792    set findallowwrap $wrap
4793    run findmore
4794}
4795
4796proc stopfinding {} {
4797    global find_dirn findcurline fprogcoord
4798
4799    if {[info exists find_dirn]} {
4800        unset find_dirn
4801        unset findcurline
4802        notbusy finding
4803        set fprogcoord 0
4804        adjustprogress
4805    }
4806}
4807
4808proc findmore {} {
4809    global commitdata commitinfo numcommits findpattern findloc
4810    global findstartline findcurline findallowwrap
4811    global find_dirn gdttype fhighlights fprogcoord
4812    global curview varcorder vrownum varccommits
4813
4814    if {![info exists find_dirn]} {
4815        return 0
4816    }
4817    set fldtypes {Headline Author Date Committer CDate Comments}
4818    set l $findcurline
4819    set moretodo 0
4820    if {$find_dirn > 0} {
4821        incr l
4822        if {$l >= $numcommits} {
4823            set l 0
4824        }
4825        if {$l <= $findstartline} {
4826            set lim [expr {$findstartline + 1}]
4827        } else {
4828            set lim $numcommits
4829            set moretodo $findallowwrap
4830        }
4831    } else {
4832        if {$l == 0} {
4833            set l $numcommits
4834        }
4835        incr l -1
4836        if {$l >= $findstartline} {
4837            set lim [expr {$findstartline - 1}]
4838        } else {
4839            set lim -1
4840            set moretodo $findallowwrap
4841        }
4842    }
4843    set n [expr {($lim - $l) * $find_dirn}]
4844    if {$n > 500} {
4845        set n 500
4846        set moretodo 1
4847    }
4848    set found 0
4849    set domore 1
4850    set ai [bsearch $vrownum($curview) $l]
4851    set a [lindex $varcorder($curview) $ai]
4852    set arow [lindex $vrownum($curview) $ai]
4853    set ids [lindex $varccommits($curview,$a)]
4854    set arowend [expr {$arow + [llength $ids]}]
4855    if {$gdttype eq "containing:"} {
4856        for {} {$n > 0} {incr n -1; incr l $find_dirn} {
4857            if {$l < $arow || $l >= $arowend} {
4858                incr ai $find_dirn
4859                set a [lindex $varcorder($curview) $ai]
4860                set arow [lindex $vrownum($curview) $ai]
4861                set ids [lindex $varccommits($curview,$a)]
4862                set arowend [expr {$arow + [llength $ids]}]
4863            }
4864            set id [lindex $ids [expr {$l - $arow}]]
4865            # shouldn't happen unless git log doesn't give all the commits...
4866            if {![info exists commitdata($id)] ||
4867                ![doesmatch $commitdata($id)]} {
4868                continue
4869            }
4870            if {![info exists commitinfo($id)]} {
4871                getcommit $id
4872            }
4873            set info $commitinfo($id)
4874            foreach f $info ty $fldtypes {
4875                if {($findloc eq "All fields" || $findloc eq $ty) &&
4876                    [doesmatch $f]} {
4877                    set found 1
4878                    break
4879                }
4880            }
4881            if {$found} break
4882        }
4883    } else {
4884        for {} {$n > 0} {incr n -1; incr l $find_dirn} {
4885            if {$l < $arow || $l >= $arowend} {
4886                incr ai $find_dirn
4887                set a [lindex $varcorder($curview) $ai]
4888                set arow [lindex $vrownum($curview) $ai]
4889                set ids [lindex $varccommits($curview,$a)]
4890                set arowend [expr {$arow + [llength $ids]}]
4891            }
4892            set id [lindex $ids [expr {$l - $arow}]]
4893            if {![info exists fhighlights($l)]} {
4894                askfilehighlight $l $id
4895                if {$domore} {
4896                    set domore 0
4897                    set findcurline [expr {$l - $find_dirn}]
4898                }
4899            } elseif {$fhighlights($l)} {
4900                set found $domore
4901                break
4902            }
4903        }
4904    }
4905    if {$found || ($domore && !$moretodo)} {
4906        unset findcurline
4907        unset find_dirn
4908        notbusy finding
4909        set fprogcoord 0
4910        adjustprogress
4911        if {$found} {
4912            findselectline $l
4913        } else {
4914            bell
4915        }
4916        return 0
4917    }
4918    if {!$domore} {
4919        flushhighlights
4920    } else {
4921        set findcurline [expr {$l - $find_dirn}]
4922    }
4923    set n [expr {($findcurline - $findstartline) * $find_dirn - 1}]
4924    if {$n < 0} {
4925        incr n $numcommits
4926    }
4927    set fprogcoord [expr {$n * 1.0 / $numcommits}]
4928    adjustprogress
4929    return $domore
4930}
4931
4932proc findselectline {l} {
4933    global findloc commentend ctext findcurline markingmatches gdttype
4934
4935    set markingmatches 1
4936    set findcurline $l
4937    selectline $l 1
4938    if {$findloc == "All fields" || $findloc == "Comments"} {
4939        # highlight the matches in the comments
4940        set f [$ctext get 1.0 $commentend]
4941        set matches [findmatches $f]
4942        foreach match $matches {
4943            set start [lindex $match 0]
4944            set end [expr {[lindex $match 1] + 1}]
4945            $ctext tag add found "1.0 + $start c" "1.0 + $end c"
4946        }
4947    }
4948    drawvisible
4949}
4950
4951# mark the bits of a headline or author that match a find string
4952proc markmatches {canv l str tag matches font row} {
4953    global selectedline
4954
4955    set bbox [$canv bbox $tag]
4956    set x0 [lindex $bbox 0]
4957    set y0 [lindex $bbox 1]
4958    set y1 [lindex $bbox 3]
4959    foreach match $matches {
4960        set start [lindex $match 0]
4961        set end [lindex $match 1]
4962        if {$start > $end} continue
4963        set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
4964        set xlen [font measure $font [string range $str 0 [expr {$end}]]]
4965        set t [$canv create rect [expr {$x0+$xoff}] $y0 \
4966                   [expr {$x0+$xlen+2}] $y1 \
4967                   -outline {} -tags [list match$l matches] -fill yellow]
4968        $canv lower $t
4969        if {[info exists selectedline] && $row == $selectedline} {
4970            $canv raise $t secsel
4971        }
4972    }
4973}
4974
4975proc unmarkmatches {} {
4976    global markingmatches
4977
4978    allcanvs delete matches
4979    set markingmatches 0
4980    stopfinding
4981}
4982
4983proc selcanvline {w x y} {
4984    global canv canvy0 ctext linespc
4985    global rowtextx
4986    set ymax [lindex [$canv cget -scrollregion] 3]
4987    if {$ymax == {}} return
4988    set yfrac [lindex [$canv yview] 0]
4989    set y [expr {$y + $yfrac * $ymax}]
4990    set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
4991    if {$l < 0} {
4992        set l 0
4993    }
4994    if {$w eq $canv} {
4995        if {![info exists rowtextx($l)] || $x < $rowtextx($l)} return
4996    }
4997    unmarkmatches
4998    selectline $l 1
4999}
5000
5001proc commit_descriptor {p} {
5002    global commitinfo
5003    if {![info exists commitinfo($p)]} {
5004        getcommit $p
5005    }
5006    set l "..."
5007    if {[llength $commitinfo($p)] > 1} {
5008        set l [lindex $commitinfo($p) 0]
5009    }
5010    return "$p ($l)\n"
5011}
5012
5013# append some text to the ctext widget, and make any SHA1 ID
5014# that we know about be a clickable link.
5015proc appendwithlinks {text tags} {
5016    global ctext linknum curview pendinglinks
5017
5018    set start [$ctext index "end - 1c"]
5019    $ctext insert end $text $tags
5020    set links [regexp -indices -all -inline {[0-9a-f]{40}} $text]
5021    foreach l $links {
5022        set s [lindex $l 0]
5023        set e [lindex $l 1]
5024        set linkid [string range $text $s $e]
5025        incr e
5026        $ctext tag delete link$linknum
5027        $ctext tag add link$linknum "$start + $s c" "$start + $e c"
5028        setlink $linkid link$linknum
5029        incr linknum
5030    }
5031}
5032
5033proc setlink {id lk} {
5034    global curview ctext pendinglinks commitinterest
5035
5036    if {[commitinview $id $curview]} {
5037        $ctext tag conf $lk -foreground blue -underline 1
5038        $ctext tag bind $lk <1> [list selectline [rowofcommit $id] 1]
5039        $ctext tag bind $lk <Enter> {linkcursor %W 1}
5040        $ctext tag bind $lk <Leave> {linkcursor %W -1}
5041    } else {
5042        lappend pendinglinks($id) $lk
5043        lappend commitinterest($id) {makelink %I}
5044    }
5045}
5046
5047proc makelink {id} {
5048    global pendinglinks
5049
5050    if {![info exists pendinglinks($id)]} return
5051    foreach lk $pendinglinks($id) {
5052        setlink $id $lk
5053    }
5054    unset pendinglinks($id)
5055}
5056
5057proc linkcursor {w inc} {
5058    global linkentercount curtextcursor
5059
5060    if {[incr linkentercount $inc] > 0} {
5061        $w configure -cursor hand2
5062    } else {
5063        $w configure -cursor $curtextcursor
5064        if {$linkentercount < 0} {
5065            set linkentercount 0
5066        }
5067    }
5068}
5069
5070proc viewnextline {dir} {
5071    global canv linespc
5072
5073    $canv delete hover
5074    set ymax [lindex [$canv cget -scrollregion] 3]
5075    set wnow [$canv yview]
5076    set wtop [expr {[lindex $wnow 0] * $ymax}]
5077    set newtop [expr {$wtop + $dir * $linespc}]
5078    if {$newtop < 0} {
5079        set newtop 0
5080    } elseif {$newtop > $ymax} {
5081        set newtop $ymax
5082    }
5083    allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
5084}
5085
5086# add a list of tag or branch names at position pos
5087# returns the number of names inserted
5088proc appendrefs {pos ids var} {
5089    global ctext linknum curview $var maxrefs
5090
5091    if {[catch {$ctext index $pos}]} {
5092        return 0
5093    }
5094    $ctext conf -state normal
5095    $ctext delete $pos "$pos lineend"
5096    set tags {}
5097    foreach id $ids {
5098        foreach tag [set $var\($id\)] {
5099            lappend tags [list $tag $id]
5100        }
5101    }
5102    if {[llength $tags] > $maxrefs} {
5103        $ctext insert $pos "many ([llength $tags])"
5104    } else {
5105        set tags [lsort -index 0 -decreasing $tags]
5106        set sep {}
5107        foreach ti $tags {
5108            set id [lindex $ti 1]
5109            set lk link$linknum
5110            incr linknum
5111            $ctext tag delete $lk
5112            $ctext insert $pos $sep
5113            $ctext insert $pos [lindex $ti 0] $lk
5114            setlink $id $lk
5115            set sep ", "
5116        }
5117    }
5118    $ctext conf -state disabled
5119    return [llength $tags]
5120}
5121
5122# called when we have finished computing the nearby tags
5123proc dispneartags {delay} {
5124    global selectedline currentid showneartags tagphase
5125
5126    if {![info exists selectedline] || !$showneartags} return
5127    after cancel dispnexttag
5128    if {$delay} {
5129        after 200 dispnexttag
5130        set tagphase -1
5131    } else {
5132        after idle dispnexttag
5133        set tagphase 0
5134    }
5135}
5136
5137proc dispnexttag {} {
5138    global selectedline currentid showneartags tagphase ctext
5139
5140    if {![info exists selectedline] || !$showneartags} return
5141    switch -- $tagphase {
5142        0 {
5143            set dtags [desctags $currentid]
5144            if {$dtags ne {}} {
5145                appendrefs precedes $dtags idtags
5146            }
5147        }
5148        1 {
5149            set atags [anctags $currentid]
5150            if {$atags ne {}} {
5151                appendrefs follows $atags idtags
5152            }
5153        }
5154        2 {
5155            set dheads [descheads $currentid]
5156            if {$dheads ne {}} {
5157                if {[appendrefs branch $dheads idheads] > 1
5158                    && [$ctext get "branch -3c"] eq "h"} {
5159                    # turn "Branch" into "Branches"
5160                    $ctext conf -state normal
5161                    $ctext insert "branch -2c" "es"
5162                    $ctext conf -state disabled
5163                }
5164            }
5165        }
5166    }
5167    if {[incr tagphase] <= 2} {
5168        after idle dispnexttag
5169    }
5170}
5171
5172proc make_secsel {l} {
5173    global linehtag linentag linedtag canv canv2 canv3
5174
5175    if {![info exists linehtag($l)]} return
5176    $canv delete secsel
5177    set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
5178               -tags secsel -fill [$canv cget -selectbackground]]
5179    $canv lower $t
5180    $canv2 delete secsel
5181    set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
5182               -tags secsel -fill [$canv2 cget -selectbackground]]
5183    $canv2 lower $t
5184    $canv3 delete secsel
5185    set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
5186               -tags secsel -fill [$canv3 cget -selectbackground]]
5187    $canv3 lower $t
5188}
5189
5190proc selectline {l isnew} {
5191    global canv ctext commitinfo selectedline
5192    global canvy0 linespc parents children curview
5193    global currentid sha1entry
5194    global commentend idtags linknum
5195    global mergemax numcommits pending_select
5196    global cmitmode showneartags allcommits
5197
5198    catch {unset pending_select}
5199    $canv delete hover
5200    normalline
5201    unsel_reflist
5202    stopfinding
5203    if {$l < 0 || $l >= $numcommits} return
5204    set y [expr {$canvy0 + $l * $linespc}]
5205    set ymax [lindex [$canv cget -scrollregion] 3]
5206    set ytop [expr {$y - $linespc - 1}]
5207    set ybot [expr {$y + $linespc + 1}]
5208    set wnow [$canv yview]
5209    set wtop [expr {[lindex $wnow 0] * $ymax}]
5210    set wbot [expr {[lindex $wnow 1] * $ymax}]
5211    set wh [expr {$wbot - $wtop}]
5212    set newtop $wtop
5213    if {$ytop < $wtop} {
5214        if {$ybot < $wtop} {
5215            set newtop [expr {$y - $wh / 2.0}]
5216        } else {
5217            set newtop $ytop
5218            if {$newtop > $wtop - $linespc} {
5219                set newtop [expr {$wtop - $linespc}]
5220            }
5221        }
5222    } elseif {$ybot > $wbot} {
5223        if {$ytop > $wbot} {
5224            set newtop [expr {$y - $wh / 2.0}]
5225        } else {
5226            set newtop [expr {$ybot - $wh}]
5227            if {$newtop < $wtop + $linespc} {
5228                set newtop [expr {$wtop + $linespc}]
5229            }
5230        }
5231    }
5232    if {$newtop != $wtop} {
5233        if {$newtop < 0} {
5234            set newtop 0
5235        }
5236        allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
5237        drawvisible
5238    }
5239
5240    make_secsel $l
5241
5242    if {$isnew} {
5243        addtohistory [list selectline $l 0]
5244    }
5245
5246    set selectedline $l
5247
5248    set id [commitonrow $l]
5249    set currentid $id
5250    $sha1entry delete 0 end
5251    $sha1entry insert 0 $id
5252    $sha1entry selection from 0
5253    $sha1entry selection to end
5254    rhighlight_sel $id
5255
5256    $ctext conf -state normal
5257    clear_ctext
5258    set linknum 0
5259    set info $commitinfo($id)
5260    set date [formatdate [lindex $info 2]]
5261    $ctext insert end "Author: [lindex $info 1]  $date\n"
5262    set date [formatdate [lindex $info 4]]
5263    $ctext insert end "Committer: [lindex $info 3]  $date\n"
5264    if {[info exists idtags($id)]} {
5265        $ctext insert end "Tags:"
5266        foreach tag $idtags($id) {
5267            $ctext insert end " $tag"
5268        }
5269        $ctext insert end "\n"
5270    }
5271
5272    set headers {}
5273    set olds $parents($curview,$id)
5274    if {[llength $olds] > 1} {
5275        set np 0
5276        foreach p $olds {
5277            if {$np >= $mergemax} {
5278                set tag mmax
5279            } else {
5280                set tag m$np
5281            }
5282            $ctext insert end "Parent: " $tag
5283            appendwithlinks [commit_descriptor $p] {}
5284            incr np
5285        }
5286    } else {
5287        foreach p $olds {
5288            append headers "Parent: [commit_descriptor $p]"
5289        }
5290    }
5291
5292    foreach c $children($curview,$id) {
5293        append headers "Child:  [commit_descriptor $c]"
5294    }
5295
5296    # make anything that looks like a SHA1 ID be a clickable link
5297    appendwithlinks $headers {}
5298    if {$showneartags} {
5299        if {![info exists allcommits]} {
5300            getallcommits
5301        }
5302        $ctext insert end "Branch: "
5303        $ctext mark set branch "end -1c"
5304        $ctext mark gravity branch left
5305        $ctext insert end "\nFollows: "
5306        $ctext mark set follows "end -1c"
5307        $ctext mark gravity follows left
5308        $ctext insert end "\nPrecedes: "
5309        $ctext mark set precedes "end -1c"
5310        $ctext mark gravity precedes left
5311        $ctext insert end "\n"
5312        dispneartags 1
5313    }
5314    $ctext insert end "\n"
5315    set comment [lindex $info 5]
5316    if {[string first "\r" $comment] >= 0} {
5317        set comment [string map {"\r" "\n    "} $comment]
5318    }
5319    appendwithlinks $comment {comment}
5320
5321    $ctext tag remove found 1.0 end
5322    $ctext conf -state disabled
5323    set commentend [$ctext index "end - 1c"]
5324
5325    init_flist "Comments"
5326    if {$cmitmode eq "tree"} {
5327        gettree $id
5328    } elseif {[llength $olds] <= 1} {
5329        startdiff $id
5330    } else {
5331        mergediff $id
5332    }
5333}
5334
5335proc selfirstline {} {
5336    unmarkmatches
5337    selectline 0 1
5338}
5339
5340proc sellastline {} {
5341    global numcommits
5342    unmarkmatches
5343    set l [expr {$numcommits - 1}]
5344    selectline $l 1
5345}
5346
5347proc selnextline {dir} {
5348    global selectedline
5349    focus .
5350    if {![info exists selectedline]} return
5351    set l [expr {$selectedline + $dir}]
5352    unmarkmatches
5353    selectline $l 1
5354}
5355
5356proc selnextpage {dir} {
5357    global canv linespc selectedline numcommits
5358
5359    set lpp [expr {([winfo height $canv] - 2) / $linespc}]
5360    if {$lpp < 1} {
5361        set lpp 1
5362    }
5363    allcanvs yview scroll [expr {$dir * $lpp}] units
5364    drawvisible
5365    if {![info exists selectedline]} return
5366    set l [expr {$selectedline + $dir * $lpp}]
5367    if {$l < 0} {
5368        set l 0
5369    } elseif {$l >= $numcommits} {
5370        set l [expr $numcommits - 1]
5371    }
5372    unmarkmatches
5373    selectline $l 1
5374}
5375
5376proc unselectline {} {
5377    global selectedline currentid
5378
5379    catch {unset selectedline}
5380    catch {unset currentid}
5381    allcanvs delete secsel
5382    rhighlight_none
5383}
5384
5385proc reselectline {} {
5386    global selectedline
5387
5388    if {[info exists selectedline]} {
5389        selectline $selectedline 0
5390    }
5391}
5392
5393proc addtohistory {cmd} {
5394    global history historyindex curview
5395
5396    set elt [list $curview $cmd]
5397    if {$historyindex > 0
5398        && [lindex $history [expr {$historyindex - 1}]] == $elt} {
5399        return
5400    }
5401
5402    if {$historyindex < [llength $history]} {
5403        set history [lreplace $history $historyindex end $elt]
5404    } else {
5405        lappend history $elt
5406    }
5407    incr historyindex
5408    if {$historyindex > 1} {
5409        .tf.bar.leftbut conf -state normal
5410    } else {
5411        .tf.bar.leftbut conf -state disabled
5412    }
5413    .tf.bar.rightbut conf -state disabled
5414}
5415
5416proc godo {elt} {
5417    global curview
5418
5419    set view [lindex $elt 0]
5420    set cmd [lindex $elt 1]
5421    if {$curview != $view} {
5422        showview $view
5423    }
5424    eval $cmd
5425}
5426
5427proc goback {} {
5428    global history historyindex
5429    focus .
5430
5431    if {$historyindex > 1} {
5432        incr historyindex -1
5433        godo [lindex $history [expr {$historyindex - 1}]]
5434        .tf.bar.rightbut conf -state normal
5435    }
5436    if {$historyindex <= 1} {
5437        .tf.bar.leftbut conf -state disabled
5438    }
5439}
5440
5441proc goforw {} {
5442    global history historyindex
5443    focus .
5444
5445    if {$historyindex < [llength $history]} {
5446        set cmd [lindex $history $historyindex]
5447        incr historyindex
5448        godo $cmd
5449        .tf.bar.leftbut conf -state normal
5450    }
5451    if {$historyindex >= [llength $history]} {
5452        .tf.bar.rightbut conf -state disabled
5453    }
5454}
5455
5456proc gettree {id} {
5457    global treefilelist treeidlist diffids diffmergeid treepending
5458    global nullid nullid2
5459
5460    set diffids $id
5461    catch {unset diffmergeid}
5462    if {![info exists treefilelist($id)]} {
5463        if {![info exists treepending]} {
5464            if {$id eq $nullid} {
5465                set cmd [list | git ls-files]
5466            } elseif {$id eq $nullid2} {
5467                set cmd [list | git ls-files --stage -t]
5468            } else {
5469                set cmd [list | git ls-tree -r $id]
5470            }
5471            if {[catch {set gtf [open $cmd r]}]} {
5472                return
5473            }
5474            set treepending $id
5475            set treefilelist($id) {}
5476            set treeidlist($id) {}
5477            fconfigure $gtf -blocking 0
5478            filerun $gtf [list gettreeline $gtf $id]
5479        }
5480    } else {
5481        setfilelist $id
5482    }
5483}
5484
5485proc gettreeline {gtf id} {
5486    global treefilelist treeidlist treepending cmitmode diffids nullid nullid2
5487
5488    set nl 0
5489    while {[incr nl] <= 1000 && [gets $gtf line] >= 0} {
5490        if {$diffids eq $nullid} {
5491            set fname $line
5492        } else {
5493            if {$diffids ne $nullid2 && [lindex $line 1] ne "blob"} continue
5494            set i [string first "\t" $line]
5495            if {$i < 0} continue
5496            set sha1 [lindex $line 2]
5497            set fname [string range $line [expr {$i+1}] end]
5498            if {[string index $fname 0] eq "\""} {
5499                set fname [lindex $fname 0]
5500            }
5501            lappend treeidlist($id) $sha1
5502        }
5503        lappend treefilelist($id) $fname
5504    }
5505    if {![eof $gtf]} {
5506        return [expr {$nl >= 1000? 2: 1}]
5507    }
5508    close $gtf
5509    unset treepending
5510    if {$cmitmode ne "tree"} {
5511        if {![info exists diffmergeid]} {
5512            gettreediffs $diffids
5513        }
5514    } elseif {$id ne $diffids} {
5515        gettree $diffids
5516    } else {
5517        setfilelist $id
5518    }
5519    return 0
5520}
5521
5522proc showfile {f} {
5523    global treefilelist treeidlist diffids nullid nullid2
5524    global ctext commentend
5525
5526    set i [lsearch -exact $treefilelist($diffids) $f]
5527    if {$i < 0} {
5528        puts "oops, $f not in list for id $diffids"
5529        return
5530    }
5531    if {$diffids eq $nullid} {
5532        if {[catch {set bf [open $f r]} err]} {
5533            puts "oops, can't read $f: $err"
5534            return
5535        }
5536    } else {
5537        set blob [lindex $treeidlist($diffids) $i]
5538        if {[catch {set bf [open [concat | git cat-file blob $blob] r]} err]} {
5539            puts "oops, error reading blob $blob: $err"
5540            return
5541        }
5542    }
5543    fconfigure $bf -blocking 0
5544    filerun $bf [list getblobline $bf $diffids]
5545    $ctext config -state normal
5546    clear_ctext $commentend
5547    $ctext insert end "\n"
5548    $ctext insert end "$f\n" filesep
5549    $ctext config -state disabled
5550    $ctext yview $commentend
5551    settabs 0
5552}
5553
5554proc getblobline {bf id} {
5555    global diffids cmitmode ctext
5556
5557    if {$id ne $diffids || $cmitmode ne "tree"} {
5558        catch {close $bf}
5559        return 0
5560    }
5561    $ctext config -state normal
5562    set nl 0
5563    while {[incr nl] <= 1000 && [gets $bf line] >= 0} {
5564        $ctext insert end "$line\n"
5565    }
5566    if {[eof $bf]} {
5567        # delete last newline
5568        $ctext delete "end - 2c" "end - 1c"
5569        close $bf
5570        return 0
5571    }
5572    $ctext config -state disabled
5573    return [expr {$nl >= 1000? 2: 1}]
5574}
5575
5576proc mergediff {id} {
5577    global diffmergeid mdifffd
5578    global diffids
5579    global parents
5580    global limitdiffs viewfiles curview
5581
5582    set diffmergeid $id
5583    set diffids $id
5584    # this doesn't seem to actually affect anything...
5585    set cmd [concat | git diff-tree --no-commit-id --cc $id]
5586    if {$limitdiffs && $viewfiles($curview) ne {}} {
5587        set cmd [concat $cmd -- $viewfiles($curview)]
5588    }
5589    if {[catch {set mdf [open $cmd r]} err]} {
5590        error_popup "Error getting merge diffs: $err"
5591        return
5592    }
5593    fconfigure $mdf -blocking 0
5594    set mdifffd($id) $mdf
5595    set np [llength $parents($curview,$id)]
5596    settabs $np
5597    filerun $mdf [list getmergediffline $mdf $id $np]
5598}
5599
5600proc getmergediffline {mdf id np} {
5601    global diffmergeid ctext cflist mergemax
5602    global difffilestart mdifffd
5603
5604    $ctext conf -state normal
5605    set nr 0
5606    while {[incr nr] <= 1000 && [gets $mdf line] >= 0} {
5607        if {![info exists diffmergeid] || $id != $diffmergeid
5608            || $mdf != $mdifffd($id)} {
5609            close $mdf
5610            return 0
5611        }
5612        if {[regexp {^diff --cc (.*)} $line match fname]} {
5613            # start of a new file
5614            $ctext insert end "\n"
5615            set here [$ctext index "end - 1c"]
5616            lappend difffilestart $here
5617            add_flist [list $fname]
5618            set l [expr {(78 - [string length $fname]) / 2}]
5619            set pad [string range "----------------------------------------" 1 $l]
5620            $ctext insert end "$pad $fname $pad\n" filesep
5621        } elseif {[regexp {^@@} $line]} {
5622            $ctext insert end "$line\n" hunksep
5623        } elseif {[regexp {^[0-9a-f]{40}$} $line] || [regexp {^index} $line]} {
5624            # do nothing
5625        } else {
5626            # parse the prefix - one ' ', '-' or '+' for each parent
5627            set spaces {}
5628            set minuses {}
5629            set pluses {}
5630            set isbad 0
5631            for {set j 0} {$j < $np} {incr j} {
5632                set c [string range $line $j $j]
5633                if {$c == " "} {
5634                    lappend spaces $j
5635                } elseif {$c == "-"} {
5636                    lappend minuses $j
5637                } elseif {$c == "+"} {
5638                    lappend pluses $j
5639                } else {
5640                    set isbad 1
5641                    break
5642                }
5643            }
5644            set tags {}
5645            set num {}
5646            if {!$isbad && $minuses ne {} && $pluses eq {}} {
5647                # line doesn't appear in result, parents in $minuses have the line
5648                set num [lindex $minuses 0]
5649            } elseif {!$isbad && $pluses ne {} && $minuses eq {}} {
5650                # line appears in result, parents in $pluses don't have the line
5651                lappend tags mresult
5652                set num [lindex $spaces 0]
5653            }
5654            if {$num ne {}} {
5655                if {$num >= $mergemax} {
5656                    set num "max"
5657                }
5658                lappend tags m$num
5659            }
5660            $ctext insert end "$line\n" $tags
5661        }
5662    }
5663    $ctext conf -state disabled
5664    if {[eof $mdf]} {
5665        close $mdf
5666        return 0
5667    }
5668    return [expr {$nr >= 1000? 2: 1}]
5669}
5670
5671proc startdiff {ids} {
5672    global treediffs diffids treepending diffmergeid nullid nullid2
5673
5674    settabs 1
5675    set diffids $ids
5676    catch {unset diffmergeid}
5677    if {![info exists treediffs($ids)] ||
5678        [lsearch -exact $ids $nullid] >= 0 ||
5679        [lsearch -exact $ids $nullid2] >= 0} {
5680        if {![info exists treepending]} {
5681            gettreediffs $ids
5682        }
5683    } else {
5684        addtocflist $ids
5685    }
5686}
5687
5688proc path_filter {filter name} {
5689    foreach p $filter {
5690        set l [string length $p]
5691        if {[string index $p end] eq "/"} {
5692            if {[string compare -length $l $p $name] == 0} {
5693                return 1
5694            }
5695        } else {
5696            if {[string compare -length $l $p $name] == 0 &&
5697                ([string length $name] == $l ||
5698                 [string index $name $l] eq "/")} {
5699                return 1
5700            }
5701        }
5702    }
5703    return 0
5704}
5705
5706proc addtocflist {ids} {
5707    global treediffs
5708
5709    add_flist $treediffs($ids)
5710    getblobdiffs $ids
5711}
5712
5713proc diffcmd {ids flags} {
5714    global nullid nullid2
5715
5716    set i [lsearch -exact $ids $nullid]
5717    set j [lsearch -exact $ids $nullid2]
5718    if {$i >= 0} {
5719        if {[llength $ids] > 1 && $j < 0} {
5720            # comparing working directory with some specific revision
5721            set cmd [concat | git diff-index $flags]
5722            if {$i == 0} {
5723                lappend cmd -R [lindex $ids 1]
5724            } else {
5725                lappend cmd [lindex $ids 0]
5726            }
5727        } else {
5728            # comparing working directory with index
5729            set cmd [concat | git diff-files $flags]
5730            if {$j == 1} {
5731                lappend cmd -R
5732            }
5733        }
5734    } elseif {$j >= 0} {
5735        set cmd [concat | git diff-index --cached $flags]
5736        if {[llength $ids] > 1} {
5737            # comparing index with specific revision
5738            if {$i == 0} {
5739                lappend cmd -R [lindex $ids 1]
5740            } else {
5741                lappend cmd [lindex $ids 0]
5742            }
5743        } else {
5744            # comparing index with HEAD
5745            lappend cmd HEAD
5746        }
5747    } else {
5748        set cmd [concat | git diff-tree -r $flags $ids]
5749    }
5750    return $cmd
5751}
5752
5753proc gettreediffs {ids} {
5754    global treediff treepending
5755
5756    set treepending $ids
5757    set treediff {}
5758    if {[catch {set gdtf [open [diffcmd $ids {--no-commit-id}] r]}]} return
5759    fconfigure $gdtf -blocking 0
5760    filerun $gdtf [list gettreediffline $gdtf $ids]
5761}
5762
5763proc gettreediffline {gdtf ids} {
5764    global treediff treediffs treepending diffids diffmergeid
5765    global cmitmode viewfiles curview limitdiffs
5766
5767    set nr 0
5768    while {[incr nr] <= 1000 && [gets $gdtf line] >= 0} {
5769        set i [string first "\t" $line]
5770        if {$i >= 0} {
5771            set file [string range $line [expr {$i+1}] end]
5772            if {[string index $file 0] eq "\""} {
5773                set file [lindex $file 0]
5774            }
5775            lappend treediff $file
5776        }
5777    }
5778    if {![eof $gdtf]} {
5779        return [expr {$nr >= 1000? 2: 1}]
5780    }
5781    close $gdtf
5782    if {$limitdiffs && $viewfiles($curview) ne {}} {
5783        set flist {}
5784        foreach f $treediff {
5785            if {[path_filter $viewfiles($curview) $f]} {
5786                lappend flist $f
5787            }
5788        }
5789        set treediffs($ids) $flist
5790    } else {
5791        set treediffs($ids) $treediff
5792    }
5793    unset treepending
5794    if {$cmitmode eq "tree"} {
5795        gettree $diffids
5796    } elseif {$ids != $diffids} {
5797        if {![info exists diffmergeid]} {
5798            gettreediffs $diffids
5799        }
5800    } else {
5801        addtocflist $ids
5802    }
5803    return 0
5804}
5805
5806# empty string or positive integer
5807proc diffcontextvalidate {v} {
5808    return [regexp {^(|[1-9][0-9]*)$} $v]
5809}
5810
5811proc diffcontextchange {n1 n2 op} {
5812    global diffcontextstring diffcontext
5813
5814    if {[string is integer -strict $diffcontextstring]} {
5815        if {$diffcontextstring > 0} {
5816            set diffcontext $diffcontextstring
5817            reselectline
5818        }
5819    }
5820}
5821
5822proc getblobdiffs {ids} {
5823    global blobdifffd diffids env
5824    global diffinhdr treediffs
5825    global diffcontext
5826    global limitdiffs viewfiles curview
5827
5828    set cmd [diffcmd $ids "-p -C --no-commit-id -U$diffcontext"]
5829    if {$limitdiffs && $viewfiles($curview) ne {}} {
5830        set cmd [concat $cmd -- $viewfiles($curview)]
5831    }
5832    if {[catch {set bdf [open $cmd r]} err]} {
5833        puts "error getting diffs: $err"
5834        return
5835    }
5836    set diffinhdr 0
5837    fconfigure $bdf -blocking 0
5838    set blobdifffd($ids) $bdf
5839    filerun $bdf [list getblobdiffline $bdf $diffids]
5840}
5841
5842proc setinlist {var i val} {
5843    global $var
5844
5845    while {[llength [set $var]] < $i} {
5846        lappend $var {}
5847    }
5848    if {[llength [set $var]] == $i} {
5849        lappend $var $val
5850    } else {
5851        lset $var $i $val
5852    }
5853}
5854
5855proc makediffhdr {fname ids} {
5856    global ctext curdiffstart treediffs
5857
5858    set i [lsearch -exact $treediffs($ids) $fname]
5859    if {$i >= 0} {
5860        setinlist difffilestart $i $curdiffstart
5861    }
5862    set l [expr {(78 - [string length $fname]) / 2}]
5863    set pad [string range "----------------------------------------" 1 $l]
5864    $ctext insert $curdiffstart "$pad $fname $pad" filesep
5865}
5866
5867proc getblobdiffline {bdf ids} {
5868    global diffids blobdifffd ctext curdiffstart
5869    global diffnexthead diffnextnote difffilestart
5870    global diffinhdr treediffs
5871
5872    set nr 0
5873    $ctext conf -state normal
5874    while {[incr nr] <= 1000 && [gets $bdf line] >= 0} {
5875        if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
5876            close $bdf
5877            return 0
5878        }
5879        if {![string compare -length 11 "diff --git " $line]} {
5880            # trim off "diff --git "
5881            set line [string range $line 11 end]
5882            set diffinhdr 1
5883            # start of a new file
5884            $ctext insert end "\n"
5885            set curdiffstart [$ctext index "end - 1c"]
5886            $ctext insert end "\n" filesep
5887            # If the name hasn't changed the length will be odd,
5888            # the middle char will be a space, and the two bits either
5889            # side will be a/name and b/name, or "a/name" and "b/name".
5890            # If the name has changed we'll get "rename from" and
5891            # "rename to" or "copy from" and "copy to" lines following this,
5892            # and we'll use them to get the filenames.
5893            # This complexity is necessary because spaces in the filename(s)
5894            # don't get escaped.
5895            set l [string length $line]
5896            set i [expr {$l / 2}]
5897            if {!(($l & 1) && [string index $line $i] eq " " &&
5898                  [string range $line 2 [expr {$i - 1}]] eq \
5899                      [string range $line [expr {$i + 3}] end])} {
5900                continue
5901            }
5902            # unescape if quoted and chop off the a/ from the front
5903            if {[string index $line 0] eq "\""} {
5904                set fname [string range [lindex $line 0] 2 end]
5905            } else {
5906                set fname [string range $line 2 [expr {$i - 1}]]
5907            }
5908            makediffhdr $fname $ids
5909
5910        } elseif {[regexp {^@@ -([0-9]+)(,[0-9]+)? \+([0-9]+)(,[0-9]+)? @@(.*)} \
5911                       $line match f1l f1c f2l f2c rest]} {
5912            $ctext insert end "$line\n" hunksep
5913            set diffinhdr 0
5914
5915        } elseif {$diffinhdr} {
5916            if {![string compare -length 12 "rename from " $line]} {
5917                set fname [string range $line [expr 6 + [string first " from " $line] ] end]
5918                if {[string index $fname 0] eq "\""} {
5919                    set fname [lindex $fname 0]
5920                }
5921                set i [lsearch -exact $treediffs($ids) $fname]
5922                if {$i >= 0} {
5923                    setinlist difffilestart $i $curdiffstart
5924                }
5925            } elseif {![string compare -length 10 $line "rename to "] ||
5926                      ![string compare -length 8 $line "copy to "]} {
5927                set fname [string range $line [expr 4 + [string first " to " $line] ] end]
5928                if {[string index $fname 0] eq "\""} {
5929                    set fname [lindex $fname 0]
5930                }
5931                makediffhdr $fname $ids
5932            } elseif {[string compare -length 3 $line "---"] == 0} {
5933                # do nothing
5934                continue
5935            } elseif {[string compare -length 3 $line "+++"] == 0} {
5936                set diffinhdr 0
5937                continue
5938            }
5939            $ctext insert end "$line\n" filesep
5940
5941        } else {
5942            set x [string range $line 0 0]
5943            if {$x == "-" || $x == "+"} {
5944                set tag [expr {$x == "+"}]
5945                $ctext insert end "$line\n" d$tag
5946            } elseif {$x == " "} {
5947                $ctext insert end "$line\n"
5948            } else {
5949                # "\ No newline at end of file",
5950                # or something else we don't recognize
5951                $ctext insert end "$line\n" hunksep
5952            }
5953        }
5954    }
5955    $ctext conf -state disabled
5956    if {[eof $bdf]} {
5957        close $bdf
5958        return 0
5959    }
5960    return [expr {$nr >= 1000? 2: 1}]
5961}
5962
5963proc changediffdisp {} {
5964    global ctext diffelide
5965
5966    $ctext tag conf d0 -elide [lindex $diffelide 0]
5967    $ctext tag conf d1 -elide [lindex $diffelide 1]
5968}
5969
5970proc prevfile {} {
5971    global difffilestart ctext
5972    set prev [lindex $difffilestart 0]
5973    set here [$ctext index @0,0]
5974    foreach loc $difffilestart {
5975        if {[$ctext compare $loc >= $here]} {
5976            $ctext yview $prev
5977            return
5978        }
5979        set prev $loc
5980    }
5981    $ctext yview $prev
5982}
5983
5984proc nextfile {} {
5985    global difffilestart ctext
5986    set here [$ctext index @0,0]
5987    foreach loc $difffilestart {
5988        if {[$ctext compare $loc > $here]} {
5989            $ctext yview $loc
5990            return
5991        }
5992    }
5993}
5994
5995proc clear_ctext {{first 1.0}} {
5996    global ctext smarktop smarkbot
5997    global pendinglinks
5998
5999    set l [lindex [split $first .] 0]
6000    if {![info exists smarktop] || [$ctext compare $first < $smarktop.0]} {
6001        set smarktop $l
6002    }
6003    if {![info exists smarkbot] || [$ctext compare $first < $smarkbot.0]} {
6004        set smarkbot $l
6005    }
6006    $ctext delete $first end
6007    if {$first eq "1.0"} {
6008        catch {unset pendinglinks}
6009    }
6010}
6011
6012proc settabs {{firstab {}}} {
6013    global firsttabstop tabstop ctext have_tk85
6014
6015    if {$firstab ne {} && $have_tk85} {
6016        set firsttabstop $firstab
6017    }
6018    set w [font measure textfont "0"]
6019    if {$firsttabstop != 0} {
6020        $ctext conf -tabs [list [expr {($firsttabstop + $tabstop) * $w}] \
6021                               [expr {($firsttabstop + 2 * $tabstop) * $w}]]
6022    } elseif {$have_tk85 || $tabstop != 8} {
6023        $ctext conf -tabs [expr {$tabstop * $w}]
6024    } else {
6025        $ctext conf -tabs {}
6026    }
6027}
6028
6029proc incrsearch {name ix op} {
6030    global ctext searchstring searchdirn
6031
6032    $ctext tag remove found 1.0 end
6033    if {[catch {$ctext index anchor}]} {
6034        # no anchor set, use start of selection, or of visible area
6035        set sel [$ctext tag ranges sel]
6036        if {$sel ne {}} {
6037            $ctext mark set anchor [lindex $sel 0]
6038        } elseif {$searchdirn eq "-forwards"} {
6039            $ctext mark set anchor @0,0
6040        } else {
6041            $ctext mark set anchor @0,[winfo height $ctext]
6042        }
6043    }
6044    if {$searchstring ne {}} {
6045        set here [$ctext search $searchdirn -- $searchstring anchor]
6046        if {$here ne {}} {
6047            $ctext see $here
6048        }
6049        searchmarkvisible 1
6050    }
6051}
6052
6053proc dosearch {} {
6054    global sstring ctext searchstring searchdirn
6055
6056    focus $sstring
6057    $sstring icursor end
6058    set searchdirn -forwards
6059    if {$searchstring ne {}} {
6060        set sel [$ctext tag ranges sel]
6061        if {$sel ne {}} {
6062            set start "[lindex $sel 0] + 1c"
6063        } elseif {[catch {set start [$ctext index anchor]}]} {
6064            set start "@0,0"
6065        }
6066        set match [$ctext search -count mlen -- $searchstring $start]
6067        $ctext tag remove sel 1.0 end
6068        if {$match eq {}} {
6069            bell
6070            return
6071        }
6072        $ctext see $match
6073        set mend "$match + $mlen c"
6074        $ctext tag add sel $match $mend
6075        $ctext mark unset anchor
6076    }
6077}
6078
6079proc dosearchback {} {
6080    global sstring ctext searchstring searchdirn
6081
6082    focus $sstring
6083    $sstring icursor end
6084    set searchdirn -backwards
6085    if {$searchstring ne {}} {
6086        set sel [$ctext tag ranges sel]
6087        if {$sel ne {}} {
6088            set start [lindex $sel 0]
6089        } elseif {[catch {set start [$ctext index anchor]}]} {
6090            set start @0,[winfo height $ctext]
6091        }
6092        set match [$ctext search -backwards -count ml -- $searchstring $start]
6093        $ctext tag remove sel 1.0 end
6094        if {$match eq {}} {
6095            bell
6096            return
6097        }
6098        $ctext see $match
6099        set mend "$match + $ml c"
6100        $ctext tag add sel $match $mend
6101        $ctext mark unset anchor
6102    }
6103}
6104
6105proc searchmark {first last} {
6106    global ctext searchstring
6107
6108    set mend $first.0
6109    while {1} {
6110        set match [$ctext search -count mlen -- $searchstring $mend $last.end]
6111        if {$match eq {}} break
6112        set mend "$match + $mlen c"
6113        $ctext tag add found $match $mend
6114    }
6115}
6116
6117proc searchmarkvisible {doall} {
6118    global ctext smarktop smarkbot
6119
6120    set topline [lindex [split [$ctext index @0,0] .] 0]
6121    set botline [lindex [split [$ctext index @0,[winfo height $ctext]] .] 0]
6122    if {$doall || $botline < $smarktop || $topline > $smarkbot} {
6123        # no overlap with previous
6124        searchmark $topline $botline
6125        set smarktop $topline
6126        set smarkbot $botline
6127    } else {
6128        if {$topline < $smarktop} {
6129            searchmark $topline [expr {$smarktop-1}]
6130            set smarktop $topline
6131        }
6132        if {$botline > $smarkbot} {
6133            searchmark [expr {$smarkbot+1}] $botline
6134            set smarkbot $botline
6135        }
6136    }
6137}
6138
6139proc scrolltext {f0 f1} {
6140    global searchstring
6141
6142    .bleft.sb set $f0 $f1
6143    if {$searchstring ne {}} {
6144        searchmarkvisible 0
6145    }
6146}
6147
6148proc setcoords {} {
6149    global linespc charspc canvx0 canvy0
6150    global xspc1 xspc2 lthickness
6151
6152    set linespc [font metrics mainfont -linespace]
6153    set charspc [font measure mainfont "m"]
6154    set canvy0 [expr {int(3 + 0.5 * $linespc)}]
6155    set canvx0 [expr {int(3 + 0.5 * $linespc)}]
6156    set lthickness [expr {int($linespc / 9) + 1}]
6157    set xspc1(0) $linespc
6158    set xspc2 $linespc
6159}
6160
6161proc redisplay {} {
6162    global canv
6163    global selectedline
6164
6165    set ymax [lindex [$canv cget -scrollregion] 3]
6166    if {$ymax eq {} || $ymax == 0} return
6167    set span [$canv yview]
6168    clear_display
6169    setcanvscroll
6170    allcanvs yview moveto [lindex $span 0]
6171    drawvisible
6172    if {[info exists selectedline]} {
6173        selectline $selectedline 0
6174        allcanvs yview moveto [lindex $span 0]
6175    }
6176}
6177
6178proc parsefont {f n} {
6179    global fontattr
6180
6181    set fontattr($f,family) [lindex $n 0]
6182    set s [lindex $n 1]
6183    if {$s eq {} || $s == 0} {
6184        set s 10
6185    } elseif {$s < 0} {
6186        set s [expr {int(-$s / [winfo fpixels . 1p] + 0.5)}]
6187    }
6188    set fontattr($f,size) $s
6189    set fontattr($f,weight) normal
6190    set fontattr($f,slant) roman
6191    foreach style [lrange $n 2 end] {
6192        switch -- $style {
6193            "normal" -
6194            "bold"   {set fontattr($f,weight) $style}
6195            "roman" -
6196            "italic" {set fontattr($f,slant) $style}
6197        }
6198    }
6199}
6200
6201proc fontflags {f {isbold 0}} {
6202    global fontattr
6203
6204    return [list -family $fontattr($f,family) -size $fontattr($f,size) \
6205                -weight [expr {$isbold? "bold": $fontattr($f,weight)}] \
6206                -slant $fontattr($f,slant)]
6207}
6208
6209proc fontname {f} {
6210    global fontattr
6211
6212    set n [list $fontattr($f,family) $fontattr($f,size)]
6213    if {$fontattr($f,weight) eq "bold"} {
6214        lappend n "bold"
6215    }
6216    if {$fontattr($f,slant) eq "italic"} {
6217        lappend n "italic"
6218    }
6219    return $n
6220}
6221
6222proc incrfont {inc} {
6223    global mainfont textfont ctext canv cflist showrefstop
6224    global stopped entries fontattr
6225
6226    unmarkmatches
6227    set s $fontattr(mainfont,size)
6228    incr s $inc
6229    if {$s < 1} {
6230        set s 1
6231    }
6232    set fontattr(mainfont,size) $s
6233    font config mainfont -size $s
6234    font config mainfontbold -size $s
6235    set mainfont [fontname mainfont]
6236    set s $fontattr(textfont,size)
6237    incr s $inc
6238    if {$s < 1} {
6239        set s 1
6240    }
6241    set fontattr(textfont,size) $s
6242    font config textfont -size $s
6243    font config textfontbold -size $s
6244    set textfont [fontname textfont]
6245    setcoords
6246    settabs
6247    redisplay
6248}
6249
6250proc clearsha1 {} {
6251    global sha1entry sha1string
6252    if {[string length $sha1string] == 40} {
6253        $sha1entry delete 0 end
6254    }
6255}
6256
6257proc sha1change {n1 n2 op} {
6258    global sha1string currentid sha1but
6259    if {$sha1string == {}
6260        || ([info exists currentid] && $sha1string == $currentid)} {
6261        set state disabled
6262    } else {
6263        set state normal
6264    }
6265    if {[$sha1but cget -state] == $state} return
6266    if {$state == "normal"} {
6267        $sha1but conf -state normal -relief raised -text "Goto: "
6268    } else {
6269        $sha1but conf -state disabled -relief flat -text "SHA1 ID: "
6270    }
6271}
6272
6273proc gotocommit {} {
6274    global sha1string tagids headids curview varcid
6275
6276    if {$sha1string == {}
6277        || ([info exists currentid] && $sha1string == $currentid)} return
6278    if {[info exists tagids($sha1string)]} {
6279        set id $tagids($sha1string)
6280    } elseif {[info exists headids($sha1string)]} {
6281        set id $headids($sha1string)
6282    } else {
6283        set id [string tolower $sha1string]
6284        if {[regexp {^[0-9a-f]{4,39}$} $id]} {
6285            set matches [array names varcid "$curview,$id*"]
6286            if {$matches ne {}} {
6287                if {[llength $matches] > 1} {
6288                    error_popup "Short SHA1 id $id is ambiguous"
6289                    return
6290                }
6291                set id [lindex [split [lindex $matches 0] ","] 1]
6292            }
6293        }
6294    }
6295    if {[commitinview $id $curview]} {
6296        selectline [rowofcommit $id] 1
6297        return
6298    }
6299    if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
6300        set type "SHA1 id"
6301    } else {
6302        set type "Tag/Head"
6303    }
6304    error_popup "$type $sha1string is not known"
6305}
6306
6307proc lineenter {x y id} {
6308    global hoverx hovery hoverid hovertimer
6309    global commitinfo canv
6310
6311    if {![info exists commitinfo($id)] && ![getcommit $id]} return
6312    set hoverx $x
6313    set hovery $y
6314    set hoverid $id
6315    if {[info exists hovertimer]} {
6316        after cancel $hovertimer
6317    }
6318    set hovertimer [after 500 linehover]
6319    $canv delete hover
6320}
6321
6322proc linemotion {x y id} {
6323    global hoverx hovery hoverid hovertimer
6324
6325    if {[info exists hoverid] && $id == $hoverid} {
6326        set hoverx $x
6327        set hovery $y
6328        if {[info exists hovertimer]} {
6329            after cancel $hovertimer
6330        }
6331        set hovertimer [after 500 linehover]
6332    }
6333}
6334
6335proc lineleave {id} {
6336    global hoverid hovertimer canv
6337
6338    if {[info exists hoverid] && $id == $hoverid} {
6339        $canv delete hover
6340        if {[info exists hovertimer]} {
6341            after cancel $hovertimer
6342            unset hovertimer
6343        }
6344        unset hoverid
6345    }
6346}
6347
6348proc linehover {} {
6349    global hoverx hovery hoverid hovertimer
6350    global canv linespc lthickness
6351    global commitinfo
6352
6353    set text [lindex $commitinfo($hoverid) 0]
6354    set ymax [lindex [$canv cget -scrollregion] 3]
6355    if {$ymax == {}} return
6356    set yfrac [lindex [$canv yview] 0]
6357    set x [expr {$hoverx + 2 * $linespc}]
6358    set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
6359    set x0 [expr {$x - 2 * $lthickness}]
6360    set y0 [expr {$y - 2 * $lthickness}]
6361    set x1 [expr {$x + [font measure mainfont $text] + 2 * $lthickness}]
6362    set y1 [expr {$y + $linespc + 2 * $lthickness}]
6363    set t [$canv create rectangle $x0 $y0 $x1 $y1 \
6364               -fill \#ffff80 -outline black -width 1 -tags hover]
6365    $canv raise $t
6366    set t [$canv create text $x $y -anchor nw -text $text -tags hover \
6367               -font mainfont]
6368    $canv raise $t
6369}
6370
6371proc clickisonarrow {id y} {
6372    global lthickness
6373
6374    set ranges [rowranges $id]
6375    set thresh [expr {2 * $lthickness + 6}]
6376    set n [expr {[llength $ranges] - 1}]
6377    for {set i 1} {$i < $n} {incr i} {
6378        set row [lindex $ranges $i]
6379        if {abs([yc $row] - $y) < $thresh} {
6380            return $i
6381        }
6382    }
6383    return {}
6384}
6385
6386proc arrowjump {id n y} {
6387    global canv
6388
6389    # 1 <-> 2, 3 <-> 4, etc...
6390    set n [expr {(($n - 1) ^ 1) + 1}]
6391    set row [lindex [rowranges $id] $n]
6392    set yt [yc $row]
6393    set ymax [lindex [$canv cget -scrollregion] 3]
6394    if {$ymax eq {} || $ymax <= 0} return
6395    set view [$canv yview]
6396    set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
6397    set yfrac [expr {$yt / $ymax - $yspan / 2}]
6398    if {$yfrac < 0} {
6399        set yfrac 0
6400    }
6401    allcanvs yview moveto $yfrac
6402}
6403
6404proc lineclick {x y id isnew} {
6405    global ctext commitinfo children canv thickerline curview
6406
6407    if {![info exists commitinfo($id)] && ![getcommit $id]} return
6408    unmarkmatches
6409    unselectline
6410    normalline
6411    $canv delete hover
6412    # draw this line thicker than normal
6413    set thickerline $id
6414    drawlines $id
6415    if {$isnew} {
6416        set ymax [lindex [$canv cget -scrollregion] 3]
6417        if {$ymax eq {}} return
6418        set yfrac [lindex [$canv yview] 0]
6419        set y [expr {$y + $yfrac * $ymax}]
6420    }
6421    set dirn [clickisonarrow $id $y]
6422    if {$dirn ne {}} {
6423        arrowjump $id $dirn $y
6424        return
6425    }
6426
6427    if {$isnew} {
6428        addtohistory [list lineclick $x $y $id 0]
6429    }
6430    # fill the details pane with info about this line
6431    $ctext conf -state normal
6432    clear_ctext
6433    settabs 0
6434    $ctext insert end "Parent:\t"
6435    $ctext insert end $id link0
6436    setlink $id link0
6437    set info $commitinfo($id)
6438    $ctext insert end "\n\t[lindex $info 0]\n"
6439    $ctext insert end "\tAuthor:\t[lindex $info 1]\n"
6440    set date [formatdate [lindex $info 2]]
6441    $ctext insert end "\tDate:\t$date\n"
6442    set kids $children($curview,$id)
6443    if {$kids ne {}} {
6444        $ctext insert end "\nChildren:"
6445        set i 0
6446        foreach child $kids {
6447            incr i
6448            if {![info exists commitinfo($child)] && ![getcommit $child]} continue
6449            set info $commitinfo($child)
6450            $ctext insert end "\n\t"
6451            $ctext insert end $child link$i
6452            setlink $child link$i
6453            $ctext insert end "\n\t[lindex $info 0]"
6454            $ctext insert end "\n\tAuthor:\t[lindex $info 1]"
6455            set date [formatdate [lindex $info 2]]
6456            $ctext insert end "\n\tDate:\t$date\n"
6457        }
6458    }
6459    $ctext conf -state disabled
6460    init_flist {}
6461}
6462
6463proc normalline {} {
6464    global thickerline
6465    if {[info exists thickerline]} {
6466        set id $thickerline
6467        unset thickerline
6468        drawlines $id
6469    }
6470}
6471
6472proc selbyid {id} {
6473    global curview
6474    if {[commitinview $id $curview]} {
6475        selectline [rowofcommit $id] 1
6476    }
6477}
6478
6479proc mstime {} {
6480    global startmstime
6481    if {![info exists startmstime]} {
6482        set startmstime [clock clicks -milliseconds]
6483    }
6484    return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
6485}
6486
6487proc rowmenu {x y id} {
6488    global rowctxmenu selectedline rowmenuid curview
6489    global nullid nullid2 fakerowmenu mainhead
6490
6491    stopfinding
6492    set rowmenuid $id
6493    if {![info exists selectedline]
6494        || [rowofcommit $id] eq $selectedline} {
6495        set state disabled
6496    } else {
6497        set state normal
6498    }
6499    if {$id ne $nullid && $id ne $nullid2} {
6500        set menu $rowctxmenu
6501        $menu entryconfigure 7 -label "Reset $mainhead branch to here"
6502    } else {
6503        set menu $fakerowmenu
6504    }
6505    $menu entryconfigure "Diff this*" -state $state
6506    $menu entryconfigure "Diff selected*" -state $state
6507    $menu entryconfigure "Make patch" -state $state
6508    tk_popup $menu $x $y
6509}
6510
6511proc diffvssel {dirn} {
6512    global rowmenuid selectedline
6513
6514    if {![info exists selectedline]} return
6515    if {$dirn} {
6516        set oldid [commitonrow $selectedline]
6517        set newid $rowmenuid
6518    } else {
6519        set oldid $rowmenuid
6520        set newid [commitonrow $selectedline]
6521    }
6522    addtohistory [list doseldiff $oldid $newid]
6523    doseldiff $oldid $newid
6524}
6525
6526proc doseldiff {oldid newid} {
6527    global ctext
6528    global commitinfo
6529
6530    $ctext conf -state normal
6531    clear_ctext
6532    init_flist "Top"
6533    $ctext insert end "From "
6534    $ctext insert end $oldid link0
6535    setlink $oldid link0
6536    $ctext insert end "\n     "
6537    $ctext insert end [lindex $commitinfo($oldid) 0]
6538    $ctext insert end "\n\nTo   "
6539    $ctext insert end $newid link1
6540    setlink $newid link1
6541    $ctext insert end "\n     "
6542    $ctext insert end [lindex $commitinfo($newid) 0]
6543    $ctext insert end "\n"
6544    $ctext conf -state disabled
6545    $ctext tag remove found 1.0 end
6546    startdiff [list $oldid $newid]
6547}
6548
6549proc mkpatch {} {
6550    global rowmenuid currentid commitinfo patchtop patchnum
6551
6552    if {![info exists currentid]} return
6553    set oldid $currentid
6554    set oldhead [lindex $commitinfo($oldid) 0]
6555    set newid $rowmenuid
6556    set newhead [lindex $commitinfo($newid) 0]
6557    set top .patch
6558    set patchtop $top
6559    catch {destroy $top}
6560    toplevel $top
6561    label $top.title -text "Generate patch"
6562    grid $top.title - -pady 10
6563    label $top.from -text "From:"
6564    entry $top.fromsha1 -width 40 -relief flat
6565    $top.fromsha1 insert 0 $oldid
6566    $top.fromsha1 conf -state readonly
6567    grid $top.from $top.fromsha1 -sticky w
6568    entry $top.fromhead -width 60 -relief flat
6569    $top.fromhead insert 0 $oldhead
6570    $top.fromhead conf -state readonly
6571    grid x $top.fromhead -sticky w
6572    label $top.to -text "To:"
6573    entry $top.tosha1 -width 40 -relief flat
6574    $top.tosha1 insert 0 $newid
6575    $top.tosha1 conf -state readonly
6576    grid $top.to $top.tosha1 -sticky w
6577    entry $top.tohead -width 60 -relief flat
6578    $top.tohead insert 0 $newhead
6579    $top.tohead conf -state readonly
6580    grid x $top.tohead -sticky w
6581    button $top.rev -text "Reverse" -command mkpatchrev -padx 5
6582    grid $top.rev x -pady 10
6583    label $top.flab -text "Output file:"
6584    entry $top.fname -width 60
6585    $top.fname insert 0 [file normalize "patch$patchnum.patch"]
6586    incr patchnum
6587    grid $top.flab $top.fname -sticky w
6588    frame $top.buts
6589    button $top.buts.gen -text "Generate" -command mkpatchgo
6590    button $top.buts.can -text "Cancel" -command mkpatchcan
6591    grid $top.buts.gen $top.buts.can
6592    grid columnconfigure $top.buts 0 -weight 1 -uniform a
6593    grid columnconfigure $top.buts 1 -weight 1 -uniform a
6594    grid $top.buts - -pady 10 -sticky ew
6595    focus $top.fname
6596}
6597
6598proc mkpatchrev {} {
6599    global patchtop
6600
6601    set oldid [$patchtop.fromsha1 get]
6602    set oldhead [$patchtop.fromhead get]
6603    set newid [$patchtop.tosha1 get]
6604    set newhead [$patchtop.tohead get]
6605    foreach e [list fromsha1 fromhead tosha1 tohead] \
6606            v [list $newid $newhead $oldid $oldhead] {
6607        $patchtop.$e conf -state normal
6608        $patchtop.$e delete 0 end
6609        $patchtop.$e insert 0 $v
6610        $patchtop.$e conf -state readonly
6611    }
6612}
6613
6614proc mkpatchgo {} {
6615    global patchtop nullid nullid2
6616
6617    set oldid [$patchtop.fromsha1 get]
6618    set newid [$patchtop.tosha1 get]
6619    set fname [$patchtop.fname get]
6620    set cmd [diffcmd [list $oldid $newid] -p]
6621    # trim off the initial "|"
6622    set cmd [lrange $cmd 1 end]
6623    lappend cmd >$fname &
6624    if {[catch {eval exec $cmd} err]} {
6625        error_popup "Error creating patch: $err"
6626    }
6627    catch {destroy $patchtop}
6628    unset patchtop
6629}
6630
6631proc mkpatchcan {} {
6632    global patchtop
6633
6634    catch {destroy $patchtop}
6635    unset patchtop
6636}
6637
6638proc mktag {} {
6639    global rowmenuid mktagtop commitinfo
6640
6641    set top .maketag
6642    set mktagtop $top
6643    catch {destroy $top}
6644    toplevel $top
6645    label $top.title -text "Create tag"
6646    grid $top.title - -pady 10
6647    label $top.id -text "ID:"
6648    entry $top.sha1 -width 40 -relief flat
6649    $top.sha1 insert 0 $rowmenuid
6650    $top.sha1 conf -state readonly
6651    grid $top.id $top.sha1 -sticky w
6652    entry $top.head -width 60 -relief flat
6653    $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
6654    $top.head conf -state readonly
6655    grid x $top.head -sticky w
6656    label $top.tlab -text "Tag name:"
6657    entry $top.tag -width 60
6658    grid $top.tlab $top.tag -sticky w
6659    frame $top.buts
6660    button $top.buts.gen -text "Create" -command mktaggo
6661    button $top.buts.can -text "Cancel" -command mktagcan
6662    grid $top.buts.gen $top.buts.can
6663    grid columnconfigure $top.buts 0 -weight 1 -uniform a
6664    grid columnconfigure $top.buts 1 -weight 1 -uniform a
6665    grid $top.buts - -pady 10 -sticky ew
6666    focus $top.tag
6667}
6668
6669proc domktag {} {
6670    global mktagtop env tagids idtags
6671
6672    set id [$mktagtop.sha1 get]
6673    set tag [$mktagtop.tag get]
6674    if {$tag == {}} {
6675        error_popup "No tag name specified"
6676        return
6677    }
6678    if {[info exists tagids($tag)]} {
6679        error_popup "Tag \"$tag\" already exists"
6680        return
6681    }
6682    if {[catch {
6683        set dir [gitdir]
6684        set fname [file join $dir "refs/tags" $tag]
6685        set f [open $fname w]
6686        puts $f $id
6687        close $f
6688    } err]} {
6689        error_popup "Error creating tag: $err"
6690        return
6691    }
6692
6693    set tagids($tag) $id
6694    lappend idtags($id) $tag
6695    redrawtags $id
6696    addedtag $id
6697    dispneartags 0
6698    run refill_reflist
6699}
6700
6701proc redrawtags {id} {
6702    global canv linehtag idpos selectedline curview
6703    global canvxmax iddrawn
6704
6705    if {![commitinview $id $curview]} return
6706    if {![info exists iddrawn($id)]} return
6707    drawcommits [rowofcommit $id]
6708    $canv delete tag.$id
6709    set xt [eval drawtags $id $idpos($id)]
6710    $canv coords $linehtag([rowofcommit $id]) $xt [lindex $idpos($id) 2]
6711    set text [$canv itemcget $linehtag([rowofcommit $id]) -text]
6712    set xr [expr {$xt + [font measure mainfont $text]}]
6713    if {$xr > $canvxmax} {
6714        set canvxmax $xr
6715        setcanvscroll
6716    }
6717    if {[info exists selectedline]
6718        && $selectedline == [rowofcommit $id]} {
6719        selectline $selectedline 0
6720    }
6721}
6722
6723proc mktagcan {} {
6724    global mktagtop
6725
6726    catch {destroy $mktagtop}
6727    unset mktagtop
6728}
6729
6730proc mktaggo {} {
6731    domktag
6732    mktagcan
6733}
6734
6735proc writecommit {} {
6736    global rowmenuid wrcomtop commitinfo wrcomcmd
6737
6738    set top .writecommit
6739    set wrcomtop $top
6740    catch {destroy $top}
6741    toplevel $top
6742    label $top.title -text "Write commit to file"
6743    grid $top.title - -pady 10
6744    label $top.id -text "ID:"
6745    entry $top.sha1 -width 40 -relief flat
6746    $top.sha1 insert 0 $rowmenuid
6747    $top.sha1 conf -state readonly
6748    grid $top.id $top.sha1 -sticky w
6749    entry $top.head -width 60 -relief flat
6750    $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
6751    $top.head conf -state readonly
6752    grid x $top.head -sticky w
6753    label $top.clab -text "Command:"
6754    entry $top.cmd -width 60 -textvariable wrcomcmd
6755    grid $top.clab $top.cmd -sticky w -pady 10
6756    label $top.flab -text "Output file:"
6757    entry $top.fname -width 60
6758    $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
6759    grid $top.flab $top.fname -sticky w
6760    frame $top.buts
6761    button $top.buts.gen -text "Write" -command wrcomgo
6762    button $top.buts.can -text "Cancel" -command wrcomcan
6763    grid $top.buts.gen $top.buts.can
6764    grid columnconfigure $top.buts 0 -weight 1 -uniform a
6765    grid columnconfigure $top.buts 1 -weight 1 -uniform a
6766    grid $top.buts - -pady 10 -sticky ew
6767    focus $top.fname
6768}
6769
6770proc wrcomgo {} {
6771    global wrcomtop
6772
6773    set id [$wrcomtop.sha1 get]
6774    set cmd "echo $id | [$wrcomtop.cmd get]"
6775    set fname [$wrcomtop.fname get]
6776    if {[catch {exec sh -c $cmd >$fname &} err]} {
6777        error_popup "Error writing commit: $err"
6778    }
6779    catch {destroy $wrcomtop}
6780    unset wrcomtop
6781}
6782
6783proc wrcomcan {} {
6784    global wrcomtop
6785
6786    catch {destroy $wrcomtop}
6787    unset wrcomtop
6788}
6789
6790proc mkbranch {} {
6791    global rowmenuid mkbrtop
6792
6793    set top .makebranch
6794    catch {destroy $top}
6795    toplevel $top
6796    label $top.title -text "Create new branch"
6797    grid $top.title - -pady 10
6798    label $top.id -text "ID:"
6799    entry $top.sha1 -width 40 -relief flat
6800    $top.sha1 insert 0 $rowmenuid
6801    $top.sha1 conf -state readonly
6802    grid $top.id $top.sha1 -sticky w
6803    label $top.nlab -text "Name:"
6804    entry $top.name -width 40
6805    grid $top.nlab $top.name -sticky w
6806    frame $top.buts
6807    button $top.buts.go -text "Create" -command [list mkbrgo $top]
6808    button $top.buts.can -text "Cancel" -command "catch {destroy $top}"
6809    grid $top.buts.go $top.buts.can
6810    grid columnconfigure $top.buts 0 -weight 1 -uniform a
6811    grid columnconfigure $top.buts 1 -weight 1 -uniform a
6812    grid $top.buts - -pady 10 -sticky ew
6813    focus $top.name
6814}
6815
6816proc mkbrgo {top} {
6817    global headids idheads
6818
6819    set name [$top.name get]
6820    set id [$top.sha1 get]
6821    if {$name eq {}} {
6822        error_popup "Please specify a name for the new branch"
6823        return
6824    }
6825    catch {destroy $top}
6826    nowbusy newbranch
6827    update
6828    if {[catch {
6829        exec git branch $name $id
6830    } err]} {
6831        notbusy newbranch
6832        error_popup $err
6833    } else {
6834        set headids($name) $id
6835        lappend idheads($id) $name
6836        addedhead $id $name
6837        notbusy newbranch
6838        redrawtags $id
6839        dispneartags 0
6840        run refill_reflist
6841    }
6842}
6843
6844proc cherrypick {} {
6845    global rowmenuid curview
6846    global mainhead
6847
6848    set oldhead [exec git rev-parse HEAD]
6849    set dheads [descheads $rowmenuid]
6850    if {$dheads ne {} && [lsearch -exact $dheads $oldhead] >= 0} {
6851        set ok [confirm_popup "Commit [string range $rowmenuid 0 7] is already\
6852                        included in branch $mainhead -- really re-apply it?"]
6853        if {!$ok} return
6854    }
6855    nowbusy cherrypick "Cherry-picking"
6856    update
6857    # Unfortunately git-cherry-pick writes stuff to stderr even when
6858    # no error occurs, and exec takes that as an indication of error...
6859    if {[catch {exec sh -c "git cherry-pick -r $rowmenuid 2>&1"} err]} {
6860        notbusy cherrypick
6861        error_popup $err
6862        return
6863    }
6864    set newhead [exec git rev-parse HEAD]
6865    if {$newhead eq $oldhead} {
6866        notbusy cherrypick
6867        error_popup "No changes committed"
6868        return
6869    }
6870    addnewchild $newhead $oldhead
6871    if {[commitinview $oldhead $curview]} {
6872        insertrow $newhead $oldhead $curview
6873        if {$mainhead ne {}} {
6874            movehead $newhead $mainhead
6875            movedhead $newhead $mainhead
6876        }
6877        redrawtags $oldhead
6878        redrawtags $newhead
6879    }
6880    notbusy cherrypick
6881}
6882
6883proc resethead {} {
6884    global mainheadid mainhead rowmenuid confirm_ok resettype
6885
6886    set confirm_ok 0
6887    set w ".confirmreset"
6888    toplevel $w
6889    wm transient $w .
6890    wm title $w "Confirm reset"
6891    message $w.m -text \
6892        "Reset branch $mainhead to [string range $rowmenuid 0 7]?" \
6893        -justify center -aspect 1000
6894    pack $w.m -side top -fill x -padx 20 -pady 20
6895    frame $w.f -relief sunken -border 2
6896    message $w.f.rt -text "Reset type:" -aspect 1000
6897    grid $w.f.rt -sticky w
6898    set resettype mixed
6899    radiobutton $w.f.soft -value soft -variable resettype -justify left \
6900        -text "Soft: Leave working tree and index untouched"
6901    grid $w.f.soft -sticky w
6902    radiobutton $w.f.mixed -value mixed -variable resettype -justify left \
6903        -text "Mixed: Leave working tree untouched, reset index"
6904    grid $w.f.mixed -sticky w
6905    radiobutton $w.f.hard -value hard -variable resettype -justify left \
6906        -text "Hard: Reset working tree and index\n(discard ALL local changes)"
6907    grid $w.f.hard -sticky w
6908    pack $w.f -side top -fill x
6909    button $w.ok -text OK -command "set confirm_ok 1; destroy $w"
6910    pack $w.ok -side left -fill x -padx 20 -pady 20
6911    button $w.cancel -text Cancel -command "destroy $w"
6912    pack $w.cancel -side right -fill x -padx 20 -pady 20
6913    bind $w <Visibility> "grab $w; focus $w"
6914    tkwait window $w
6915    if {!$confirm_ok} return
6916    if {[catch {set fd [open \
6917            [list | sh -c "git reset --$resettype $rowmenuid 2>&1"] r]} err]} {
6918        error_popup $err
6919    } else {
6920        dohidelocalchanges
6921        filerun $fd [list readresetstat $fd]
6922        nowbusy reset "Resetting"
6923    }
6924}
6925
6926proc readresetstat {fd} {
6927    global mainhead mainheadid showlocalchanges rprogcoord
6928
6929    if {[gets $fd line] >= 0} {
6930        if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
6931            set rprogcoord [expr {1.0 * $m / $n}]
6932            adjustprogress
6933        }
6934        return 1
6935    }
6936    set rprogcoord 0
6937    adjustprogress
6938    notbusy reset
6939    if {[catch {close $fd} err]} {
6940        error_popup $err
6941    }
6942    set oldhead $mainheadid
6943    set newhead [exec git rev-parse HEAD]
6944    if {$newhead ne $oldhead} {
6945        movehead $newhead $mainhead
6946        movedhead $newhead $mainhead
6947        set mainheadid $newhead
6948        redrawtags $oldhead
6949        redrawtags $newhead
6950    }
6951    if {$showlocalchanges} {
6952        doshowlocalchanges
6953    }
6954    return 0
6955}
6956
6957# context menu for a head
6958proc headmenu {x y id head} {
6959    global headmenuid headmenuhead headctxmenu mainhead
6960
6961    stopfinding
6962    set headmenuid $id
6963    set headmenuhead $head
6964    set state normal
6965    if {$head eq $mainhead} {
6966        set state disabled
6967    }
6968    $headctxmenu entryconfigure 0 -state $state
6969    $headctxmenu entryconfigure 1 -state $state
6970    tk_popup $headctxmenu $x $y
6971}
6972
6973proc cobranch {} {
6974    global headmenuid headmenuhead mainhead headids
6975    global showlocalchanges mainheadid
6976
6977    # check the tree is clean first??
6978    set oldmainhead $mainhead
6979    nowbusy checkout "Checking out"
6980    update
6981    dohidelocalchanges
6982    if {[catch {
6983        exec git checkout -q $headmenuhead
6984    } err]} {
6985        notbusy checkout
6986        error_popup $err
6987    } else {
6988        notbusy checkout
6989        set mainhead $headmenuhead
6990        set mainheadid $headmenuid
6991        if {[info exists headids($oldmainhead)]} {
6992            redrawtags $headids($oldmainhead)
6993        }
6994        redrawtags $headmenuid
6995    }
6996    if {$showlocalchanges} {
6997        dodiffindex
6998    }
6999}
7000
7001proc rmbranch {} {
7002    global headmenuid headmenuhead mainhead
7003    global idheads
7004
7005    set head $headmenuhead
7006    set id $headmenuid
7007    # this check shouldn't be needed any more...
7008    if {$head eq $mainhead} {
7009        error_popup "Cannot delete the currently checked-out branch"
7010        return
7011    }
7012    set dheads [descheads $id]
7013    if {[llength $dheads] == 1 && $idheads($dheads) eq $head} {
7014        # the stuff on this branch isn't on any other branch
7015        if {![confirm_popup "The commits on branch $head aren't on any other\
7016                        branch.\nReally delete branch $head?"]} return
7017    }
7018    nowbusy rmbranch
7019    update
7020    if {[catch {exec git branch -D $head} err]} {
7021        notbusy rmbranch
7022        error_popup $err
7023        return
7024    }
7025    removehead $id $head
7026    removedhead $id $head
7027    redrawtags $id
7028    notbusy rmbranch
7029    dispneartags 0
7030    run refill_reflist
7031}
7032
7033# Display a list of tags and heads
7034proc showrefs {} {
7035    global showrefstop bgcolor fgcolor selectbgcolor
7036    global bglist fglist reflistfilter reflist maincursor
7037
7038    set top .showrefs
7039    set showrefstop $top
7040    if {[winfo exists $top]} {
7041        raise $top
7042        refill_reflist
7043        return
7044    }
7045    toplevel $top
7046    wm title $top "Tags and heads: [file tail [pwd]]"
7047    text $top.list -background $bgcolor -foreground $fgcolor \
7048        -selectbackground $selectbgcolor -font mainfont \
7049        -xscrollcommand "$top.xsb set" -yscrollcommand "$top.ysb set" \
7050        -width 30 -height 20 -cursor $maincursor \
7051        -spacing1 1 -spacing3 1 -state disabled
7052    $top.list tag configure highlight -background $selectbgcolor
7053    lappend bglist $top.list
7054    lappend fglist $top.list
7055    scrollbar $top.ysb -command "$top.list yview" -orient vertical
7056    scrollbar $top.xsb -command "$top.list xview" -orient horizontal
7057    grid $top.list $top.ysb -sticky nsew
7058    grid $top.xsb x -sticky ew
7059    frame $top.f
7060    label $top.f.l -text "Filter: " -font uifont
7061    entry $top.f.e -width 20 -textvariable reflistfilter -font uifont
7062    set reflistfilter "*"
7063    trace add variable reflistfilter write reflistfilter_change
7064    pack $top.f.e -side right -fill x -expand 1
7065    pack $top.f.l -side left
7066    grid $top.f - -sticky ew -pady 2
7067    button $top.close -command [list destroy $top] -text "Close" \
7068        -font uifont
7069    grid $top.close -
7070    grid columnconfigure $top 0 -weight 1
7071    grid rowconfigure $top 0 -weight 1
7072    bind $top.list <1> {break}
7073    bind $top.list <B1-Motion> {break}
7074    bind $top.list <ButtonRelease-1> {sel_reflist %W %x %y; break}
7075    set reflist {}
7076    refill_reflist
7077}
7078
7079proc sel_reflist {w x y} {
7080    global showrefstop reflist headids tagids otherrefids
7081
7082    if {![winfo exists $showrefstop]} return
7083    set l [lindex [split [$w index "@$x,$y"] "."] 0]
7084    set ref [lindex $reflist [expr {$l-1}]]
7085    set n [lindex $ref 0]
7086    switch -- [lindex $ref 1] {
7087        "H" {selbyid $headids($n)}
7088        "T" {selbyid $tagids($n)}
7089        "o" {selbyid $otherrefids($n)}
7090    }
7091    $showrefstop.list tag add highlight $l.0 "$l.0 lineend"
7092}
7093
7094proc unsel_reflist {} {
7095    global showrefstop
7096
7097    if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
7098    $showrefstop.list tag remove highlight 0.0 end
7099}
7100
7101proc reflistfilter_change {n1 n2 op} {
7102    global reflistfilter
7103
7104    after cancel refill_reflist
7105    after 200 refill_reflist
7106}
7107
7108proc refill_reflist {} {
7109    global reflist reflistfilter showrefstop headids tagids otherrefids
7110    global curview commitinterest
7111
7112    if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
7113    set refs {}
7114    foreach n [array names headids] {
7115        if {[string match $reflistfilter $n]} {
7116            if {[commitinview $headids($n) $curview]} {
7117                lappend refs [list $n H]
7118            } else {
7119                set commitinterest($headids($n)) {run refill_reflist}
7120            }
7121        }
7122    }
7123    foreach n [array names tagids] {
7124        if {[string match $reflistfilter $n]} {
7125            if {[commitinview $tagids($n) $curview]} {
7126                lappend refs [list $n T]
7127            } else {
7128                set commitinterest($tagids($n)) {run refill_reflist}
7129            }
7130        }
7131    }
7132    foreach n [array names otherrefids] {
7133        if {[string match $reflistfilter $n]} {
7134            if {[commitinview $otherrefids($n) $curview]} {
7135                lappend refs [list $n o]
7136            } else {
7137                set commitinterest($otherrefids($n)) {run refill_reflist}
7138            }
7139        }
7140    }
7141    set refs [lsort -index 0 $refs]
7142    if {$refs eq $reflist} return
7143
7144    # Update the contents of $showrefstop.list according to the
7145    # differences between $reflist (old) and $refs (new)
7146    $showrefstop.list conf -state normal
7147    $showrefstop.list insert end "\n"
7148    set i 0
7149    set j 0
7150    while {$i < [llength $reflist] || $j < [llength $refs]} {
7151        if {$i < [llength $reflist]} {
7152            if {$j < [llength $refs]} {
7153                set cmp [string compare [lindex $reflist $i 0] \
7154                             [lindex $refs $j 0]]
7155                if {$cmp == 0} {
7156                    set cmp [string compare [lindex $reflist $i 1] \
7157                                 [lindex $refs $j 1]]
7158                }
7159            } else {
7160                set cmp -1
7161            }
7162        } else {
7163            set cmp 1
7164        }
7165        switch -- $cmp {
7166            -1 {
7167                $showrefstop.list delete "[expr {$j+1}].0" "[expr {$j+2}].0"
7168                incr i
7169            }
7170            0 {
7171                incr i
7172                incr j
7173            }
7174            1 {
7175                set l [expr {$j + 1}]
7176                $showrefstop.list image create $l.0 -align baseline \
7177                    -image reficon-[lindex $refs $j 1] -padx 2
7178                $showrefstop.list insert $l.1 "[lindex $refs $j 0]\n"
7179                incr j
7180            }
7181        }
7182    }
7183    set reflist $refs
7184    # delete last newline
7185    $showrefstop.list delete end-2c end-1c
7186    $showrefstop.list conf -state disabled
7187}
7188
7189# Stuff for finding nearby tags
7190proc getallcommits {} {
7191    global allcommits nextarc seeds allccache allcwait cachedarcs allcupdate
7192    global idheads idtags idotherrefs allparents tagobjid
7193
7194    if {![info exists allcommits]} {
7195        set nextarc 0
7196        set allcommits 0
7197        set seeds {}
7198        set allcwait 0
7199        set cachedarcs 0
7200        set allccache [file join [gitdir] "gitk.cache"]
7201        if {![catch {
7202            set f [open $allccache r]
7203            set allcwait 1
7204            getcache $f
7205        }]} return
7206    }
7207
7208    if {$allcwait} {
7209        return
7210    }
7211    set cmd [list | git rev-list --parents]
7212    set allcupdate [expr {$seeds ne {}}]
7213    if {!$allcupdate} {
7214        set ids "--all"
7215    } else {
7216        set refs [concat [array names idheads] [array names idtags] \
7217                      [array names idotherrefs]]
7218        set ids {}
7219        set tagobjs {}
7220        foreach name [array names tagobjid] {
7221            lappend tagobjs $tagobjid($name)
7222        }
7223        foreach id [lsort -unique $refs] {
7224            if {![info exists allparents($id)] &&
7225                [lsearch -exact $tagobjs $id] < 0} {
7226                lappend ids $id
7227            }
7228        }
7229        if {$ids ne {}} {
7230            foreach id $seeds {
7231                lappend ids "^$id"
7232            }
7233        }
7234    }
7235    if {$ids ne {}} {
7236        set fd [open [concat $cmd $ids] r]
7237        fconfigure $fd -blocking 0
7238        incr allcommits
7239        nowbusy allcommits
7240        filerun $fd [list getallclines $fd]
7241    } else {
7242        dispneartags 0
7243    }
7244}
7245
7246# Since most commits have 1 parent and 1 child, we group strings of
7247# such commits into "arcs" joining branch/merge points (BMPs), which
7248# are commits that either don't have 1 parent or don't have 1 child.
7249#
7250# arcnos(id) - incoming arcs for BMP, arc we're on for other nodes
7251# arcout(id) - outgoing arcs for BMP
7252# arcids(a) - list of IDs on arc including end but not start
7253# arcstart(a) - BMP ID at start of arc
7254# arcend(a) - BMP ID at end of arc
7255# growing(a) - arc a is still growing
7256# arctags(a) - IDs out of arcids (excluding end) that have tags
7257# archeads(a) - IDs out of arcids (excluding end) that have heads
7258# The start of an arc is at the descendent end, so "incoming" means
7259# coming from descendents, and "outgoing" means going towards ancestors.
7260
7261proc getallclines {fd} {
7262    global allparents allchildren idtags idheads nextarc
7263    global arcnos arcids arctags arcout arcend arcstart archeads growing
7264    global seeds allcommits cachedarcs allcupdate
7265    
7266    set nid 0
7267    while {[incr nid] <= 1000 && [gets $fd line] >= 0} {
7268        set id [lindex $line 0]
7269        if {[info exists allparents($id)]} {
7270            # seen it already
7271            continue
7272        }
7273        set cachedarcs 0
7274        set olds [lrange $line 1 end]
7275        set allparents($id) $olds
7276        if {![info exists allchildren($id)]} {
7277            set allchildren($id) {}
7278            set arcnos($id) {}
7279            lappend seeds $id
7280        } else {
7281            set a $arcnos($id)
7282            if {[llength $olds] == 1 && [llength $a] == 1} {
7283                lappend arcids($a) $id
7284                if {[info exists idtags($id)]} {
7285                    lappend arctags($a) $id
7286                }
7287                if {[info exists idheads($id)]} {
7288                    lappend archeads($a) $id
7289                }
7290                if {[info exists allparents($olds)]} {
7291                    # seen parent already
7292                    if {![info exists arcout($olds)]} {
7293                        splitarc $olds
7294                    }
7295                    lappend arcids($a) $olds
7296                    set arcend($a) $olds
7297                    unset growing($a)
7298                }
7299                lappend allchildren($olds) $id
7300                lappend arcnos($olds) $a
7301                continue
7302            }
7303        }
7304        foreach a $arcnos($id) {
7305            lappend arcids($a) $id
7306            set arcend($a) $id
7307            unset growing($a)
7308        }
7309
7310        set ao {}
7311        foreach p $olds {
7312            lappend allchildren($p) $id
7313            set a [incr nextarc]
7314            set arcstart($a) $id
7315            set archeads($a) {}
7316            set arctags($a) {}
7317            set archeads($a) {}
7318            set arcids($a) {}
7319            lappend ao $a
7320            set growing($a) 1
7321            if {[info exists allparents($p)]} {
7322                # seen it already, may need to make a new branch
7323                if {![info exists arcout($p)]} {
7324                    splitarc $p
7325                }
7326                lappend arcids($a) $p
7327                set arcend($a) $p
7328                unset growing($a)
7329            }
7330            lappend arcnos($p) $a
7331        }
7332        set arcout($id) $ao
7333    }
7334    if {$nid > 0} {
7335        global cached_dheads cached_dtags cached_atags
7336        catch {unset cached_dheads}
7337        catch {unset cached_dtags}
7338        catch {unset cached_atags}
7339    }
7340    if {![eof $fd]} {
7341        return [expr {$nid >= 1000? 2: 1}]
7342    }
7343    set cacheok 1
7344    if {[catch {
7345        fconfigure $fd -blocking 1
7346        close $fd
7347    } err]} {
7348        # got an error reading the list of commits
7349        # if we were updating, try rereading the whole thing again
7350        if {$allcupdate} {
7351            incr allcommits -1
7352            dropcache $err
7353            return
7354        }
7355        error_popup "Error reading commit topology information;\
7356                branch and preceding/following tag information\
7357                will be incomplete.\n($err)"
7358        set cacheok 0
7359    }
7360    if {[incr allcommits -1] == 0} {
7361        notbusy allcommits
7362        if {$cacheok} {
7363            run savecache
7364        }
7365    }
7366    dispneartags 0
7367    return 0
7368}
7369
7370proc recalcarc {a} {
7371    global arctags archeads arcids idtags idheads
7372
7373    set at {}
7374    set ah {}
7375    foreach id [lrange $arcids($a) 0 end-1] {
7376        if {[info exists idtags($id)]} {
7377            lappend at $id
7378        }
7379        if {[info exists idheads($id)]} {
7380            lappend ah $id
7381        }
7382    }
7383    set arctags($a) $at
7384    set archeads($a) $ah
7385}
7386
7387proc splitarc {p} {
7388    global arcnos arcids nextarc arctags archeads idtags idheads
7389    global arcstart arcend arcout allparents growing
7390
7391    set a $arcnos($p)
7392    if {[llength $a] != 1} {
7393        puts "oops splitarc called but [llength $a] arcs already"
7394        return
7395    }
7396    set a [lindex $a 0]
7397    set i [lsearch -exact $arcids($a) $p]
7398    if {$i < 0} {
7399        puts "oops splitarc $p not in arc $a"
7400        return
7401    }
7402    set na [incr nextarc]
7403    if {[info exists arcend($a)]} {
7404        set arcend($na) $arcend($a)
7405    } else {
7406        set l [lindex $allparents([lindex $arcids($a) end]) 0]
7407        set j [lsearch -exact $arcnos($l) $a]
7408        set arcnos($l) [lreplace $arcnos($l) $j $j $na]
7409    }
7410    set tail [lrange $arcids($a) [expr {$i+1}] end]
7411    set arcids($a) [lrange $arcids($a) 0 $i]
7412    set arcend($a) $p
7413    set arcstart($na) $p
7414    set arcout($p) $na
7415    set arcids($na) $tail
7416    if {[info exists growing($a)]} {
7417        set growing($na) 1
7418        unset growing($a)
7419    }
7420
7421    foreach id $tail {
7422        if {[llength $arcnos($id)] == 1} {
7423            set arcnos($id) $na
7424        } else {
7425            set j [lsearch -exact $arcnos($id) $a]
7426            set arcnos($id) [lreplace $arcnos($id) $j $j $na]
7427        }
7428    }
7429
7430    # reconstruct tags and heads lists
7431    if {$arctags($a) ne {} || $archeads($a) ne {}} {
7432        recalcarc $a
7433        recalcarc $na
7434    } else {
7435        set arctags($na) {}
7436        set archeads($na) {}
7437    }
7438}
7439
7440# Update things for a new commit added that is a child of one
7441# existing commit.  Used when cherry-picking.
7442proc addnewchild {id p} {
7443    global allparents allchildren idtags nextarc
7444    global arcnos arcids arctags arcout arcend arcstart archeads growing
7445    global seeds allcommits
7446
7447    if {![info exists allcommits] || ![info exists arcnos($p)]} return
7448    set allparents($id) [list $p]
7449    set allchildren($id) {}
7450    set arcnos($id) {}
7451    lappend seeds $id
7452    lappend allchildren($p) $id
7453    set a [incr nextarc]
7454    set arcstart($a) $id
7455    set archeads($a) {}
7456    set arctags($a) {}
7457    set arcids($a) [list $p]
7458    set arcend($a) $p
7459    if {![info exists arcout($p)]} {
7460        splitarc $p
7461    }
7462    lappend arcnos($p) $a
7463    set arcout($id) [list $a]
7464}
7465
7466# This implements a cache for the topology information.
7467# The cache saves, for each arc, the start and end of the arc,
7468# the ids on the arc, and the outgoing arcs from the end.
7469proc readcache {f} {
7470    global arcnos arcids arcout arcstart arcend arctags archeads nextarc
7471    global idtags idheads allparents cachedarcs possible_seeds seeds growing
7472    global allcwait
7473
7474    set a $nextarc
7475    set lim $cachedarcs
7476    if {$lim - $a > 500} {
7477        set lim [expr {$a + 500}]
7478    }
7479    if {[catch {
7480        if {$a == $lim} {
7481            # finish reading the cache and setting up arctags, etc.
7482            set line [gets $f]
7483            if {$line ne "1"} {error "bad final version"}
7484            close $f
7485            foreach id [array names idtags] {
7486                if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
7487                    [llength $allparents($id)] == 1} {
7488                    set a [lindex $arcnos($id) 0]
7489                    if {$arctags($a) eq {}} {
7490                        recalcarc $a
7491                    }
7492                }
7493            }
7494            foreach id [array names idheads] {
7495                if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
7496                    [llength $allparents($id)] == 1} {
7497                    set a [lindex $arcnos($id) 0]
7498                    if {$archeads($a) eq {}} {
7499                        recalcarc $a
7500                    }
7501                }
7502            }
7503            foreach id [lsort -unique $possible_seeds] {
7504                if {$arcnos($id) eq {}} {
7505                    lappend seeds $id
7506                }
7507            }
7508            set allcwait 0
7509        } else {
7510            while {[incr a] <= $lim} {
7511                set line [gets $f]
7512                if {[llength $line] != 3} {error "bad line"}
7513                set s [lindex $line 0]
7514                set arcstart($a) $s
7515                lappend arcout($s) $a
7516                if {![info exists arcnos($s)]} {
7517                    lappend possible_seeds $s
7518                    set arcnos($s) {}
7519                }
7520                set e [lindex $line 1]
7521                if {$e eq {}} {
7522                    set growing($a) 1
7523                } else {
7524                    set arcend($a) $e
7525                    if {![info exists arcout($e)]} {
7526                        set arcout($e) {}
7527                    }
7528                }
7529                set arcids($a) [lindex $line 2]
7530                foreach id $arcids($a) {
7531                    lappend allparents($s) $id
7532                    set s $id
7533                    lappend arcnos($id) $a
7534                }
7535                if {![info exists allparents($s)]} {
7536                    set allparents($s) {}
7537                }
7538                set arctags($a) {}
7539                set archeads($a) {}
7540            }
7541            set nextarc [expr {$a - 1}]
7542        }
7543    } err]} {
7544        dropcache $err
7545        return 0
7546    }
7547    if {!$allcwait} {
7548        getallcommits
7549    }
7550    return $allcwait
7551}
7552
7553proc getcache {f} {
7554    global nextarc cachedarcs possible_seeds
7555
7556    if {[catch {
7557        set line [gets $f]
7558        if {[llength $line] != 2 || [lindex $line 0] ne "1"} {error "bad version"}
7559        # make sure it's an integer
7560        set cachedarcs [expr {int([lindex $line 1])}]
7561        if {$cachedarcs < 0} {error "bad number of arcs"}
7562        set nextarc 0
7563        set possible_seeds {}
7564        run readcache $f
7565    } err]} {
7566        dropcache $err
7567    }
7568    return 0
7569}
7570
7571proc dropcache {err} {
7572    global allcwait nextarc cachedarcs seeds
7573
7574    #puts "dropping cache ($err)"
7575    foreach v {arcnos arcout arcids arcstart arcend growing \
7576                   arctags archeads allparents allchildren} {
7577        global $v
7578        catch {unset $v}
7579    }
7580    set allcwait 0
7581    set nextarc 0
7582    set cachedarcs 0
7583    set seeds {}
7584    getallcommits
7585}
7586
7587proc writecache {f} {
7588    global cachearc cachedarcs allccache
7589    global arcstart arcend arcnos arcids arcout
7590
7591    set a $cachearc
7592    set lim $cachedarcs
7593    if {$lim - $a > 1000} {
7594        set lim [expr {$a + 1000}]
7595    }
7596    if {[catch {
7597        while {[incr a] <= $lim} {
7598            if {[info exists arcend($a)]} {
7599                puts $f [list $arcstart($a) $arcend($a) $arcids($a)]
7600            } else {
7601                puts $f [list $arcstart($a) {} $arcids($a)]
7602            }
7603        }
7604    } err]} {
7605        catch {close $f}
7606        catch {file delete $allccache}
7607        #puts "writing cache failed ($err)"
7608        return 0
7609    }
7610    set cachearc [expr {$a - 1}]
7611    if {$a > $cachedarcs} {
7612        puts $f "1"
7613        close $f
7614        return 0
7615    }
7616    return 1
7617}
7618
7619proc savecache {} {
7620    global nextarc cachedarcs cachearc allccache
7621
7622    if {$nextarc == $cachedarcs} return
7623    set cachearc 0
7624    set cachedarcs $nextarc
7625    catch {
7626        set f [open $allccache w]
7627        puts $f [list 1 $cachedarcs]
7628        run writecache $f
7629    }
7630}
7631
7632# Returns 1 if a is an ancestor of b, -1 if b is an ancestor of a,
7633# or 0 if neither is true.
7634proc anc_or_desc {a b} {
7635    global arcout arcstart arcend arcnos cached_isanc
7636
7637    if {$arcnos($a) eq $arcnos($b)} {
7638        # Both are on the same arc(s); either both are the same BMP,
7639        # or if one is not a BMP, the other is also not a BMP or is
7640        # the BMP at end of the arc (and it only has 1 incoming arc).
7641        # Or both can be BMPs with no incoming arcs.
7642        if {$a eq $b || $arcnos($a) eq {}} {
7643            return 0
7644        }
7645        # assert {[llength $arcnos($a)] == 1}
7646        set arc [lindex $arcnos($a) 0]
7647        set i [lsearch -exact $arcids($arc) $a]
7648        set j [lsearch -exact $arcids($arc) $b]
7649        if {$i < 0 || $i > $j} {
7650            return 1
7651        } else {
7652            return -1
7653        }
7654    }
7655
7656    if {![info exists arcout($a)]} {
7657        set arc [lindex $arcnos($a) 0]
7658        if {[info exists arcend($arc)]} {
7659            set aend $arcend($arc)
7660        } else {
7661            set aend {}
7662        }
7663        set a $arcstart($arc)
7664    } else {
7665        set aend $a
7666    }
7667    if {![info exists arcout($b)]} {
7668        set arc [lindex $arcnos($b) 0]
7669        if {[info exists arcend($arc)]} {
7670            set bend $arcend($arc)
7671        } else {
7672            set bend {}
7673        }
7674        set b $arcstart($arc)
7675    } else {
7676        set bend $b
7677    }
7678    if {$a eq $bend} {
7679        return 1
7680    }
7681    if {$b eq $aend} {
7682        return -1
7683    }
7684    if {[info exists cached_isanc($a,$bend)]} {
7685        if {$cached_isanc($a,$bend)} {
7686            return 1
7687        }
7688    }
7689    if {[info exists cached_isanc($b,$aend)]} {
7690        if {$cached_isanc($b,$aend)} {
7691            return -1
7692        }
7693        if {[info exists cached_isanc($a,$bend)]} {
7694            return 0
7695        }
7696    }
7697
7698    set todo [list $a $b]
7699    set anc($a) a
7700    set anc($b) b
7701    for {set i 0} {$i < [llength $todo]} {incr i} {
7702        set x [lindex $todo $i]
7703        if {$anc($x) eq {}} {
7704            continue
7705        }
7706        foreach arc $arcnos($x) {
7707            set xd $arcstart($arc)
7708            if {$xd eq $bend} {
7709                set cached_isanc($a,$bend) 1
7710                set cached_isanc($b,$aend) 0
7711                return 1
7712            } elseif {$xd eq $aend} {
7713                set cached_isanc($b,$aend) 1
7714                set cached_isanc($a,$bend) 0
7715                return -1
7716            }
7717            if {![info exists anc($xd)]} {
7718                set anc($xd) $anc($x)
7719                lappend todo $xd
7720            } elseif {$anc($xd) ne $anc($x)} {
7721                set anc($xd) {}
7722            }
7723        }
7724    }
7725    set cached_isanc($a,$bend) 0
7726    set cached_isanc($b,$aend) 0
7727    return 0
7728}
7729
7730# This identifies whether $desc has an ancestor that is
7731# a growing tip of the graph and which is not an ancestor of $anc
7732# and returns 0 if so and 1 if not.
7733# If we subsequently discover a tag on such a growing tip, and that
7734# turns out to be a descendent of $anc (which it could, since we
7735# don't necessarily see children before parents), then $desc
7736# isn't a good choice to display as a descendent tag of
7737# $anc (since it is the descendent of another tag which is
7738# a descendent of $anc).  Similarly, $anc isn't a good choice to
7739# display as a ancestor tag of $desc.
7740#
7741proc is_certain {desc anc} {
7742    global arcnos arcout arcstart arcend growing problems
7743
7744    set certain {}
7745    if {[llength $arcnos($anc)] == 1} {
7746        # tags on the same arc are certain
7747        if {$arcnos($desc) eq $arcnos($anc)} {
7748            return 1
7749        }
7750        if {![info exists arcout($anc)]} {
7751            # if $anc is partway along an arc, use the start of the arc instead
7752            set a [lindex $arcnos($anc) 0]
7753            set anc $arcstart($a)
7754        }
7755    }
7756    if {[llength $arcnos($desc)] > 1 || [info exists arcout($desc)]} {
7757        set x $desc
7758    } else {
7759        set a [lindex $arcnos($desc) 0]
7760        set x $arcend($a)
7761    }
7762    if {$x == $anc} {
7763        return 1
7764    }
7765    set anclist [list $x]
7766    set dl($x) 1
7767    set nnh 1
7768    set ngrowanc 0
7769    for {set i 0} {$i < [llength $anclist] && ($nnh > 0 || $ngrowanc > 0)} {incr i} {
7770        set x [lindex $anclist $i]
7771        if {$dl($x)} {
7772            incr nnh -1
7773        }
7774        set done($x) 1
7775        foreach a $arcout($x) {
7776            if {[info exists growing($a)]} {
7777                if {![info exists growanc($x)] && $dl($x)} {
7778                    set growanc($x) 1
7779                    incr ngrowanc
7780                }
7781            } else {
7782                set y $arcend($a)
7783                if {[info exists dl($y)]} {
7784                    if {$dl($y)} {
7785                        if {!$dl($x)} {
7786                            set dl($y) 0
7787                            if {![info exists done($y)]} {
7788                                incr nnh -1
7789                            }
7790                            if {[info exists growanc($x)]} {
7791                                incr ngrowanc -1
7792                            }
7793                            set xl [list $y]
7794                            for {set k 0} {$k < [llength $xl]} {incr k} {
7795                                set z [lindex $xl $k]
7796                                foreach c $arcout($z) {
7797                                    if {[info exists arcend($c)]} {
7798                                        set v $arcend($c)
7799                                        if {[info exists dl($v)] && $dl($v)} {
7800                                            set dl($v) 0
7801                                            if {![info exists done($v)]} {
7802                                                incr nnh -1
7803                                            }
7804                                            if {[info exists growanc($v)]} {
7805                                                incr ngrowanc -1
7806                                            }
7807                                            lappend xl $v
7808                                        }
7809                                    }
7810                                }
7811                            }
7812                        }
7813                    }
7814                } elseif {$y eq $anc || !$dl($x)} {
7815                    set dl($y) 0
7816                    lappend anclist $y
7817                } else {
7818                    set dl($y) 1
7819                    lappend anclist $y
7820                    incr nnh
7821                }
7822            }
7823        }
7824    }
7825    foreach x [array names growanc] {
7826        if {$dl($x)} {
7827            return 0
7828        }
7829        return 0
7830    }
7831    return 1
7832}
7833
7834proc validate_arctags {a} {
7835    global arctags idtags
7836
7837    set i -1
7838    set na $arctags($a)
7839    foreach id $arctags($a) {
7840        incr i
7841        if {![info exists idtags($id)]} {
7842            set na [lreplace $na $i $i]
7843            incr i -1
7844        }
7845    }
7846    set arctags($a) $na
7847}
7848
7849proc validate_archeads {a} {
7850    global archeads idheads
7851
7852    set i -1
7853    set na $archeads($a)
7854    foreach id $archeads($a) {
7855        incr i
7856        if {![info exists idheads($id)]} {
7857            set na [lreplace $na $i $i]
7858            incr i -1
7859        }
7860    }
7861    set archeads($a) $na
7862}
7863
7864# Return the list of IDs that have tags that are descendents of id,
7865# ignoring IDs that are descendents of IDs already reported.
7866proc desctags {id} {
7867    global arcnos arcstart arcids arctags idtags allparents
7868    global growing cached_dtags
7869
7870    if {![info exists allparents($id)]} {
7871        return {}
7872    }
7873    set t1 [clock clicks -milliseconds]
7874    set argid $id
7875    if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
7876        # part-way along an arc; check that arc first
7877        set a [lindex $arcnos($id) 0]
7878        if {$arctags($a) ne {}} {
7879            validate_arctags $a
7880            set i [lsearch -exact $arcids($a) $id]
7881            set tid {}
7882            foreach t $arctags($a) {
7883                set j [lsearch -exact $arcids($a) $t]
7884                if {$j >= $i} break
7885                set tid $t
7886            }
7887            if {$tid ne {}} {
7888                return $tid
7889            }
7890        }
7891        set id $arcstart($a)
7892        if {[info exists idtags($id)]} {
7893            return $id
7894        }
7895    }
7896    if {[info exists cached_dtags($id)]} {
7897        return $cached_dtags($id)
7898    }
7899
7900    set origid $id
7901    set todo [list $id]
7902    set queued($id) 1
7903    set nc 1
7904    for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
7905        set id [lindex $todo $i]
7906        set done($id) 1
7907        set ta [info exists hastaggedancestor($id)]
7908        if {!$ta} {
7909            incr nc -1
7910        }
7911        # ignore tags on starting node
7912        if {!$ta && $i > 0} {
7913            if {[info exists idtags($id)]} {
7914                set tagloc($id) $id
7915                set ta 1
7916            } elseif {[info exists cached_dtags($id)]} {
7917                set tagloc($id) $cached_dtags($id)
7918                set ta 1
7919            }
7920        }
7921        foreach a $arcnos($id) {
7922            set d $arcstart($a)
7923            if {!$ta && $arctags($a) ne {}} {
7924                validate_arctags $a
7925                if {$arctags($a) ne {}} {
7926                    lappend tagloc($id) [lindex $arctags($a) end]
7927                }
7928            }
7929            if {$ta || $arctags($a) ne {}} {
7930                set tomark [list $d]
7931                for {set j 0} {$j < [llength $tomark]} {incr j} {
7932                    set dd [lindex $tomark $j]
7933                    if {![info exists hastaggedancestor($dd)]} {
7934                        if {[info exists done($dd)]} {
7935                            foreach b $arcnos($dd) {
7936                                lappend tomark $arcstart($b)
7937                            }
7938                            if {[info exists tagloc($dd)]} {
7939                                unset tagloc($dd)
7940                            }
7941                        } elseif {[info exists queued($dd)]} {
7942                            incr nc -1
7943                        }
7944                        set hastaggedancestor($dd) 1
7945                    }
7946                }
7947            }
7948            if {![info exists queued($d)]} {
7949                lappend todo $d
7950                set queued($d) 1
7951                if {![info exists hastaggedancestor($d)]} {
7952                    incr nc
7953                }
7954            }
7955        }
7956    }
7957    set tags {}
7958    foreach id [array names tagloc] {
7959        if {![info exists hastaggedancestor($id)]} {
7960            foreach t $tagloc($id) {
7961                if {[lsearch -exact $tags $t] < 0} {
7962                    lappend tags $t
7963                }
7964            }
7965        }
7966    }
7967    set t2 [clock clicks -milliseconds]
7968    set loopix $i
7969
7970    # remove tags that are descendents of other tags
7971    for {set i 0} {$i < [llength $tags]} {incr i} {
7972        set a [lindex $tags $i]
7973        for {set j 0} {$j < $i} {incr j} {
7974            set b [lindex $tags $j]
7975            set r [anc_or_desc $a $b]
7976            if {$r == 1} {
7977                set tags [lreplace $tags $j $j]
7978                incr j -1
7979                incr i -1
7980            } elseif {$r == -1} {
7981                set tags [lreplace $tags $i $i]
7982                incr i -1
7983                break
7984            }
7985        }
7986    }
7987
7988    if {[array names growing] ne {}} {
7989        # graph isn't finished, need to check if any tag could get
7990        # eclipsed by another tag coming later.  Simply ignore any
7991        # tags that could later get eclipsed.
7992        set ctags {}
7993        foreach t $tags {
7994            if {[is_certain $t $origid]} {
7995                lappend ctags $t
7996            }
7997        }
7998        if {$tags eq $ctags} {
7999            set cached_dtags($origid) $tags
8000        } else {
8001            set tags $ctags
8002        }
8003    } else {
8004        set cached_dtags($origid) $tags
8005    }
8006    set t3 [clock clicks -milliseconds]
8007    if {0 && $t3 - $t1 >= 100} {
8008        puts "iterating descendents ($loopix/[llength $todo] nodes) took\
8009            [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
8010    }
8011    return $tags
8012}
8013
8014proc anctags {id} {
8015    global arcnos arcids arcout arcend arctags idtags allparents
8016    global growing cached_atags
8017
8018    if {![info exists allparents($id)]} {
8019        return {}
8020    }
8021    set t1 [clock clicks -milliseconds]
8022    set argid $id
8023    if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
8024        # part-way along an arc; check that arc first
8025        set a [lindex $arcnos($id) 0]
8026        if {$arctags($a) ne {}} {
8027            validate_arctags $a
8028            set i [lsearch -exact $arcids($a) $id]
8029            foreach t $arctags($a) {
8030                set j [lsearch -exact $arcids($a) $t]
8031                if {$j > $i} {
8032                    return $t
8033                }
8034            }
8035        }
8036        if {![info exists arcend($a)]} {
8037            return {}
8038        }
8039        set id $arcend($a)
8040        if {[info exists idtags($id)]} {
8041            return $id
8042        }
8043    }
8044    if {[info exists cached_atags($id)]} {
8045        return $cached_atags($id)
8046    }
8047
8048    set origid $id
8049    set todo [list $id]
8050    set queued($id) 1
8051    set taglist {}
8052    set nc 1
8053    for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
8054        set id [lindex $todo $i]
8055        set done($id) 1
8056        set td [info exists hastaggeddescendent($id)]
8057        if {!$td} {
8058            incr nc -1
8059        }
8060        # ignore tags on starting node
8061        if {!$td && $i > 0} {
8062            if {[info exists idtags($id)]} {
8063                set tagloc($id) $id
8064                set td 1
8065            } elseif {[info exists cached_atags($id)]} {
8066                set tagloc($id) $cached_atags($id)
8067                set td 1
8068            }
8069        }
8070        foreach a $arcout($id) {
8071            if {!$td && $arctags($a) ne {}} {
8072                validate_arctags $a
8073                if {$arctags($a) ne {}} {
8074                    lappend tagloc($id) [lindex $arctags($a) 0]
8075                }
8076            }
8077            if {![info exists arcend($a)]} continue
8078            set d $arcend($a)
8079            if {$td || $arctags($a) ne {}} {
8080                set tomark [list $d]
8081                for {set j 0} {$j < [llength $tomark]} {incr j} {
8082                    set dd [lindex $tomark $j]
8083                    if {![info exists hastaggeddescendent($dd)]} {
8084                        if {[info exists done($dd)]} {
8085                            foreach b $arcout($dd) {
8086                                if {[info exists arcend($b)]} {
8087                                    lappend tomark $arcend($b)
8088                                }
8089                            }
8090                            if {[info exists tagloc($dd)]} {
8091                                unset tagloc($dd)
8092                            }
8093                        } elseif {[info exists queued($dd)]} {
8094                            incr nc -1
8095                        }
8096                        set hastaggeddescendent($dd) 1
8097                    }
8098                }
8099            }
8100            if {![info exists queued($d)]} {
8101                lappend todo $d
8102                set queued($d) 1
8103                if {![info exists hastaggeddescendent($d)]} {
8104                    incr nc
8105                }
8106            }
8107        }
8108    }
8109    set t2 [clock clicks -milliseconds]
8110    set loopix $i
8111    set tags {}
8112    foreach id [array names tagloc] {
8113        if {![info exists hastaggeddescendent($id)]} {
8114            foreach t $tagloc($id) {
8115                if {[lsearch -exact $tags $t] < 0} {
8116                    lappend tags $t
8117                }
8118            }
8119        }
8120    }
8121
8122    # remove tags that are ancestors of other tags
8123    for {set i 0} {$i < [llength $tags]} {incr i} {
8124        set a [lindex $tags $i]
8125        for {set j 0} {$j < $i} {incr j} {
8126            set b [lindex $tags $j]
8127            set r [anc_or_desc $a $b]
8128            if {$r == -1} {
8129                set tags [lreplace $tags $j $j]
8130                incr j -1
8131                incr i -1
8132            } elseif {$r == 1} {
8133                set tags [lreplace $tags $i $i]
8134                incr i -1
8135                break
8136            }
8137        }
8138    }
8139
8140    if {[array names growing] ne {}} {
8141        # graph isn't finished, need to check if any tag could get
8142        # eclipsed by another tag coming later.  Simply ignore any
8143        # tags that could later get eclipsed.
8144        set ctags {}
8145        foreach t $tags {
8146            if {[is_certain $origid $t]} {
8147                lappend ctags $t
8148            }
8149        }
8150        if {$tags eq $ctags} {
8151            set cached_atags($origid) $tags
8152        } else {
8153            set tags $ctags
8154        }
8155    } else {
8156        set cached_atags($origid) $tags
8157    }
8158    set t3 [clock clicks -milliseconds]
8159    if {0 && $t3 - $t1 >= 100} {
8160        puts "iterating ancestors ($loopix/[llength $todo] nodes) took\
8161            [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
8162    }
8163    return $tags
8164}
8165
8166# Return the list of IDs that have heads that are descendents of id,
8167# including id itself if it has a head.
8168proc descheads {id} {
8169    global arcnos arcstart arcids archeads idheads cached_dheads
8170    global allparents
8171
8172    if {![info exists allparents($id)]} {
8173        return {}
8174    }
8175    set aret {}
8176    if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
8177        # part-way along an arc; check it first
8178        set a [lindex $arcnos($id) 0]
8179        if {$archeads($a) ne {}} {
8180            validate_archeads $a
8181            set i [lsearch -exact $arcids($a) $id]
8182            foreach t $archeads($a) {
8183                set j [lsearch -exact $arcids($a) $t]
8184                if {$j > $i} break
8185                lappend aret $t
8186            }
8187        }
8188        set id $arcstart($a)
8189    }
8190    set origid $id
8191    set todo [list $id]
8192    set seen($id) 1
8193    set ret {}
8194    for {set i 0} {$i < [llength $todo]} {incr i} {
8195        set id [lindex $todo $i]
8196        if {[info exists cached_dheads($id)]} {
8197            set ret [concat $ret $cached_dheads($id)]
8198        } else {
8199            if {[info exists idheads($id)]} {
8200                lappend ret $id
8201            }
8202            foreach a $arcnos($id) {
8203                if {$archeads($a) ne {}} {
8204                    validate_archeads $a
8205                    if {$archeads($a) ne {}} {
8206                        set ret [concat $ret $archeads($a)]
8207                    }
8208                }
8209                set d $arcstart($a)
8210                if {![info exists seen($d)]} {
8211                    lappend todo $d
8212                    set seen($d) 1
8213                }
8214            }
8215        }
8216    }
8217    set ret [lsort -unique $ret]
8218    set cached_dheads($origid) $ret
8219    return [concat $ret $aret]
8220}
8221
8222proc addedtag {id} {
8223    global arcnos arcout cached_dtags cached_atags
8224
8225    if {![info exists arcnos($id)]} return
8226    if {![info exists arcout($id)]} {
8227        recalcarc [lindex $arcnos($id) 0]
8228    }
8229    catch {unset cached_dtags}
8230    catch {unset cached_atags}
8231}
8232
8233proc addedhead {hid head} {
8234    global arcnos arcout cached_dheads
8235
8236    if {![info exists arcnos($hid)]} return
8237    if {![info exists arcout($hid)]} {
8238        recalcarc [lindex $arcnos($hid) 0]
8239    }
8240    catch {unset cached_dheads}
8241}
8242
8243proc removedhead {hid head} {
8244    global cached_dheads
8245
8246    catch {unset cached_dheads}
8247}
8248
8249proc movedhead {hid head} {
8250    global arcnos arcout cached_dheads
8251
8252    if {![info exists arcnos($hid)]} return
8253    if {![info exists arcout($hid)]} {
8254        recalcarc [lindex $arcnos($hid) 0]
8255    }
8256    catch {unset cached_dheads}
8257}
8258
8259proc changedrefs {} {
8260    global cached_dheads cached_dtags cached_atags
8261    global arctags archeads arcnos arcout idheads idtags
8262
8263    foreach id [concat [array names idheads] [array names idtags]] {
8264        if {[info exists arcnos($id)] && ![info exists arcout($id)]} {
8265            set a [lindex $arcnos($id) 0]
8266            if {![info exists donearc($a)]} {
8267                recalcarc $a
8268                set donearc($a) 1
8269            }
8270        }
8271    }
8272    catch {unset cached_dtags}
8273    catch {unset cached_atags}
8274    catch {unset cached_dheads}
8275}
8276
8277proc rereadrefs {} {
8278    global idtags idheads idotherrefs mainhead
8279
8280    set refids [concat [array names idtags] \
8281                    [array names idheads] [array names idotherrefs]]
8282    foreach id $refids {
8283        if {![info exists ref($id)]} {
8284            set ref($id) [listrefs $id]
8285        }
8286    }
8287    set oldmainhead $mainhead
8288    readrefs
8289    changedrefs
8290    set refids [lsort -unique [concat $refids [array names idtags] \
8291                        [array names idheads] [array names idotherrefs]]]
8292    foreach id $refids {
8293        set v [listrefs $id]
8294        if {![info exists ref($id)] || $ref($id) != $v ||
8295            ($id eq $oldmainhead && $id ne $mainhead) ||
8296            ($id eq $mainhead && $id ne $oldmainhead)} {
8297            redrawtags $id
8298        }
8299    }
8300    run refill_reflist
8301}
8302
8303proc listrefs {id} {
8304    global idtags idheads idotherrefs
8305
8306    set x {}
8307    if {[info exists idtags($id)]} {
8308        set x $idtags($id)
8309    }
8310    set y {}
8311    if {[info exists idheads($id)]} {
8312        set y $idheads($id)
8313    }
8314    set z {}
8315    if {[info exists idotherrefs($id)]} {
8316        set z $idotherrefs($id)
8317    }
8318    return [list $x $y $z]
8319}
8320
8321proc showtag {tag isnew} {
8322    global ctext tagcontents tagids linknum tagobjid
8323
8324    if {$isnew} {
8325        addtohistory [list showtag $tag 0]
8326    }
8327    $ctext conf -state normal
8328    clear_ctext
8329    settabs 0
8330    set linknum 0
8331    if {![info exists tagcontents($tag)]} {
8332        catch {
8333            set tagcontents($tag) [exec git cat-file tag $tagobjid($tag)]
8334        }
8335    }
8336    if {[info exists tagcontents($tag)]} {
8337        set text $tagcontents($tag)
8338    } else {
8339        set text "Tag: $tag\nId:  $tagids($tag)"
8340    }
8341    appendwithlinks $text {}
8342    $ctext conf -state disabled
8343    init_flist {}
8344}
8345
8346proc doquit {} {
8347    global stopped
8348    set stopped 100
8349    savestuff .
8350    destroy .
8351}
8352
8353proc mkfontdisp {font top which} {
8354    global fontattr fontpref $font
8355
8356    set fontpref($font) [set $font]
8357    button $top.${font}but -text $which -font optionfont \
8358        -command [list choosefont $font $which]
8359    label $top.$font -relief flat -font $font \
8360        -text $fontattr($font,family) -justify left
8361    grid x $top.${font}but $top.$font -sticky w
8362}
8363
8364proc choosefont {font which} {
8365    global fontparam fontlist fonttop fontattr
8366
8367    set fontparam(which) $which
8368    set fontparam(font) $font
8369    set fontparam(family) [font actual $font -family]
8370    set fontparam(size) $fontattr($font,size)
8371    set fontparam(weight) $fontattr($font,weight)
8372    set fontparam(slant) $fontattr($font,slant)
8373    set top .gitkfont
8374    set fonttop $top
8375    if {![winfo exists $top]} {
8376        font create sample
8377        eval font config sample [font actual $font]
8378        toplevel $top
8379        wm title $top "Gitk font chooser"
8380        label $top.l -textvariable fontparam(which) -font uifont
8381        pack $top.l -side top
8382        set fontlist [lsort [font families]]
8383        frame $top.f
8384        listbox $top.f.fam -listvariable fontlist \
8385            -yscrollcommand [list $top.f.sb set]
8386        bind $top.f.fam <<ListboxSelect>> selfontfam
8387        scrollbar $top.f.sb -command [list $top.f.fam yview]
8388        pack $top.f.sb -side right -fill y
8389        pack $top.f.fam -side left -fill both -expand 1
8390        pack $top.f -side top -fill both -expand 1
8391        frame $top.g
8392        spinbox $top.g.size -from 4 -to 40 -width 4 \
8393            -textvariable fontparam(size) \
8394            -validatecommand {string is integer -strict %s}
8395        checkbutton $top.g.bold -padx 5 \
8396            -font {{Times New Roman} 12 bold} -text "B" -indicatoron 0 \
8397            -variable fontparam(weight) -onvalue bold -offvalue normal
8398        checkbutton $top.g.ital -padx 5 \
8399            -font {{Times New Roman} 12 italic} -text "I" -indicatoron 0  \
8400            -variable fontparam(slant) -onvalue italic -offvalue roman
8401        pack $top.g.size $top.g.bold $top.g.ital -side left
8402        pack $top.g -side top
8403        canvas $top.c -width 150 -height 50 -border 2 -relief sunk \
8404            -background white
8405        $top.c create text 100 25 -anchor center -text $which -font sample \
8406            -fill black -tags text
8407        bind $top.c <Configure> [list centertext $top.c]
8408        pack $top.c -side top -fill x
8409        frame $top.buts
8410        button $top.buts.ok -text "OK" -command fontok -default active \
8411            -font uifont
8412        button $top.buts.can -text "Cancel" -command fontcan -default normal \
8413            -font uifont
8414        grid $top.buts.ok $top.buts.can
8415        grid columnconfigure $top.buts 0 -weight 1 -uniform a
8416        grid columnconfigure $top.buts 1 -weight 1 -uniform a
8417        pack $top.buts -side bottom -fill x
8418        trace add variable fontparam write chg_fontparam
8419    } else {
8420        raise $top
8421        $top.c itemconf text -text $which
8422    }
8423    set i [lsearch -exact $fontlist $fontparam(family)]
8424    if {$i >= 0} {
8425        $top.f.fam selection set $i
8426        $top.f.fam see $i
8427    }
8428}
8429
8430proc centertext {w} {
8431    $w coords text [expr {[winfo width $w] / 2}] [expr {[winfo height $w] / 2}]
8432}
8433
8434proc fontok {} {
8435    global fontparam fontpref prefstop
8436
8437    set f $fontparam(font)
8438    set fontpref($f) [list $fontparam(family) $fontparam(size)]
8439    if {$fontparam(weight) eq "bold"} {
8440        lappend fontpref($f) "bold"
8441    }
8442    if {$fontparam(slant) eq "italic"} {
8443        lappend fontpref($f) "italic"
8444    }
8445    set w $prefstop.$f
8446    $w conf -text $fontparam(family) -font $fontpref($f)
8447        
8448    fontcan
8449}
8450
8451proc fontcan {} {
8452    global fonttop fontparam
8453
8454    if {[info exists fonttop]} {
8455        catch {destroy $fonttop}
8456        catch {font delete sample}
8457        unset fonttop
8458        unset fontparam
8459    }
8460}
8461
8462proc selfontfam {} {
8463    global fonttop fontparam
8464
8465    set i [$fonttop.f.fam curselection]
8466    if {$i ne {}} {
8467        set fontparam(family) [$fonttop.f.fam get $i]
8468    }
8469}
8470
8471proc chg_fontparam {v sub op} {
8472    global fontparam
8473
8474    font config sample -$sub $fontparam($sub)
8475}
8476
8477proc doprefs {} {
8478    global maxwidth maxgraphpct
8479    global oldprefs prefstop showneartags showlocalchanges
8480    global bgcolor fgcolor ctext diffcolors selectbgcolor
8481    global uifont tabstop limitdiffs
8482
8483    set top .gitkprefs
8484    set prefstop $top
8485    if {[winfo exists $top]} {
8486        raise $top
8487        return
8488    }
8489    foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
8490                   limitdiffs tabstop} {
8491        set oldprefs($v) [set $v]
8492    }
8493    toplevel $top
8494    wm title $top "Gitk preferences"
8495    label $top.ldisp -text "Commit list display options"
8496    $top.ldisp configure -font uifont
8497    grid $top.ldisp - -sticky w -pady 10
8498    label $top.spacer -text " "
8499    label $top.maxwidthl -text "Maximum graph width (lines)" \
8500        -font optionfont
8501    spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
8502    grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
8503    label $top.maxpctl -text "Maximum graph width (% of pane)" \
8504        -font optionfont
8505    spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
8506    grid x $top.maxpctl $top.maxpct -sticky w
8507    frame $top.showlocal
8508    label $top.showlocal.l -text "Show local changes" -font optionfont
8509    checkbutton $top.showlocal.b -variable showlocalchanges
8510    pack $top.showlocal.b $top.showlocal.l -side left
8511    grid x $top.showlocal -sticky w
8512
8513    label $top.ddisp -text "Diff display options"
8514    $top.ddisp configure -font uifont
8515    grid $top.ddisp - -sticky w -pady 10
8516    label $top.tabstopl -text "Tab spacing" -font optionfont
8517    spinbox $top.tabstop -from 1 -to 20 -width 4 -textvariable tabstop
8518    grid x $top.tabstopl $top.tabstop -sticky w
8519    frame $top.ntag
8520    label $top.ntag.l -text "Display nearby tags" -font optionfont
8521    checkbutton $top.ntag.b -variable showneartags
8522    pack $top.ntag.b $top.ntag.l -side left
8523    grid x $top.ntag -sticky w
8524    frame $top.ldiff
8525    label $top.ldiff.l -text "Limit diffs to listed paths" -font optionfont
8526    checkbutton $top.ldiff.b -variable limitdiffs
8527    pack $top.ldiff.b $top.ldiff.l -side left
8528    grid x $top.ldiff -sticky w
8529
8530    label $top.cdisp -text "Colors: press to choose"
8531    $top.cdisp configure -font uifont
8532    grid $top.cdisp - -sticky w -pady 10
8533    label $top.bg -padx 40 -relief sunk -background $bgcolor
8534    button $top.bgbut -text "Background" -font optionfont \
8535        -command [list choosecolor bgcolor 0 $top.bg background setbg]
8536    grid x $top.bgbut $top.bg -sticky w
8537    label $top.fg -padx 40 -relief sunk -background $fgcolor
8538    button $top.fgbut -text "Foreground" -font optionfont \
8539        -command [list choosecolor fgcolor 0 $top.fg foreground setfg]
8540    grid x $top.fgbut $top.fg -sticky w
8541    label $top.diffold -padx 40 -relief sunk -background [lindex $diffcolors 0]
8542    button $top.diffoldbut -text "Diff: old lines" -font optionfont \
8543        -command [list choosecolor diffcolors 0 $top.diffold "diff old lines" \
8544                      [list $ctext tag conf d0 -foreground]]
8545    grid x $top.diffoldbut $top.diffold -sticky w
8546    label $top.diffnew -padx 40 -relief sunk -background [lindex $diffcolors 1]
8547    button $top.diffnewbut -text "Diff: new lines" -font optionfont \
8548        -command [list choosecolor diffcolors 1 $top.diffnew "diff new lines" \
8549                      [list $ctext tag conf d1 -foreground]]
8550    grid x $top.diffnewbut $top.diffnew -sticky w
8551    label $top.hunksep -padx 40 -relief sunk -background [lindex $diffcolors 2]
8552    button $top.hunksepbut -text "Diff: hunk header" -font optionfont \
8553        -command [list choosecolor diffcolors 2 $top.hunksep \
8554                      "diff hunk header" \
8555                      [list $ctext tag conf hunksep -foreground]]
8556    grid x $top.hunksepbut $top.hunksep -sticky w
8557    label $top.selbgsep -padx 40 -relief sunk -background $selectbgcolor
8558    button $top.selbgbut -text "Select bg" -font optionfont \
8559        -command [list choosecolor selectbgcolor 0 $top.selbgsep background setselbg]
8560    grid x $top.selbgbut $top.selbgsep -sticky w
8561
8562    label $top.cfont -text "Fonts: press to choose"
8563    $top.cfont configure -font uifont
8564    grid $top.cfont - -sticky w -pady 10
8565    mkfontdisp mainfont $top "Main font"
8566    mkfontdisp textfont $top "Diff display font"
8567    mkfontdisp uifont $top "User interface font"
8568
8569    frame $top.buts
8570    button $top.buts.ok -text "OK" -command prefsok -default active
8571    $top.buts.ok configure -font uifont
8572    button $top.buts.can -text "Cancel" -command prefscan -default normal
8573    $top.buts.can configure -font uifont
8574    grid $top.buts.ok $top.buts.can
8575    grid columnconfigure $top.buts 0 -weight 1 -uniform a
8576    grid columnconfigure $top.buts 1 -weight 1 -uniform a
8577    grid $top.buts - - -pady 10 -sticky ew
8578    bind $top <Visibility> "focus $top.buts.ok"
8579}
8580
8581proc choosecolor {v vi w x cmd} {
8582    global $v
8583
8584    set c [tk_chooseColor -initialcolor [lindex [set $v] $vi] \
8585               -title "Gitk: choose color for $x"]
8586    if {$c eq {}} return
8587    $w conf -background $c
8588    lset $v $vi $c
8589    eval $cmd $c
8590}
8591
8592proc setselbg {c} {
8593    global bglist cflist
8594    foreach w $bglist {
8595        $w configure -selectbackground $c
8596    }
8597    $cflist tag configure highlight \
8598        -background [$cflist cget -selectbackground]
8599    allcanvs itemconf secsel -fill $c
8600}
8601
8602proc setbg {c} {
8603    global bglist
8604
8605    foreach w $bglist {
8606        $w conf -background $c
8607    }
8608}
8609
8610proc setfg {c} {
8611    global fglist canv
8612
8613    foreach w $fglist {
8614        $w conf -foreground $c
8615    }
8616    allcanvs itemconf text -fill $c
8617    $canv itemconf circle -outline $c
8618}
8619
8620proc prefscan {} {
8621    global oldprefs prefstop
8622
8623    foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
8624                   limitdiffs tabstop} {
8625        global $v
8626        set $v $oldprefs($v)
8627    }
8628    catch {destroy $prefstop}
8629    unset prefstop
8630    fontcan
8631}
8632
8633proc prefsok {} {
8634    global maxwidth maxgraphpct
8635    global oldprefs prefstop showneartags showlocalchanges
8636    global fontpref mainfont textfont uifont
8637    global limitdiffs treediffs
8638
8639    catch {destroy $prefstop}
8640    unset prefstop
8641    fontcan
8642    set fontchanged 0
8643    if {$mainfont ne $fontpref(mainfont)} {
8644        set mainfont $fontpref(mainfont)
8645        parsefont mainfont $mainfont
8646        eval font configure mainfont [fontflags mainfont]
8647        eval font configure mainfontbold [fontflags mainfont 1]
8648        setcoords
8649        set fontchanged 1
8650    }
8651    if {$textfont ne $fontpref(textfont)} {
8652        set textfont $fontpref(textfont)
8653        parsefont textfont $textfont
8654        eval font configure textfont [fontflags textfont]
8655        eval font configure textfontbold [fontflags textfont 1]
8656    }
8657    if {$uifont ne $fontpref(uifont)} {
8658        set uifont $fontpref(uifont)
8659        parsefont uifont $uifont
8660        eval font configure uifont [fontflags uifont]
8661    }
8662    settabs
8663    if {$showlocalchanges != $oldprefs(showlocalchanges)} {
8664        if {$showlocalchanges} {
8665            doshowlocalchanges
8666        } else {
8667            dohidelocalchanges
8668        }
8669    }
8670    if {$limitdiffs != $oldprefs(limitdiffs)} {
8671        # treediffs elements are limited by path
8672        catch {unset treediffs}
8673    }
8674    if {$fontchanged || $maxwidth != $oldprefs(maxwidth)
8675        || $maxgraphpct != $oldprefs(maxgraphpct)} {
8676        redisplay
8677    } elseif {$showneartags != $oldprefs(showneartags) ||
8678          $limitdiffs != $oldprefs(limitdiffs)} {
8679        reselectline
8680    }
8681}
8682
8683proc formatdate {d} {
8684    global datetimeformat
8685    if {$d ne {}} {
8686        set d [clock format $d -format $datetimeformat]
8687    }
8688    return $d
8689}
8690
8691# This list of encoding names and aliases is distilled from
8692# http://www.iana.org/assignments/character-sets.
8693# Not all of them are supported by Tcl.
8694set encoding_aliases {
8695    { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
8696      ISO646-US US-ASCII us IBM367 cp367 csASCII }
8697    { ISO-10646-UTF-1 csISO10646UTF1 }
8698    { ISO_646.basic:1983 ref csISO646basic1983 }
8699    { INVARIANT csINVARIANT }
8700    { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
8701    { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
8702    { NATS-SEFI iso-ir-8-1 csNATSSEFI }
8703    { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
8704    { NATS-DANO iso-ir-9-1 csNATSDANO }
8705    { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
8706    { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
8707    { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
8708    { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
8709    { ISO-2022-KR csISO2022KR }
8710    { EUC-KR csEUCKR }
8711    { ISO-2022-JP csISO2022JP }
8712    { ISO-2022-JP-2 csISO2022JP2 }
8713    { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
8714      csISO13JISC6220jp }
8715    { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
8716    { IT iso-ir-15 ISO646-IT csISO15Italian }
8717    { PT iso-ir-16 ISO646-PT csISO16Portuguese }
8718    { ES iso-ir-17 ISO646-ES csISO17Spanish }
8719    { greek7-old iso-ir-18 csISO18Greek7Old }
8720    { latin-greek iso-ir-19 csISO19LatinGreek }
8721    { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
8722    { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
8723    { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
8724    { ISO_5427 iso-ir-37 csISO5427Cyrillic }
8725    { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
8726    { BS_viewdata iso-ir-47 csISO47BSViewdata }
8727    { INIS iso-ir-49 csISO49INIS }
8728    { INIS-8 iso-ir-50 csISO50INIS8 }
8729    { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
8730    { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
8731    { ISO_5428:1980 iso-ir-55 csISO5428Greek }
8732    { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
8733    { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
8734    { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
8735      csISO60Norwegian1 }
8736    { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
8737    { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
8738    { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
8739    { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
8740    { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
8741    { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
8742    { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
8743    { greek7 iso-ir-88 csISO88Greek7 }
8744    { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
8745    { iso-ir-90 csISO90 }
8746    { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
8747    { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
8748      csISO92JISC62991984b }
8749    { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
8750    { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
8751    { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
8752      csISO95JIS62291984handadd }
8753    { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
8754    { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
8755    { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
8756    { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
8757      CP819 csISOLatin1 }
8758    { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
8759    { T.61-7bit iso-ir-102 csISO102T617bit }
8760    { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
8761    { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
8762    { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
8763    { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
8764    { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
8765    { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
8766    { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
8767    { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
8768      arabic csISOLatinArabic }
8769    { ISO_8859-6-E csISO88596E ISO-8859-6-E }
8770    { ISO_8859-6-I csISO88596I ISO-8859-6-I }
8771    { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
8772      greek greek8 csISOLatinGreek }
8773    { T.101-G2 iso-ir-128 csISO128T101G2 }
8774    { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
8775      csISOLatinHebrew }
8776    { ISO_8859-8-E csISO88598E ISO-8859-8-E }
8777    { ISO_8859-8-I csISO88598I ISO-8859-8-I }
8778    { CSN_369103 iso-ir-139 csISO139CSN369103 }
8779    { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
8780    { ISO_6937-2-add iso-ir-142 csISOTextComm }
8781    { IEC_P27-1 iso-ir-143 csISO143IECP271 }
8782    { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
8783      csISOLatinCyrillic }
8784    { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
8785    { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
8786    { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
8787    { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
8788    { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
8789    { ISO_6937-2-25 iso-ir-152 csISO6937Add }
8790    { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
8791    { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
8792    { ISO_10367-box iso-ir-155 csISO10367Box }
8793    { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
8794    { latin-lap lap iso-ir-158 csISO158Lap }
8795    { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
8796    { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
8797    { us-dk csUSDK }
8798    { dk-us csDKUS }
8799    { JIS_X0201 X0201 csHalfWidthKatakana }
8800    { KSC5636 ISO646-KR csKSC5636 }
8801    { ISO-10646-UCS-2 csUnicode }
8802    { ISO-10646-UCS-4 csUCS4 }
8803    { DEC-MCS dec csDECMCS }
8804    { hp-roman8 roman8 r8 csHPRoman8 }
8805    { macintosh mac csMacintosh }
8806    { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
8807      csIBM037 }
8808    { IBM038 EBCDIC-INT cp038 csIBM038 }
8809    { IBM273 CP273 csIBM273 }
8810    { IBM274 EBCDIC-BE CP274 csIBM274 }
8811    { IBM275 EBCDIC-BR cp275 csIBM275 }
8812    { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
8813    { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
8814    { IBM280 CP280 ebcdic-cp-it csIBM280 }
8815    { IBM281 EBCDIC-JP-E cp281 csIBM281 }
8816    { IBM284 CP284 ebcdic-cp-es csIBM284 }
8817    { IBM285 CP285 ebcdic-cp-gb csIBM285 }
8818    { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
8819    { IBM297 cp297 ebcdic-cp-fr csIBM297 }
8820    { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
8821    { IBM423 cp423 ebcdic-cp-gr csIBM423 }
8822    { IBM424 cp424 ebcdic-cp-he csIBM424 }
8823    { IBM437 cp437 437 csPC8CodePage437 }
8824    { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
8825    { IBM775 cp775 csPC775Baltic }
8826    { IBM850 cp850 850 csPC850Multilingual }
8827    { IBM851 cp851 851 csIBM851 }
8828    { IBM852 cp852 852 csPCp852 }
8829    { IBM855 cp855 855 csIBM855 }
8830    { IBM857 cp857 857 csIBM857 }
8831    { IBM860 cp860 860 csIBM860 }
8832    { IBM861 cp861 861 cp-is csIBM861 }
8833    { IBM862 cp862 862 csPC862LatinHebrew }
8834    { IBM863 cp863 863 csIBM863 }
8835    { IBM864 cp864 csIBM864 }
8836    { IBM865 cp865 865 csIBM865 }
8837    { IBM866 cp866 866 csIBM866 }
8838    { IBM868 CP868 cp-ar csIBM868 }
8839    { IBM869 cp869 869 cp-gr csIBM869 }
8840    { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
8841    { IBM871 CP871 ebcdic-cp-is csIBM871 }
8842    { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
8843    { IBM891 cp891 csIBM891 }
8844    { IBM903 cp903 csIBM903 }
8845    { IBM904 cp904 904 csIBBM904 }
8846    { IBM905 CP905 ebcdic-cp-tr csIBM905 }
8847    { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
8848    { IBM1026 CP1026 csIBM1026 }
8849    { EBCDIC-AT-DE csIBMEBCDICATDE }
8850    { EBCDIC-AT-DE-A csEBCDICATDEA }
8851    { EBCDIC-CA-FR csEBCDICCAFR }
8852    { EBCDIC-DK-NO csEBCDICDKNO }
8853    { EBCDIC-DK-NO-A csEBCDICDKNOA }
8854    { EBCDIC-FI-SE csEBCDICFISE }
8855    { EBCDIC-FI-SE-A csEBCDICFISEA }
8856    { EBCDIC-FR csEBCDICFR }
8857    { EBCDIC-IT csEBCDICIT }
8858    { EBCDIC-PT csEBCDICPT }
8859    { EBCDIC-ES csEBCDICES }
8860    { EBCDIC-ES-A csEBCDICESA }
8861    { EBCDIC-ES-S csEBCDICESS }
8862    { EBCDIC-UK csEBCDICUK }
8863    { EBCDIC-US csEBCDICUS }
8864    { UNKNOWN-8BIT csUnknown8BiT }
8865    { MNEMONIC csMnemonic }
8866    { MNEM csMnem }
8867    { VISCII csVISCII }
8868    { VIQR csVIQR }
8869    { KOI8-R csKOI8R }
8870    { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
8871    { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
8872    { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
8873    { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
8874    { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
8875    { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
8876    { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
8877    { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
8878    { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
8879    { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
8880    { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
8881    { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
8882    { IBM1047 IBM-1047 }
8883    { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
8884    { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
8885    { UNICODE-1-1 csUnicode11 }
8886    { CESU-8 csCESU-8 }
8887    { BOCU-1 csBOCU-1 }
8888    { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
8889    { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
8890      l8 }
8891    { ISO-8859-15 ISO_8859-15 Latin-9 }
8892    { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
8893    { GBK CP936 MS936 windows-936 }
8894    { JIS_Encoding csJISEncoding }
8895    { Shift_JIS MS_Kanji csShiftJIS }
8896    { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
8897      EUC-JP }
8898    { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
8899    { ISO-10646-UCS-Basic csUnicodeASCII }
8900    { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
8901    { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
8902    { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
8903    { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
8904    { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
8905    { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
8906    { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
8907    { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
8908    { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
8909    { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
8910    { Adobe-Standard-Encoding csAdobeStandardEncoding }
8911    { Ventura-US csVenturaUS }
8912    { Ventura-International csVenturaInternational }
8913    { PC8-Danish-Norwegian csPC8DanishNorwegian }
8914    { PC8-Turkish csPC8Turkish }
8915    { IBM-Symbols csIBMSymbols }
8916    { IBM-Thai csIBMThai }
8917    { HP-Legal csHPLegal }
8918    { HP-Pi-font csHPPiFont }
8919    { HP-Math8 csHPMath8 }
8920    { Adobe-Symbol-Encoding csHPPSMath }
8921    { HP-DeskTop csHPDesktop }
8922    { Ventura-Math csVenturaMath }
8923    { Microsoft-Publishing csMicrosoftPublishing }
8924    { Windows-31J csWindows31J }
8925    { GB2312 csGB2312 }
8926    { Big5 csBig5 }
8927}
8928
8929proc tcl_encoding {enc} {
8930    global encoding_aliases
8931    set names [encoding names]
8932    set lcnames [string tolower $names]
8933    set enc [string tolower $enc]
8934    set i [lsearch -exact $lcnames $enc]
8935    if {$i < 0} {
8936        # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
8937        if {[regsub {^iso[-_]} $enc iso encx]} {
8938            set i [lsearch -exact $lcnames $encx]
8939        }
8940    }
8941    if {$i < 0} {
8942        foreach l $encoding_aliases {
8943            set ll [string tolower $l]
8944            if {[lsearch -exact $ll $enc] < 0} continue
8945            # look through the aliases for one that tcl knows about
8946            foreach e $ll {
8947                set i [lsearch -exact $lcnames $e]
8948                if {$i < 0} {
8949                    if {[regsub {^iso[-_]} $e iso ex]} {
8950                        set i [lsearch -exact $lcnames $ex]
8951                    }
8952                }
8953                if {$i >= 0} break
8954            }
8955            break
8956        }
8957    }
8958    if {$i >= 0} {
8959        return [lindex $names $i]
8960    }
8961    return {}
8962}
8963
8964# First check that Tcl/Tk is recent enough
8965if {[catch {package require Tk 8.4} err]} {
8966    show_error {} . "Sorry, gitk cannot run with this version of Tcl/Tk.\n\
8967                     Gitk requires at least Tcl/Tk 8.4."
8968    exit 1
8969}
8970
8971# defaults...
8972set datemode 0
8973set wrcomcmd "git diff-tree --stdin -p --pretty"
8974
8975set gitencoding {}
8976catch {
8977    set gitencoding [exec git config --get i18n.commitencoding]
8978}
8979if {$gitencoding == ""} {
8980    set gitencoding "utf-8"
8981}
8982set tclencoding [tcl_encoding $gitencoding]
8983if {$tclencoding == {}} {
8984    puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
8985}
8986
8987set mainfont {Helvetica 9}
8988set textfont {Courier 9}
8989set uifont {Helvetica 9 bold}
8990set tabstop 8
8991set findmergefiles 0
8992set maxgraphpct 50
8993set maxwidth 16
8994set revlistorder 0
8995set fastdate 0
8996set uparrowlen 5
8997set downarrowlen 5
8998set mingaplen 100
8999set cmitmode "patch"
9000set wrapcomment "none"
9001set showneartags 1
9002set maxrefs 20
9003set maxlinelen 200
9004set showlocalchanges 1
9005set limitdiffs 1
9006set datetimeformat "%Y-%m-%d %H:%M:%S"
9007
9008set colors {green red blue magenta darkgrey brown orange}
9009set bgcolor white
9010set fgcolor black
9011set diffcolors {red "#00a000" blue}
9012set diffcontext 3
9013set selectbgcolor gray85
9014
9015catch {source ~/.gitk}
9016
9017font create optionfont -family sans-serif -size -12
9018
9019parsefont mainfont $mainfont
9020eval font create mainfont [fontflags mainfont]
9021eval font create mainfontbold [fontflags mainfont 1]
9022
9023parsefont textfont $textfont
9024eval font create textfont [fontflags textfont]
9025eval font create textfontbold [fontflags textfont 1]
9026
9027parsefont uifont $uifont
9028eval font create uifont [fontflags uifont]
9029
9030# check that we can find a .git directory somewhere...
9031if {[catch {set gitdir [gitdir]}]} {
9032    show_error {} . "Cannot find a git repository here."
9033    exit 1
9034}
9035if {![file isdirectory $gitdir]} {
9036    show_error {} . "Cannot find the git directory \"$gitdir\"."
9037    exit 1
9038}
9039
9040set mergeonly 0
9041set revtreeargs {}
9042set cmdline_files {}
9043set i 0
9044foreach arg $argv {
9045    switch -- $arg {
9046        "" { }
9047        "-d" { set datemode 1 }
9048        "--merge" {
9049            set mergeonly 1
9050            lappend revtreeargs $arg
9051        }
9052        "--" {
9053            set cmdline_files [lrange $argv [expr {$i + 1}] end]
9054            break
9055        }
9056        default {
9057            lappend revtreeargs $arg
9058        }
9059    }
9060    incr i
9061}
9062
9063if {$i >= [llength $argv] && $revtreeargs ne {}} {
9064    # no -- on command line, but some arguments (other than -d)
9065    if {[catch {
9066        set f [eval exec git rev-parse --no-revs --no-flags $revtreeargs]
9067        set cmdline_files [split $f "\n"]
9068        set n [llength $cmdline_files]
9069        set revtreeargs [lrange $revtreeargs 0 end-$n]
9070        # Unfortunately git rev-parse doesn't produce an error when
9071        # something is both a revision and a filename.  To be consistent
9072        # with git log and git rev-list, check revtreeargs for filenames.
9073        foreach arg $revtreeargs {
9074            if {[file exists $arg]} {
9075                show_error {} . "Ambiguous argument '$arg': both revision\
9076                                 and filename"
9077                exit 1
9078            }
9079        }
9080    } err]} {
9081        # unfortunately we get both stdout and stderr in $err,
9082        # so look for "fatal:".
9083        set i [string first "fatal:" $err]
9084        if {$i > 0} {
9085            set err [string range $err [expr {$i + 6}] end]
9086        }
9087        show_error {} . "Bad arguments to gitk:\n$err"
9088        exit 1
9089    }
9090}
9091
9092if {$mergeonly} {
9093    # find the list of unmerged files
9094    set mlist {}
9095    set nr_unmerged 0
9096    if {[catch {
9097        set fd [open "| git ls-files -u" r]
9098    } err]} {
9099        show_error {} . "Couldn't get list of unmerged files: $err"
9100        exit 1
9101    }
9102    while {[gets $fd line] >= 0} {
9103        set i [string first "\t" $line]
9104        if {$i < 0} continue
9105        set fname [string range $line [expr {$i+1}] end]
9106        if {[lsearch -exact $mlist $fname] >= 0} continue
9107        incr nr_unmerged
9108        if {$cmdline_files eq {} || [path_filter $cmdline_files $fname]} {
9109            lappend mlist $fname
9110        }
9111    }
9112    catch {close $fd}
9113    if {$mlist eq {}} {
9114        if {$nr_unmerged == 0} {
9115            show_error {} . "No files selected: --merge specified but\
9116                             no files are unmerged."
9117        } else {
9118            show_error {} . "No files selected: --merge specified but\
9119                             no unmerged files are within file limit."
9120        }
9121        exit 1
9122    }
9123    set cmdline_files $mlist
9124}
9125
9126set nullid "0000000000000000000000000000000000000000"
9127set nullid2 "0000000000000000000000000000000000000001"
9128
9129set have_tk85 [expr {[package vcompare $tk_version "8.5"] >= 0}]
9130
9131set runq {}
9132set history {}
9133set historyindex 0
9134set fh_serial 0
9135set nhl_names {}
9136set highlight_paths {}
9137set findpattern {}
9138set searchdirn -forwards
9139set boldrows {}
9140set boldnamerows {}
9141set diffelide {0 0}
9142set markingmatches 0
9143set linkentercount 0
9144set need_redisplay 0
9145set nrows_drawn 0
9146set firsttabstop 0
9147
9148set nextviewnum 1
9149set curview 0
9150set selectedview 0
9151set selectedhlview None
9152set highlight_related None
9153set highlight_files {}
9154set viewfiles(0) {}
9155set viewperm(0) 0
9156set viewargs(0) {}
9157
9158set loginstance 0
9159set getdbg 0
9160set cmdlineok 0
9161set stopped 0
9162set stuffsaved 0
9163set patchnum 0
9164set lserial 0
9165setcoords
9166makewindow
9167# wait for the window to become visible
9168tkwait visibility .
9169wm title . "[file tail $argv0]: [file tail [pwd]]"
9170readrefs
9171
9172if {$cmdline_files ne {} || $revtreeargs ne {}} {
9173    # create a view for the files/dirs specified on the command line
9174    set curview 1
9175    set selectedview 1
9176    set nextviewnum 2
9177    set viewname(1) "Command line"
9178    set viewfiles(1) $cmdline_files
9179    set viewargs(1) $revtreeargs
9180    set viewperm(1) 0
9181    addviewmenu 1
9182    .bar.view entryconf Edit* -state normal
9183    .bar.view entryconf Delete* -state normal
9184}
9185
9186if {[info exists permviews]} {
9187    foreach v $permviews {
9188        set n $nextviewnum
9189        incr nextviewnum
9190        set viewname($n) [lindex $v 0]
9191        set viewfiles($n) [lindex $v 1]
9192        set viewargs($n) [lindex $v 2]
9193        set viewperm($n) 1
9194        addviewmenu $n
9195    }
9196}
9197getcommits