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