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