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