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