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