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