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