gitkon commit gitk: Make it possible to lay out all the rows we have received so far (f5f3c2e)
   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        foreach id [lindex $rowidlist [expr {$row - 1}]] {
3012            if {$id ne {}} {
3013                lappend idlist $id
3014            }
3015        }
3016    }
3017    for {} {$row < $endrow} {incr row} {
3018        set rm1 [expr {$row - 1}]
3019        if {$rm1 < 0 || [lindex $rowidlist $rm1] eq {}} {
3020            set idlist [make_idlist $row]
3021            set final 1
3022        } else {
3023            set id [lindex $displayorder $rm1]
3024            set final [lindex $rowfinal $rm1]
3025            set col [lsearch -exact $idlist $id]
3026            set idlist [lreplace $idlist $col $col]
3027            foreach p [lindex $parentlist $rm1] {
3028                if {[lsearch -exact $idlist $p] < 0} {
3029                    set col [idcol $idlist $p $col]
3030                    set idlist [linsert $idlist $col $p]
3031                    # if not the first child, we have to insert a line going up
3032                    if {$id ne [lindex $children($curview,$p) 0]} {
3033                        makeupline $p $rm1 $row $col
3034                    }
3035                }
3036            }
3037            set id [lindex $displayorder $row]
3038            if {$row > $downarrowlen} {
3039                set termrow [expr {$row - $downarrowlen - 1}]
3040                foreach p [lindex $parentlist $termrow] {
3041                    set i [lsearch -exact $idlist $p]
3042                    if {$i < 0} continue
3043                    set nr [nextuse $p $termrow]
3044                    if {$nr < 0 || $nr >= $row + $mingaplen + $uparrowlen} {
3045                        set idlist [lreplace $idlist $i $i]
3046                    }
3047                }
3048            }
3049            set col [lsearch -exact $idlist $id]
3050            if {$col < 0} {
3051                set col [idcol $idlist $id]
3052                set idlist [linsert $idlist $col $id]
3053                if {$children($curview,$id) ne {}} {
3054                    makeupline $id $rm1 $row $col
3055                }
3056            }
3057            set r [expr {$row + $uparrowlen - 1}]
3058            if {$r < $commitidx($curview)} {
3059                set x $col
3060                foreach p [lindex $parentlist $r] {
3061                    if {[lsearch -exact $idlist $p] >= 0} continue
3062                    set fk [lindex $children($curview,$p) 0]
3063                    if {$commitrow($curview,$fk) < $row} {
3064                        set x [idcol $idlist $p $x]
3065                        set idlist [linsert $idlist $x $p]
3066                    }
3067                }
3068                if {[incr r] < $commitidx($curview)} {
3069                    set p [lindex $displayorder $r]
3070                    if {[lsearch -exact $idlist $p] < 0} {
3071                        set fk [lindex $children($curview,$p) 0]
3072                        if {$fk ne {} && $commitrow($curview,$fk) < $row} {
3073                            set x [idcol $idlist $p $x]
3074                            set idlist [linsert $idlist $x $p]
3075                        }
3076                    }
3077                }
3078            }
3079        }
3080        if {$final && !$viewcomplete($curview) &&
3081            $row + $uparrowlen + $mingaplen + $downarrowlen
3082                >= $commitidx($curview)} {
3083            set final 0
3084        }
3085        set l [llength $rowidlist]
3086        if {$row == $l} {
3087            lappend rowidlist $idlist
3088            lappend rowisopt 0
3089            lappend rowfinal $final
3090        } elseif {$row < $l} {
3091            if {![rowsequal $idlist [lindex $rowidlist $row]]} {
3092                lset rowidlist $row $idlist
3093                lset rowfinal $row $final
3094                changedrow $row
3095            }
3096        } else {
3097            set pad [ntimes [expr {$row - $l}] {}]
3098            set rowidlist [concat $rowidlist $pad]
3099            lappend rowidlist $idlist
3100            set rowfinal [concat $rowfinal $pad]
3101            lappend rowfinal $final
3102            set rowisopt [concat $rowisopt [ntimes [expr {$row - $l + 1}] 0]]
3103        }
3104    }
3105    return $row
3106}
3107
3108proc changedrow {row} {
3109    global displayorder iddrawn rowisopt need_redisplay
3110
3111    set l [llength $rowisopt]
3112    if {$row < $l} {
3113        lset rowisopt $row 0
3114        if {$row + 1 < $l} {
3115            lset rowisopt [expr {$row + 1}] 0
3116            if {$row + 2 < $l} {
3117                lset rowisopt [expr {$row + 2}] 0
3118            }
3119        }
3120    }
3121    set id [lindex $displayorder $row]
3122    if {[info exists iddrawn($id)]} {
3123        set need_redisplay 1
3124    }
3125}
3126
3127proc insert_pad {row col npad} {
3128    global rowidlist
3129
3130    set pad [ntimes $npad {}]
3131    set idlist [lindex $rowidlist $row]
3132    set bef [lrange $idlist 0 [expr {$col - 1}]]
3133    set aft [lrange $idlist $col end]
3134    set i [lsearch -exact $aft {}]
3135    if {$i > 0} {
3136        set aft [lreplace $aft $i $i]
3137    }
3138    lset rowidlist $row [concat $bef $pad $aft]
3139    changedrow $row
3140}
3141
3142proc optimize_rows {row col endrow} {
3143    global rowidlist rowisopt displayorder curview children
3144
3145    if {$row < 1} {
3146        set row 1
3147    }
3148    for {} {$row < $endrow} {incr row; set col 0} {
3149        if {[lindex $rowisopt $row]} continue
3150        set haspad 0
3151        set y0 [expr {$row - 1}]
3152        set ym [expr {$row - 2}]
3153        set idlist [lindex $rowidlist $row]
3154        set previdlist [lindex $rowidlist $y0]
3155        if {$idlist eq {} || $previdlist eq {}} continue
3156        if {$ym >= 0} {
3157            set pprevidlist [lindex $rowidlist $ym]
3158            if {$pprevidlist eq {}} continue
3159        } else {
3160            set pprevidlist {}
3161        }
3162        set x0 -1
3163        set xm -1
3164        for {} {$col < [llength $idlist]} {incr col} {
3165            set id [lindex $idlist $col]
3166            if {[lindex $previdlist $col] eq $id} continue
3167            if {$id eq {}} {
3168                set haspad 1
3169                continue
3170            }
3171            set x0 [lsearch -exact $previdlist $id]
3172            if {$x0 < 0} continue
3173            set z [expr {$x0 - $col}]
3174            set isarrow 0
3175            set z0 {}
3176            if {$ym >= 0} {
3177                set xm [lsearch -exact $pprevidlist $id]
3178                if {$xm >= 0} {
3179                    set z0 [expr {$xm - $x0}]
3180                }
3181            }
3182            if {$z0 eq {}} {
3183                # if row y0 is the first child of $id then it's not an arrow
3184                if {[lindex $children($curview,$id) 0] ne
3185                    [lindex $displayorder $y0]} {
3186                    set isarrow 1
3187                }
3188            }
3189            if {!$isarrow && $id ne [lindex $displayorder $row] &&
3190                [lsearch -exact [lindex $rowidlist [expr {$row+1}]] $id] < 0} {
3191                set isarrow 1
3192            }
3193            # Looking at lines from this row to the previous row,
3194            # make them go straight up if they end in an arrow on
3195            # the previous row; otherwise make them go straight up
3196            # or at 45 degrees.
3197            if {$z < -1 || ($z < 0 && $isarrow)} {
3198                # Line currently goes left too much;
3199                # insert pads in the previous row, then optimize it
3200                set npad [expr {-1 - $z + $isarrow}]
3201                insert_pad $y0 $x0 $npad
3202                if {$y0 > 0} {
3203                    optimize_rows $y0 $x0 $row
3204                }
3205                set previdlist [lindex $rowidlist $y0]
3206                set x0 [lsearch -exact $previdlist $id]
3207                set z [expr {$x0 - $col}]
3208                if {$z0 ne {}} {
3209                    set pprevidlist [lindex $rowidlist $ym]
3210                    set xm [lsearch -exact $pprevidlist $id]
3211                    set z0 [expr {$xm - $x0}]
3212                }
3213            } elseif {$z > 1 || ($z > 0 && $isarrow)} {
3214                # Line currently goes right too much;
3215                # insert pads in this line
3216                set npad [expr {$z - 1 + $isarrow}]
3217                insert_pad $row $col $npad
3218                set idlist [lindex $rowidlist $row]
3219                incr col $npad
3220                set z [expr {$x0 - $col}]
3221                set haspad 1
3222            }
3223            if {$z0 eq {} && !$isarrow && $ym >= 0} {
3224                # this line links to its first child on row $row-2
3225                set id [lindex $displayorder $ym]
3226                set xc [lsearch -exact $pprevidlist $id]
3227                if {$xc >= 0} {
3228                    set z0 [expr {$xc - $x0}]
3229                }
3230            }
3231            # avoid lines jigging left then immediately right
3232            if {$z0 ne {} && $z < 0 && $z0 > 0} {
3233                insert_pad $y0 $x0 1
3234                incr x0
3235                optimize_rows $y0 $x0 $row
3236                set previdlist [lindex $rowidlist $y0]
3237            }
3238        }
3239        if {!$haspad} {
3240            # Find the first column that doesn't have a line going right
3241            for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
3242                set id [lindex $idlist $col]
3243                if {$id eq {}} break
3244                set x0 [lsearch -exact $previdlist $id]
3245                if {$x0 < 0} {
3246                    # check if this is the link to the first child
3247                    set kid [lindex $displayorder $y0]
3248                    if {[lindex $children($curview,$id) 0] eq $kid} {
3249                        # it is, work out offset to child
3250                        set x0 [lsearch -exact $previdlist $kid]
3251                    }
3252                }
3253                if {$x0 <= $col} break
3254            }
3255            # Insert a pad at that column as long as it has a line and
3256            # isn't the last column
3257            if {$x0 >= 0 && [incr col] < [llength $idlist]} {
3258                set idlist [linsert $idlist $col {}]
3259                lset rowidlist $row $idlist
3260                changedrow $row
3261            }
3262        }
3263    }
3264}
3265
3266proc xc {row col} {
3267    global canvx0 linespc
3268    return [expr {$canvx0 + $col * $linespc}]
3269}
3270
3271proc yc {row} {
3272    global canvy0 linespc
3273    return [expr {$canvy0 + $row * $linespc}]
3274}
3275
3276proc linewidth {id} {
3277    global thickerline lthickness
3278
3279    set wid $lthickness
3280    if {[info exists thickerline] && $id eq $thickerline} {
3281        set wid [expr {2 * $lthickness}]
3282    }
3283    return $wid
3284}
3285
3286proc rowranges {id} {
3287    global commitrow curview children uparrowlen downarrowlen
3288    global rowidlist
3289
3290    set kids $children($curview,$id)
3291    if {$kids eq {}} {
3292        return {}
3293    }
3294    set ret {}
3295    lappend kids $id
3296    foreach child $kids {
3297        if {![info exists commitrow($curview,$child)]} break
3298        set row $commitrow($curview,$child)
3299        if {![info exists prev]} {
3300            lappend ret [expr {$row + 1}]
3301        } else {
3302            if {$row <= $prevrow} {
3303                puts "oops children out of order [shortids $id] $row < [shortids $prev] $prevrow"
3304            }
3305            # see if the line extends the whole way from prevrow to row
3306            if {$row > $prevrow + $uparrowlen + $downarrowlen &&
3307                [lsearch -exact [lindex $rowidlist \
3308                            [expr {int(($row + $prevrow) / 2)}]] $id] < 0} {
3309                # it doesn't, see where it ends
3310                set r [expr {$prevrow + $downarrowlen}]
3311                if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
3312                    while {[incr r -1] > $prevrow &&
3313                           [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
3314                } else {
3315                    while {[incr r] <= $row &&
3316                           [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
3317                    incr r -1
3318                }
3319                lappend ret $r
3320                # see where it starts up again
3321                set r [expr {$row - $uparrowlen}]
3322                if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
3323                    while {[incr r] < $row &&
3324                           [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
3325                } else {
3326                    while {[incr r -1] >= $prevrow &&
3327                           [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
3328                    incr r
3329                }
3330                lappend ret $r
3331            }
3332        }
3333        if {$child eq $id} {
3334            lappend ret $row
3335        }
3336        set prev $id
3337        set prevrow $row
3338    }
3339    return $ret
3340}
3341
3342proc drawlineseg {id row endrow arrowlow} {
3343    global rowidlist displayorder iddrawn linesegs
3344    global canv colormap linespc curview maxlinelen parentlist
3345
3346    set cols [list [lsearch -exact [lindex $rowidlist $row] $id]]
3347    set le [expr {$row + 1}]
3348    set arrowhigh 1
3349    while {1} {
3350        set c [lsearch -exact [lindex $rowidlist $le] $id]
3351        if {$c < 0} {
3352            incr le -1
3353            break
3354        }
3355        lappend cols $c
3356        set x [lindex $displayorder $le]
3357        if {$x eq $id} {
3358            set arrowhigh 0
3359            break
3360        }
3361        if {[info exists iddrawn($x)] || $le == $endrow} {
3362            set c [lsearch -exact [lindex $rowidlist [expr {$le+1}]] $id]
3363            if {$c >= 0} {
3364                lappend cols $c
3365                set arrowhigh 0
3366            }
3367            break
3368        }
3369        incr le
3370    }
3371    if {$le <= $row} {
3372        return $row
3373    }
3374
3375    set lines {}
3376    set i 0
3377    set joinhigh 0
3378    if {[info exists linesegs($id)]} {
3379        set lines $linesegs($id)
3380        foreach li $lines {
3381            set r0 [lindex $li 0]
3382            if {$r0 > $row} {
3383                if {$r0 == $le && [lindex $li 1] - $row <= $maxlinelen} {
3384                    set joinhigh 1
3385                }
3386                break
3387            }
3388            incr i
3389        }
3390    }
3391    set joinlow 0
3392    if {$i > 0} {
3393        set li [lindex $lines [expr {$i-1}]]
3394        set r1 [lindex $li 1]
3395        if {$r1 == $row && $le - [lindex $li 0] <= $maxlinelen} {
3396            set joinlow 1
3397        }
3398    }
3399
3400    set x [lindex $cols [expr {$le - $row}]]
3401    set xp [lindex $cols [expr {$le - 1 - $row}]]
3402    set dir [expr {$xp - $x}]
3403    if {$joinhigh} {
3404        set ith [lindex $lines $i 2]
3405        set coords [$canv coords $ith]
3406        set ah [$canv itemcget $ith -arrow]
3407        set arrowhigh [expr {$ah eq "first" || $ah eq "both"}]
3408        set x2 [lindex $cols [expr {$le + 1 - $row}]]
3409        if {$x2 ne {} && $x - $x2 == $dir} {
3410            set coords [lrange $coords 0 end-2]
3411        }
3412    } else {
3413        set coords [list [xc $le $x] [yc $le]]
3414    }
3415    if {$joinlow} {
3416        set itl [lindex $lines [expr {$i-1}] 2]
3417        set al [$canv itemcget $itl -arrow]
3418        set arrowlow [expr {$al eq "last" || $al eq "both"}]
3419    } elseif {$arrowlow} {
3420        if {[lsearch -exact [lindex $rowidlist [expr {$row-1}]] $id] >= 0 ||
3421            [lsearch -exact [lindex $parentlist [expr {$row-1}]] $id] >= 0} {
3422            set arrowlow 0
3423        }
3424    }
3425    set arrow [lindex {none first last both} [expr {$arrowhigh + 2*$arrowlow}]]
3426    for {set y $le} {[incr y -1] > $row} {} {
3427        set x $xp
3428        set xp [lindex $cols [expr {$y - 1 - $row}]]
3429        set ndir [expr {$xp - $x}]
3430        if {$dir != $ndir || $xp < 0} {
3431            lappend coords [xc $y $x] [yc $y]
3432        }
3433        set dir $ndir
3434    }
3435    if {!$joinlow} {
3436        if {$xp < 0} {
3437            # join parent line to first child
3438            set ch [lindex $displayorder $row]
3439            set xc [lsearch -exact [lindex $rowidlist $row] $ch]
3440            if {$xc < 0} {
3441                puts "oops: drawlineseg: child $ch not on row $row"
3442            } elseif {$xc != $x} {
3443                if {($arrowhigh && $le == $row + 1) || $dir == 0} {
3444                    set d [expr {int(0.5 * $linespc)}]
3445                    set x1 [xc $row $x]
3446                    if {$xc < $x} {
3447                        set x2 [expr {$x1 - $d}]
3448                    } else {
3449                        set x2 [expr {$x1 + $d}]
3450                    }
3451                    set y2 [yc $row]
3452                    set y1 [expr {$y2 + $d}]
3453                    lappend coords $x1 $y1 $x2 $y2
3454                } elseif {$xc < $x - 1} {
3455                    lappend coords [xc $row [expr {$x-1}]] [yc $row]
3456                } elseif {$xc > $x + 1} {
3457                    lappend coords [xc $row [expr {$x+1}]] [yc $row]
3458                }
3459                set x $xc
3460            }
3461            lappend coords [xc $row $x] [yc $row]
3462        } else {
3463            set xn [xc $row $xp]
3464            set yn [yc $row]
3465            lappend coords $xn $yn
3466        }
3467        if {!$joinhigh} {
3468            assigncolor $id
3469            set t [$canv create line $coords -width [linewidth $id] \
3470                       -fill $colormap($id) -tags lines.$id -arrow $arrow]
3471            $canv lower $t
3472            bindline $t $id
3473            set lines [linsert $lines $i [list $row $le $t]]
3474        } else {
3475            $canv coords $ith $coords
3476            if {$arrow ne $ah} {
3477                $canv itemconf $ith -arrow $arrow
3478            }
3479            lset lines $i 0 $row
3480        }
3481    } else {
3482        set xo [lsearch -exact [lindex $rowidlist [expr {$row - 1}]] $id]
3483        set ndir [expr {$xo - $xp}]
3484        set clow [$canv coords $itl]
3485        if {$dir == $ndir} {
3486            set clow [lrange $clow 2 end]
3487        }
3488        set coords [concat $coords $clow]
3489        if {!$joinhigh} {
3490            lset lines [expr {$i-1}] 1 $le
3491        } else {
3492            # coalesce two pieces
3493            $canv delete $ith
3494            set b [lindex $lines [expr {$i-1}] 0]
3495            set e [lindex $lines $i 1]
3496            set lines [lreplace $lines [expr {$i-1}] $i [list $b $e $itl]]
3497        }
3498        $canv coords $itl $coords
3499        if {$arrow ne $al} {
3500            $canv itemconf $itl -arrow $arrow
3501        }
3502    }
3503
3504    set linesegs($id) $lines
3505    return $le
3506}
3507
3508proc drawparentlinks {id row} {
3509    global rowidlist canv colormap curview parentlist
3510    global idpos linespc
3511
3512    set rowids [lindex $rowidlist $row]
3513    set col [lsearch -exact $rowids $id]
3514    if {$col < 0} return
3515    set olds [lindex $parentlist $row]
3516    set row2 [expr {$row + 1}]
3517    set x [xc $row $col]
3518    set y [yc $row]
3519    set y2 [yc $row2]
3520    set d [expr {int(0.5 * $linespc)}]
3521    set ymid [expr {$y + $d}]
3522    set ids [lindex $rowidlist $row2]
3523    # rmx = right-most X coord used
3524    set rmx 0
3525    foreach p $olds {
3526        set i [lsearch -exact $ids $p]
3527        if {$i < 0} {
3528            puts "oops, parent $p of $id not in list"
3529            continue
3530        }
3531        set x2 [xc $row2 $i]
3532        if {$x2 > $rmx} {
3533            set rmx $x2
3534        }
3535        set j [lsearch -exact $rowids $p]
3536        if {$j < 0} {
3537            # drawlineseg will do this one for us
3538            continue
3539        }
3540        assigncolor $p
3541        # should handle duplicated parents here...
3542        set coords [list $x $y]
3543        if {$i != $col} {
3544            # if attaching to a vertical segment, draw a smaller
3545            # slant for visual distinctness
3546            if {$i == $j} {
3547                if {$i < $col} {
3548                    lappend coords [expr {$x2 + $d}] $y $x2 $ymid
3549                } else {
3550                    lappend coords [expr {$x2 - $d}] $y $x2 $ymid
3551                }
3552            } elseif {$i < $col && $i < $j} {
3553                # segment slants towards us already
3554                lappend coords [xc $row $j] $y
3555            } else {
3556                if {$i < $col - 1} {
3557                    lappend coords [expr {$x2 + $linespc}] $y
3558                } elseif {$i > $col + 1} {
3559                    lappend coords [expr {$x2 - $linespc}] $y
3560                }
3561                lappend coords $x2 $y2
3562            }
3563        } else {
3564            lappend coords $x2 $y2
3565        }
3566        set t [$canv create line $coords -width [linewidth $p] \
3567                   -fill $colormap($p) -tags lines.$p]
3568        $canv lower $t
3569        bindline $t $p
3570    }
3571    if {$rmx > [lindex $idpos($id) 1]} {
3572        lset idpos($id) 1 $rmx
3573        redrawtags $id
3574    }
3575}
3576
3577proc drawlines {id} {
3578    global canv
3579
3580    $canv itemconf lines.$id -width [linewidth $id]
3581}
3582
3583proc drawcmittext {id row col} {
3584    global linespc canv canv2 canv3 canvy0 fgcolor curview
3585    global commitlisted commitinfo rowidlist parentlist
3586    global rowtextx idpos idtags idheads idotherrefs
3587    global linehtag linentag linedtag selectedline
3588    global mainfont canvxmax boldrows boldnamerows fgcolor nullid nullid2
3589
3590    # listed is 0 for boundary, 1 for normal, 2 for left, 3 for right
3591    set listed [lindex $commitlisted $row]
3592    if {$id eq $nullid} {
3593        set ofill red
3594    } elseif {$id eq $nullid2} {
3595        set ofill green
3596    } else {
3597        set ofill [expr {$listed != 0? "blue": "white"}]
3598    }
3599    set x [xc $row $col]
3600    set y [yc $row]
3601    set orad [expr {$linespc / 3}]
3602    if {$listed <= 1} {
3603        set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
3604                   [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
3605                   -fill $ofill -outline $fgcolor -width 1 -tags circle]
3606    } elseif {$listed == 2} {
3607        # triangle pointing left for left-side commits
3608        set t [$canv create polygon \
3609                   [expr {$x - $orad}] $y \
3610                   [expr {$x + $orad - 1}] [expr {$y - $orad}] \
3611                   [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
3612                   -fill $ofill -outline $fgcolor -width 1 -tags circle]
3613    } else {
3614        # triangle pointing right for right-side commits
3615        set t [$canv create polygon \
3616                   [expr {$x + $orad - 1}] $y \
3617                   [expr {$x - $orad}] [expr {$y - $orad}] \
3618                   [expr {$x - $orad}] [expr {$y + $orad - 1}] \
3619                   -fill $ofill -outline $fgcolor -width 1 -tags circle]
3620    }
3621    $canv raise $t
3622    $canv bind $t <1> {selcanvline {} %x %y}
3623    set rmx [llength [lindex $rowidlist $row]]
3624    set olds [lindex $parentlist $row]
3625    if {$olds ne {}} {
3626        set nextids [lindex $rowidlist [expr {$row + 1}]]
3627        foreach p $olds {
3628            set i [lsearch -exact $nextids $p]
3629            if {$i > $rmx} {
3630                set rmx $i
3631            }
3632        }
3633    }
3634    set xt [xc $row $rmx]
3635    set rowtextx($row) $xt
3636    set idpos($id) [list $x $xt $y]
3637    if {[info exists idtags($id)] || [info exists idheads($id)]
3638        || [info exists idotherrefs($id)]} {
3639        set xt [drawtags $id $x $xt $y]
3640    }
3641    set headline [lindex $commitinfo($id) 0]
3642    set name [lindex $commitinfo($id) 1]
3643    set date [lindex $commitinfo($id) 2]
3644    set date [formatdate $date]
3645    set font $mainfont
3646    set nfont $mainfont
3647    set isbold [ishighlighted $row]
3648    if {$isbold > 0} {
3649        lappend boldrows $row
3650        lappend font bold
3651        if {$isbold > 1} {
3652            lappend boldnamerows $row
3653            lappend nfont bold
3654        }
3655    }
3656    set linehtag($row) [$canv create text $xt $y -anchor w -fill $fgcolor \
3657                            -text $headline -font $font -tags text]
3658    $canv bind $linehtag($row) <Button-3> "rowmenu %X %Y $id"
3659    set linentag($row) [$canv2 create text 3 $y -anchor w -fill $fgcolor \
3660                            -text $name -font $nfont -tags text]
3661    set linedtag($row) [$canv3 create text 3 $y -anchor w -fill $fgcolor \
3662                            -text $date -font $mainfont -tags text]
3663    if {[info exists selectedline] && $selectedline == $row} {
3664        make_secsel $row
3665    }
3666    set xr [expr {$xt + [font measure $mainfont $headline]}]
3667    if {$xr > $canvxmax} {
3668        set canvxmax $xr
3669        setcanvscroll
3670    }
3671}
3672
3673proc drawcmitrow {row} {
3674    global displayorder rowidlist nrows_drawn
3675    global iddrawn markingmatches
3676    global commitinfo parentlist numcommits
3677    global filehighlight fhighlights findstring nhighlights
3678    global hlview vhighlights
3679    global highlight_related rhighlights
3680
3681    if {$row >= $numcommits} return
3682
3683    set id [lindex $displayorder $row]
3684    if {[info exists hlview] && ![info exists vhighlights($row)]} {
3685        askvhighlight $row $id
3686    }
3687    if {[info exists filehighlight] && ![info exists fhighlights($row)]} {
3688        askfilehighlight $row $id
3689    }
3690    if {$findstring ne {} && ![info exists nhighlights($row)]} {
3691        askfindhighlight $row $id
3692    }
3693    if {$highlight_related ne "None" && ![info exists rhighlights($row)]} {
3694        askrelhighlight $row $id
3695    }
3696    if {![info exists iddrawn($id)]} {
3697        set col [lsearch -exact [lindex $rowidlist $row] $id]
3698        if {$col < 0} {
3699            puts "oops, row $row id $id not in list"
3700            return
3701        }
3702        if {![info exists commitinfo($id)]} {
3703            getcommit $id
3704        }
3705        assigncolor $id
3706        drawcmittext $id $row $col
3707        set iddrawn($id) 1
3708        incr nrows_drawn
3709    }
3710    if {$markingmatches} {
3711        markrowmatches $row $id
3712    }
3713}
3714
3715proc drawcommits {row {endrow {}}} {
3716    global numcommits iddrawn displayorder curview need_redisplay
3717    global parentlist rowidlist rowfinal uparrowlen downarrowlen nrows_drawn
3718
3719    if {$row < 0} {
3720        set row 0
3721    }
3722    if {$endrow eq {}} {
3723        set endrow $row
3724    }
3725    if {$endrow >= $numcommits} {
3726        set endrow [expr {$numcommits - 1}]
3727    }
3728
3729    set rl1 [expr {$row - $downarrowlen - 3}]
3730    if {$rl1 < 0} {
3731        set rl1 0
3732    }
3733    set ro1 [expr {$row - 3}]
3734    if {$ro1 < 0} {
3735        set ro1 0
3736    }
3737    set r2 [expr {$endrow + $uparrowlen + 3}]
3738    if {$r2 > $numcommits} {
3739        set r2 $numcommits
3740    }
3741    for {set r $rl1} {$r < $r2} {incr r} {
3742        if {[lindex $rowidlist $r] ne {} && [lindex $rowfinal $r]} {
3743            if {$rl1 < $r} {
3744                layoutrows $rl1 $r
3745            }
3746            set rl1 [expr {$r + 1}]
3747        }
3748    }
3749    if {$rl1 < $r} {
3750        layoutrows $rl1 $r
3751    }
3752    optimize_rows $ro1 0 $r2
3753    if {$need_redisplay || $nrows_drawn > 2000} {
3754        clear_display
3755        drawvisible
3756    }
3757
3758    # make the lines join to already-drawn rows either side
3759    set r [expr {$row - 1}]
3760    if {$r < 0 || ![info exists iddrawn([lindex $displayorder $r])]} {
3761        set r $row
3762    }
3763    set er [expr {$endrow + 1}]
3764    if {$er >= $numcommits ||
3765        ![info exists iddrawn([lindex $displayorder $er])]} {
3766        set er $endrow
3767    }
3768    for {} {$r <= $er} {incr r} {
3769        set id [lindex $displayorder $r]
3770        set wasdrawn [info exists iddrawn($id)]
3771        drawcmitrow $r
3772        if {$r == $er} break
3773        set nextid [lindex $displayorder [expr {$r + 1}]]
3774        if {$wasdrawn && [info exists iddrawn($nextid)]} {
3775            catch {unset prevlines}
3776            continue
3777        }
3778        drawparentlinks $id $r
3779
3780        if {[info exists lineends($r)]} {
3781            foreach lid $lineends($r) {
3782                unset prevlines($lid)
3783            }
3784        }
3785        set rowids [lindex $rowidlist $r]
3786        foreach lid $rowids {
3787            if {$lid eq {}} continue
3788            if {$lid eq $id} {
3789                # see if this is the first child of any of its parents
3790                foreach p [lindex $parentlist $r] {
3791                    if {[lsearch -exact $rowids $p] < 0} {
3792                        # make this line extend up to the child
3793                        set le [drawlineseg $p $r $er 0]
3794                        lappend lineends($le) $p
3795                        set prevlines($p) 1
3796                    }
3797                }
3798            } elseif {![info exists prevlines($lid)]} {
3799                set le [drawlineseg $lid $r $er 1]
3800                lappend lineends($le) $lid
3801                set prevlines($lid) 1
3802            }
3803        }
3804    }
3805}
3806
3807proc drawfrac {f0 f1} {
3808    global canv linespc
3809
3810    set ymax [lindex [$canv cget -scrollregion] 3]
3811    if {$ymax eq {} || $ymax == 0} return
3812    set y0 [expr {int($f0 * $ymax)}]
3813    set row [expr {int(($y0 - 3) / $linespc) - 1}]
3814    set y1 [expr {int($f1 * $ymax)}]
3815    set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
3816    drawcommits $row $endrow
3817}
3818
3819proc drawvisible {} {
3820    global canv
3821    eval drawfrac [$canv yview]
3822}
3823
3824proc clear_display {} {
3825    global iddrawn linesegs need_redisplay nrows_drawn
3826    global vhighlights fhighlights nhighlights rhighlights
3827
3828    allcanvs delete all
3829    catch {unset iddrawn}
3830    catch {unset linesegs}
3831    catch {unset vhighlights}
3832    catch {unset fhighlights}
3833    catch {unset nhighlights}
3834    catch {unset rhighlights}
3835    set need_redisplay 0
3836    set nrows_drawn 0
3837}
3838
3839proc findcrossings {id} {
3840    global rowidlist parentlist numcommits displayorder
3841
3842    set cross {}
3843    set ccross {}
3844    foreach {s e} [rowranges $id] {
3845        if {$e >= $numcommits} {
3846            set e [expr {$numcommits - 1}]
3847        }
3848        if {$e <= $s} continue
3849        for {set row $e} {[incr row -1] >= $s} {} {
3850            set x [lsearch -exact [lindex $rowidlist $row] $id]
3851            if {$x < 0} break
3852            set olds [lindex $parentlist $row]
3853            set kid [lindex $displayorder $row]
3854            set kidx [lsearch -exact [lindex $rowidlist $row] $kid]
3855            if {$kidx < 0} continue
3856            set nextrow [lindex $rowidlist [expr {$row + 1}]]
3857            foreach p $olds {
3858                set px [lsearch -exact $nextrow $p]
3859                if {$px < 0} continue
3860                if {($kidx < $x && $x < $px) || ($px < $x && $x < $kidx)} {
3861                    if {[lsearch -exact $ccross $p] >= 0} continue
3862                    if {$x == $px + ($kidx < $px? -1: 1)} {
3863                        lappend ccross $p
3864                    } elseif {[lsearch -exact $cross $p] < 0} {
3865                        lappend cross $p
3866                    }
3867                }
3868            }
3869        }
3870    }
3871    return [concat $ccross {{}} $cross]
3872}
3873
3874proc assigncolor {id} {
3875    global colormap colors nextcolor
3876    global commitrow parentlist children children curview
3877
3878    if {[info exists colormap($id)]} return
3879    set ncolors [llength $colors]
3880    if {[info exists children($curview,$id)]} {
3881        set kids $children($curview,$id)
3882    } else {
3883        set kids {}
3884    }
3885    if {[llength $kids] == 1} {
3886        set child [lindex $kids 0]
3887        if {[info exists colormap($child)]
3888            && [llength [lindex $parentlist $commitrow($curview,$child)]] == 1} {
3889            set colormap($id) $colormap($child)
3890            return
3891        }
3892    }
3893    set badcolors {}
3894    set origbad {}
3895    foreach x [findcrossings $id] {
3896        if {$x eq {}} {
3897            # delimiter between corner crossings and other crossings
3898            if {[llength $badcolors] >= $ncolors - 1} break
3899            set origbad $badcolors
3900        }
3901        if {[info exists colormap($x)]
3902            && [lsearch -exact $badcolors $colormap($x)] < 0} {
3903            lappend badcolors $colormap($x)
3904        }
3905    }
3906    if {[llength $badcolors] >= $ncolors} {
3907        set badcolors $origbad
3908    }
3909    set origbad $badcolors
3910    if {[llength $badcolors] < $ncolors - 1} {
3911        foreach child $kids {
3912            if {[info exists colormap($child)]
3913                && [lsearch -exact $badcolors $colormap($child)] < 0} {
3914                lappend badcolors $colormap($child)
3915            }
3916            foreach p [lindex $parentlist $commitrow($curview,$child)] {
3917                if {[info exists colormap($p)]
3918                    && [lsearch -exact $badcolors $colormap($p)] < 0} {
3919                    lappend badcolors $colormap($p)
3920                }
3921            }
3922        }
3923        if {[llength $badcolors] >= $ncolors} {
3924            set badcolors $origbad
3925        }
3926    }
3927    for {set i 0} {$i <= $ncolors} {incr i} {
3928        set c [lindex $colors $nextcolor]
3929        if {[incr nextcolor] >= $ncolors} {
3930            set nextcolor 0
3931        }
3932        if {[lsearch -exact $badcolors $c]} break
3933    }
3934    set colormap($id) $c
3935}
3936
3937proc bindline {t id} {
3938    global canv
3939
3940    $canv bind $t <Enter> "lineenter %x %y $id"
3941    $canv bind $t <Motion> "linemotion %x %y $id"
3942    $canv bind $t <Leave> "lineleave $id"
3943    $canv bind $t <Button-1> "lineclick %x %y $id 1"
3944}
3945
3946proc drawtags {id x xt y1} {
3947    global idtags idheads idotherrefs mainhead
3948    global linespc lthickness
3949    global canv mainfont commitrow rowtextx curview fgcolor bgcolor
3950
3951    set marks {}
3952    set ntags 0
3953    set nheads 0
3954    if {[info exists idtags($id)]} {
3955        set marks $idtags($id)
3956        set ntags [llength $marks]
3957    }
3958    if {[info exists idheads($id)]} {
3959        set marks [concat $marks $idheads($id)]
3960        set nheads [llength $idheads($id)]
3961    }
3962    if {[info exists idotherrefs($id)]} {
3963        set marks [concat $marks $idotherrefs($id)]
3964    }
3965    if {$marks eq {}} {
3966        return $xt
3967    }
3968
3969    set delta [expr {int(0.5 * ($linespc - $lthickness))}]
3970    set yt [expr {$y1 - 0.5 * $linespc}]
3971    set yb [expr {$yt + $linespc - 1}]
3972    set xvals {}
3973    set wvals {}
3974    set i -1
3975    foreach tag $marks {
3976        incr i
3977        if {$i >= $ntags && $i < $ntags + $nheads && $tag eq $mainhead} {
3978            set wid [font measure [concat $mainfont bold] $tag]
3979        } else {
3980            set wid [font measure $mainfont $tag]
3981        }
3982        lappend xvals $xt
3983        lappend wvals $wid
3984        set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
3985    }
3986    set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
3987               -width $lthickness -fill black -tags tag.$id]
3988    $canv lower $t
3989    foreach tag $marks x $xvals wid $wvals {
3990        set xl [expr {$x + $delta}]
3991        set xr [expr {$x + $delta + $wid + $lthickness}]
3992        set font $mainfont
3993        if {[incr ntags -1] >= 0} {
3994            # draw a tag
3995            set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
3996                       $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
3997                       -width 1 -outline black -fill yellow -tags tag.$id]
3998            $canv bind $t <1> [list showtag $tag 1]
3999            set rowtextx($commitrow($curview,$id)) [expr {$xr + $linespc}]
4000        } else {
4001            # draw a head or other ref
4002            if {[incr nheads -1] >= 0} {
4003                set col green
4004                if {$tag eq $mainhead} {
4005                    lappend font bold
4006                }
4007            } else {
4008                set col "#ddddff"
4009            }
4010            set xl [expr {$xl - $delta/2}]
4011            $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
4012                -width 1 -outline black -fill $col -tags tag.$id
4013            if {[regexp {^(remotes/.*/|remotes/)} $tag match remoteprefix]} {
4014                set rwid [font measure $mainfont $remoteprefix]
4015                set xi [expr {$x + 1}]
4016                set yti [expr {$yt + 1}]
4017                set xri [expr {$x + $rwid}]
4018                $canv create polygon $xi $yti $xri $yti $xri $yb $xi $yb \
4019                        -width 0 -fill "#ffddaa" -tags tag.$id
4020            }
4021        }
4022        set t [$canv create text $xl $y1 -anchor w -text $tag -fill $fgcolor \
4023                   -font $font -tags [list tag.$id text]]
4024        if {$ntags >= 0} {
4025            $canv bind $t <1> [list showtag $tag 1]
4026        } elseif {$nheads >= 0} {
4027            $canv bind $t <Button-3> [list headmenu %X %Y $id $tag]
4028        }
4029    }
4030    return $xt
4031}
4032
4033proc xcoord {i level ln} {
4034    global canvx0 xspc1 xspc2
4035
4036    set x [expr {$canvx0 + $i * $xspc1($ln)}]
4037    if {$i > 0 && $i == $level} {
4038        set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
4039    } elseif {$i > $level} {
4040        set x [expr {$x + $xspc2 - $xspc1($ln)}]
4041    }
4042    return $x
4043}
4044
4045proc show_status {msg} {
4046    global canv mainfont fgcolor
4047
4048    clear_display
4049    $canv create text 3 3 -anchor nw -text $msg -font $mainfont \
4050        -tags text -fill $fgcolor
4051}
4052
4053# Insert a new commit as the child of the commit on row $row.
4054# The new commit will be displayed on row $row and the commits
4055# on that row and below will move down one row.
4056proc insertrow {row newcmit} {
4057    global displayorder parentlist commitlisted children
4058    global commitrow curview rowidlist rowisopt numcommits
4059    global numcommits
4060    global selectedline commitidx ordertok
4061
4062    if {$row >= $numcommits} {
4063        puts "oops, inserting new row $row but only have $numcommits rows"
4064        return
4065    }
4066    set p [lindex $displayorder $row]
4067    set displayorder [linsert $displayorder $row $newcmit]
4068    set parentlist [linsert $parentlist $row $p]
4069    set kids $children($curview,$p)
4070    lappend kids $newcmit
4071    set children($curview,$p) $kids
4072    set children($curview,$newcmit) {}
4073    set commitlisted [linsert $commitlisted $row 1]
4074    set l [llength $displayorder]
4075    for {set r $row} {$r < $l} {incr r} {
4076        set id [lindex $displayorder $r]
4077        set commitrow($curview,$id) $r
4078    }
4079    incr commitidx($curview)
4080    set ordertok($curview,$newcmit) $ordertok($curview,$p)
4081
4082    set idlist [lindex $rowidlist $row]
4083    if {[llength $kids] == 1} {
4084        set col [lsearch -exact $idlist $p]
4085        lset idlist $col $newcmit
4086    } else {
4087        set col [llength $idlist]
4088        lappend idlist $newcmit
4089    }
4090    set rowidlist [linsert $rowidlist $row $idlist]
4091    set rowisopt [linsert $rowisopt $row 0]
4092
4093    incr numcommits
4094
4095    if {[info exists selectedline] && $selectedline >= $row} {
4096        incr selectedline
4097    }
4098    redisplay
4099}
4100
4101# Remove a commit that was inserted with insertrow on row $row.
4102proc removerow {row} {
4103    global displayorder parentlist commitlisted children
4104    global commitrow curview rowidlist rowisopt numcommits
4105    global numcommits
4106    global linesegends selectedline commitidx
4107
4108    if {$row >= $numcommits} {
4109        puts "oops, removing row $row but only have $numcommits rows"
4110        return
4111    }
4112    set rp1 [expr {$row + 1}]
4113    set id [lindex $displayorder $row]
4114    set p [lindex $parentlist $row]
4115    set displayorder [lreplace $displayorder $row $row]
4116    set parentlist [lreplace $parentlist $row $row]
4117    set commitlisted [lreplace $commitlisted $row $row]
4118    set kids $children($curview,$p)
4119    set i [lsearch -exact $kids $id]
4120    if {$i >= 0} {
4121        set kids [lreplace $kids $i $i]
4122        set children($curview,$p) $kids
4123    }
4124    set l [llength $displayorder]
4125    for {set r $row} {$r < $l} {incr r} {
4126        set id [lindex $displayorder $r]
4127        set commitrow($curview,$id) $r
4128    }
4129    incr commitidx($curview) -1
4130
4131    set rowidlist [lreplace $rowidlist $row $row]
4132    set rowisopt [lreplace $rowisopt $row $row]
4133
4134    incr numcommits -1
4135
4136    if {[info exists selectedline] && $selectedline > $row} {
4137        incr selectedline -1
4138    }
4139    redisplay
4140}
4141
4142# Don't change the text pane cursor if it is currently the hand cursor,
4143# showing that we are over a sha1 ID link.
4144proc settextcursor {c} {
4145    global ctext curtextcursor
4146
4147    if {[$ctext cget -cursor] == $curtextcursor} {
4148        $ctext config -cursor $c
4149    }
4150    set curtextcursor $c
4151}
4152
4153proc nowbusy {what} {
4154    global isbusy
4155
4156    if {[array names isbusy] eq {}} {
4157        . config -cursor watch
4158        settextcursor watch
4159    }
4160    set isbusy($what) 1
4161}
4162
4163proc notbusy {what} {
4164    global isbusy maincursor textcursor
4165
4166    catch {unset isbusy($what)}
4167    if {[array names isbusy] eq {}} {
4168        . config -cursor $maincursor
4169        settextcursor $textcursor
4170    }
4171}
4172
4173proc findmatches {f} {
4174    global findtype findstring
4175    if {$findtype == "Regexp"} {
4176        set matches [regexp -indices -all -inline $findstring $f]
4177    } else {
4178        set fs $findstring
4179        if {$findtype == "IgnCase"} {
4180            set f [string tolower $f]
4181            set fs [string tolower $fs]
4182        }
4183        set matches {}
4184        set i 0
4185        set l [string length $fs]
4186        while {[set j [string first $fs $f $i]] >= 0} {
4187            lappend matches [list $j [expr {$j+$l-1}]]
4188            set i [expr {$j + $l}]
4189        }
4190    }
4191    return $matches
4192}
4193
4194proc dofind {{rev 0}} {
4195    global findstring findstartline findcurline selectedline numcommits
4196
4197    unmarkmatches
4198    cancel_next_highlight
4199    focus .
4200    if {$findstring eq {} || $numcommits == 0} return
4201    if {![info exists selectedline]} {
4202        set findstartline [lindex [visiblerows] $rev]
4203    } else {
4204        set findstartline $selectedline
4205    }
4206    set findcurline $findstartline
4207    nowbusy finding
4208    if {!$rev} {
4209        run findmore
4210    } else {
4211        if {$findcurline == 0} {
4212            set findcurline $numcommits
4213        }
4214        incr findcurline -1
4215        run findmorerev
4216    }
4217}
4218
4219proc findnext {restart} {
4220    global findcurline
4221    if {![info exists findcurline]} {
4222        if {$restart} {
4223            dofind
4224        } else {
4225            bell
4226        }
4227    } else {
4228        run findmore
4229        nowbusy finding
4230    }
4231}
4232
4233proc findprev {} {
4234    global findcurline
4235    if {![info exists findcurline]} {
4236        dofind 1
4237    } else {
4238        run findmorerev
4239        nowbusy finding
4240    }
4241}
4242
4243proc findmore {} {
4244    global commitdata commitinfo numcommits findstring findpattern findloc
4245    global findstartline findcurline displayorder
4246
4247    set fldtypes {Headline Author Date Committer CDate Comments}
4248    set l [expr {$findcurline + 1}]
4249    if {$l >= $numcommits} {
4250        set l 0
4251    }
4252    if {$l <= $findstartline} {
4253        set lim [expr {$findstartline + 1}]
4254    } else {
4255        set lim $numcommits
4256    }
4257    if {$lim - $l > 500} {
4258        set lim [expr {$l + 500}]
4259    }
4260    set last 0
4261    for {} {$l < $lim} {incr l} {
4262        set id [lindex $displayorder $l]
4263        # shouldn't happen unless git log doesn't give all the commits...
4264        if {![info exists commitdata($id)]} continue
4265        if {![doesmatch $commitdata($id)]} continue
4266        if {![info exists commitinfo($id)]} {
4267            getcommit $id
4268        }
4269        set info $commitinfo($id)
4270        foreach f $info ty $fldtypes {
4271            if {($findloc eq "All fields" || $findloc eq $ty) &&
4272                [doesmatch $f]} {
4273                findselectline $l
4274                notbusy finding
4275                return 0
4276            }
4277        }
4278    }
4279    if {$l == $findstartline + 1} {
4280        bell
4281        unset findcurline
4282        notbusy finding
4283        return 0
4284    }
4285    set findcurline [expr {$l - 1}]
4286    return 1
4287}
4288
4289proc findmorerev {} {
4290    global commitdata commitinfo numcommits findstring findpattern findloc
4291    global findstartline findcurline displayorder
4292
4293    set fldtypes {Headline Author Date Committer CDate Comments}
4294    set l $findcurline
4295    if {$l == 0} {
4296        set l $numcommits
4297    }
4298    incr l -1
4299    if {$l >= $findstartline} {
4300        set lim [expr {$findstartline - 1}]
4301    } else {
4302        set lim -1
4303    }
4304    if {$l - $lim > 500} {
4305        set lim [expr {$l - 500}]
4306    }
4307    set last 0
4308    for {} {$l > $lim} {incr l -1} {
4309        set id [lindex $displayorder $l]
4310        if {![info exists commitdata($id)]} continue
4311        if {![doesmatch $commitdata($id)]} continue
4312        if {![info exists commitinfo($id)]} {
4313            getcommit $id
4314        }
4315        set info $commitinfo($id)
4316        foreach f $info ty $fldtypes {
4317            if {($findloc eq "All fields" || $findloc eq $ty) &&
4318                [doesmatch $f]} {
4319                findselectline $l
4320                notbusy finding
4321                return 0
4322            }
4323        }
4324    }
4325    if {$l == -1} {
4326        bell
4327        unset findcurline
4328        notbusy finding
4329        return 0
4330    }
4331    set findcurline [expr {$l + 1}]
4332    return 1
4333}
4334
4335proc findselectline {l} {
4336    global findloc commentend ctext findcurline markingmatches
4337
4338    set markingmatches 1
4339    set findcurline $l
4340    selectline $l 1
4341    if {$findloc == "All fields" || $findloc == "Comments"} {
4342        # highlight the matches in the comments
4343        set f [$ctext get 1.0 $commentend]
4344        set matches [findmatches $f]
4345        foreach match $matches {
4346            set start [lindex $match 0]
4347            set end [expr {[lindex $match 1] + 1}]
4348            $ctext tag add found "1.0 + $start c" "1.0 + $end c"
4349        }
4350    }
4351    drawvisible
4352}
4353
4354# mark the bits of a headline or author that match a find string
4355proc markmatches {canv l str tag matches font row} {
4356    global selectedline
4357
4358    set bbox [$canv bbox $tag]
4359    set x0 [lindex $bbox 0]
4360    set y0 [lindex $bbox 1]
4361    set y1 [lindex $bbox 3]
4362    foreach match $matches {
4363        set start [lindex $match 0]
4364        set end [lindex $match 1]
4365        if {$start > $end} continue
4366        set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
4367        set xlen [font measure $font [string range $str 0 [expr {$end}]]]
4368        set t [$canv create rect [expr {$x0+$xoff}] $y0 \
4369                   [expr {$x0+$xlen+2}] $y1 \
4370                   -outline {} -tags [list match$l matches] -fill yellow]
4371        $canv lower $t
4372        if {[info exists selectedline] && $row == $selectedline} {
4373            $canv raise $t secsel
4374        }
4375    }
4376}
4377
4378proc unmarkmatches {} {
4379    global findids markingmatches findcurline
4380
4381    allcanvs delete matches
4382    catch {unset findids}
4383    set markingmatches 0
4384    catch {unset findcurline}
4385}
4386
4387proc selcanvline {w x y} {
4388    global canv canvy0 ctext linespc
4389    global rowtextx
4390    set ymax [lindex [$canv cget -scrollregion] 3]
4391    if {$ymax == {}} return
4392    set yfrac [lindex [$canv yview] 0]
4393    set y [expr {$y + $yfrac * $ymax}]
4394    set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
4395    if {$l < 0} {
4396        set l 0
4397    }
4398    if {$w eq $canv} {
4399        if {![info exists rowtextx($l)] || $x < $rowtextx($l)} return
4400    }
4401    unmarkmatches
4402    selectline $l 1
4403}
4404
4405proc commit_descriptor {p} {
4406    global commitinfo
4407    if {![info exists commitinfo($p)]} {
4408        getcommit $p
4409    }
4410    set l "..."
4411    if {[llength $commitinfo($p)] > 1} {
4412        set l [lindex $commitinfo($p) 0]
4413    }
4414    return "$p ($l)\n"
4415}
4416
4417# append some text to the ctext widget, and make any SHA1 ID
4418# that we know about be a clickable link.
4419proc appendwithlinks {text tags} {
4420    global ctext commitrow linknum curview pendinglinks
4421
4422    set start [$ctext index "end - 1c"]
4423    $ctext insert end $text $tags
4424    set links [regexp -indices -all -inline {[0-9a-f]{40}} $text]
4425    foreach l $links {
4426        set s [lindex $l 0]
4427        set e [lindex $l 1]
4428        set linkid [string range $text $s $e]
4429        incr e
4430        $ctext tag add link$linknum "$start + $s c" "$start + $e c"
4431        setlink $linkid link$linknum
4432        incr linknum
4433    }
4434}
4435
4436proc setlink {id lk} {
4437    global curview commitrow ctext pendinglinks commitinterest
4438
4439    if {[info exists commitrow($curview,$id)]} {
4440        $ctext tag conf $lk -foreground blue -underline 1
4441        $ctext tag bind $lk <1> [list selectline $commitrow($curview,$id) 1]
4442        $ctext tag bind $lk <Enter> {linkcursor %W 1}
4443        $ctext tag bind $lk <Leave> {linkcursor %W -1}
4444    } else {
4445        lappend pendinglinks($id) $lk
4446        lappend commitinterest($id) {makelink %I}
4447    }
4448}
4449
4450proc makelink {id} {
4451    global pendinglinks
4452
4453    if {![info exists pendinglinks($id)]} return
4454    foreach lk $pendinglinks($id) {
4455        setlink $id $lk
4456    }
4457    unset pendinglinks($id)
4458}
4459
4460proc linkcursor {w inc} {
4461    global linkentercount curtextcursor
4462
4463    if {[incr linkentercount $inc] > 0} {
4464        $w configure -cursor hand2
4465    } else {
4466        $w configure -cursor $curtextcursor
4467        if {$linkentercount < 0} {
4468            set linkentercount 0
4469        }
4470    }
4471}
4472
4473proc viewnextline {dir} {
4474    global canv linespc
4475
4476    $canv delete hover
4477    set ymax [lindex [$canv cget -scrollregion] 3]
4478    set wnow [$canv yview]
4479    set wtop [expr {[lindex $wnow 0] * $ymax}]
4480    set newtop [expr {$wtop + $dir * $linespc}]
4481    if {$newtop < 0} {
4482        set newtop 0
4483    } elseif {$newtop > $ymax} {
4484        set newtop $ymax
4485    }
4486    allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
4487}
4488
4489# add a list of tag or branch names at position pos
4490# returns the number of names inserted
4491proc appendrefs {pos ids var} {
4492    global ctext commitrow linknum curview $var maxrefs
4493
4494    if {[catch {$ctext index $pos}]} {
4495        return 0
4496    }
4497    $ctext conf -state normal
4498    $ctext delete $pos "$pos lineend"
4499    set tags {}
4500    foreach id $ids {
4501        foreach tag [set $var\($id\)] {
4502            lappend tags [list $tag $id]
4503        }
4504    }
4505    if {[llength $tags] > $maxrefs} {
4506        $ctext insert $pos "many ([llength $tags])"
4507    } else {
4508        set tags [lsort -index 0 -decreasing $tags]
4509        set sep {}
4510        foreach ti $tags {
4511            set id [lindex $ti 1]
4512            set lk link$linknum
4513            incr linknum
4514            $ctext tag delete $lk
4515            $ctext insert $pos $sep
4516            $ctext insert $pos [lindex $ti 0] $lk
4517            setlink $id $lk
4518            set sep ", "
4519        }
4520    }
4521    $ctext conf -state disabled
4522    return [llength $tags]
4523}
4524
4525# called when we have finished computing the nearby tags
4526proc dispneartags {delay} {
4527    global selectedline currentid showneartags tagphase
4528
4529    if {![info exists selectedline] || !$showneartags} return
4530    after cancel dispnexttag
4531    if {$delay} {
4532        after 200 dispnexttag
4533        set tagphase -1
4534    } else {
4535        after idle dispnexttag
4536        set tagphase 0
4537    }
4538}
4539
4540proc dispnexttag {} {
4541    global selectedline currentid showneartags tagphase ctext
4542
4543    if {![info exists selectedline] || !$showneartags} return
4544    switch -- $tagphase {
4545        0 {
4546            set dtags [desctags $currentid]
4547            if {$dtags ne {}} {
4548                appendrefs precedes $dtags idtags
4549            }
4550        }
4551        1 {
4552            set atags [anctags $currentid]
4553            if {$atags ne {}} {
4554                appendrefs follows $atags idtags
4555            }
4556        }
4557        2 {
4558            set dheads [descheads $currentid]
4559            if {$dheads ne {}} {
4560                if {[appendrefs branch $dheads idheads] > 1
4561                    && [$ctext get "branch -3c"] eq "h"} {
4562                    # turn "Branch" into "Branches"
4563                    $ctext conf -state normal
4564                    $ctext insert "branch -2c" "es"
4565                    $ctext conf -state disabled
4566                }
4567            }
4568        }
4569    }
4570    if {[incr tagphase] <= 2} {
4571        after idle dispnexttag
4572    }
4573}
4574
4575proc make_secsel {l} {
4576    global linehtag linentag linedtag canv canv2 canv3
4577
4578    if {![info exists linehtag($l)]} return
4579    $canv delete secsel
4580    set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
4581               -tags secsel -fill [$canv cget -selectbackground]]
4582    $canv lower $t
4583    $canv2 delete secsel
4584    set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
4585               -tags secsel -fill [$canv2 cget -selectbackground]]
4586    $canv2 lower $t
4587    $canv3 delete secsel
4588    set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
4589               -tags secsel -fill [$canv3 cget -selectbackground]]
4590    $canv3 lower $t
4591}
4592
4593proc selectline {l isnew} {
4594    global canv ctext commitinfo selectedline
4595    global displayorder
4596    global canvy0 linespc parentlist children curview
4597    global currentid sha1entry
4598    global commentend idtags linknum
4599    global mergemax numcommits pending_select
4600    global cmitmode showneartags allcommits
4601
4602    catch {unset pending_select}
4603    $canv delete hover
4604    normalline
4605    cancel_next_highlight
4606    unsel_reflist
4607    if {$l < 0 || $l >= $numcommits} return
4608    set y [expr {$canvy0 + $l * $linespc}]
4609    set ymax [lindex [$canv cget -scrollregion] 3]
4610    set ytop [expr {$y - $linespc - 1}]
4611    set ybot [expr {$y + $linespc + 1}]
4612    set wnow [$canv yview]
4613    set wtop [expr {[lindex $wnow 0] * $ymax}]
4614    set wbot [expr {[lindex $wnow 1] * $ymax}]
4615    set wh [expr {$wbot - $wtop}]
4616    set newtop $wtop
4617    if {$ytop < $wtop} {
4618        if {$ybot < $wtop} {
4619            set newtop [expr {$y - $wh / 2.0}]
4620        } else {
4621            set newtop $ytop
4622            if {$newtop > $wtop - $linespc} {
4623                set newtop [expr {$wtop - $linespc}]
4624            }
4625        }
4626    } elseif {$ybot > $wbot} {
4627        if {$ytop > $wbot} {
4628            set newtop [expr {$y - $wh / 2.0}]
4629        } else {
4630            set newtop [expr {$ybot - $wh}]
4631            if {$newtop < $wtop + $linespc} {
4632                set newtop [expr {$wtop + $linespc}]
4633            }
4634        }
4635    }
4636    if {$newtop != $wtop} {
4637        if {$newtop < 0} {
4638            set newtop 0
4639        }
4640        allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
4641        drawvisible
4642    }
4643
4644    make_secsel $l
4645
4646    if {$isnew} {
4647        addtohistory [list selectline $l 0]
4648    }
4649
4650    set selectedline $l
4651
4652    set id [lindex $displayorder $l]
4653    set currentid $id
4654    $sha1entry delete 0 end
4655    $sha1entry insert 0 $id
4656    $sha1entry selection from 0
4657    $sha1entry selection to end
4658    rhighlight_sel $id
4659
4660    $ctext conf -state normal
4661    clear_ctext
4662    set linknum 0
4663    set info $commitinfo($id)
4664    set date [formatdate [lindex $info 2]]
4665    $ctext insert end "Author: [lindex $info 1]  $date\n"
4666    set date [formatdate [lindex $info 4]]
4667    $ctext insert end "Committer: [lindex $info 3]  $date\n"
4668    if {[info exists idtags($id)]} {
4669        $ctext insert end "Tags:"
4670        foreach tag $idtags($id) {
4671            $ctext insert end " $tag"
4672        }
4673        $ctext insert end "\n"
4674    }
4675
4676    set headers {}
4677    set olds [lindex $parentlist $l]
4678    if {[llength $olds] > 1} {
4679        set np 0
4680        foreach p $olds {
4681            if {$np >= $mergemax} {
4682                set tag mmax
4683            } else {
4684                set tag m$np
4685            }
4686            $ctext insert end "Parent: " $tag
4687            appendwithlinks [commit_descriptor $p] {}
4688            incr np
4689        }
4690    } else {
4691        foreach p $olds {
4692            append headers "Parent: [commit_descriptor $p]"
4693        }
4694    }
4695
4696    foreach c $children($curview,$id) {
4697        append headers "Child:  [commit_descriptor $c]"
4698    }
4699
4700    # make anything that looks like a SHA1 ID be a clickable link
4701    appendwithlinks $headers {}
4702    if {$showneartags} {
4703        if {![info exists allcommits]} {
4704            getallcommits
4705        }
4706        $ctext insert end "Branch: "
4707        $ctext mark set branch "end -1c"
4708        $ctext mark gravity branch left
4709        $ctext insert end "\nFollows: "
4710        $ctext mark set follows "end -1c"
4711        $ctext mark gravity follows left
4712        $ctext insert end "\nPrecedes: "
4713        $ctext mark set precedes "end -1c"
4714        $ctext mark gravity precedes left
4715        $ctext insert end "\n"
4716        dispneartags 1
4717    }
4718    $ctext insert end "\n"
4719    set comment [lindex $info 5]
4720    if {[string first "\r" $comment] >= 0} {
4721        set comment [string map {"\r" "\n    "} $comment]
4722    }
4723    appendwithlinks $comment {comment}
4724
4725    $ctext tag remove found 1.0 end
4726    $ctext conf -state disabled
4727    set commentend [$ctext index "end - 1c"]
4728
4729    init_flist "Comments"
4730    if {$cmitmode eq "tree"} {
4731        gettree $id
4732    } elseif {[llength $olds] <= 1} {
4733        startdiff $id
4734    } else {
4735        mergediff $id $l
4736    }
4737}
4738
4739proc selfirstline {} {
4740    unmarkmatches
4741    selectline 0 1
4742}
4743
4744proc sellastline {} {
4745    global numcommits
4746    unmarkmatches
4747    set l [expr {$numcommits - 1}]
4748    selectline $l 1
4749}
4750
4751proc selnextline {dir} {
4752    global selectedline
4753    focus .
4754    if {![info exists selectedline]} return
4755    set l [expr {$selectedline + $dir}]
4756    unmarkmatches
4757    selectline $l 1
4758}
4759
4760proc selnextpage {dir} {
4761    global canv linespc selectedline numcommits
4762
4763    set lpp [expr {([winfo height $canv] - 2) / $linespc}]
4764    if {$lpp < 1} {
4765        set lpp 1
4766    }
4767    allcanvs yview scroll [expr {$dir * $lpp}] units
4768    drawvisible
4769    if {![info exists selectedline]} return
4770    set l [expr {$selectedline + $dir * $lpp}]
4771    if {$l < 0} {
4772        set l 0
4773    } elseif {$l >= $numcommits} {
4774        set l [expr $numcommits - 1]
4775    }
4776    unmarkmatches
4777    selectline $l 1
4778}
4779
4780proc unselectline {} {
4781    global selectedline currentid
4782
4783    catch {unset selectedline}
4784    catch {unset currentid}
4785    allcanvs delete secsel
4786    rhighlight_none
4787    cancel_next_highlight
4788}
4789
4790proc reselectline {} {
4791    global selectedline
4792
4793    if {[info exists selectedline]} {
4794        selectline $selectedline 0
4795    }
4796}
4797
4798proc addtohistory {cmd} {
4799    global history historyindex curview
4800
4801    set elt [list $curview $cmd]
4802    if {$historyindex > 0
4803        && [lindex $history [expr {$historyindex - 1}]] == $elt} {
4804        return
4805    }
4806
4807    if {$historyindex < [llength $history]} {
4808        set history [lreplace $history $historyindex end $elt]
4809    } else {
4810        lappend history $elt
4811    }
4812    incr historyindex
4813    if {$historyindex > 1} {
4814        .tf.bar.leftbut conf -state normal
4815    } else {
4816        .tf.bar.leftbut conf -state disabled
4817    }
4818    .tf.bar.rightbut conf -state disabled
4819}
4820
4821proc godo {elt} {
4822    global curview
4823
4824    set view [lindex $elt 0]
4825    set cmd [lindex $elt 1]
4826    if {$curview != $view} {
4827        showview $view
4828    }
4829    eval $cmd
4830}
4831
4832proc goback {} {
4833    global history historyindex
4834    focus .
4835
4836    if {$historyindex > 1} {
4837        incr historyindex -1
4838        godo [lindex $history [expr {$historyindex - 1}]]
4839        .tf.bar.rightbut conf -state normal
4840    }
4841    if {$historyindex <= 1} {
4842        .tf.bar.leftbut conf -state disabled
4843    }
4844}
4845
4846proc goforw {} {
4847    global history historyindex
4848    focus .
4849
4850    if {$historyindex < [llength $history]} {
4851        set cmd [lindex $history $historyindex]
4852        incr historyindex
4853        godo $cmd
4854        .tf.bar.leftbut conf -state normal
4855    }
4856    if {$historyindex >= [llength $history]} {
4857        .tf.bar.rightbut conf -state disabled
4858    }
4859}
4860
4861proc gettree {id} {
4862    global treefilelist treeidlist diffids diffmergeid treepending
4863    global nullid nullid2
4864
4865    set diffids $id
4866    catch {unset diffmergeid}
4867    if {![info exists treefilelist($id)]} {
4868        if {![info exists treepending]} {
4869            if {$id eq $nullid} {
4870                set cmd [list | git ls-files]
4871            } elseif {$id eq $nullid2} {
4872                set cmd [list | git ls-files --stage -t]
4873            } else {
4874                set cmd [list | git ls-tree -r $id]
4875            }
4876            if {[catch {set gtf [open $cmd r]}]} {
4877                return
4878            }
4879            set treepending $id
4880            set treefilelist($id) {}
4881            set treeidlist($id) {}
4882            fconfigure $gtf -blocking 0
4883            filerun $gtf [list gettreeline $gtf $id]
4884        }
4885    } else {
4886        setfilelist $id
4887    }
4888}
4889
4890proc gettreeline {gtf id} {
4891    global treefilelist treeidlist treepending cmitmode diffids nullid nullid2
4892
4893    set nl 0
4894    while {[incr nl] <= 1000 && [gets $gtf line] >= 0} {
4895        if {$diffids eq $nullid} {
4896            set fname $line
4897        } else {
4898            if {$diffids ne $nullid2 && [lindex $line 1] ne "blob"} continue
4899            set i [string first "\t" $line]
4900            if {$i < 0} continue
4901            set sha1 [lindex $line 2]
4902            set fname [string range $line [expr {$i+1}] end]
4903            if {[string index $fname 0] eq "\""} {
4904                set fname [lindex $fname 0]
4905            }
4906            lappend treeidlist($id) $sha1
4907        }
4908        lappend treefilelist($id) $fname
4909    }
4910    if {![eof $gtf]} {
4911        return [expr {$nl >= 1000? 2: 1}]
4912    }
4913    close $gtf
4914    unset treepending
4915    if {$cmitmode ne "tree"} {
4916        if {![info exists diffmergeid]} {
4917            gettreediffs $diffids
4918        }
4919    } elseif {$id ne $diffids} {
4920        gettree $diffids
4921    } else {
4922        setfilelist $id
4923    }
4924    return 0
4925}
4926
4927proc showfile {f} {
4928    global treefilelist treeidlist diffids nullid nullid2
4929    global ctext commentend
4930
4931    set i [lsearch -exact $treefilelist($diffids) $f]
4932    if {$i < 0} {
4933        puts "oops, $f not in list for id $diffids"
4934        return
4935    }
4936    if {$diffids eq $nullid} {
4937        if {[catch {set bf [open $f r]} err]} {
4938            puts "oops, can't read $f: $err"
4939            return
4940        }
4941    } else {
4942        set blob [lindex $treeidlist($diffids) $i]
4943        if {[catch {set bf [open [concat | git cat-file blob $blob] r]} err]} {
4944            puts "oops, error reading blob $blob: $err"
4945            return
4946        }
4947    }
4948    fconfigure $bf -blocking 0
4949    filerun $bf [list getblobline $bf $diffids]
4950    $ctext config -state normal
4951    clear_ctext $commentend
4952    $ctext insert end "\n"
4953    $ctext insert end "$f\n" filesep
4954    $ctext config -state disabled
4955    $ctext yview $commentend
4956}
4957
4958proc getblobline {bf id} {
4959    global diffids cmitmode ctext
4960
4961    if {$id ne $diffids || $cmitmode ne "tree"} {
4962        catch {close $bf}
4963        return 0
4964    }
4965    $ctext config -state normal
4966    set nl 0
4967    while {[incr nl] <= 1000 && [gets $bf line] >= 0} {
4968        $ctext insert end "$line\n"
4969    }
4970    if {[eof $bf]} {
4971        # delete last newline
4972        $ctext delete "end - 2c" "end - 1c"
4973        close $bf
4974        return 0
4975    }
4976    $ctext config -state disabled
4977    return [expr {$nl >= 1000? 2: 1}]
4978}
4979
4980proc mergediff {id l} {
4981    global diffmergeid diffopts mdifffd
4982    global diffids
4983    global parentlist
4984
4985    set diffmergeid $id
4986    set diffids $id
4987    # this doesn't seem to actually affect anything...
4988    set env(GIT_DIFF_OPTS) $diffopts
4989    set cmd [concat | git diff-tree --no-commit-id --cc $id]
4990    if {[catch {set mdf [open $cmd r]} err]} {
4991        error_popup "Error getting merge diffs: $err"
4992        return
4993    }
4994    fconfigure $mdf -blocking 0
4995    set mdifffd($id) $mdf
4996    set np [llength [lindex $parentlist $l]]
4997    filerun $mdf [list getmergediffline $mdf $id $np]
4998}
4999
5000proc getmergediffline {mdf id np} {
5001    global diffmergeid ctext cflist mergemax
5002    global difffilestart mdifffd
5003
5004    $ctext conf -state normal
5005    set nr 0
5006    while {[incr nr] <= 1000 && [gets $mdf line] >= 0} {
5007        if {![info exists diffmergeid] || $id != $diffmergeid
5008            || $mdf != $mdifffd($id)} {
5009            close $mdf
5010            return 0
5011        }
5012        if {[regexp {^diff --cc (.*)} $line match fname]} {
5013            # start of a new file
5014            $ctext insert end "\n"
5015            set here [$ctext index "end - 1c"]
5016            lappend difffilestart $here
5017            add_flist [list $fname]
5018            set l [expr {(78 - [string length $fname]) / 2}]
5019            set pad [string range "----------------------------------------" 1 $l]
5020            $ctext insert end "$pad $fname $pad\n" filesep
5021        } elseif {[regexp {^@@} $line]} {
5022            $ctext insert end "$line\n" hunksep
5023        } elseif {[regexp {^[0-9a-f]{40}$} $line] || [regexp {^index} $line]} {
5024            # do nothing
5025        } else {
5026            # parse the prefix - one ' ', '-' or '+' for each parent
5027            set spaces {}
5028            set minuses {}
5029            set pluses {}
5030            set isbad 0
5031            for {set j 0} {$j < $np} {incr j} {
5032                set c [string range $line $j $j]
5033                if {$c == " "} {
5034                    lappend spaces $j
5035                } elseif {$c == "-"} {
5036                    lappend minuses $j
5037                } elseif {$c == "+"} {
5038                    lappend pluses $j
5039                } else {
5040                    set isbad 1
5041                    break
5042                }
5043            }
5044            set tags {}
5045            set num {}
5046            if {!$isbad && $minuses ne {} && $pluses eq {}} {
5047                # line doesn't appear in result, parents in $minuses have the line
5048                set num [lindex $minuses 0]
5049            } elseif {!$isbad && $pluses ne {} && $minuses eq {}} {
5050                # line appears in result, parents in $pluses don't have the line
5051                lappend tags mresult
5052                set num [lindex $spaces 0]
5053            }
5054            if {$num ne {}} {
5055                if {$num >= $mergemax} {
5056                    set num "max"
5057                }
5058                lappend tags m$num
5059            }
5060            $ctext insert end "$line\n" $tags
5061        }
5062    }
5063    $ctext conf -state disabled
5064    if {[eof $mdf]} {
5065        close $mdf
5066        return 0
5067    }
5068    return [expr {$nr >= 1000? 2: 1}]
5069}
5070
5071proc startdiff {ids} {
5072    global treediffs diffids treepending diffmergeid nullid nullid2
5073
5074    set diffids $ids
5075    catch {unset diffmergeid}
5076    if {![info exists treediffs($ids)] ||
5077        [lsearch -exact $ids $nullid] >= 0 ||
5078        [lsearch -exact $ids $nullid2] >= 0} {
5079        if {![info exists treepending]} {
5080            gettreediffs $ids
5081        }
5082    } else {
5083        addtocflist $ids
5084    }
5085}
5086
5087proc addtocflist {ids} {
5088    global treediffs cflist
5089    add_flist $treediffs($ids)
5090    getblobdiffs $ids
5091}
5092
5093proc diffcmd {ids flags} {
5094    global nullid nullid2
5095
5096    set i [lsearch -exact $ids $nullid]
5097    set j [lsearch -exact $ids $nullid2]
5098    if {$i >= 0} {
5099        if {[llength $ids] > 1 && $j < 0} {
5100            # comparing working directory with some specific revision
5101            set cmd [concat | git diff-index $flags]
5102            if {$i == 0} {
5103                lappend cmd -R [lindex $ids 1]
5104            } else {
5105                lappend cmd [lindex $ids 0]
5106            }
5107        } else {
5108            # comparing working directory with index
5109            set cmd [concat | git diff-files $flags]
5110            if {$j == 1} {
5111                lappend cmd -R
5112            }
5113        }
5114    } elseif {$j >= 0} {
5115        set cmd [concat | git diff-index --cached $flags]
5116        if {[llength $ids] > 1} {
5117            # comparing index with specific revision
5118            if {$i == 0} {
5119                lappend cmd -R [lindex $ids 1]
5120            } else {
5121                lappend cmd [lindex $ids 0]
5122            }
5123        } else {
5124            # comparing index with HEAD
5125            lappend cmd HEAD
5126        }
5127    } else {
5128        set cmd [concat | git diff-tree -r $flags $ids]
5129    }
5130    return $cmd
5131}
5132
5133proc gettreediffs {ids} {
5134    global treediff treepending
5135
5136    set treepending $ids
5137    set treediff {}
5138    if {[catch {set gdtf [open [diffcmd $ids {--no-commit-id}] r]}]} return
5139    fconfigure $gdtf -blocking 0
5140    filerun $gdtf [list gettreediffline $gdtf $ids]
5141}
5142
5143proc gettreediffline {gdtf ids} {
5144    global treediff treediffs treepending diffids diffmergeid
5145    global cmitmode
5146
5147    set nr 0
5148    while {[incr nr] <= 1000 && [gets $gdtf line] >= 0} {
5149        set i [string first "\t" $line]
5150        if {$i >= 0} {
5151            set file [string range $line [expr {$i+1}] end]
5152            if {[string index $file 0] eq "\""} {
5153                set file [lindex $file 0]
5154            }
5155            lappend treediff $file
5156        }
5157    }
5158    if {![eof $gdtf]} {
5159        return [expr {$nr >= 1000? 2: 1}]
5160    }
5161    close $gdtf
5162    set treediffs($ids) $treediff
5163    unset treepending
5164    if {$cmitmode eq "tree"} {
5165        gettree $diffids
5166    } elseif {$ids != $diffids} {
5167        if {![info exists diffmergeid]} {
5168            gettreediffs $diffids
5169        }
5170    } else {
5171        addtocflist $ids
5172    }
5173    return 0
5174}
5175
5176# empty string or positive integer
5177proc diffcontextvalidate {v} {
5178    return [regexp {^(|[1-9][0-9]*)$} $v]
5179}
5180
5181proc diffcontextchange {n1 n2 op} {
5182    global diffcontextstring diffcontext
5183
5184    if {[string is integer -strict $diffcontextstring]} {
5185        if {$diffcontextstring > 0} {
5186            set diffcontext $diffcontextstring
5187            reselectline
5188        }
5189    }
5190}
5191
5192proc getblobdiffs {ids} {
5193    global diffopts blobdifffd diffids env
5194    global diffinhdr treediffs
5195    global diffcontext
5196
5197    set env(GIT_DIFF_OPTS) $diffopts
5198    if {[catch {set bdf [open [diffcmd $ids "-p -C --no-commit-id -U$diffcontext"] r]} err]} {
5199        puts "error getting diffs: $err"
5200        return
5201    }
5202    set diffinhdr 0
5203    fconfigure $bdf -blocking 0
5204    set blobdifffd($ids) $bdf
5205    filerun $bdf [list getblobdiffline $bdf $diffids]
5206}
5207
5208proc setinlist {var i val} {
5209    global $var
5210
5211    while {[llength [set $var]] < $i} {
5212        lappend $var {}
5213    }
5214    if {[llength [set $var]] == $i} {
5215        lappend $var $val
5216    } else {
5217        lset $var $i $val
5218    }
5219}
5220
5221proc makediffhdr {fname ids} {
5222    global ctext curdiffstart treediffs
5223
5224    set i [lsearch -exact $treediffs($ids) $fname]
5225    if {$i >= 0} {
5226        setinlist difffilestart $i $curdiffstart
5227    }
5228    set l [expr {(78 - [string length $fname]) / 2}]
5229    set pad [string range "----------------------------------------" 1 $l]
5230    $ctext insert $curdiffstart "$pad $fname $pad" filesep
5231}
5232
5233proc getblobdiffline {bdf ids} {
5234    global diffids blobdifffd ctext curdiffstart
5235    global diffnexthead diffnextnote difffilestart
5236    global diffinhdr treediffs
5237
5238    set nr 0
5239    $ctext conf -state normal
5240    while {[incr nr] <= 1000 && [gets $bdf line] >= 0} {
5241        if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
5242            close $bdf
5243            return 0
5244        }
5245        if {![string compare -length 11 "diff --git " $line]} {
5246            # trim off "diff --git "
5247            set line [string range $line 11 end]
5248            set diffinhdr 1
5249            # start of a new file
5250            $ctext insert end "\n"
5251            set curdiffstart [$ctext index "end - 1c"]
5252            $ctext insert end "\n" filesep
5253            # If the name hasn't changed the length will be odd,
5254            # the middle char will be a space, and the two bits either
5255            # side will be a/name and b/name, or "a/name" and "b/name".
5256            # If the name has changed we'll get "rename from" and
5257            # "rename to" or "copy from" and "copy to" lines following this,
5258            # and we'll use them to get the filenames.
5259            # This complexity is necessary because spaces in the filename(s)
5260            # don't get escaped.
5261            set l [string length $line]
5262            set i [expr {$l / 2}]
5263            if {!(($l & 1) && [string index $line $i] eq " " &&
5264                  [string range $line 2 [expr {$i - 1}]] eq \
5265                      [string range $line [expr {$i + 3}] end])} {
5266                continue
5267            }
5268            # unescape if quoted and chop off the a/ from the front
5269            if {[string index $line 0] eq "\""} {
5270                set fname [string range [lindex $line 0] 2 end]
5271            } else {
5272                set fname [string range $line 2 [expr {$i - 1}]]
5273            }
5274            makediffhdr $fname $ids
5275
5276        } elseif {[regexp {^@@ -([0-9]+)(,[0-9]+)? \+([0-9]+)(,[0-9]+)? @@(.*)} \
5277                       $line match f1l f1c f2l f2c rest]} {
5278            $ctext insert end "$line\n" hunksep
5279            set diffinhdr 0
5280
5281        } elseif {$diffinhdr} {
5282            if {![string compare -length 12 "rename from " $line] ||
5283                ![string compare -length 10 "copy from " $line]} {
5284                set fname [string range $line [expr 6 + [string first " from " $line] ] end]
5285                if {[string index $fname 0] eq "\""} {
5286                    set fname [lindex $fname 0]
5287                }
5288                set i [lsearch -exact $treediffs($ids) $fname]
5289                if {$i >= 0} {
5290                    setinlist difffilestart $i $curdiffstart
5291                }
5292            } elseif {![string compare -length 10 $line "rename to "] ||
5293                      ![string compare -length 8 $line "copy to "]} {
5294                set fname [string range $line [expr 4 + [string first " to " $line] ] end]
5295                if {[string index $fname 0] eq "\""} {
5296                    set fname [lindex $fname 0]
5297                }
5298                makediffhdr $fname $ids
5299            } elseif {[string compare -length 3 $line "---"] == 0} {
5300                # do nothing
5301                continue
5302            } elseif {[string compare -length 3 $line "+++"] == 0} {
5303                set diffinhdr 0
5304                continue
5305            }
5306            $ctext insert end "$line\n" filesep
5307
5308        } else {
5309            set x [string range $line 0 0]
5310            if {$x == "-" || $x == "+"} {
5311                set tag [expr {$x == "+"}]
5312                $ctext insert end "$line\n" d$tag
5313            } elseif {$x == " "} {
5314                $ctext insert end "$line\n"
5315            } else {
5316                # "\ No newline at end of file",
5317                # or something else we don't recognize
5318                $ctext insert end "$line\n" hunksep
5319            }
5320        }
5321    }
5322    $ctext conf -state disabled
5323    if {[eof $bdf]} {
5324        close $bdf
5325        return 0
5326    }
5327    return [expr {$nr >= 1000? 2: 1}]
5328}
5329
5330proc changediffdisp {} {
5331    global ctext diffelide
5332
5333    $ctext tag conf d0 -elide [lindex $diffelide 0]
5334    $ctext tag conf d1 -elide [lindex $diffelide 1]
5335}
5336
5337proc prevfile {} {
5338    global difffilestart ctext
5339    set prev [lindex $difffilestart 0]
5340    set here [$ctext index @0,0]
5341    foreach loc $difffilestart {
5342        if {[$ctext compare $loc >= $here]} {
5343            $ctext yview $prev
5344            return
5345        }
5346        set prev $loc
5347    }
5348    $ctext yview $prev
5349}
5350
5351proc nextfile {} {
5352    global difffilestart ctext
5353    set here [$ctext index @0,0]
5354    foreach loc $difffilestart {
5355        if {[$ctext compare $loc > $here]} {
5356            $ctext yview $loc
5357            return
5358        }
5359    }
5360}
5361
5362proc clear_ctext {{first 1.0}} {
5363    global ctext smarktop smarkbot
5364    global pendinglinks
5365
5366    set l [lindex [split $first .] 0]
5367    if {![info exists smarktop] || [$ctext compare $first < $smarktop.0]} {
5368        set smarktop $l
5369    }
5370    if {![info exists smarkbot] || [$ctext compare $first < $smarkbot.0]} {
5371        set smarkbot $l
5372    }
5373    $ctext delete $first end
5374    if {$first eq "1.0"} {
5375        catch {unset pendinglinks}
5376    }
5377}
5378
5379proc incrsearch {name ix op} {
5380    global ctext searchstring searchdirn
5381
5382    $ctext tag remove found 1.0 end
5383    if {[catch {$ctext index anchor}]} {
5384        # no anchor set, use start of selection, or of visible area
5385        set sel [$ctext tag ranges sel]
5386        if {$sel ne {}} {
5387            $ctext mark set anchor [lindex $sel 0]
5388        } elseif {$searchdirn eq "-forwards"} {
5389            $ctext mark set anchor @0,0
5390        } else {
5391            $ctext mark set anchor @0,[winfo height $ctext]
5392        }
5393    }
5394    if {$searchstring ne {}} {
5395        set here [$ctext search $searchdirn -- $searchstring anchor]
5396        if {$here ne {}} {
5397            $ctext see $here
5398        }
5399        searchmarkvisible 1
5400    }
5401}
5402
5403proc dosearch {} {
5404    global sstring ctext searchstring searchdirn
5405
5406    focus $sstring
5407    $sstring icursor end
5408    set searchdirn -forwards
5409    if {$searchstring ne {}} {
5410        set sel [$ctext tag ranges sel]
5411        if {$sel ne {}} {
5412            set start "[lindex $sel 0] + 1c"
5413        } elseif {[catch {set start [$ctext index anchor]}]} {
5414            set start "@0,0"
5415        }
5416        set match [$ctext search -count mlen -- $searchstring $start]
5417        $ctext tag remove sel 1.0 end
5418        if {$match eq {}} {
5419            bell
5420            return
5421        }
5422        $ctext see $match
5423        set mend "$match + $mlen c"
5424        $ctext tag add sel $match $mend
5425        $ctext mark unset anchor
5426    }
5427}
5428
5429proc dosearchback {} {
5430    global sstring ctext searchstring searchdirn
5431
5432    focus $sstring
5433    $sstring icursor end
5434    set searchdirn -backwards
5435    if {$searchstring ne {}} {
5436        set sel [$ctext tag ranges sel]
5437        if {$sel ne {}} {
5438            set start [lindex $sel 0]
5439        } elseif {[catch {set start [$ctext index anchor]}]} {
5440            set start @0,[winfo height $ctext]
5441        }
5442        set match [$ctext search -backwards -count ml -- $searchstring $start]
5443        $ctext tag remove sel 1.0 end
5444        if {$match eq {}} {
5445            bell
5446            return
5447        }
5448        $ctext see $match
5449        set mend "$match + $ml c"
5450        $ctext tag add sel $match $mend
5451        $ctext mark unset anchor
5452    }
5453}
5454
5455proc searchmark {first last} {
5456    global ctext searchstring
5457
5458    set mend $first.0
5459    while {1} {
5460        set match [$ctext search -count mlen -- $searchstring $mend $last.end]
5461        if {$match eq {}} break
5462        set mend "$match + $mlen c"
5463        $ctext tag add found $match $mend
5464    }
5465}
5466
5467proc searchmarkvisible {doall} {
5468    global ctext smarktop smarkbot
5469
5470    set topline [lindex [split [$ctext index @0,0] .] 0]
5471    set botline [lindex [split [$ctext index @0,[winfo height $ctext]] .] 0]
5472    if {$doall || $botline < $smarktop || $topline > $smarkbot} {
5473        # no overlap with previous
5474        searchmark $topline $botline
5475        set smarktop $topline
5476        set smarkbot $botline
5477    } else {
5478        if {$topline < $smarktop} {
5479            searchmark $topline [expr {$smarktop-1}]
5480            set smarktop $topline
5481        }
5482        if {$botline > $smarkbot} {
5483            searchmark [expr {$smarkbot+1}] $botline
5484            set smarkbot $botline
5485        }
5486    }
5487}
5488
5489proc scrolltext {f0 f1} {
5490    global searchstring
5491
5492    .bleft.sb set $f0 $f1
5493    if {$searchstring ne {}} {
5494        searchmarkvisible 0
5495    }
5496}
5497
5498proc setcoords {} {
5499    global linespc charspc canvx0 canvy0 mainfont
5500    global xspc1 xspc2 lthickness
5501
5502    set linespc [font metrics $mainfont -linespace]
5503    set charspc [font measure $mainfont "m"]
5504    set canvy0 [expr {int(3 + 0.5 * $linespc)}]
5505    set canvx0 [expr {int(3 + 0.5 * $linespc)}]
5506    set lthickness [expr {int($linespc / 9) + 1}]
5507    set xspc1(0) $linespc
5508    set xspc2 $linespc
5509}
5510
5511proc redisplay {} {
5512    global canv
5513    global selectedline
5514
5515    set ymax [lindex [$canv cget -scrollregion] 3]
5516    if {$ymax eq {} || $ymax == 0} return
5517    set span [$canv yview]
5518    clear_display
5519    setcanvscroll
5520    allcanvs yview moveto [lindex $span 0]
5521    drawvisible
5522    if {[info exists selectedline]} {
5523        selectline $selectedline 0
5524        allcanvs yview moveto [lindex $span 0]
5525    }
5526}
5527
5528proc incrfont {inc} {
5529    global mainfont textfont ctext canv phase cflist showrefstop
5530    global charspc tabstop
5531    global stopped entries
5532    unmarkmatches
5533    set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
5534    set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
5535    setcoords
5536    $ctext conf -font $textfont -tabs "[expr {$tabstop * $charspc}]"
5537    $cflist conf -font $textfont
5538    $ctext tag conf filesep -font [concat $textfont bold]
5539    foreach e $entries {
5540        $e conf -font $mainfont
5541    }
5542    if {$phase eq "getcommits"} {
5543        $canv itemconf textitems -font $mainfont
5544    }
5545    if {[info exists showrefstop] && [winfo exists $showrefstop]} {
5546        $showrefstop.list conf -font $mainfont
5547    }
5548    redisplay
5549}
5550
5551proc clearsha1 {} {
5552    global sha1entry sha1string
5553    if {[string length $sha1string] == 40} {
5554        $sha1entry delete 0 end
5555    }
5556}
5557
5558proc sha1change {n1 n2 op} {
5559    global sha1string currentid sha1but
5560    if {$sha1string == {}
5561        || ([info exists currentid] && $sha1string == $currentid)} {
5562        set state disabled
5563    } else {
5564        set state normal
5565    }
5566    if {[$sha1but cget -state] == $state} return
5567    if {$state == "normal"} {
5568        $sha1but conf -state normal -relief raised -text "Goto: "
5569    } else {
5570        $sha1but conf -state disabled -relief flat -text "SHA1 ID: "
5571    }
5572}
5573
5574proc gotocommit {} {
5575    global sha1string currentid commitrow tagids headids
5576    global displayorder numcommits curview
5577
5578    if {$sha1string == {}
5579        || ([info exists currentid] && $sha1string == $currentid)} return
5580    if {[info exists tagids($sha1string)]} {
5581        set id $tagids($sha1string)
5582    } elseif {[info exists headids($sha1string)]} {
5583        set id $headids($sha1string)
5584    } else {
5585        set id [string tolower $sha1string]
5586        if {[regexp {^[0-9a-f]{4,39}$} $id]} {
5587            set matches {}
5588            foreach i $displayorder {
5589                if {[string match $id* $i]} {
5590                    lappend matches $i
5591                }
5592            }
5593            if {$matches ne {}} {
5594                if {[llength $matches] > 1} {
5595                    error_popup "Short SHA1 id $id is ambiguous"
5596                    return
5597                }
5598                set id [lindex $matches 0]
5599            }
5600        }
5601    }
5602    if {[info exists commitrow($curview,$id)]} {
5603        selectline $commitrow($curview,$id) 1
5604        return
5605    }
5606    if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
5607        set type "SHA1 id"
5608    } else {
5609        set type "Tag/Head"
5610    }
5611    error_popup "$type $sha1string is not known"
5612}
5613
5614proc lineenter {x y id} {
5615    global hoverx hovery hoverid hovertimer
5616    global commitinfo canv
5617
5618    if {![info exists commitinfo($id)] && ![getcommit $id]} return
5619    set hoverx $x
5620    set hovery $y
5621    set hoverid $id
5622    if {[info exists hovertimer]} {
5623        after cancel $hovertimer
5624    }
5625    set hovertimer [after 500 linehover]
5626    $canv delete hover
5627}
5628
5629proc linemotion {x y id} {
5630    global hoverx hovery hoverid hovertimer
5631
5632    if {[info exists hoverid] && $id == $hoverid} {
5633        set hoverx $x
5634        set hovery $y
5635        if {[info exists hovertimer]} {
5636            after cancel $hovertimer
5637        }
5638        set hovertimer [after 500 linehover]
5639    }
5640}
5641
5642proc lineleave {id} {
5643    global hoverid hovertimer canv
5644
5645    if {[info exists hoverid] && $id == $hoverid} {
5646        $canv delete hover
5647        if {[info exists hovertimer]} {
5648            after cancel $hovertimer
5649            unset hovertimer
5650        }
5651        unset hoverid
5652    }
5653}
5654
5655proc linehover {} {
5656    global hoverx hovery hoverid hovertimer
5657    global canv linespc lthickness
5658    global commitinfo mainfont
5659
5660    set text [lindex $commitinfo($hoverid) 0]
5661    set ymax [lindex [$canv cget -scrollregion] 3]
5662    if {$ymax == {}} return
5663    set yfrac [lindex [$canv yview] 0]
5664    set x [expr {$hoverx + 2 * $linespc}]
5665    set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
5666    set x0 [expr {$x - 2 * $lthickness}]
5667    set y0 [expr {$y - 2 * $lthickness}]
5668    set x1 [expr {$x + [font measure $mainfont $text] + 2 * $lthickness}]
5669    set y1 [expr {$y + $linespc + 2 * $lthickness}]
5670    set t [$canv create rectangle $x0 $y0 $x1 $y1 \
5671               -fill \#ffff80 -outline black -width 1 -tags hover]
5672    $canv raise $t
5673    set t [$canv create text $x $y -anchor nw -text $text -tags hover \
5674               -font $mainfont]
5675    $canv raise $t
5676}
5677
5678proc clickisonarrow {id y} {
5679    global lthickness
5680
5681    set ranges [rowranges $id]
5682    set thresh [expr {2 * $lthickness + 6}]
5683    set n [expr {[llength $ranges] - 1}]
5684    for {set i 1} {$i < $n} {incr i} {
5685        set row [lindex $ranges $i]
5686        if {abs([yc $row] - $y) < $thresh} {
5687            return $i
5688        }
5689    }
5690    return {}
5691}
5692
5693proc arrowjump {id n y} {
5694    global canv
5695
5696    # 1 <-> 2, 3 <-> 4, etc...
5697    set n [expr {(($n - 1) ^ 1) + 1}]
5698    set row [lindex [rowranges $id] $n]
5699    set yt [yc $row]
5700    set ymax [lindex [$canv cget -scrollregion] 3]
5701    if {$ymax eq {} || $ymax <= 0} return
5702    set view [$canv yview]
5703    set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
5704    set yfrac [expr {$yt / $ymax - $yspan / 2}]
5705    if {$yfrac < 0} {
5706        set yfrac 0
5707    }
5708    allcanvs yview moveto $yfrac
5709}
5710
5711proc lineclick {x y id isnew} {
5712    global ctext commitinfo children canv thickerline curview commitrow
5713
5714    if {![info exists commitinfo($id)] && ![getcommit $id]} return
5715    unmarkmatches
5716    unselectline
5717    normalline
5718    $canv delete hover
5719    # draw this line thicker than normal
5720    set thickerline $id
5721    drawlines $id
5722    if {$isnew} {
5723        set ymax [lindex [$canv cget -scrollregion] 3]
5724        if {$ymax eq {}} return
5725        set yfrac [lindex [$canv yview] 0]
5726        set y [expr {$y + $yfrac * $ymax}]
5727    }
5728    set dirn [clickisonarrow $id $y]
5729    if {$dirn ne {}} {
5730        arrowjump $id $dirn $y
5731        return
5732    }
5733
5734    if {$isnew} {
5735        addtohistory [list lineclick $x $y $id 0]
5736    }
5737    # fill the details pane with info about this line
5738    $ctext conf -state normal
5739    clear_ctext
5740    $ctext insert end "Parent:\t"
5741    $ctext insert end $id link0
5742    setlink $id link0
5743    set info $commitinfo($id)
5744    $ctext insert end "\n\t[lindex $info 0]\n"
5745    $ctext insert end "\tAuthor:\t[lindex $info 1]\n"
5746    set date [formatdate [lindex $info 2]]
5747    $ctext insert end "\tDate:\t$date\n"
5748    set kids $children($curview,$id)
5749    if {$kids ne {}} {
5750        $ctext insert end "\nChildren:"
5751        set i 0
5752        foreach child $kids {
5753            incr i
5754            if {![info exists commitinfo($child)] && ![getcommit $child]} continue
5755            set info $commitinfo($child)
5756            $ctext insert end "\n\t"
5757            $ctext insert end $child link$i
5758            setlink $child link$i
5759            $ctext insert end "\n\t[lindex $info 0]"
5760            $ctext insert end "\n\tAuthor:\t[lindex $info 1]"
5761            set date [formatdate [lindex $info 2]]
5762            $ctext insert end "\n\tDate:\t$date\n"
5763        }
5764    }
5765    $ctext conf -state disabled
5766    init_flist {}
5767}
5768
5769proc normalline {} {
5770    global thickerline
5771    if {[info exists thickerline]} {
5772        set id $thickerline
5773        unset thickerline
5774        drawlines $id
5775    }
5776}
5777
5778proc selbyid {id} {
5779    global commitrow curview
5780    if {[info exists commitrow($curview,$id)]} {
5781        selectline $commitrow($curview,$id) 1
5782    }
5783}
5784
5785proc mstime {} {
5786    global startmstime
5787    if {![info exists startmstime]} {
5788        set startmstime [clock clicks -milliseconds]
5789    }
5790    return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
5791}
5792
5793proc rowmenu {x y id} {
5794    global rowctxmenu commitrow selectedline rowmenuid curview
5795    global nullid nullid2 fakerowmenu mainhead
5796
5797    set rowmenuid $id
5798    if {![info exists selectedline]
5799        || $commitrow($curview,$id) eq $selectedline} {
5800        set state disabled
5801    } else {
5802        set state normal
5803    }
5804    if {$id ne $nullid && $id ne $nullid2} {
5805        set menu $rowctxmenu
5806        $menu entryconfigure 7 -label "Reset $mainhead branch to here"
5807    } else {
5808        set menu $fakerowmenu
5809    }
5810    $menu entryconfigure "Diff this*" -state $state
5811    $menu entryconfigure "Diff selected*" -state $state
5812    $menu entryconfigure "Make patch" -state $state
5813    tk_popup $menu $x $y
5814}
5815
5816proc diffvssel {dirn} {
5817    global rowmenuid selectedline displayorder
5818
5819    if {![info exists selectedline]} return
5820    if {$dirn} {
5821        set oldid [lindex $displayorder $selectedline]
5822        set newid $rowmenuid
5823    } else {
5824        set oldid $rowmenuid
5825        set newid [lindex $displayorder $selectedline]
5826    }
5827    addtohistory [list doseldiff $oldid $newid]
5828    doseldiff $oldid $newid
5829}
5830
5831proc doseldiff {oldid newid} {
5832    global ctext
5833    global commitinfo
5834
5835    $ctext conf -state normal
5836    clear_ctext
5837    init_flist "Top"
5838    $ctext insert end "From "
5839    $ctext insert end $oldid link0
5840    setlink $oldid link0
5841    $ctext insert end "\n     "
5842    $ctext insert end [lindex $commitinfo($oldid) 0]
5843    $ctext insert end "\n\nTo   "
5844    $ctext insert end $newid link1
5845    setlink $newid link1
5846    $ctext insert end "\n     "
5847    $ctext insert end [lindex $commitinfo($newid) 0]
5848    $ctext insert end "\n"
5849    $ctext conf -state disabled
5850    $ctext tag remove found 1.0 end
5851    startdiff [list $oldid $newid]
5852}
5853
5854proc mkpatch {} {
5855    global rowmenuid currentid commitinfo patchtop patchnum
5856
5857    if {![info exists currentid]} return
5858    set oldid $currentid
5859    set oldhead [lindex $commitinfo($oldid) 0]
5860    set newid $rowmenuid
5861    set newhead [lindex $commitinfo($newid) 0]
5862    set top .patch
5863    set patchtop $top
5864    catch {destroy $top}
5865    toplevel $top
5866    label $top.title -text "Generate patch"
5867    grid $top.title - -pady 10
5868    label $top.from -text "From:"
5869    entry $top.fromsha1 -width 40 -relief flat
5870    $top.fromsha1 insert 0 $oldid
5871    $top.fromsha1 conf -state readonly
5872    grid $top.from $top.fromsha1 -sticky w
5873    entry $top.fromhead -width 60 -relief flat
5874    $top.fromhead insert 0 $oldhead
5875    $top.fromhead conf -state readonly
5876    grid x $top.fromhead -sticky w
5877    label $top.to -text "To:"
5878    entry $top.tosha1 -width 40 -relief flat
5879    $top.tosha1 insert 0 $newid
5880    $top.tosha1 conf -state readonly
5881    grid $top.to $top.tosha1 -sticky w
5882    entry $top.tohead -width 60 -relief flat
5883    $top.tohead insert 0 $newhead
5884    $top.tohead conf -state readonly
5885    grid x $top.tohead -sticky w
5886    button $top.rev -text "Reverse" -command mkpatchrev -padx 5
5887    grid $top.rev x -pady 10
5888    label $top.flab -text "Output file:"
5889    entry $top.fname -width 60
5890    $top.fname insert 0 [file normalize "patch$patchnum.patch"]
5891    incr patchnum
5892    grid $top.flab $top.fname -sticky w
5893    frame $top.buts
5894    button $top.buts.gen -text "Generate" -command mkpatchgo
5895    button $top.buts.can -text "Cancel" -command mkpatchcan
5896    grid $top.buts.gen $top.buts.can
5897    grid columnconfigure $top.buts 0 -weight 1 -uniform a
5898    grid columnconfigure $top.buts 1 -weight 1 -uniform a
5899    grid $top.buts - -pady 10 -sticky ew
5900    focus $top.fname
5901}
5902
5903proc mkpatchrev {} {
5904    global patchtop
5905
5906    set oldid [$patchtop.fromsha1 get]
5907    set oldhead [$patchtop.fromhead get]
5908    set newid [$patchtop.tosha1 get]
5909    set newhead [$patchtop.tohead get]
5910    foreach e [list fromsha1 fromhead tosha1 tohead] \
5911            v [list $newid $newhead $oldid $oldhead] {
5912        $patchtop.$e conf -state normal
5913        $patchtop.$e delete 0 end
5914        $patchtop.$e insert 0 $v
5915        $patchtop.$e conf -state readonly
5916    }
5917}
5918
5919proc mkpatchgo {} {
5920    global patchtop nullid nullid2
5921
5922    set oldid [$patchtop.fromsha1 get]
5923    set newid [$patchtop.tosha1 get]
5924    set fname [$patchtop.fname get]
5925    set cmd [diffcmd [list $oldid $newid] -p]
5926    lappend cmd >$fname &
5927    if {[catch {eval exec $cmd} err]} {
5928        error_popup "Error creating patch: $err"
5929    }
5930    catch {destroy $patchtop}
5931    unset patchtop
5932}
5933
5934proc mkpatchcan {} {
5935    global patchtop
5936
5937    catch {destroy $patchtop}
5938    unset patchtop
5939}
5940
5941proc mktag {} {
5942    global rowmenuid mktagtop commitinfo
5943
5944    set top .maketag
5945    set mktagtop $top
5946    catch {destroy $top}
5947    toplevel $top
5948    label $top.title -text "Create tag"
5949    grid $top.title - -pady 10
5950    label $top.id -text "ID:"
5951    entry $top.sha1 -width 40 -relief flat
5952    $top.sha1 insert 0 $rowmenuid
5953    $top.sha1 conf -state readonly
5954    grid $top.id $top.sha1 -sticky w
5955    entry $top.head -width 60 -relief flat
5956    $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
5957    $top.head conf -state readonly
5958    grid x $top.head -sticky w
5959    label $top.tlab -text "Tag name:"
5960    entry $top.tag -width 60
5961    grid $top.tlab $top.tag -sticky w
5962    frame $top.buts
5963    button $top.buts.gen -text "Create" -command mktaggo
5964    button $top.buts.can -text "Cancel" -command mktagcan
5965    grid $top.buts.gen $top.buts.can
5966    grid columnconfigure $top.buts 0 -weight 1 -uniform a
5967    grid columnconfigure $top.buts 1 -weight 1 -uniform a
5968    grid $top.buts - -pady 10 -sticky ew
5969    focus $top.tag
5970}
5971
5972proc domktag {} {
5973    global mktagtop env tagids idtags
5974
5975    set id [$mktagtop.sha1 get]
5976    set tag [$mktagtop.tag get]
5977    if {$tag == {}} {
5978        error_popup "No tag name specified"
5979        return
5980    }
5981    if {[info exists tagids($tag)]} {
5982        error_popup "Tag \"$tag\" already exists"
5983        return
5984    }
5985    if {[catch {
5986        set dir [gitdir]
5987        set fname [file join $dir "refs/tags" $tag]
5988        set f [open $fname w]
5989        puts $f $id
5990        close $f
5991    } err]} {
5992        error_popup "Error creating tag: $err"
5993        return
5994    }
5995
5996    set tagids($tag) $id
5997    lappend idtags($id) $tag
5998    redrawtags $id
5999    addedtag $id
6000    dispneartags 0
6001    run refill_reflist
6002}
6003
6004proc redrawtags {id} {
6005    global canv linehtag commitrow idpos selectedline curview
6006    global mainfont canvxmax iddrawn
6007
6008    if {![info exists commitrow($curview,$id)]} return
6009    if {![info exists iddrawn($id)]} return
6010    drawcommits $commitrow($curview,$id)
6011    $canv delete tag.$id
6012    set xt [eval drawtags $id $idpos($id)]
6013    $canv coords $linehtag($commitrow($curview,$id)) $xt [lindex $idpos($id) 2]
6014    set text [$canv itemcget $linehtag($commitrow($curview,$id)) -text]
6015    set xr [expr {$xt + [font measure $mainfont $text]}]
6016    if {$xr > $canvxmax} {
6017        set canvxmax $xr
6018        setcanvscroll
6019    }
6020    if {[info exists selectedline]
6021        && $selectedline == $commitrow($curview,$id)} {
6022        selectline $selectedline 0
6023    }
6024}
6025
6026proc mktagcan {} {
6027    global mktagtop
6028
6029    catch {destroy $mktagtop}
6030    unset mktagtop
6031}
6032
6033proc mktaggo {} {
6034    domktag
6035    mktagcan
6036}
6037
6038proc writecommit {} {
6039    global rowmenuid wrcomtop commitinfo wrcomcmd
6040
6041    set top .writecommit
6042    set wrcomtop $top
6043    catch {destroy $top}
6044    toplevel $top
6045    label $top.title -text "Write commit to file"
6046    grid $top.title - -pady 10
6047    label $top.id -text "ID:"
6048    entry $top.sha1 -width 40 -relief flat
6049    $top.sha1 insert 0 $rowmenuid
6050    $top.sha1 conf -state readonly
6051    grid $top.id $top.sha1 -sticky w
6052    entry $top.head -width 60 -relief flat
6053    $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
6054    $top.head conf -state readonly
6055    grid x $top.head -sticky w
6056    label $top.clab -text "Command:"
6057    entry $top.cmd -width 60 -textvariable wrcomcmd
6058    grid $top.clab $top.cmd -sticky w -pady 10
6059    label $top.flab -text "Output file:"
6060    entry $top.fname -width 60
6061    $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
6062    grid $top.flab $top.fname -sticky w
6063    frame $top.buts
6064    button $top.buts.gen -text "Write" -command wrcomgo
6065    button $top.buts.can -text "Cancel" -command wrcomcan
6066    grid $top.buts.gen $top.buts.can
6067    grid columnconfigure $top.buts 0 -weight 1 -uniform a
6068    grid columnconfigure $top.buts 1 -weight 1 -uniform a
6069    grid $top.buts - -pady 10 -sticky ew
6070    focus $top.fname
6071}
6072
6073proc wrcomgo {} {
6074    global wrcomtop
6075
6076    set id [$wrcomtop.sha1 get]
6077    set cmd "echo $id | [$wrcomtop.cmd get]"
6078    set fname [$wrcomtop.fname get]
6079    if {[catch {exec sh -c $cmd >$fname &} err]} {
6080        error_popup "Error writing commit: $err"
6081    }
6082    catch {destroy $wrcomtop}
6083    unset wrcomtop
6084}
6085
6086proc wrcomcan {} {
6087    global wrcomtop
6088
6089    catch {destroy $wrcomtop}
6090    unset wrcomtop
6091}
6092
6093proc mkbranch {} {
6094    global rowmenuid mkbrtop
6095
6096    set top .makebranch
6097    catch {destroy $top}
6098    toplevel $top
6099    label $top.title -text "Create new branch"
6100    grid $top.title - -pady 10
6101    label $top.id -text "ID:"
6102    entry $top.sha1 -width 40 -relief flat
6103    $top.sha1 insert 0 $rowmenuid
6104    $top.sha1 conf -state readonly
6105    grid $top.id $top.sha1 -sticky w
6106    label $top.nlab -text "Name:"
6107    entry $top.name -width 40
6108    grid $top.nlab $top.name -sticky w
6109    frame $top.buts
6110    button $top.buts.go -text "Create" -command [list mkbrgo $top]
6111    button $top.buts.can -text "Cancel" -command "catch {destroy $top}"
6112    grid $top.buts.go $top.buts.can
6113    grid columnconfigure $top.buts 0 -weight 1 -uniform a
6114    grid columnconfigure $top.buts 1 -weight 1 -uniform a
6115    grid $top.buts - -pady 10 -sticky ew
6116    focus $top.name
6117}
6118
6119proc mkbrgo {top} {
6120    global headids idheads
6121
6122    set name [$top.name get]
6123    set id [$top.sha1 get]
6124    if {$name eq {}} {
6125        error_popup "Please specify a name for the new branch"
6126        return
6127    }
6128    catch {destroy $top}
6129    nowbusy newbranch
6130    update
6131    if {[catch {
6132        exec git branch $name $id
6133    } err]} {
6134        notbusy newbranch
6135        error_popup $err
6136    } else {
6137        set headids($name) $id
6138        lappend idheads($id) $name
6139        addedhead $id $name
6140        notbusy newbranch
6141        redrawtags $id
6142        dispneartags 0
6143        run refill_reflist
6144    }
6145}
6146
6147proc cherrypick {} {
6148    global rowmenuid curview commitrow
6149    global mainhead
6150
6151    set oldhead [exec git rev-parse HEAD]
6152    set dheads [descheads $rowmenuid]
6153    if {$dheads ne {} && [lsearch -exact $dheads $oldhead] >= 0} {
6154        set ok [confirm_popup "Commit [string range $rowmenuid 0 7] is already\
6155                        included in branch $mainhead -- really re-apply it?"]
6156        if {!$ok} return
6157    }
6158    nowbusy cherrypick
6159    update
6160    # Unfortunately git-cherry-pick writes stuff to stderr even when
6161    # no error occurs, and exec takes that as an indication of error...
6162    if {[catch {exec sh -c "git cherry-pick -r $rowmenuid 2>&1"} err]} {
6163        notbusy cherrypick
6164        error_popup $err
6165        return
6166    }
6167    set newhead [exec git rev-parse HEAD]
6168    if {$newhead eq $oldhead} {
6169        notbusy cherrypick
6170        error_popup "No changes committed"
6171        return
6172    }
6173    addnewchild $newhead $oldhead
6174    if {[info exists commitrow($curview,$oldhead)]} {
6175        insertrow $commitrow($curview,$oldhead) $newhead
6176        if {$mainhead ne {}} {
6177            movehead $newhead $mainhead
6178            movedhead $newhead $mainhead
6179        }
6180        redrawtags $oldhead
6181        redrawtags $newhead
6182    }
6183    notbusy cherrypick
6184}
6185
6186proc resethead {} {
6187    global mainheadid mainhead rowmenuid confirm_ok resettype
6188    global showlocalchanges
6189
6190    set confirm_ok 0
6191    set w ".confirmreset"
6192    toplevel $w
6193    wm transient $w .
6194    wm title $w "Confirm reset"
6195    message $w.m -text \
6196        "Reset branch $mainhead to [string range $rowmenuid 0 7]?" \
6197        -justify center -aspect 1000
6198    pack $w.m -side top -fill x -padx 20 -pady 20
6199    frame $w.f -relief sunken -border 2
6200    message $w.f.rt -text "Reset type:" -aspect 1000
6201    grid $w.f.rt -sticky w
6202    set resettype mixed
6203    radiobutton $w.f.soft -value soft -variable resettype -justify left \
6204        -text "Soft: Leave working tree and index untouched"
6205    grid $w.f.soft -sticky w
6206    radiobutton $w.f.mixed -value mixed -variable resettype -justify left \
6207        -text "Mixed: Leave working tree untouched, reset index"
6208    grid $w.f.mixed -sticky w
6209    radiobutton $w.f.hard -value hard -variable resettype -justify left \
6210        -text "Hard: Reset working tree and index\n(discard ALL local changes)"
6211    grid $w.f.hard -sticky w
6212    pack $w.f -side top -fill x
6213    button $w.ok -text OK -command "set confirm_ok 1; destroy $w"
6214    pack $w.ok -side left -fill x -padx 20 -pady 20
6215    button $w.cancel -text Cancel -command "destroy $w"
6216    pack $w.cancel -side right -fill x -padx 20 -pady 20
6217    bind $w <Visibility> "grab $w; focus $w"
6218    tkwait window $w
6219    if {!$confirm_ok} return
6220    if {[catch {set fd [open \
6221            [list | sh -c "git reset --$resettype $rowmenuid 2>&1"] r]} err]} {
6222        error_popup $err
6223    } else {
6224        dohidelocalchanges
6225        set w ".resetprogress"
6226        filerun $fd [list readresetstat $fd $w]
6227        toplevel $w
6228        wm transient $w
6229        wm title $w "Reset progress"
6230        message $w.m -text "Reset in progress, please wait..." \
6231            -justify center -aspect 1000
6232        pack $w.m -side top -fill x -padx 20 -pady 5
6233        canvas $w.c -width 150 -height 20 -bg white
6234        $w.c create rect 0 0 0 20 -fill green -tags rect
6235        pack $w.c -side top -fill x -padx 20 -pady 5 -expand 1
6236        nowbusy reset
6237    }
6238}
6239
6240proc readresetstat {fd w} {
6241    global mainhead mainheadid showlocalchanges
6242
6243    if {[gets $fd line] >= 0} {
6244        if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
6245            set x [expr {($m * 150) / $n}]
6246            $w.c coords rect 0 0 $x 20
6247        }
6248        return 1
6249    }
6250    destroy $w
6251    notbusy reset
6252    if {[catch {close $fd} err]} {
6253        error_popup $err
6254    }
6255    set oldhead $mainheadid
6256    set newhead [exec git rev-parse HEAD]
6257    if {$newhead ne $oldhead} {
6258        movehead $newhead $mainhead
6259        movedhead $newhead $mainhead
6260        set mainheadid $newhead
6261        redrawtags $oldhead
6262        redrawtags $newhead
6263    }
6264    if {$showlocalchanges} {
6265        doshowlocalchanges
6266    }
6267    return 0
6268}
6269
6270# context menu for a head
6271proc headmenu {x y id head} {
6272    global headmenuid headmenuhead headctxmenu mainhead
6273
6274    set headmenuid $id
6275    set headmenuhead $head
6276    set state normal
6277    if {$head eq $mainhead} {
6278        set state disabled
6279    }
6280    $headctxmenu entryconfigure 0 -state $state
6281    $headctxmenu entryconfigure 1 -state $state
6282    tk_popup $headctxmenu $x $y
6283}
6284
6285proc cobranch {} {
6286    global headmenuid headmenuhead mainhead headids
6287    global showlocalchanges mainheadid
6288
6289    # check the tree is clean first??
6290    set oldmainhead $mainhead
6291    nowbusy checkout
6292    update
6293    dohidelocalchanges
6294    if {[catch {
6295        exec git checkout -q $headmenuhead
6296    } err]} {
6297        notbusy checkout
6298        error_popup $err
6299    } else {
6300        notbusy checkout
6301        set mainhead $headmenuhead
6302        set mainheadid $headmenuid
6303        if {[info exists headids($oldmainhead)]} {
6304            redrawtags $headids($oldmainhead)
6305        }
6306        redrawtags $headmenuid
6307    }
6308    if {$showlocalchanges} {
6309        dodiffindex
6310    }
6311}
6312
6313proc rmbranch {} {
6314    global headmenuid headmenuhead mainhead
6315    global idheads
6316
6317    set head $headmenuhead
6318    set id $headmenuid
6319    # this check shouldn't be needed any more...
6320    if {$head eq $mainhead} {
6321        error_popup "Cannot delete the currently checked-out branch"
6322        return
6323    }
6324    set dheads [descheads $id]
6325    if {[llength $dheads] == 1 && $idheads($dheads) eq $head} {
6326        # the stuff on this branch isn't on any other branch
6327        if {![confirm_popup "The commits on branch $head aren't on any other\
6328                        branch.\nReally delete branch $head?"]} return
6329    }
6330    nowbusy rmbranch
6331    update
6332    if {[catch {exec git branch -D $head} err]} {
6333        notbusy rmbranch
6334        error_popup $err
6335        return
6336    }
6337    removehead $id $head
6338    removedhead $id $head
6339    redrawtags $id
6340    notbusy rmbranch
6341    dispneartags 0
6342    run refill_reflist
6343}
6344
6345# Display a list of tags and heads
6346proc showrefs {} {
6347    global showrefstop bgcolor fgcolor selectbgcolor mainfont
6348    global bglist fglist uifont reflistfilter reflist maincursor
6349
6350    set top .showrefs
6351    set showrefstop $top
6352    if {[winfo exists $top]} {
6353        raise $top
6354        refill_reflist
6355        return
6356    }
6357    toplevel $top
6358    wm title $top "Tags and heads: [file tail [pwd]]"
6359    text $top.list -background $bgcolor -foreground $fgcolor \
6360        -selectbackground $selectbgcolor -font $mainfont \
6361        -xscrollcommand "$top.xsb set" -yscrollcommand "$top.ysb set" \
6362        -width 30 -height 20 -cursor $maincursor \
6363        -spacing1 1 -spacing3 1 -state disabled
6364    $top.list tag configure highlight -background $selectbgcolor
6365    lappend bglist $top.list
6366    lappend fglist $top.list
6367    scrollbar $top.ysb -command "$top.list yview" -orient vertical
6368    scrollbar $top.xsb -command "$top.list xview" -orient horizontal
6369    grid $top.list $top.ysb -sticky nsew
6370    grid $top.xsb x -sticky ew
6371    frame $top.f
6372    label $top.f.l -text "Filter: " -font $uifont
6373    entry $top.f.e -width 20 -textvariable reflistfilter -font $uifont
6374    set reflistfilter "*"
6375    trace add variable reflistfilter write reflistfilter_change
6376    pack $top.f.e -side right -fill x -expand 1
6377    pack $top.f.l -side left
6378    grid $top.f - -sticky ew -pady 2
6379    button $top.close -command [list destroy $top] -text "Close" \
6380        -font $uifont
6381    grid $top.close -
6382    grid columnconfigure $top 0 -weight 1
6383    grid rowconfigure $top 0 -weight 1
6384    bind $top.list <1> {break}
6385    bind $top.list <B1-Motion> {break}
6386    bind $top.list <ButtonRelease-1> {sel_reflist %W %x %y; break}
6387    set reflist {}
6388    refill_reflist
6389}
6390
6391proc sel_reflist {w x y} {
6392    global showrefstop reflist headids tagids otherrefids
6393
6394    if {![winfo exists $showrefstop]} return
6395    set l [lindex [split [$w index "@$x,$y"] "."] 0]
6396    set ref [lindex $reflist [expr {$l-1}]]
6397    set n [lindex $ref 0]
6398    switch -- [lindex $ref 1] {
6399        "H" {selbyid $headids($n)}
6400        "T" {selbyid $tagids($n)}
6401        "o" {selbyid $otherrefids($n)}
6402    }
6403    $showrefstop.list tag add highlight $l.0 "$l.0 lineend"
6404}
6405
6406proc unsel_reflist {} {
6407    global showrefstop
6408
6409    if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
6410    $showrefstop.list tag remove highlight 0.0 end
6411}
6412
6413proc reflistfilter_change {n1 n2 op} {
6414    global reflistfilter
6415
6416    after cancel refill_reflist
6417    after 200 refill_reflist
6418}
6419
6420proc refill_reflist {} {
6421    global reflist reflistfilter showrefstop headids tagids otherrefids
6422    global commitrow curview commitinterest
6423
6424    if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
6425    set refs {}
6426    foreach n [array names headids] {
6427        if {[string match $reflistfilter $n]} {
6428            if {[info exists commitrow($curview,$headids($n))]} {
6429                lappend refs [list $n H]
6430            } else {
6431                set commitinterest($headids($n)) {run refill_reflist}
6432            }
6433        }
6434    }
6435    foreach n [array names tagids] {
6436        if {[string match $reflistfilter $n]} {
6437            if {[info exists commitrow($curview,$tagids($n))]} {
6438                lappend refs [list $n T]
6439            } else {
6440                set commitinterest($tagids($n)) {run refill_reflist}
6441            }
6442        }
6443    }
6444    foreach n [array names otherrefids] {
6445        if {[string match $reflistfilter $n]} {
6446            if {[info exists commitrow($curview,$otherrefids($n))]} {
6447                lappend refs [list $n o]
6448            } else {
6449                set commitinterest($otherrefids($n)) {run refill_reflist}
6450            }
6451        }
6452    }
6453    set refs [lsort -index 0 $refs]
6454    if {$refs eq $reflist} return
6455
6456    # Update the contents of $showrefstop.list according to the
6457    # differences between $reflist (old) and $refs (new)
6458    $showrefstop.list conf -state normal
6459    $showrefstop.list insert end "\n"
6460    set i 0
6461    set j 0
6462    while {$i < [llength $reflist] || $j < [llength $refs]} {
6463        if {$i < [llength $reflist]} {
6464            if {$j < [llength $refs]} {
6465                set cmp [string compare [lindex $reflist $i 0] \
6466                             [lindex $refs $j 0]]
6467                if {$cmp == 0} {
6468                    set cmp [string compare [lindex $reflist $i 1] \
6469                                 [lindex $refs $j 1]]
6470                }
6471            } else {
6472                set cmp -1
6473            }
6474        } else {
6475            set cmp 1
6476        }
6477        switch -- $cmp {
6478            -1 {
6479                $showrefstop.list delete "[expr {$j+1}].0" "[expr {$j+2}].0"
6480                incr i
6481            }
6482            0 {
6483                incr i
6484                incr j
6485            }
6486            1 {
6487                set l [expr {$j + 1}]
6488                $showrefstop.list image create $l.0 -align baseline \
6489                    -image reficon-[lindex $refs $j 1] -padx 2
6490                $showrefstop.list insert $l.1 "[lindex $refs $j 0]\n"
6491                incr j
6492            }
6493        }
6494    }
6495    set reflist $refs
6496    # delete last newline
6497    $showrefstop.list delete end-2c end-1c
6498    $showrefstop.list conf -state disabled
6499}
6500
6501# Stuff for finding nearby tags
6502proc getallcommits {} {
6503    global allcommits nextarc seeds allccache allcwait cachedarcs allcupdate
6504    global idheads idtags idotherrefs allparents tagobjid
6505
6506    if {![info exists allcommits]} {
6507        set nextarc 0
6508        set allcommits 0
6509        set seeds {}
6510        set allcwait 0
6511        set cachedarcs 0
6512        set allccache [file join [gitdir] "gitk.cache"]
6513        if {![catch {
6514            set f [open $allccache r]
6515            set allcwait 1
6516            getcache $f
6517        }]} return
6518    }
6519
6520    if {$allcwait} {
6521        return
6522    }
6523    set cmd [list | git rev-list --parents]
6524    set allcupdate [expr {$seeds ne {}}]
6525    if {!$allcupdate} {
6526        set ids "--all"
6527    } else {
6528        set refs [concat [array names idheads] [array names idtags] \
6529                      [array names idotherrefs]]
6530        set ids {}
6531        set tagobjs {}
6532        foreach name [array names tagobjid] {
6533            lappend tagobjs $tagobjid($name)
6534        }
6535        foreach id [lsort -unique $refs] {
6536            if {![info exists allparents($id)] &&
6537                [lsearch -exact $tagobjs $id] < 0} {
6538                lappend ids $id
6539            }
6540        }
6541        if {$ids ne {}} {
6542            foreach id $seeds {
6543                lappend ids "^$id"
6544            }
6545        }
6546    }
6547    if {$ids ne {}} {
6548        set fd [open [concat $cmd $ids] r]
6549        fconfigure $fd -blocking 0
6550        incr allcommits
6551        nowbusy allcommits
6552        filerun $fd [list getallclines $fd]
6553    } else {
6554        dispneartags 0
6555    }
6556}
6557
6558# Since most commits have 1 parent and 1 child, we group strings of
6559# such commits into "arcs" joining branch/merge points (BMPs), which
6560# are commits that either don't have 1 parent or don't have 1 child.
6561#
6562# arcnos(id) - incoming arcs for BMP, arc we're on for other nodes
6563# arcout(id) - outgoing arcs for BMP
6564# arcids(a) - list of IDs on arc including end but not start
6565# arcstart(a) - BMP ID at start of arc
6566# arcend(a) - BMP ID at end of arc
6567# growing(a) - arc a is still growing
6568# arctags(a) - IDs out of arcids (excluding end) that have tags
6569# archeads(a) - IDs out of arcids (excluding end) that have heads
6570# The start of an arc is at the descendent end, so "incoming" means
6571# coming from descendents, and "outgoing" means going towards ancestors.
6572
6573proc getallclines {fd} {
6574    global allparents allchildren idtags idheads nextarc
6575    global arcnos arcids arctags arcout arcend arcstart archeads growing
6576    global seeds allcommits cachedarcs allcupdate
6577    
6578    set nid 0
6579    while {[incr nid] <= 1000 && [gets $fd line] >= 0} {
6580        set id [lindex $line 0]
6581        if {[info exists allparents($id)]} {
6582            # seen it already
6583            continue
6584        }
6585        set cachedarcs 0
6586        set olds [lrange $line 1 end]
6587        set allparents($id) $olds
6588        if {![info exists allchildren($id)]} {
6589            set allchildren($id) {}
6590            set arcnos($id) {}
6591            lappend seeds $id
6592        } else {
6593            set a $arcnos($id)
6594            if {[llength $olds] == 1 && [llength $a] == 1} {
6595                lappend arcids($a) $id
6596                if {[info exists idtags($id)]} {
6597                    lappend arctags($a) $id
6598                }
6599                if {[info exists idheads($id)]} {
6600                    lappend archeads($a) $id
6601                }
6602                if {[info exists allparents($olds)]} {
6603                    # seen parent already
6604                    if {![info exists arcout($olds)]} {
6605                        splitarc $olds
6606                    }
6607                    lappend arcids($a) $olds
6608                    set arcend($a) $olds
6609                    unset growing($a)
6610                }
6611                lappend allchildren($olds) $id
6612                lappend arcnos($olds) $a
6613                continue
6614            }
6615        }
6616        foreach a $arcnos($id) {
6617            lappend arcids($a) $id
6618            set arcend($a) $id
6619            unset growing($a)
6620        }
6621
6622        set ao {}
6623        foreach p $olds {
6624            lappend allchildren($p) $id
6625            set a [incr nextarc]
6626            set arcstart($a) $id
6627            set archeads($a) {}
6628            set arctags($a) {}
6629            set archeads($a) {}
6630            set arcids($a) {}
6631            lappend ao $a
6632            set growing($a) 1
6633            if {[info exists allparents($p)]} {
6634                # seen it already, may need to make a new branch
6635                if {![info exists arcout($p)]} {
6636                    splitarc $p
6637                }
6638                lappend arcids($a) $p
6639                set arcend($a) $p
6640                unset growing($a)
6641            }
6642            lappend arcnos($p) $a
6643        }
6644        set arcout($id) $ao
6645    }
6646    if {$nid > 0} {
6647        global cached_dheads cached_dtags cached_atags
6648        catch {unset cached_dheads}
6649        catch {unset cached_dtags}
6650        catch {unset cached_atags}
6651    }
6652    if {![eof $fd]} {
6653        return [expr {$nid >= 1000? 2: 1}]
6654    }
6655    set cacheok 1
6656    if {[catch {
6657        fconfigure $fd -blocking 1
6658        close $fd
6659    } err]} {
6660        # got an error reading the list of commits
6661        # if we were updating, try rereading the whole thing again
6662        if {$allcupdate} {
6663            incr allcommits -1
6664            dropcache $err
6665            return
6666        }
6667        error_popup "Error reading commit topology information;\
6668                branch and preceding/following tag information\
6669                will be incomplete.\n($err)"
6670        set cacheok 0
6671    }
6672    if {[incr allcommits -1] == 0} {
6673        notbusy allcommits
6674        if {$cacheok} {
6675            run savecache
6676        }
6677    }
6678    dispneartags 0
6679    return 0
6680}
6681
6682proc recalcarc {a} {
6683    global arctags archeads arcids idtags idheads
6684
6685    set at {}
6686    set ah {}
6687    foreach id [lrange $arcids($a) 0 end-1] {
6688        if {[info exists idtags($id)]} {
6689            lappend at $id
6690        }
6691        if {[info exists idheads($id)]} {
6692            lappend ah $id
6693        }
6694    }
6695    set arctags($a) $at
6696    set archeads($a) $ah
6697}
6698
6699proc splitarc {p} {
6700    global arcnos arcids nextarc arctags archeads idtags idheads
6701    global arcstart arcend arcout allparents growing
6702
6703    set a $arcnos($p)
6704    if {[llength $a] != 1} {
6705        puts "oops splitarc called but [llength $a] arcs already"
6706        return
6707    }
6708    set a [lindex $a 0]
6709    set i [lsearch -exact $arcids($a) $p]
6710    if {$i < 0} {
6711        puts "oops splitarc $p not in arc $a"
6712        return
6713    }
6714    set na [incr nextarc]
6715    if {[info exists arcend($a)]} {
6716        set arcend($na) $arcend($a)
6717    } else {
6718        set l [lindex $allparents([lindex $arcids($a) end]) 0]
6719        set j [lsearch -exact $arcnos($l) $a]
6720        set arcnos($l) [lreplace $arcnos($l) $j $j $na]
6721    }
6722    set tail [lrange $arcids($a) [expr {$i+1}] end]
6723    set arcids($a) [lrange $arcids($a) 0 $i]
6724    set arcend($a) $p
6725    set arcstart($na) $p
6726    set arcout($p) $na
6727    set arcids($na) $tail
6728    if {[info exists growing($a)]} {
6729        set growing($na) 1
6730        unset growing($a)
6731    }
6732
6733    foreach id $tail {
6734        if {[llength $arcnos($id)] == 1} {
6735            set arcnos($id) $na
6736        } else {
6737            set j [lsearch -exact $arcnos($id) $a]
6738            set arcnos($id) [lreplace $arcnos($id) $j $j $na]
6739        }
6740    }
6741
6742    # reconstruct tags and heads lists
6743    if {$arctags($a) ne {} || $archeads($a) ne {}} {
6744        recalcarc $a
6745        recalcarc $na
6746    } else {
6747        set arctags($na) {}
6748        set archeads($na) {}
6749    }
6750}
6751
6752# Update things for a new commit added that is a child of one
6753# existing commit.  Used when cherry-picking.
6754proc addnewchild {id p} {
6755    global allparents allchildren idtags nextarc
6756    global arcnos arcids arctags arcout arcend arcstart archeads growing
6757    global seeds allcommits
6758
6759    if {![info exists allcommits]} return
6760    set allparents($id) [list $p]
6761    set allchildren($id) {}
6762    set arcnos($id) {}
6763    lappend seeds $id
6764    lappend allchildren($p) $id
6765    set a [incr nextarc]
6766    set arcstart($a) $id
6767    set archeads($a) {}
6768    set arctags($a) {}
6769    set arcids($a) [list $p]
6770    set arcend($a) $p
6771    if {![info exists arcout($p)]} {
6772        splitarc $p
6773    }
6774    lappend arcnos($p) $a
6775    set arcout($id) [list $a]
6776}
6777
6778# This implements a cache for the topology information.
6779# The cache saves, for each arc, the start and end of the arc,
6780# the ids on the arc, and the outgoing arcs from the end.
6781proc readcache {f} {
6782    global arcnos arcids arcout arcstart arcend arctags archeads nextarc
6783    global idtags idheads allparents cachedarcs possible_seeds seeds growing
6784    global allcwait
6785
6786    set a $nextarc
6787    set lim $cachedarcs
6788    if {$lim - $a > 500} {
6789        set lim [expr {$a + 500}]
6790    }
6791    if {[catch {
6792        if {$a == $lim} {
6793            # finish reading the cache and setting up arctags, etc.
6794            set line [gets $f]
6795            if {$line ne "1"} {error "bad final version"}
6796            close $f
6797            foreach id [array names idtags] {
6798                if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
6799                    [llength $allparents($id)] == 1} {
6800                    set a [lindex $arcnos($id) 0]
6801                    if {$arctags($a) eq {}} {
6802                        recalcarc $a
6803                    }
6804                }
6805            }
6806            foreach id [array names idheads] {
6807                if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
6808                    [llength $allparents($id)] == 1} {
6809                    set a [lindex $arcnos($id) 0]
6810                    if {$archeads($a) eq {}} {
6811                        recalcarc $a
6812                    }
6813                }
6814            }
6815            foreach id [lsort -unique $possible_seeds] {
6816                if {$arcnos($id) eq {}} {
6817                    lappend seeds $id
6818                }
6819            }
6820            set allcwait 0
6821        } else {
6822            while {[incr a] <= $lim} {
6823                set line [gets $f]
6824                if {[llength $line] != 3} {error "bad line"}
6825                set s [lindex $line 0]
6826                set arcstart($a) $s
6827                lappend arcout($s) $a
6828                if {![info exists arcnos($s)]} {
6829                    lappend possible_seeds $s
6830                    set arcnos($s) {}
6831                }
6832                set e [lindex $line 1]
6833                if {$e eq {}} {
6834                    set growing($a) 1
6835                } else {
6836                    set arcend($a) $e
6837                    if {![info exists arcout($e)]} {
6838                        set arcout($e) {}
6839                    }
6840                }
6841                set arcids($a) [lindex $line 2]
6842                foreach id $arcids($a) {
6843                    lappend allparents($s) $id
6844                    set s $id
6845                    lappend arcnos($id) $a
6846                }
6847                if {![info exists allparents($s)]} {
6848                    set allparents($s) {}
6849                }
6850                set arctags($a) {}
6851                set archeads($a) {}
6852            }
6853            set nextarc [expr {$a - 1}]
6854        }
6855    } err]} {
6856        dropcache $err
6857        return 0
6858    }
6859    if {!$allcwait} {
6860        getallcommits
6861    }
6862    return $allcwait
6863}
6864
6865proc getcache {f} {
6866    global nextarc cachedarcs possible_seeds
6867
6868    if {[catch {
6869        set line [gets $f]
6870        if {[llength $line] != 2 || [lindex $line 0] ne "1"} {error "bad version"}
6871        # make sure it's an integer
6872        set cachedarcs [expr {int([lindex $line 1])}]
6873        if {$cachedarcs < 0} {error "bad number of arcs"}
6874        set nextarc 0
6875        set possible_seeds {}
6876        run readcache $f
6877    } err]} {
6878        dropcache $err
6879    }
6880    return 0
6881}
6882
6883proc dropcache {err} {
6884    global allcwait nextarc cachedarcs seeds
6885
6886    #puts "dropping cache ($err)"
6887    foreach v {arcnos arcout arcids arcstart arcend growing \
6888                   arctags archeads allparents allchildren} {
6889        global $v
6890        catch {unset $v}
6891    }
6892    set allcwait 0
6893    set nextarc 0
6894    set cachedarcs 0
6895    set seeds {}
6896    getallcommits
6897}
6898
6899proc writecache {f} {
6900    global cachearc cachedarcs allccache
6901    global arcstart arcend arcnos arcids arcout
6902
6903    set a $cachearc
6904    set lim $cachedarcs
6905    if {$lim - $a > 1000} {
6906        set lim [expr {$a + 1000}]
6907    }
6908    if {[catch {
6909        while {[incr a] <= $lim} {
6910            if {[info exists arcend($a)]} {
6911                puts $f [list $arcstart($a) $arcend($a) $arcids($a)]
6912            } else {
6913                puts $f [list $arcstart($a) {} $arcids($a)]
6914            }
6915        }
6916    } err]} {
6917        catch {close $f}
6918        catch {file delete $allccache}
6919        #puts "writing cache failed ($err)"
6920        return 0
6921    }
6922    set cachearc [expr {$a - 1}]
6923    if {$a > $cachedarcs} {
6924        puts $f "1"
6925        close $f
6926        return 0
6927    }
6928    return 1
6929}
6930
6931proc savecache {} {
6932    global nextarc cachedarcs cachearc allccache
6933
6934    if {$nextarc == $cachedarcs} return
6935    set cachearc 0
6936    set cachedarcs $nextarc
6937    catch {
6938        set f [open $allccache w]
6939        puts $f [list 1 $cachedarcs]
6940        run writecache $f
6941    }
6942}
6943
6944# Returns 1 if a is an ancestor of b, -1 if b is an ancestor of a,
6945# or 0 if neither is true.
6946proc anc_or_desc {a b} {
6947    global arcout arcstart arcend arcnos cached_isanc
6948
6949    if {$arcnos($a) eq $arcnos($b)} {
6950        # Both are on the same arc(s); either both are the same BMP,
6951        # or if one is not a BMP, the other is also not a BMP or is
6952        # the BMP at end of the arc (and it only has 1 incoming arc).
6953        # Or both can be BMPs with no incoming arcs.
6954        if {$a eq $b || $arcnos($a) eq {}} {
6955            return 0
6956        }
6957        # assert {[llength $arcnos($a)] == 1}
6958        set arc [lindex $arcnos($a) 0]
6959        set i [lsearch -exact $arcids($arc) $a]
6960        set j [lsearch -exact $arcids($arc) $b]
6961        if {$i < 0 || $i > $j} {
6962            return 1
6963        } else {
6964            return -1
6965        }
6966    }
6967
6968    if {![info exists arcout($a)]} {
6969        set arc [lindex $arcnos($a) 0]
6970        if {[info exists arcend($arc)]} {
6971            set aend $arcend($arc)
6972        } else {
6973            set aend {}
6974        }
6975        set a $arcstart($arc)
6976    } else {
6977        set aend $a
6978    }
6979    if {![info exists arcout($b)]} {
6980        set arc [lindex $arcnos($b) 0]
6981        if {[info exists arcend($arc)]} {
6982            set bend $arcend($arc)
6983        } else {
6984            set bend {}
6985        }
6986        set b $arcstart($arc)
6987    } else {
6988        set bend $b
6989    }
6990    if {$a eq $bend} {
6991        return 1
6992    }
6993    if {$b eq $aend} {
6994        return -1
6995    }
6996    if {[info exists cached_isanc($a,$bend)]} {
6997        if {$cached_isanc($a,$bend)} {
6998            return 1
6999        }
7000    }
7001    if {[info exists cached_isanc($b,$aend)]} {
7002        if {$cached_isanc($b,$aend)} {
7003            return -1
7004        }
7005        if {[info exists cached_isanc($a,$bend)]} {
7006            return 0
7007        }
7008    }
7009
7010    set todo [list $a $b]
7011    set anc($a) a
7012    set anc($b) b
7013    for {set i 0} {$i < [llength $todo]} {incr i} {
7014        set x [lindex $todo $i]
7015        if {$anc($x) eq {}} {
7016            continue
7017        }
7018        foreach arc $arcnos($x) {
7019            set xd $arcstart($arc)
7020            if {$xd eq $bend} {
7021                set cached_isanc($a,$bend) 1
7022                set cached_isanc($b,$aend) 0
7023                return 1
7024            } elseif {$xd eq $aend} {
7025                set cached_isanc($b,$aend) 1
7026                set cached_isanc($a,$bend) 0
7027                return -1
7028            }
7029            if {![info exists anc($xd)]} {
7030                set anc($xd) $anc($x)
7031                lappend todo $xd
7032            } elseif {$anc($xd) ne $anc($x)} {
7033                set anc($xd) {}
7034            }
7035        }
7036    }
7037    set cached_isanc($a,$bend) 0
7038    set cached_isanc($b,$aend) 0
7039    return 0
7040}
7041
7042# This identifies whether $desc has an ancestor that is
7043# a growing tip of the graph and which is not an ancestor of $anc
7044# and returns 0 if so and 1 if not.
7045# If we subsequently discover a tag on such a growing tip, and that
7046# turns out to be a descendent of $anc (which it could, since we
7047# don't necessarily see children before parents), then $desc
7048# isn't a good choice to display as a descendent tag of
7049# $anc (since it is the descendent of another tag which is
7050# a descendent of $anc).  Similarly, $anc isn't a good choice to
7051# display as a ancestor tag of $desc.
7052#
7053proc is_certain {desc anc} {
7054    global arcnos arcout arcstart arcend growing problems
7055
7056    set certain {}
7057    if {[llength $arcnos($anc)] == 1} {
7058        # tags on the same arc are certain
7059        if {$arcnos($desc) eq $arcnos($anc)} {
7060            return 1
7061        }
7062        if {![info exists arcout($anc)]} {
7063            # if $anc is partway along an arc, use the start of the arc instead
7064            set a [lindex $arcnos($anc) 0]
7065            set anc $arcstart($a)
7066        }
7067    }
7068    if {[llength $arcnos($desc)] > 1 || [info exists arcout($desc)]} {
7069        set x $desc
7070    } else {
7071        set a [lindex $arcnos($desc) 0]
7072        set x $arcend($a)
7073    }
7074    if {$x == $anc} {
7075        return 1
7076    }
7077    set anclist [list $x]
7078    set dl($x) 1
7079    set nnh 1
7080    set ngrowanc 0
7081    for {set i 0} {$i < [llength $anclist] && ($nnh > 0 || $ngrowanc > 0)} {incr i} {
7082        set x [lindex $anclist $i]
7083        if {$dl($x)} {
7084            incr nnh -1
7085        }
7086        set done($x) 1
7087        foreach a $arcout($x) {
7088            if {[info exists growing($a)]} {
7089                if {![info exists growanc($x)] && $dl($x)} {
7090                    set growanc($x) 1
7091                    incr ngrowanc
7092                }
7093            } else {
7094                set y $arcend($a)
7095                if {[info exists dl($y)]} {
7096                    if {$dl($y)} {
7097                        if {!$dl($x)} {
7098                            set dl($y) 0
7099                            if {![info exists done($y)]} {
7100                                incr nnh -1
7101                            }
7102                            if {[info exists growanc($x)]} {
7103                                incr ngrowanc -1
7104                            }
7105                            set xl [list $y]
7106                            for {set k 0} {$k < [llength $xl]} {incr k} {
7107                                set z [lindex $xl $k]
7108                                foreach c $arcout($z) {
7109                                    if {[info exists arcend($c)]} {
7110                                        set v $arcend($c)
7111                                        if {[info exists dl($v)] && $dl($v)} {
7112                                            set dl($v) 0
7113                                            if {![info exists done($v)]} {
7114                                                incr nnh -1
7115                                            }
7116                                            if {[info exists growanc($v)]} {
7117                                                incr ngrowanc -1
7118                                            }
7119                                            lappend xl $v
7120                                        }
7121                                    }
7122                                }
7123                            }
7124                        }
7125                    }
7126                } elseif {$y eq $anc || !$dl($x)} {
7127                    set dl($y) 0
7128                    lappend anclist $y
7129                } else {
7130                    set dl($y) 1
7131                    lappend anclist $y
7132                    incr nnh
7133                }
7134            }
7135        }
7136    }
7137    foreach x [array names growanc] {
7138        if {$dl($x)} {
7139            return 0
7140        }
7141        return 0
7142    }
7143    return 1
7144}
7145
7146proc validate_arctags {a} {
7147    global arctags idtags
7148
7149    set i -1
7150    set na $arctags($a)
7151    foreach id $arctags($a) {
7152        incr i
7153        if {![info exists idtags($id)]} {
7154            set na [lreplace $na $i $i]
7155            incr i -1
7156        }
7157    }
7158    set arctags($a) $na
7159}
7160
7161proc validate_archeads {a} {
7162    global archeads idheads
7163
7164    set i -1
7165    set na $archeads($a)
7166    foreach id $archeads($a) {
7167        incr i
7168        if {![info exists idheads($id)]} {
7169            set na [lreplace $na $i $i]
7170            incr i -1
7171        }
7172    }
7173    set archeads($a) $na
7174}
7175
7176# Return the list of IDs that have tags that are descendents of id,
7177# ignoring IDs that are descendents of IDs already reported.
7178proc desctags {id} {
7179    global arcnos arcstart arcids arctags idtags allparents
7180    global growing cached_dtags
7181
7182    if {![info exists allparents($id)]} {
7183        return {}
7184    }
7185    set t1 [clock clicks -milliseconds]
7186    set argid $id
7187    if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
7188        # part-way along an arc; check that arc first
7189        set a [lindex $arcnos($id) 0]
7190        if {$arctags($a) ne {}} {
7191            validate_arctags $a
7192            set i [lsearch -exact $arcids($a) $id]
7193            set tid {}
7194            foreach t $arctags($a) {
7195                set j [lsearch -exact $arcids($a) $t]
7196                if {$j >= $i} break
7197                set tid $t
7198            }
7199            if {$tid ne {}} {
7200                return $tid
7201            }
7202        }
7203        set id $arcstart($a)
7204        if {[info exists idtags($id)]} {
7205            return $id
7206        }
7207    }
7208    if {[info exists cached_dtags($id)]} {
7209        return $cached_dtags($id)
7210    }
7211
7212    set origid $id
7213    set todo [list $id]
7214    set queued($id) 1
7215    set nc 1
7216    for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
7217        set id [lindex $todo $i]
7218        set done($id) 1
7219        set ta [info exists hastaggedancestor($id)]
7220        if {!$ta} {
7221            incr nc -1
7222        }
7223        # ignore tags on starting node
7224        if {!$ta && $i > 0} {
7225            if {[info exists idtags($id)]} {
7226                set tagloc($id) $id
7227                set ta 1
7228            } elseif {[info exists cached_dtags($id)]} {
7229                set tagloc($id) $cached_dtags($id)
7230                set ta 1
7231            }
7232        }
7233        foreach a $arcnos($id) {
7234            set d $arcstart($a)
7235            if {!$ta && $arctags($a) ne {}} {
7236                validate_arctags $a
7237                if {$arctags($a) ne {}} {
7238                    lappend tagloc($id) [lindex $arctags($a) end]
7239                }
7240            }
7241            if {$ta || $arctags($a) ne {}} {
7242                set tomark [list $d]
7243                for {set j 0} {$j < [llength $tomark]} {incr j} {
7244                    set dd [lindex $tomark $j]
7245                    if {![info exists hastaggedancestor($dd)]} {
7246                        if {[info exists done($dd)]} {
7247                            foreach b $arcnos($dd) {
7248                                lappend tomark $arcstart($b)
7249                            }
7250                            if {[info exists tagloc($dd)]} {
7251                                unset tagloc($dd)
7252                            }
7253                        } elseif {[info exists queued($dd)]} {
7254                            incr nc -1
7255                        }
7256                        set hastaggedancestor($dd) 1
7257                    }
7258                }
7259            }
7260            if {![info exists queued($d)]} {
7261                lappend todo $d
7262                set queued($d) 1
7263                if {![info exists hastaggedancestor($d)]} {
7264                    incr nc
7265                }
7266            }
7267        }
7268    }
7269    set tags {}
7270    foreach id [array names tagloc] {
7271        if {![info exists hastaggedancestor($id)]} {
7272            foreach t $tagloc($id) {
7273                if {[lsearch -exact $tags $t] < 0} {
7274                    lappend tags $t
7275                }
7276            }
7277        }
7278    }
7279    set t2 [clock clicks -milliseconds]
7280    set loopix $i
7281
7282    # remove tags that are descendents of other tags
7283    for {set i 0} {$i < [llength $tags]} {incr i} {
7284        set a [lindex $tags $i]
7285        for {set j 0} {$j < $i} {incr j} {
7286            set b [lindex $tags $j]
7287            set r [anc_or_desc $a $b]
7288            if {$r == 1} {
7289                set tags [lreplace $tags $j $j]
7290                incr j -1
7291                incr i -1
7292            } elseif {$r == -1} {
7293                set tags [lreplace $tags $i $i]
7294                incr i -1
7295                break
7296            }
7297        }
7298    }
7299
7300    if {[array names growing] ne {}} {
7301        # graph isn't finished, need to check if any tag could get
7302        # eclipsed by another tag coming later.  Simply ignore any
7303        # tags that could later get eclipsed.
7304        set ctags {}
7305        foreach t $tags {
7306            if {[is_certain $t $origid]} {
7307                lappend ctags $t
7308            }
7309        }
7310        if {$tags eq $ctags} {
7311            set cached_dtags($origid) $tags
7312        } else {
7313            set tags $ctags
7314        }
7315    } else {
7316        set cached_dtags($origid) $tags
7317    }
7318    set t3 [clock clicks -milliseconds]
7319    if {0 && $t3 - $t1 >= 100} {
7320        puts "iterating descendents ($loopix/[llength $todo] nodes) took\
7321            [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
7322    }
7323    return $tags
7324}
7325
7326proc anctags {id} {
7327    global arcnos arcids arcout arcend arctags idtags allparents
7328    global growing cached_atags
7329
7330    if {![info exists allparents($id)]} {
7331        return {}
7332    }
7333    set t1 [clock clicks -milliseconds]
7334    set argid $id
7335    if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
7336        # part-way along an arc; check that arc first
7337        set a [lindex $arcnos($id) 0]
7338        if {$arctags($a) ne {}} {
7339            validate_arctags $a
7340            set i [lsearch -exact $arcids($a) $id]
7341            foreach t $arctags($a) {
7342                set j [lsearch -exact $arcids($a) $t]
7343                if {$j > $i} {
7344                    return $t
7345                }
7346            }
7347        }
7348        if {![info exists arcend($a)]} {
7349            return {}
7350        }
7351        set id $arcend($a)
7352        if {[info exists idtags($id)]} {
7353            return $id
7354        }
7355    }
7356    if {[info exists cached_atags($id)]} {
7357        return $cached_atags($id)
7358    }
7359
7360    set origid $id
7361    set todo [list $id]
7362    set queued($id) 1
7363    set taglist {}
7364    set nc 1
7365    for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
7366        set id [lindex $todo $i]
7367        set done($id) 1
7368        set td [info exists hastaggeddescendent($id)]
7369        if {!$td} {
7370            incr nc -1
7371        }
7372        # ignore tags on starting node
7373        if {!$td && $i > 0} {
7374            if {[info exists idtags($id)]} {
7375                set tagloc($id) $id
7376                set td 1
7377            } elseif {[info exists cached_atags($id)]} {
7378                set tagloc($id) $cached_atags($id)
7379                set td 1
7380            }
7381        }
7382        foreach a $arcout($id) {
7383            if {!$td && $arctags($a) ne {}} {
7384                validate_arctags $a
7385                if {$arctags($a) ne {}} {
7386                    lappend tagloc($id) [lindex $arctags($a) 0]
7387                }
7388            }
7389            if {![info exists arcend($a)]} continue
7390            set d $arcend($a)
7391            if {$td || $arctags($a) ne {}} {
7392                set tomark [list $d]
7393                for {set j 0} {$j < [llength $tomark]} {incr j} {
7394                    set dd [lindex $tomark $j]
7395                    if {![info exists hastaggeddescendent($dd)]} {
7396                        if {[info exists done($dd)]} {
7397                            foreach b $arcout($dd) {
7398                                if {[info exists arcend($b)]} {
7399                                    lappend tomark $arcend($b)
7400                                }
7401                            }
7402                            if {[info exists tagloc($dd)]} {
7403                                unset tagloc($dd)
7404                            }
7405                        } elseif {[info exists queued($dd)]} {
7406                            incr nc -1
7407                        }
7408                        set hastaggeddescendent($dd) 1
7409                    }
7410                }
7411            }
7412            if {![info exists queued($d)]} {
7413                lappend todo $d
7414                set queued($d) 1
7415                if {![info exists hastaggeddescendent($d)]} {
7416                    incr nc
7417                }
7418            }
7419        }
7420    }
7421    set t2 [clock clicks -milliseconds]
7422    set loopix $i
7423    set tags {}
7424    foreach id [array names tagloc] {
7425        if {![info exists hastaggeddescendent($id)]} {
7426            foreach t $tagloc($id) {
7427                if {[lsearch -exact $tags $t] < 0} {
7428                    lappend tags $t
7429                }
7430            }
7431        }
7432    }
7433
7434    # remove tags that are ancestors of other tags
7435    for {set i 0} {$i < [llength $tags]} {incr i} {
7436        set a [lindex $tags $i]
7437        for {set j 0} {$j < $i} {incr j} {
7438            set b [lindex $tags $j]
7439            set r [anc_or_desc $a $b]
7440            if {$r == -1} {
7441                set tags [lreplace $tags $j $j]
7442                incr j -1
7443                incr i -1
7444            } elseif {$r == 1} {
7445                set tags [lreplace $tags $i $i]
7446                incr i -1
7447                break
7448            }
7449        }
7450    }
7451
7452    if {[array names growing] ne {}} {
7453        # graph isn't finished, need to check if any tag could get
7454        # eclipsed by another tag coming later.  Simply ignore any
7455        # tags that could later get eclipsed.
7456        set ctags {}
7457        foreach t $tags {
7458            if {[is_certain $origid $t]} {
7459                lappend ctags $t
7460            }
7461        }
7462        if {$tags eq $ctags} {
7463            set cached_atags($origid) $tags
7464        } else {
7465            set tags $ctags
7466        }
7467    } else {
7468        set cached_atags($origid) $tags
7469    }
7470    set t3 [clock clicks -milliseconds]
7471    if {0 && $t3 - $t1 >= 100} {
7472        puts "iterating ancestors ($loopix/[llength $todo] nodes) took\
7473            [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
7474    }
7475    return $tags
7476}
7477
7478# Return the list of IDs that have heads that are descendents of id,
7479# including id itself if it has a head.
7480proc descheads {id} {
7481    global arcnos arcstart arcids archeads idheads cached_dheads
7482    global allparents
7483
7484    if {![info exists allparents($id)]} {
7485        return {}
7486    }
7487    set aret {}
7488    if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
7489        # part-way along an arc; check it first
7490        set a [lindex $arcnos($id) 0]
7491        if {$archeads($a) ne {}} {
7492            validate_archeads $a
7493            set i [lsearch -exact $arcids($a) $id]
7494            foreach t $archeads($a) {
7495                set j [lsearch -exact $arcids($a) $t]
7496                if {$j > $i} break
7497                lappend aret $t
7498            }
7499        }
7500        set id $arcstart($a)
7501    }
7502    set origid $id
7503    set todo [list $id]
7504    set seen($id) 1
7505    set ret {}
7506    for {set i 0} {$i < [llength $todo]} {incr i} {
7507        set id [lindex $todo $i]
7508        if {[info exists cached_dheads($id)]} {
7509            set ret [concat $ret $cached_dheads($id)]
7510        } else {
7511            if {[info exists idheads($id)]} {
7512                lappend ret $id
7513            }
7514            foreach a $arcnos($id) {
7515                if {$archeads($a) ne {}} {
7516                    validate_archeads $a
7517                    if {$archeads($a) ne {}} {
7518                        set ret [concat $ret $archeads($a)]
7519                    }
7520                }
7521                set d $arcstart($a)
7522                if {![info exists seen($d)]} {
7523                    lappend todo $d
7524                    set seen($d) 1
7525                }
7526            }
7527        }
7528    }
7529    set ret [lsort -unique $ret]
7530    set cached_dheads($origid) $ret
7531    return [concat $ret $aret]
7532}
7533
7534proc addedtag {id} {
7535    global arcnos arcout cached_dtags cached_atags
7536
7537    if {![info exists arcnos($id)]} return
7538    if {![info exists arcout($id)]} {
7539        recalcarc [lindex $arcnos($id) 0]
7540    }
7541    catch {unset cached_dtags}
7542    catch {unset cached_atags}
7543}
7544
7545proc addedhead {hid head} {
7546    global arcnos arcout cached_dheads
7547
7548    if {![info exists arcnos($hid)]} return
7549    if {![info exists arcout($hid)]} {
7550        recalcarc [lindex $arcnos($hid) 0]
7551    }
7552    catch {unset cached_dheads}
7553}
7554
7555proc removedhead {hid head} {
7556    global cached_dheads
7557
7558    catch {unset cached_dheads}
7559}
7560
7561proc movedhead {hid head} {
7562    global arcnos arcout cached_dheads
7563
7564    if {![info exists arcnos($hid)]} return
7565    if {![info exists arcout($hid)]} {
7566        recalcarc [lindex $arcnos($hid) 0]
7567    }
7568    catch {unset cached_dheads}
7569}
7570
7571proc changedrefs {} {
7572    global cached_dheads cached_dtags cached_atags
7573    global arctags archeads arcnos arcout idheads idtags
7574
7575    foreach id [concat [array names idheads] [array names idtags]] {
7576        if {[info exists arcnos($id)] && ![info exists arcout($id)]} {
7577            set a [lindex $arcnos($id) 0]
7578            if {![info exists donearc($a)]} {
7579                recalcarc $a
7580                set donearc($a) 1
7581            }
7582        }
7583    }
7584    catch {unset cached_dtags}
7585    catch {unset cached_atags}
7586    catch {unset cached_dheads}
7587}
7588
7589proc rereadrefs {} {
7590    global idtags idheads idotherrefs mainhead
7591
7592    set refids [concat [array names idtags] \
7593                    [array names idheads] [array names idotherrefs]]
7594    foreach id $refids {
7595        if {![info exists ref($id)]} {
7596            set ref($id) [listrefs $id]
7597        }
7598    }
7599    set oldmainhead $mainhead
7600    readrefs
7601    changedrefs
7602    set refids [lsort -unique [concat $refids [array names idtags] \
7603                        [array names idheads] [array names idotherrefs]]]
7604    foreach id $refids {
7605        set v [listrefs $id]
7606        if {![info exists ref($id)] || $ref($id) != $v ||
7607            ($id eq $oldmainhead && $id ne $mainhead) ||
7608            ($id eq $mainhead && $id ne $oldmainhead)} {
7609            redrawtags $id
7610        }
7611    }
7612    run refill_reflist
7613}
7614
7615proc listrefs {id} {
7616    global idtags idheads idotherrefs
7617
7618    set x {}
7619    if {[info exists idtags($id)]} {
7620        set x $idtags($id)
7621    }
7622    set y {}
7623    if {[info exists idheads($id)]} {
7624        set y $idheads($id)
7625    }
7626    set z {}
7627    if {[info exists idotherrefs($id)]} {
7628        set z $idotherrefs($id)
7629    }
7630    return [list $x $y $z]
7631}
7632
7633proc showtag {tag isnew} {
7634    global ctext tagcontents tagids linknum tagobjid
7635
7636    if {$isnew} {
7637        addtohistory [list showtag $tag 0]
7638    }
7639    $ctext conf -state normal
7640    clear_ctext
7641    set linknum 0
7642    if {![info exists tagcontents($tag)]} {
7643        catch {
7644            set tagcontents($tag) [exec git cat-file tag $tagobjid($tag)]
7645        }
7646    }
7647    if {[info exists tagcontents($tag)]} {
7648        set text $tagcontents($tag)
7649    } else {
7650        set text "Tag: $tag\nId:  $tagids($tag)"
7651    }
7652    appendwithlinks $text {}
7653    $ctext conf -state disabled
7654    init_flist {}
7655}
7656
7657proc doquit {} {
7658    global stopped
7659    set stopped 100
7660    savestuff .
7661    destroy .
7662}
7663
7664proc doprefs {} {
7665    global maxwidth maxgraphpct diffopts
7666    global oldprefs prefstop showneartags showlocalchanges
7667    global bgcolor fgcolor ctext diffcolors selectbgcolor
7668    global uifont tabstop
7669
7670    set top .gitkprefs
7671    set prefstop $top
7672    if {[winfo exists $top]} {
7673        raise $top
7674        return
7675    }
7676    foreach v {maxwidth maxgraphpct diffopts showneartags showlocalchanges} {
7677        set oldprefs($v) [set $v]
7678    }
7679    toplevel $top
7680    wm title $top "Gitk preferences"
7681    label $top.ldisp -text "Commit list display options"
7682    $top.ldisp configure -font $uifont
7683    grid $top.ldisp - -sticky w -pady 10
7684    label $top.spacer -text " "
7685    label $top.maxwidthl -text "Maximum graph width (lines)" \
7686        -font optionfont
7687    spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
7688    grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
7689    label $top.maxpctl -text "Maximum graph width (% of pane)" \
7690        -font optionfont
7691    spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
7692    grid x $top.maxpctl $top.maxpct -sticky w
7693    frame $top.showlocal
7694    label $top.showlocal.l -text "Show local changes" -font optionfont
7695    checkbutton $top.showlocal.b -variable showlocalchanges
7696    pack $top.showlocal.b $top.showlocal.l -side left
7697    grid x $top.showlocal -sticky w
7698
7699    label $top.ddisp -text "Diff display options"
7700    $top.ddisp configure -font $uifont
7701    grid $top.ddisp - -sticky w -pady 10
7702    label $top.diffoptl -text "Options for diff program" \
7703        -font optionfont
7704    entry $top.diffopt -width 20 -textvariable diffopts
7705    grid x $top.diffoptl $top.diffopt -sticky w
7706    frame $top.ntag
7707    label $top.ntag.l -text "Display nearby tags" -font optionfont
7708    checkbutton $top.ntag.b -variable showneartags
7709    pack $top.ntag.b $top.ntag.l -side left
7710    grid x $top.ntag -sticky w
7711    label $top.tabstopl -text "tabstop" -font optionfont
7712    spinbox $top.tabstop -from 1 -to 20 -width 4 -textvariable tabstop
7713    grid x $top.tabstopl $top.tabstop -sticky w
7714
7715    label $top.cdisp -text "Colors: press to choose"
7716    $top.cdisp configure -font $uifont
7717    grid $top.cdisp - -sticky w -pady 10
7718    label $top.bg -padx 40 -relief sunk -background $bgcolor
7719    button $top.bgbut -text "Background" -font optionfont \
7720        -command [list choosecolor bgcolor 0 $top.bg background setbg]
7721    grid x $top.bgbut $top.bg -sticky w
7722    label $top.fg -padx 40 -relief sunk -background $fgcolor
7723    button $top.fgbut -text "Foreground" -font optionfont \
7724        -command [list choosecolor fgcolor 0 $top.fg foreground setfg]
7725    grid x $top.fgbut $top.fg -sticky w
7726    label $top.diffold -padx 40 -relief sunk -background [lindex $diffcolors 0]
7727    button $top.diffoldbut -text "Diff: old lines" -font optionfont \
7728        -command [list choosecolor diffcolors 0 $top.diffold "diff old lines" \
7729                      [list $ctext tag conf d0 -foreground]]
7730    grid x $top.diffoldbut $top.diffold -sticky w
7731    label $top.diffnew -padx 40 -relief sunk -background [lindex $diffcolors 1]
7732    button $top.diffnewbut -text "Diff: new lines" -font optionfont \
7733        -command [list choosecolor diffcolors 1 $top.diffnew "diff new lines" \
7734                      [list $ctext tag conf d1 -foreground]]
7735    grid x $top.diffnewbut $top.diffnew -sticky w
7736    label $top.hunksep -padx 40 -relief sunk -background [lindex $diffcolors 2]
7737    button $top.hunksepbut -text "Diff: hunk header" -font optionfont \
7738        -command [list choosecolor diffcolors 2 $top.hunksep \
7739                      "diff hunk header" \
7740                      [list $ctext tag conf hunksep -foreground]]
7741    grid x $top.hunksepbut $top.hunksep -sticky w
7742    label $top.selbgsep -padx 40 -relief sunk -background $selectbgcolor
7743    button $top.selbgbut -text "Select bg" -font optionfont \
7744        -command [list choosecolor selectbgcolor 0 $top.selbgsep background setselbg]
7745    grid x $top.selbgbut $top.selbgsep -sticky w
7746
7747    frame $top.buts
7748    button $top.buts.ok -text "OK" -command prefsok -default active
7749    $top.buts.ok configure -font $uifont
7750    button $top.buts.can -text "Cancel" -command prefscan -default normal
7751    $top.buts.can configure -font $uifont
7752    grid $top.buts.ok $top.buts.can
7753    grid columnconfigure $top.buts 0 -weight 1 -uniform a
7754    grid columnconfigure $top.buts 1 -weight 1 -uniform a
7755    grid $top.buts - - -pady 10 -sticky ew
7756    bind $top <Visibility> "focus $top.buts.ok"
7757}
7758
7759proc choosecolor {v vi w x cmd} {
7760    global $v
7761
7762    set c [tk_chooseColor -initialcolor [lindex [set $v] $vi] \
7763               -title "Gitk: choose color for $x"]
7764    if {$c eq {}} return
7765    $w conf -background $c
7766    lset $v $vi $c
7767    eval $cmd $c
7768}
7769
7770proc setselbg {c} {
7771    global bglist cflist
7772    foreach w $bglist {
7773        $w configure -selectbackground $c
7774    }
7775    $cflist tag configure highlight \
7776        -background [$cflist cget -selectbackground]
7777    allcanvs itemconf secsel -fill $c
7778}
7779
7780proc setbg {c} {
7781    global bglist
7782
7783    foreach w $bglist {
7784        $w conf -background $c
7785    }
7786}
7787
7788proc setfg {c} {
7789    global fglist canv
7790
7791    foreach w $fglist {
7792        $w conf -foreground $c
7793    }
7794    allcanvs itemconf text -fill $c
7795    $canv itemconf circle -outline $c
7796}
7797
7798proc prefscan {} {
7799    global maxwidth maxgraphpct diffopts
7800    global oldprefs prefstop showneartags showlocalchanges
7801
7802    foreach v {maxwidth maxgraphpct diffopts showneartags showlocalchanges} {
7803        set $v $oldprefs($v)
7804    }
7805    catch {destroy $prefstop}
7806    unset prefstop
7807}
7808
7809proc prefsok {} {
7810    global maxwidth maxgraphpct
7811    global oldprefs prefstop showneartags showlocalchanges
7812    global charspc ctext tabstop
7813
7814    catch {destroy $prefstop}
7815    unset prefstop
7816    $ctext configure -tabs "[expr {$tabstop * $charspc}]"
7817    if {$showlocalchanges != $oldprefs(showlocalchanges)} {
7818        if {$showlocalchanges} {
7819            doshowlocalchanges
7820        } else {
7821            dohidelocalchanges
7822        }
7823    }
7824    if {$maxwidth != $oldprefs(maxwidth)
7825        || $maxgraphpct != $oldprefs(maxgraphpct)} {
7826        redisplay
7827    } elseif {$showneartags != $oldprefs(showneartags)} {
7828        reselectline
7829    }
7830}
7831
7832proc formatdate {d} {
7833    global datetimeformat
7834    if {$d ne {}} {
7835        set d [clock format $d -format $datetimeformat]
7836    }
7837    return $d
7838}
7839
7840# This list of encoding names and aliases is distilled from
7841# http://www.iana.org/assignments/character-sets.
7842# Not all of them are supported by Tcl.
7843set encoding_aliases {
7844    { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
7845      ISO646-US US-ASCII us IBM367 cp367 csASCII }
7846    { ISO-10646-UTF-1 csISO10646UTF1 }
7847    { ISO_646.basic:1983 ref csISO646basic1983 }
7848    { INVARIANT csINVARIANT }
7849    { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
7850    { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
7851    { NATS-SEFI iso-ir-8-1 csNATSSEFI }
7852    { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
7853    { NATS-DANO iso-ir-9-1 csNATSDANO }
7854    { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
7855    { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
7856    { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
7857    { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
7858    { ISO-2022-KR csISO2022KR }
7859    { EUC-KR csEUCKR }
7860    { ISO-2022-JP csISO2022JP }
7861    { ISO-2022-JP-2 csISO2022JP2 }
7862    { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
7863      csISO13JISC6220jp }
7864    { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
7865    { IT iso-ir-15 ISO646-IT csISO15Italian }
7866    { PT iso-ir-16 ISO646-PT csISO16Portuguese }
7867    { ES iso-ir-17 ISO646-ES csISO17Spanish }
7868    { greek7-old iso-ir-18 csISO18Greek7Old }
7869    { latin-greek iso-ir-19 csISO19LatinGreek }
7870    { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
7871    { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
7872    { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
7873    { ISO_5427 iso-ir-37 csISO5427Cyrillic }
7874    { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
7875    { BS_viewdata iso-ir-47 csISO47BSViewdata }
7876    { INIS iso-ir-49 csISO49INIS }
7877    { INIS-8 iso-ir-50 csISO50INIS8 }
7878    { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
7879    { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
7880    { ISO_5428:1980 iso-ir-55 csISO5428Greek }
7881    { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
7882    { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
7883    { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
7884      csISO60Norwegian1 }
7885    { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
7886    { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
7887    { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
7888    { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
7889    { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
7890    { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
7891    { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
7892    { greek7 iso-ir-88 csISO88Greek7 }
7893    { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
7894    { iso-ir-90 csISO90 }
7895    { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
7896    { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
7897      csISO92JISC62991984b }
7898    { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
7899    { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
7900    { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
7901      csISO95JIS62291984handadd }
7902    { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
7903    { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
7904    { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
7905    { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
7906      CP819 csISOLatin1 }
7907    { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
7908    { T.61-7bit iso-ir-102 csISO102T617bit }
7909    { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
7910    { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
7911    { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
7912    { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
7913    { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
7914    { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
7915    { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
7916    { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
7917      arabic csISOLatinArabic }
7918    { ISO_8859-6-E csISO88596E ISO-8859-6-E }
7919    { ISO_8859-6-I csISO88596I ISO-8859-6-I }
7920    { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
7921      greek greek8 csISOLatinGreek }
7922    { T.101-G2 iso-ir-128 csISO128T101G2 }
7923    { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
7924      csISOLatinHebrew }
7925    { ISO_8859-8-E csISO88598E ISO-8859-8-E }
7926    { ISO_8859-8-I csISO88598I ISO-8859-8-I }
7927    { CSN_369103 iso-ir-139 csISO139CSN369103 }
7928    { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
7929    { ISO_6937-2-add iso-ir-142 csISOTextComm }
7930    { IEC_P27-1 iso-ir-143 csISO143IECP271 }
7931    { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
7932      csISOLatinCyrillic }
7933    { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
7934    { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
7935    { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
7936    { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
7937    { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
7938    { ISO_6937-2-25 iso-ir-152 csISO6937Add }
7939    { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
7940    { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
7941    { ISO_10367-box iso-ir-155 csISO10367Box }
7942    { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
7943    { latin-lap lap iso-ir-158 csISO158Lap }
7944    { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
7945    { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
7946    { us-dk csUSDK }
7947    { dk-us csDKUS }
7948    { JIS_X0201 X0201 csHalfWidthKatakana }
7949    { KSC5636 ISO646-KR csKSC5636 }
7950    { ISO-10646-UCS-2 csUnicode }
7951    { ISO-10646-UCS-4 csUCS4 }
7952    { DEC-MCS dec csDECMCS }
7953    { hp-roman8 roman8 r8 csHPRoman8 }
7954    { macintosh mac csMacintosh }
7955    { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
7956      csIBM037 }
7957    { IBM038 EBCDIC-INT cp038 csIBM038 }
7958    { IBM273 CP273 csIBM273 }
7959    { IBM274 EBCDIC-BE CP274 csIBM274 }
7960    { IBM275 EBCDIC-BR cp275 csIBM275 }
7961    { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
7962    { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
7963    { IBM280 CP280 ebcdic-cp-it csIBM280 }
7964    { IBM281 EBCDIC-JP-E cp281 csIBM281 }
7965    { IBM284 CP284 ebcdic-cp-es csIBM284 }
7966    { IBM285 CP285 ebcdic-cp-gb csIBM285 }
7967    { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
7968    { IBM297 cp297 ebcdic-cp-fr csIBM297 }
7969    { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
7970    { IBM423 cp423 ebcdic-cp-gr csIBM423 }
7971    { IBM424 cp424 ebcdic-cp-he csIBM424 }
7972    { IBM437 cp437 437 csPC8CodePage437 }
7973    { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
7974    { IBM775 cp775 csPC775Baltic }
7975    { IBM850 cp850 850 csPC850Multilingual }
7976    { IBM851 cp851 851 csIBM851 }
7977    { IBM852 cp852 852 csPCp852 }
7978    { IBM855 cp855 855 csIBM855 }
7979    { IBM857 cp857 857 csIBM857 }
7980    { IBM860 cp860 860 csIBM860 }
7981    { IBM861 cp861 861 cp-is csIBM861 }
7982    { IBM862 cp862 862 csPC862LatinHebrew }
7983    { IBM863 cp863 863 csIBM863 }
7984    { IBM864 cp864 csIBM864 }
7985    { IBM865 cp865 865 csIBM865 }
7986    { IBM866 cp866 866 csIBM866 }
7987    { IBM868 CP868 cp-ar csIBM868 }
7988    { IBM869 cp869 869 cp-gr csIBM869 }
7989    { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
7990    { IBM871 CP871 ebcdic-cp-is csIBM871 }
7991    { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
7992    { IBM891 cp891 csIBM891 }
7993    { IBM903 cp903 csIBM903 }
7994    { IBM904 cp904 904 csIBBM904 }
7995    { IBM905 CP905 ebcdic-cp-tr csIBM905 }
7996    { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
7997    { IBM1026 CP1026 csIBM1026 }
7998    { EBCDIC-AT-DE csIBMEBCDICATDE }
7999    { EBCDIC-AT-DE-A csEBCDICATDEA }
8000    { EBCDIC-CA-FR csEBCDICCAFR }
8001    { EBCDIC-DK-NO csEBCDICDKNO }
8002    { EBCDIC-DK-NO-A csEBCDICDKNOA }
8003    { EBCDIC-FI-SE csEBCDICFISE }
8004    { EBCDIC-FI-SE-A csEBCDICFISEA }
8005    { EBCDIC-FR csEBCDICFR }
8006    { EBCDIC-IT csEBCDICIT }
8007    { EBCDIC-PT csEBCDICPT }
8008    { EBCDIC-ES csEBCDICES }
8009    { EBCDIC-ES-A csEBCDICESA }
8010    { EBCDIC-ES-S csEBCDICESS }
8011    { EBCDIC-UK csEBCDICUK }
8012    { EBCDIC-US csEBCDICUS }
8013    { UNKNOWN-8BIT csUnknown8BiT }
8014    { MNEMONIC csMnemonic }
8015    { MNEM csMnem }
8016    { VISCII csVISCII }
8017    { VIQR csVIQR }
8018    { KOI8-R csKOI8R }
8019    { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
8020    { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
8021    { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
8022    { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
8023    { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
8024    { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
8025    { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
8026    { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
8027    { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
8028    { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
8029    { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
8030    { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
8031    { IBM1047 IBM-1047 }
8032    { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
8033    { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
8034    { UNICODE-1-1 csUnicode11 }
8035    { CESU-8 csCESU-8 }
8036    { BOCU-1 csBOCU-1 }
8037    { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
8038    { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
8039      l8 }
8040    { ISO-8859-15 ISO_8859-15 Latin-9 }
8041    { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
8042    { GBK CP936 MS936 windows-936 }
8043    { JIS_Encoding csJISEncoding }
8044    { Shift_JIS MS_Kanji csShiftJIS }
8045    { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
8046      EUC-JP }
8047    { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
8048    { ISO-10646-UCS-Basic csUnicodeASCII }
8049    { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
8050    { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
8051    { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
8052    { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
8053    { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
8054    { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
8055    { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
8056    { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
8057    { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
8058    { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
8059    { Adobe-Standard-Encoding csAdobeStandardEncoding }
8060    { Ventura-US csVenturaUS }
8061    { Ventura-International csVenturaInternational }
8062    { PC8-Danish-Norwegian csPC8DanishNorwegian }
8063    { PC8-Turkish csPC8Turkish }
8064    { IBM-Symbols csIBMSymbols }
8065    { IBM-Thai csIBMThai }
8066    { HP-Legal csHPLegal }
8067    { HP-Pi-font csHPPiFont }
8068    { HP-Math8 csHPMath8 }
8069    { Adobe-Symbol-Encoding csHPPSMath }
8070    { HP-DeskTop csHPDesktop }
8071    { Ventura-Math csVenturaMath }
8072    { Microsoft-Publishing csMicrosoftPublishing }
8073    { Windows-31J csWindows31J }
8074    { GB2312 csGB2312 }
8075    { Big5 csBig5 }
8076}
8077
8078proc tcl_encoding {enc} {
8079    global encoding_aliases
8080    set names [encoding names]
8081    set lcnames [string tolower $names]
8082    set enc [string tolower $enc]
8083    set i [lsearch -exact $lcnames $enc]
8084    if {$i < 0} {
8085        # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
8086        if {[regsub {^iso[-_]} $enc iso encx]} {
8087            set i [lsearch -exact $lcnames $encx]
8088        }
8089    }
8090    if {$i < 0} {
8091        foreach l $encoding_aliases {
8092            set ll [string tolower $l]
8093            if {[lsearch -exact $ll $enc] < 0} continue
8094            # look through the aliases for one that tcl knows about
8095            foreach e $ll {
8096                set i [lsearch -exact $lcnames $e]
8097                if {$i < 0} {
8098                    if {[regsub {^iso[-_]} $e iso ex]} {
8099                        set i [lsearch -exact $lcnames $ex]
8100                    }
8101                }
8102                if {$i >= 0} break
8103            }
8104            break
8105        }
8106    }
8107    if {$i >= 0} {
8108        return [lindex $names $i]
8109    }
8110    return {}
8111}
8112
8113# defaults...
8114set datemode 0
8115set diffopts "-U 5 -p"
8116set wrcomcmd "git diff-tree --stdin -p --pretty"
8117
8118set gitencoding {}
8119catch {
8120    set gitencoding [exec git config --get i18n.commitencoding]
8121}
8122if {$gitencoding == ""} {
8123    set gitencoding "utf-8"
8124}
8125set tclencoding [tcl_encoding $gitencoding]
8126if {$tclencoding == {}} {
8127    puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
8128}
8129
8130set mainfont {Helvetica 9}
8131set textfont {Courier 9}
8132set uifont {Helvetica 9 bold}
8133set tabstop 8
8134set findmergefiles 0
8135set maxgraphpct 50
8136set maxwidth 16
8137set revlistorder 0
8138set fastdate 0
8139set uparrowlen 5
8140set downarrowlen 5
8141set mingaplen 100
8142set cmitmode "patch"
8143set wrapcomment "none"
8144set showneartags 1
8145set maxrefs 20
8146set maxlinelen 200
8147set showlocalchanges 1
8148set datetimeformat "%Y-%m-%d %H:%M:%S"
8149
8150set colors {green red blue magenta darkgrey brown orange}
8151set bgcolor white
8152set fgcolor black
8153set diffcolors {red "#00a000" blue}
8154set diffcontext 3
8155set selectbgcolor gray85
8156
8157catch {source ~/.gitk}
8158
8159font create optionfont -family sans-serif -size -12
8160
8161# check that we can find a .git directory somewhere...
8162if {[catch {set gitdir [gitdir]}]} {
8163    show_error {} . "Cannot find a git repository here."
8164    exit 1
8165}
8166if {![file isdirectory $gitdir]} {
8167    show_error {} . "Cannot find the git directory \"$gitdir\"."
8168    exit 1
8169}
8170
8171set revtreeargs {}
8172set cmdline_files {}
8173set i 0
8174foreach arg $argv {
8175    switch -- $arg {
8176        "" { }
8177        "-d" { set datemode 1 }
8178        "--" {
8179            set cmdline_files [lrange $argv [expr {$i + 1}] end]
8180            break
8181        }
8182        default {
8183            lappend revtreeargs $arg
8184        }
8185    }
8186    incr i
8187}
8188
8189if {$i >= [llength $argv] && $revtreeargs ne {}} {
8190    # no -- on command line, but some arguments (other than -d)
8191    if {[catch {
8192        set f [eval exec git rev-parse --no-revs --no-flags $revtreeargs]
8193        set cmdline_files [split $f "\n"]
8194        set n [llength $cmdline_files]
8195        set revtreeargs [lrange $revtreeargs 0 end-$n]
8196        # Unfortunately git rev-parse doesn't produce an error when
8197        # something is both a revision and a filename.  To be consistent
8198        # with git log and git rev-list, check revtreeargs for filenames.
8199        foreach arg $revtreeargs {
8200            if {[file exists $arg]} {
8201                show_error {} . "Ambiguous argument '$arg': both revision\
8202                                 and filename"
8203                exit 1
8204            }
8205        }
8206    } err]} {
8207        # unfortunately we get both stdout and stderr in $err,
8208        # so look for "fatal:".
8209        set i [string first "fatal:" $err]
8210        if {$i > 0} {
8211            set err [string range $err [expr {$i + 6}] end]
8212        }
8213        show_error {} . "Bad arguments to gitk:\n$err"
8214        exit 1
8215    }
8216}
8217
8218set nullid "0000000000000000000000000000000000000000"
8219set nullid2 "0000000000000000000000000000000000000001"
8220
8221
8222set runq {}
8223set history {}
8224set historyindex 0
8225set fh_serial 0
8226set nhl_names {}
8227set highlight_paths {}
8228set searchdirn -forwards
8229set boldrows {}
8230set boldnamerows {}
8231set diffelide {0 0}
8232set markingmatches 0
8233set linkentercount 0
8234set need_redisplay 0
8235set nrows_drawn 0
8236
8237set nextviewnum 1
8238set curview 0
8239set selectedview 0
8240set selectedhlview None
8241set viewfiles(0) {}
8242set viewperm(0) 0
8243set viewargs(0) {}
8244
8245set cmdlineok 0
8246set stopped 0
8247set stuffsaved 0
8248set patchnum 0
8249set lookingforhead 0
8250set localirow -1
8251set localfrow -1
8252set lserial 0
8253setcoords
8254makewindow
8255# wait for the window to become visible
8256tkwait visibility .
8257wm title . "[file tail $argv0]: [file tail [pwd]]"
8258readrefs
8259
8260if {$cmdline_files ne {} || $revtreeargs ne {}} {
8261    # create a view for the files/dirs specified on the command line
8262    set curview 1
8263    set selectedview 1
8264    set nextviewnum 2
8265    set viewname(1) "Command line"
8266    set viewfiles(1) $cmdline_files
8267    set viewargs(1) $revtreeargs
8268    set viewperm(1) 0
8269    addviewmenu 1
8270    .bar.view entryconf Edit* -state normal
8271    .bar.view entryconf Delete* -state normal
8272}
8273
8274if {[info exists permviews]} {
8275    foreach v $permviews {
8276        set n $nextviewnum
8277        incr nextviewnum
8278        set viewname($n) [lindex $v 0]
8279        set viewfiles($n) [lindex $v 1]
8280        set viewargs($n) [lindex $v 2]
8281        set viewperm($n) 1
8282        addviewmenu $n
8283    }
8284}
8285getcommits