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