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