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