dab9df067eb1f575002ae2123e60869bfe5e7d7f
   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        set dir [gitdir]
6153        set fname [file join $dir "refs/tags" $tag]
6154        set f [open $fname w]
6155        puts $f $id
6156        close $f
6157    } err]} {
6158        error_popup "[mc "Error creating tag:"] $err"
6159        return
6160    }
6161
6162    set tagids($tag) $id
6163    lappend idtags($id) $tag
6164    redrawtags $id
6165    addedtag $id
6166    dispneartags 0
6167    run refill_reflist
6168}
6169
6170proc redrawtags {id} {
6171    global canv linehtag commitrow idpos selectedline curview
6172    global canvxmax iddrawn
6173
6174    if {![info exists commitrow($curview,$id)]} return
6175    if {![info exists iddrawn($id)]} return
6176    drawcommits $commitrow($curview,$id)
6177    $canv delete tag.$id
6178    set xt [eval drawtags $id $idpos($id)]
6179    $canv coords $linehtag($commitrow($curview,$id)) $xt [lindex $idpos($id) 2]
6180    set text [$canv itemcget $linehtag($commitrow($curview,$id)) -text]
6181    set xr [expr {$xt + [font measure mainfont $text]}]
6182    if {$xr > $canvxmax} {
6183        set canvxmax $xr
6184        setcanvscroll
6185    }
6186    if {[info exists selectedline]
6187        && $selectedline == $commitrow($curview,$id)} {
6188        selectline $selectedline 0
6189    }
6190}
6191
6192proc mktagcan {} {
6193    global mktagtop
6194
6195    catch {destroy $mktagtop}
6196    unset mktagtop
6197}
6198
6199proc mktaggo {} {
6200    domktag
6201    mktagcan
6202}
6203
6204proc writecommit {} {
6205    global rowmenuid wrcomtop commitinfo wrcomcmd
6206
6207    set top .writecommit
6208    set wrcomtop $top
6209    catch {destroy $top}
6210    toplevel $top
6211    label $top.title -text [mc "Write commit to file"]
6212    grid $top.title - -pady 10
6213    label $top.id -text [mc "ID:"]
6214    entry $top.sha1 -width 40 -relief flat
6215    $top.sha1 insert 0 $rowmenuid
6216    $top.sha1 conf -state readonly
6217    grid $top.id $top.sha1 -sticky w
6218    entry $top.head -width 60 -relief flat
6219    $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
6220    $top.head conf -state readonly
6221    grid x $top.head -sticky w
6222    label $top.clab -text [mc "Command:"]
6223    entry $top.cmd -width 60 -textvariable wrcomcmd
6224    grid $top.clab $top.cmd -sticky w -pady 10
6225    label $top.flab -text [mc "Output file:"]
6226    entry $top.fname -width 60
6227    $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
6228    grid $top.flab $top.fname -sticky w
6229    frame $top.buts
6230    button $top.buts.gen -text [mc "Write"] -command wrcomgo
6231    button $top.buts.can -text [mc "Cancel"] -command wrcomcan
6232    grid $top.buts.gen $top.buts.can
6233    grid columnconfigure $top.buts 0 -weight 1 -uniform a
6234    grid columnconfigure $top.buts 1 -weight 1 -uniform a
6235    grid $top.buts - -pady 10 -sticky ew
6236    focus $top.fname
6237}
6238
6239proc wrcomgo {} {
6240    global wrcomtop
6241
6242    set id [$wrcomtop.sha1 get]
6243    set cmd "echo $id | [$wrcomtop.cmd get]"
6244    set fname [$wrcomtop.fname get]
6245    if {[catch {exec sh -c $cmd >$fname &} err]} {
6246        error_popup "[mc "Error writing commit:"] $err"
6247    }
6248    catch {destroy $wrcomtop}
6249    unset wrcomtop
6250}
6251
6252proc wrcomcan {} {
6253    global wrcomtop
6254
6255    catch {destroy $wrcomtop}
6256    unset wrcomtop
6257}
6258
6259proc mkbranch {} {
6260    global rowmenuid mkbrtop
6261
6262    set top .makebranch
6263    catch {destroy $top}
6264    toplevel $top
6265    label $top.title -text [mc "Create new branch"]
6266    grid $top.title - -pady 10
6267    label $top.id -text [mc "ID:"]
6268    entry $top.sha1 -width 40 -relief flat
6269    $top.sha1 insert 0 $rowmenuid
6270    $top.sha1 conf -state readonly
6271    grid $top.id $top.sha1 -sticky w
6272    label $top.nlab -text [mc "Name:"]
6273    entry $top.name -width 40
6274    grid $top.nlab $top.name -sticky w
6275    frame $top.buts
6276    button $top.buts.go -text [mc "Create"] -command [list mkbrgo $top]
6277    button $top.buts.can -text [mc "Cancel"] -command "catch {destroy $top}"
6278    grid $top.buts.go $top.buts.can
6279    grid columnconfigure $top.buts 0 -weight 1 -uniform a
6280    grid columnconfigure $top.buts 1 -weight 1 -uniform a
6281    grid $top.buts - -pady 10 -sticky ew
6282    focus $top.name
6283}
6284
6285proc mkbrgo {top} {
6286    global headids idheads
6287
6288    set name [$top.name get]
6289    set id [$top.sha1 get]
6290    if {$name eq {}} {
6291        error_popup [mc "Please specify a name for the new branch"]
6292        return
6293    }
6294    catch {destroy $top}
6295    nowbusy newbranch
6296    update
6297    if {[catch {
6298        exec git branch $name $id
6299    } err]} {
6300        notbusy newbranch
6301        error_popup $err
6302    } else {
6303        set headids($name) $id
6304        lappend idheads($id) $name
6305        addedhead $id $name
6306        notbusy newbranch
6307        redrawtags $id
6308        dispneartags 0
6309        run refill_reflist
6310    }
6311}
6312
6313proc cherrypick {} {
6314    global rowmenuid curview commitrow
6315    global mainhead
6316
6317    set oldhead [exec git rev-parse HEAD]
6318    set dheads [descheads $rowmenuid]
6319    if {$dheads ne {} && [lsearch -exact $dheads $oldhead] >= 0} {
6320        set ok [confirm_popup [mc "Commit %s is already\
6321                included in branch %s -- really re-apply it?" \
6322                                   [string range $rowmenuid 0 7] $mainhead]]
6323        if {!$ok} return
6324    }
6325    nowbusy cherrypick [mc "Cherry-picking"]
6326    update
6327    # Unfortunately git-cherry-pick writes stuff to stderr even when
6328    # no error occurs, and exec takes that as an indication of error...
6329    if {[catch {exec sh -c "git cherry-pick -r $rowmenuid 2>&1"} err]} {
6330        notbusy cherrypick
6331        error_popup $err
6332        return
6333    }
6334    set newhead [exec git rev-parse HEAD]
6335    if {$newhead eq $oldhead} {
6336        notbusy cherrypick
6337        error_popup [mc "No changes committed"]
6338        return
6339    }
6340    addnewchild $newhead $oldhead
6341    if {[info exists commitrow($curview,$oldhead)]} {
6342        insertrow $commitrow($curview,$oldhead) $newhead
6343        if {$mainhead ne {}} {
6344            movehead $newhead $mainhead
6345            movedhead $newhead $mainhead
6346        }
6347        redrawtags $oldhead
6348        redrawtags $newhead
6349    }
6350    notbusy cherrypick
6351}
6352
6353proc resethead {} {
6354    global mainheadid mainhead rowmenuid confirm_ok resettype
6355
6356    set confirm_ok 0
6357    set w ".confirmreset"
6358    toplevel $w
6359    wm transient $w .
6360    wm title $w [mc "Confirm reset"]
6361    message $w.m -text \
6362        [mc "Reset branch %s to %s?" $mainhead [string range $rowmenuid 0 7]] \
6363        -justify center -aspect 1000
6364    pack $w.m -side top -fill x -padx 20 -pady 20
6365    frame $w.f -relief sunken -border 2
6366    message $w.f.rt -text [mc "Reset type:"] -aspect 1000
6367    grid $w.f.rt -sticky w
6368    set resettype mixed
6369    radiobutton $w.f.soft -value soft -variable resettype -justify left \
6370        -text [mc "Soft: Leave working tree and index untouched"]
6371    grid $w.f.soft -sticky w
6372    radiobutton $w.f.mixed -value mixed -variable resettype -justify left \
6373        -text [mc "Mixed: Leave working tree untouched, reset index"]
6374    grid $w.f.mixed -sticky w
6375    radiobutton $w.f.hard -value hard -variable resettype -justify left \
6376        -text [mc "Hard: Reset working tree and index\n(discard ALL local changes)"]
6377    grid $w.f.hard -sticky w
6378    pack $w.f -side top -fill x
6379    button $w.ok -text [mc OK] -command "set confirm_ok 1; destroy $w"
6380    pack $w.ok -side left -fill x -padx 20 -pady 20
6381    button $w.cancel -text [mc Cancel] -command "destroy $w"
6382    pack $w.cancel -side right -fill x -padx 20 -pady 20
6383    bind $w <Visibility> "grab $w; focus $w"
6384    tkwait window $w
6385    if {!$confirm_ok} return
6386    if {[catch {set fd [open \
6387            [list | sh -c "git reset --$resettype $rowmenuid 2>&1"] r]} err]} {
6388        error_popup $err
6389    } else {
6390        dohidelocalchanges
6391        filerun $fd [list readresetstat $fd]
6392        nowbusy reset [mc "Resetting"]
6393    }
6394}
6395
6396proc readresetstat {fd} {
6397    global mainhead mainheadid showlocalchanges rprogcoord
6398
6399    if {[gets $fd line] >= 0} {
6400        if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
6401            set rprogcoord [expr {1.0 * $m / $n}]
6402            adjustprogress
6403        }
6404        return 1
6405    }
6406    set rprogcoord 0
6407    adjustprogress
6408    notbusy reset
6409    if {[catch {close $fd} err]} {
6410        error_popup $err
6411    }
6412    set oldhead $mainheadid
6413    set newhead [exec git rev-parse HEAD]
6414    if {$newhead ne $oldhead} {
6415        movehead $newhead $mainhead
6416        movedhead $newhead $mainhead
6417        set mainheadid $newhead
6418        redrawtags $oldhead
6419        redrawtags $newhead
6420    }
6421    if {$showlocalchanges} {
6422        doshowlocalchanges
6423    }
6424    return 0
6425}
6426
6427# context menu for a head
6428proc headmenu {x y id head} {
6429    global headmenuid headmenuhead headctxmenu mainhead
6430
6431    stopfinding
6432    set headmenuid $id
6433    set headmenuhead $head
6434    set state normal
6435    if {$head eq $mainhead} {
6436        set state disabled
6437    }
6438    $headctxmenu entryconfigure 0 -state $state
6439    $headctxmenu entryconfigure 1 -state $state
6440    tk_popup $headctxmenu $x $y
6441}
6442
6443proc cobranch {} {
6444    global headmenuid headmenuhead mainhead headids
6445    global showlocalchanges mainheadid
6446
6447    # check the tree is clean first??
6448    set oldmainhead $mainhead
6449    nowbusy checkout [mc "Checking out"]
6450    update
6451    dohidelocalchanges
6452    if {[catch {
6453        exec git checkout -q $headmenuhead
6454    } err]} {
6455        notbusy checkout
6456        error_popup $err
6457    } else {
6458        notbusy checkout
6459        set mainhead $headmenuhead
6460        set mainheadid $headmenuid
6461        if {[info exists headids($oldmainhead)]} {
6462            redrawtags $headids($oldmainhead)
6463        }
6464        redrawtags $headmenuid
6465    }
6466    if {$showlocalchanges} {
6467        dodiffindex
6468    }
6469}
6470
6471proc rmbranch {} {
6472    global headmenuid headmenuhead mainhead
6473    global idheads
6474
6475    set head $headmenuhead
6476    set id $headmenuid
6477    # this check shouldn't be needed any more...
6478    if {$head eq $mainhead} {
6479        error_popup [mc "Cannot delete the currently checked-out branch"]
6480        return
6481    }
6482    set dheads [descheads $id]
6483    if {[llength $dheads] == 1 && $idheads($dheads) eq $head} {
6484        # the stuff on this branch isn't on any other branch
6485        if {![confirm_popup [mc "The commits on branch %s aren't on any other\
6486                        branch.\nReally delete branch %s?" $head $head]]} return
6487    }
6488    nowbusy rmbranch
6489    update
6490    if {[catch {exec git branch -D $head} err]} {
6491        notbusy rmbranch
6492        error_popup $err
6493        return
6494    }
6495    removehead $id $head
6496    removedhead $id $head
6497    redrawtags $id
6498    notbusy rmbranch
6499    dispneartags 0
6500    run refill_reflist
6501}
6502
6503# Display a list of tags and heads
6504proc showrefs {} {
6505    global showrefstop bgcolor fgcolor selectbgcolor
6506    global bglist fglist reflistfilter reflist maincursor
6507
6508    set top .showrefs
6509    set showrefstop $top
6510    if {[winfo exists $top]} {
6511        raise $top
6512        refill_reflist
6513        return
6514    }
6515    toplevel $top
6516    wm title $top [mc "Tags and heads: %s" [file tail [pwd]]]
6517    text $top.list -background $bgcolor -foreground $fgcolor \
6518        -selectbackground $selectbgcolor -font mainfont \
6519        -xscrollcommand "$top.xsb set" -yscrollcommand "$top.ysb set" \
6520        -width 30 -height 20 -cursor $maincursor \
6521        -spacing1 1 -spacing3 1 -state disabled
6522    $top.list tag configure highlight -background $selectbgcolor
6523    lappend bglist $top.list
6524    lappend fglist $top.list
6525    scrollbar $top.ysb -command "$top.list yview" -orient vertical
6526    scrollbar $top.xsb -command "$top.list xview" -orient horizontal
6527    grid $top.list $top.ysb -sticky nsew
6528    grid $top.xsb x -sticky ew
6529    frame $top.f
6530    label $top.f.l -text "[mc "Filter"]: "
6531    entry $top.f.e -width 20 -textvariable reflistfilter
6532    set reflistfilter "*"
6533    trace add variable reflistfilter write reflistfilter_change
6534    pack $top.f.e -side right -fill x -expand 1
6535    pack $top.f.l -side left
6536    grid $top.f - -sticky ew -pady 2
6537    button $top.close -command [list destroy $top] -text [mc "Close"]
6538    grid $top.close -
6539    grid columnconfigure $top 0 -weight 1
6540    grid rowconfigure $top 0 -weight 1
6541    bind $top.list <1> {break}
6542    bind $top.list <B1-Motion> {break}
6543    bind $top.list <ButtonRelease-1> {sel_reflist %W %x %y; break}
6544    set reflist {}
6545    refill_reflist
6546}
6547
6548proc sel_reflist {w x y} {
6549    global showrefstop reflist headids tagids otherrefids
6550
6551    if {![winfo exists $showrefstop]} return
6552    set l [lindex [split [$w index "@$x,$y"] "."] 0]
6553    set ref [lindex $reflist [expr {$l-1}]]
6554    set n [lindex $ref 0]
6555    switch -- [lindex $ref 1] {
6556        "H" {selbyid $headids($n)}
6557        "T" {selbyid $tagids($n)}
6558        "o" {selbyid $otherrefids($n)}
6559    }
6560    $showrefstop.list tag add highlight $l.0 "$l.0 lineend"
6561}
6562
6563proc unsel_reflist {} {
6564    global showrefstop
6565
6566    if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
6567    $showrefstop.list tag remove highlight 0.0 end
6568}
6569
6570proc reflistfilter_change {n1 n2 op} {
6571    global reflistfilter
6572
6573    after cancel refill_reflist
6574    after 200 refill_reflist
6575}
6576
6577proc refill_reflist {} {
6578    global reflist reflistfilter showrefstop headids tagids otherrefids
6579    global commitrow curview commitinterest
6580
6581    if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
6582    set refs {}
6583    foreach n [array names headids] {
6584        if {[string match $reflistfilter $n]} {
6585            if {[info exists commitrow($curview,$headids($n))]} {
6586                lappend refs [list $n H]
6587            } else {
6588                set commitinterest($headids($n)) {run refill_reflist}
6589            }
6590        }
6591    }
6592    foreach n [array names tagids] {
6593        if {[string match $reflistfilter $n]} {
6594            if {[info exists commitrow($curview,$tagids($n))]} {
6595                lappend refs [list $n T]
6596            } else {
6597                set commitinterest($tagids($n)) {run refill_reflist}
6598            }
6599        }
6600    }
6601    foreach n [array names otherrefids] {
6602        if {[string match $reflistfilter $n]} {
6603            if {[info exists commitrow($curview,$otherrefids($n))]} {
6604                lappend refs [list $n o]
6605            } else {
6606                set commitinterest($otherrefids($n)) {run refill_reflist}
6607            }
6608        }
6609    }
6610    set refs [lsort -index 0 $refs]
6611    if {$refs eq $reflist} return
6612
6613    # Update the contents of $showrefstop.list according to the
6614    # differences between $reflist (old) and $refs (new)
6615    $showrefstop.list conf -state normal
6616    $showrefstop.list insert end "\n"
6617    set i 0
6618    set j 0
6619    while {$i < [llength $reflist] || $j < [llength $refs]} {
6620        if {$i < [llength $reflist]} {
6621            if {$j < [llength $refs]} {
6622                set cmp [string compare [lindex $reflist $i 0] \
6623                             [lindex $refs $j 0]]
6624                if {$cmp == 0} {
6625                    set cmp [string compare [lindex $reflist $i 1] \
6626                                 [lindex $refs $j 1]]
6627                }
6628            } else {
6629                set cmp -1
6630            }
6631        } else {
6632            set cmp 1
6633        }
6634        switch -- $cmp {
6635            -1 {
6636                $showrefstop.list delete "[expr {$j+1}].0" "[expr {$j+2}].0"
6637                incr i
6638            }
6639            0 {
6640                incr i
6641                incr j
6642            }
6643            1 {
6644                set l [expr {$j + 1}]
6645                $showrefstop.list image create $l.0 -align baseline \
6646                    -image reficon-[lindex $refs $j 1] -padx 2
6647                $showrefstop.list insert $l.1 "[lindex $refs $j 0]\n"
6648                incr j
6649            }
6650        }
6651    }
6652    set reflist $refs
6653    # delete last newline
6654    $showrefstop.list delete end-2c end-1c
6655    $showrefstop.list conf -state disabled
6656}
6657
6658# Stuff for finding nearby tags
6659proc getallcommits {} {
6660    global allcommits nextarc seeds allccache allcwait cachedarcs allcupdate
6661    global idheads idtags idotherrefs allparents tagobjid
6662
6663    if {![info exists allcommits]} {
6664        set nextarc 0
6665        set allcommits 0
6666        set seeds {}
6667        set allcwait 0
6668        set cachedarcs 0
6669        set allccache [file join [gitdir] "gitk.cache"]
6670        if {![catch {
6671            set f [open $allccache r]
6672            set allcwait 1
6673            getcache $f
6674        }]} return
6675    }
6676
6677    if {$allcwait} {
6678        return
6679    }
6680    set cmd [list | git rev-list --parents]
6681    set allcupdate [expr {$seeds ne {}}]
6682    if {!$allcupdate} {
6683        set ids "--all"
6684    } else {
6685        set refs [concat [array names idheads] [array names idtags] \
6686                      [array names idotherrefs]]
6687        set ids {}
6688        set tagobjs {}
6689        foreach name [array names tagobjid] {
6690            lappend tagobjs $tagobjid($name)
6691        }
6692        foreach id [lsort -unique $refs] {
6693            if {![info exists allparents($id)] &&
6694                [lsearch -exact $tagobjs $id] < 0} {
6695                lappend ids $id
6696            }
6697        }
6698        if {$ids ne {}} {
6699            foreach id $seeds {
6700                lappend ids "^$id"
6701            }
6702        }
6703    }
6704    if {$ids ne {}} {
6705        set fd [open [concat $cmd $ids] r]
6706        fconfigure $fd -blocking 0
6707        incr allcommits
6708        nowbusy allcommits
6709        filerun $fd [list getallclines $fd]
6710    } else {
6711        dispneartags 0
6712    }
6713}
6714
6715# Since most commits have 1 parent and 1 child, we group strings of
6716# such commits into "arcs" joining branch/merge points (BMPs), which
6717# are commits that either don't have 1 parent or don't have 1 child.
6718#
6719# arcnos(id) - incoming arcs for BMP, arc we're on for other nodes
6720# arcout(id) - outgoing arcs for BMP
6721# arcids(a) - list of IDs on arc including end but not start
6722# arcstart(a) - BMP ID at start of arc
6723# arcend(a) - BMP ID at end of arc
6724# growing(a) - arc a is still growing
6725# arctags(a) - IDs out of arcids (excluding end) that have tags
6726# archeads(a) - IDs out of arcids (excluding end) that have heads
6727# The start of an arc is at the descendent end, so "incoming" means
6728# coming from descendents, and "outgoing" means going towards ancestors.
6729
6730proc getallclines {fd} {
6731    global allparents allchildren idtags idheads nextarc
6732    global arcnos arcids arctags arcout arcend arcstart archeads growing
6733    global seeds allcommits cachedarcs allcupdate
6734    
6735    set nid 0
6736    while {[incr nid] <= 1000 && [gets $fd line] >= 0} {
6737        set id [lindex $line 0]
6738        if {[info exists allparents($id)]} {
6739            # seen it already
6740            continue
6741        }
6742        set cachedarcs 0
6743        set olds [lrange $line 1 end]
6744        set allparents($id) $olds
6745        if {![info exists allchildren($id)]} {
6746            set allchildren($id) {}
6747            set arcnos($id) {}
6748            lappend seeds $id
6749        } else {
6750            set a $arcnos($id)
6751            if {[llength $olds] == 1 && [llength $a] == 1} {
6752                lappend arcids($a) $id
6753                if {[info exists idtags($id)]} {
6754                    lappend arctags($a) $id
6755                }
6756                if {[info exists idheads($id)]} {
6757                    lappend archeads($a) $id
6758                }
6759                if {[info exists allparents($olds)]} {
6760                    # seen parent already
6761                    if {![info exists arcout($olds)]} {
6762                        splitarc $olds
6763                    }
6764                    lappend arcids($a) $olds
6765                    set arcend($a) $olds
6766                    unset growing($a)
6767                }
6768                lappend allchildren($olds) $id
6769                lappend arcnos($olds) $a
6770                continue
6771            }
6772        }
6773        foreach a $arcnos($id) {
6774            lappend arcids($a) $id
6775            set arcend($a) $id
6776            unset growing($a)
6777        }
6778
6779        set ao {}
6780        foreach p $olds {
6781            lappend allchildren($p) $id
6782            set a [incr nextarc]
6783            set arcstart($a) $id
6784            set archeads($a) {}
6785            set arctags($a) {}
6786            set archeads($a) {}
6787            set arcids($a) {}
6788            lappend ao $a
6789            set growing($a) 1
6790            if {[info exists allparents($p)]} {
6791                # seen it already, may need to make a new branch
6792                if {![info exists arcout($p)]} {
6793                    splitarc $p
6794                }
6795                lappend arcids($a) $p
6796                set arcend($a) $p
6797                unset growing($a)
6798            }
6799            lappend arcnos($p) $a
6800        }
6801        set arcout($id) $ao
6802    }
6803    if {$nid > 0} {
6804        global cached_dheads cached_dtags cached_atags
6805        catch {unset cached_dheads}
6806        catch {unset cached_dtags}
6807        catch {unset cached_atags}
6808    }
6809    if {![eof $fd]} {
6810        return [expr {$nid >= 1000? 2: 1}]
6811    }
6812    set cacheok 1
6813    if {[catch {
6814        fconfigure $fd -blocking 1
6815        close $fd
6816    } err]} {
6817        # got an error reading the list of commits
6818        # if we were updating, try rereading the whole thing again
6819        if {$allcupdate} {
6820            incr allcommits -1
6821            dropcache $err
6822            return
6823        }
6824        error_popup "[mc "Error reading commit topology information;\
6825                branch and preceding/following tag information\
6826                will be incomplete."]\n($err)"
6827        set cacheok 0
6828    }
6829    if {[incr allcommits -1] == 0} {
6830        notbusy allcommits
6831        if {$cacheok} {
6832            run savecache
6833        }
6834    }
6835    dispneartags 0
6836    return 0
6837}
6838
6839proc recalcarc {a} {
6840    global arctags archeads arcids idtags idheads
6841
6842    set at {}
6843    set ah {}
6844    foreach id [lrange $arcids($a) 0 end-1] {
6845        if {[info exists idtags($id)]} {
6846            lappend at $id
6847        }
6848        if {[info exists idheads($id)]} {
6849            lappend ah $id
6850        }
6851    }
6852    set arctags($a) $at
6853    set archeads($a) $ah
6854}
6855
6856proc splitarc {p} {
6857    global arcnos arcids nextarc arctags archeads idtags idheads
6858    global arcstart arcend arcout allparents growing
6859
6860    set a $arcnos($p)
6861    if {[llength $a] != 1} {
6862        puts "oops splitarc called but [llength $a] arcs already"
6863        return
6864    }
6865    set a [lindex $a 0]
6866    set i [lsearch -exact $arcids($a) $p]
6867    if {$i < 0} {
6868        puts "oops splitarc $p not in arc $a"
6869        return
6870    }
6871    set na [incr nextarc]
6872    if {[info exists arcend($a)]} {
6873        set arcend($na) $arcend($a)
6874    } else {
6875        set l [lindex $allparents([lindex $arcids($a) end]) 0]
6876        set j [lsearch -exact $arcnos($l) $a]
6877        set arcnos($l) [lreplace $arcnos($l) $j $j $na]
6878    }
6879    set tail [lrange $arcids($a) [expr {$i+1}] end]
6880    set arcids($a) [lrange $arcids($a) 0 $i]
6881    set arcend($a) $p
6882    set arcstart($na) $p
6883    set arcout($p) $na
6884    set arcids($na) $tail
6885    if {[info exists growing($a)]} {
6886        set growing($na) 1
6887        unset growing($a)
6888    }
6889
6890    foreach id $tail {
6891        if {[llength $arcnos($id)] == 1} {
6892            set arcnos($id) $na
6893        } else {
6894            set j [lsearch -exact $arcnos($id) $a]
6895            set arcnos($id) [lreplace $arcnos($id) $j $j $na]
6896        }
6897    }
6898
6899    # reconstruct tags and heads lists
6900    if {$arctags($a) ne {} || $archeads($a) ne {}} {
6901        recalcarc $a
6902        recalcarc $na
6903    } else {
6904        set arctags($na) {}
6905        set archeads($na) {}
6906    }
6907}
6908
6909# Update things for a new commit added that is a child of one
6910# existing commit.  Used when cherry-picking.
6911proc addnewchild {id p} {
6912    global allparents allchildren idtags nextarc
6913    global arcnos arcids arctags arcout arcend arcstart archeads growing
6914    global seeds allcommits
6915
6916    if {![info exists allcommits] || ![info exists arcnos($p)]} return
6917    set allparents($id) [list $p]
6918    set allchildren($id) {}
6919    set arcnos($id) {}
6920    lappend seeds $id
6921    lappend allchildren($p) $id
6922    set a [incr nextarc]
6923    set arcstart($a) $id
6924    set archeads($a) {}
6925    set arctags($a) {}
6926    set arcids($a) [list $p]
6927    set arcend($a) $p
6928    if {![info exists arcout($p)]} {
6929        splitarc $p
6930    }
6931    lappend arcnos($p) $a
6932    set arcout($id) [list $a]
6933}
6934
6935# This implements a cache for the topology information.
6936# The cache saves, for each arc, the start and end of the arc,
6937# the ids on the arc, and the outgoing arcs from the end.
6938proc readcache {f} {
6939    global arcnos arcids arcout arcstart arcend arctags archeads nextarc
6940    global idtags idheads allparents cachedarcs possible_seeds seeds growing
6941    global allcwait
6942
6943    set a $nextarc
6944    set lim $cachedarcs
6945    if {$lim - $a > 500} {
6946        set lim [expr {$a + 500}]
6947    }
6948    if {[catch {
6949        if {$a == $lim} {
6950            # finish reading the cache and setting up arctags, etc.
6951            set line [gets $f]
6952            if {$line ne "1"} {error "bad final version"}
6953            close $f
6954            foreach id [array names idtags] {
6955                if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
6956                    [llength $allparents($id)] == 1} {
6957                    set a [lindex $arcnos($id) 0]
6958                    if {$arctags($a) eq {}} {
6959                        recalcarc $a
6960                    }
6961                }
6962            }
6963            foreach id [array names idheads] {
6964                if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
6965                    [llength $allparents($id)] == 1} {
6966                    set a [lindex $arcnos($id) 0]
6967                    if {$archeads($a) eq {}} {
6968                        recalcarc $a
6969                    }
6970                }
6971            }
6972            foreach id [lsort -unique $possible_seeds] {
6973                if {$arcnos($id) eq {}} {
6974                    lappend seeds $id
6975                }
6976            }
6977            set allcwait 0
6978        } else {
6979            while {[incr a] <= $lim} {
6980                set line [gets $f]
6981                if {[llength $line] != 3} {error "bad line"}
6982                set s [lindex $line 0]
6983                set arcstart($a) $s
6984                lappend arcout($s) $a
6985                if {![info exists arcnos($s)]} {
6986                    lappend possible_seeds $s
6987                    set arcnos($s) {}
6988                }
6989                set e [lindex $line 1]
6990                if {$e eq {}} {
6991                    set growing($a) 1
6992                } else {
6993                    set arcend($a) $e
6994                    if {![info exists arcout($e)]} {
6995                        set arcout($e) {}
6996                    }
6997                }
6998                set arcids($a) [lindex $line 2]
6999                foreach id $arcids($a) {
7000                    lappend allparents($s) $id
7001                    set s $id
7002                    lappend arcnos($id) $a
7003                }
7004                if {![info exists allparents($s)]} {
7005                    set allparents($s) {}
7006                }
7007                set arctags($a) {}
7008                set archeads($a) {}
7009            }
7010            set nextarc [expr {$a - 1}]
7011        }
7012    } err]} {
7013        dropcache $err
7014        return 0
7015    }
7016    if {!$allcwait} {
7017        getallcommits
7018    }
7019    return $allcwait
7020}
7021
7022proc getcache {f} {
7023    global nextarc cachedarcs possible_seeds
7024
7025    if {[catch {
7026        set line [gets $f]
7027        if {[llength $line] != 2 || [lindex $line 0] ne "1"} {error "bad version"}
7028        # make sure it's an integer
7029        set cachedarcs [expr {int([lindex $line 1])}]
7030        if {$cachedarcs < 0} {error "bad number of arcs"}
7031        set nextarc 0
7032        set possible_seeds {}
7033        run readcache $f
7034    } err]} {
7035        dropcache $err
7036    }
7037    return 0
7038}
7039
7040proc dropcache {err} {
7041    global allcwait nextarc cachedarcs seeds
7042
7043    #puts "dropping cache ($err)"
7044    foreach v {arcnos arcout arcids arcstart arcend growing \
7045                   arctags archeads allparents allchildren} {
7046        global $v
7047        catch {unset $v}
7048    }
7049    set allcwait 0
7050    set nextarc 0
7051    set cachedarcs 0
7052    set seeds {}
7053    getallcommits
7054}
7055
7056proc writecache {f} {
7057    global cachearc cachedarcs allccache
7058    global arcstart arcend arcnos arcids arcout
7059
7060    set a $cachearc
7061    set lim $cachedarcs
7062    if {$lim - $a > 1000} {
7063        set lim [expr {$a + 1000}]
7064    }
7065    if {[catch {
7066        while {[incr a] <= $lim} {
7067            if {[info exists arcend($a)]} {
7068                puts $f [list $arcstart($a) $arcend($a) $arcids($a)]
7069            } else {
7070                puts $f [list $arcstart($a) {} $arcids($a)]
7071            }
7072        }
7073    } err]} {
7074        catch {close $f}
7075        catch {file delete $allccache}
7076        #puts "writing cache failed ($err)"
7077        return 0
7078    }
7079    set cachearc [expr {$a - 1}]
7080    if {$a > $cachedarcs} {
7081        puts $f "1"
7082        close $f
7083        return 0
7084    }
7085    return 1
7086}
7087
7088proc savecache {} {
7089    global nextarc cachedarcs cachearc allccache
7090
7091    if {$nextarc == $cachedarcs} return
7092    set cachearc 0
7093    set cachedarcs $nextarc
7094    catch {
7095        set f [open $allccache w]
7096        puts $f [list 1 $cachedarcs]
7097        run writecache $f
7098    }
7099}
7100
7101# Returns 1 if a is an ancestor of b, -1 if b is an ancestor of a,
7102# or 0 if neither is true.
7103proc anc_or_desc {a b} {
7104    global arcout arcstart arcend arcnos cached_isanc
7105
7106    if {$arcnos($a) eq $arcnos($b)} {
7107        # Both are on the same arc(s); either both are the same BMP,
7108        # or if one is not a BMP, the other is also not a BMP or is
7109        # the BMP at end of the arc (and it only has 1 incoming arc).
7110        # Or both can be BMPs with no incoming arcs.
7111        if {$a eq $b || $arcnos($a) eq {}} {
7112            return 0
7113        }
7114        # assert {[llength $arcnos($a)] == 1}
7115        set arc [lindex $arcnos($a) 0]
7116        set i [lsearch -exact $arcids($arc) $a]
7117        set j [lsearch -exact $arcids($arc) $b]
7118        if {$i < 0 || $i > $j} {
7119            return 1
7120        } else {
7121            return -1
7122        }
7123    }
7124
7125    if {![info exists arcout($a)]} {
7126        set arc [lindex $arcnos($a) 0]
7127        if {[info exists arcend($arc)]} {
7128            set aend $arcend($arc)
7129        } else {
7130            set aend {}
7131        }
7132        set a $arcstart($arc)
7133    } else {
7134        set aend $a
7135    }
7136    if {![info exists arcout($b)]} {
7137        set arc [lindex $arcnos($b) 0]
7138        if {[info exists arcend($arc)]} {
7139            set bend $arcend($arc)
7140        } else {
7141            set bend {}
7142        }
7143        set b $arcstart($arc)
7144    } else {
7145        set bend $b
7146    }
7147    if {$a eq $bend} {
7148        return 1
7149    }
7150    if {$b eq $aend} {
7151        return -1
7152    }
7153    if {[info exists cached_isanc($a,$bend)]} {
7154        if {$cached_isanc($a,$bend)} {
7155            return 1
7156        }
7157    }
7158    if {[info exists cached_isanc($b,$aend)]} {
7159        if {$cached_isanc($b,$aend)} {
7160            return -1
7161        }
7162        if {[info exists cached_isanc($a,$bend)]} {
7163            return 0
7164        }
7165    }
7166
7167    set todo [list $a $b]
7168    set anc($a) a
7169    set anc($b) b
7170    for {set i 0} {$i < [llength $todo]} {incr i} {
7171        set x [lindex $todo $i]
7172        if {$anc($x) eq {}} {
7173            continue
7174        }
7175        foreach arc $arcnos($x) {
7176            set xd $arcstart($arc)
7177            if {$xd eq $bend} {
7178                set cached_isanc($a,$bend) 1
7179                set cached_isanc($b,$aend) 0
7180                return 1
7181            } elseif {$xd eq $aend} {
7182                set cached_isanc($b,$aend) 1
7183                set cached_isanc($a,$bend) 0
7184                return -1
7185            }
7186            if {![info exists anc($xd)]} {
7187                set anc($xd) $anc($x)
7188                lappend todo $xd
7189            } elseif {$anc($xd) ne $anc($x)} {
7190                set anc($xd) {}
7191            }
7192        }
7193    }
7194    set cached_isanc($a,$bend) 0
7195    set cached_isanc($b,$aend) 0
7196    return 0
7197}
7198
7199# This identifies whether $desc has an ancestor that is
7200# a growing tip of the graph and which is not an ancestor of $anc
7201# and returns 0 if so and 1 if not.
7202# If we subsequently discover a tag on such a growing tip, and that
7203# turns out to be a descendent of $anc (which it could, since we
7204# don't necessarily see children before parents), then $desc
7205# isn't a good choice to display as a descendent tag of
7206# $anc (since it is the descendent of another tag which is
7207# a descendent of $anc).  Similarly, $anc isn't a good choice to
7208# display as a ancestor tag of $desc.
7209#
7210proc is_certain {desc anc} {
7211    global arcnos arcout arcstart arcend growing problems
7212
7213    set certain {}
7214    if {[llength $arcnos($anc)] == 1} {
7215        # tags on the same arc are certain
7216        if {$arcnos($desc) eq $arcnos($anc)} {
7217            return 1
7218        }
7219        if {![info exists arcout($anc)]} {
7220            # if $anc is partway along an arc, use the start of the arc instead
7221            set a [lindex $arcnos($anc) 0]
7222            set anc $arcstart($a)
7223        }
7224    }
7225    if {[llength $arcnos($desc)] > 1 || [info exists arcout($desc)]} {
7226        set x $desc
7227    } else {
7228        set a [lindex $arcnos($desc) 0]
7229        set x $arcend($a)
7230    }
7231    if {$x == $anc} {
7232        return 1
7233    }
7234    set anclist [list $x]
7235    set dl($x) 1
7236    set nnh 1
7237    set ngrowanc 0
7238    for {set i 0} {$i < [llength $anclist] && ($nnh > 0 || $ngrowanc > 0)} {incr i} {
7239        set x [lindex $anclist $i]
7240        if {$dl($x)} {
7241            incr nnh -1
7242        }
7243        set done($x) 1
7244        foreach a $arcout($x) {
7245            if {[info exists growing($a)]} {
7246                if {![info exists growanc($x)] && $dl($x)} {
7247                    set growanc($x) 1
7248                    incr ngrowanc
7249                }
7250            } else {
7251                set y $arcend($a)
7252                if {[info exists dl($y)]} {
7253                    if {$dl($y)} {
7254                        if {!$dl($x)} {
7255                            set dl($y) 0
7256                            if {![info exists done($y)]} {
7257                                incr nnh -1
7258                            }
7259                            if {[info exists growanc($x)]} {
7260                                incr ngrowanc -1
7261                            }
7262                            set xl [list $y]
7263                            for {set k 0} {$k < [llength $xl]} {incr k} {
7264                                set z [lindex $xl $k]
7265                                foreach c $arcout($z) {
7266                                    if {[info exists arcend($c)]} {
7267                                        set v $arcend($c)
7268                                        if {[info exists dl($v)] && $dl($v)} {
7269                                            set dl($v) 0
7270                                            if {![info exists done($v)]} {
7271                                                incr nnh -1
7272                                            }
7273                                            if {[info exists growanc($v)]} {
7274                                                incr ngrowanc -1
7275                                            }
7276                                            lappend xl $v
7277                                        }
7278                                    }
7279                                }
7280                            }
7281                        }
7282                    }
7283                } elseif {$y eq $anc || !$dl($x)} {
7284                    set dl($y) 0
7285                    lappend anclist $y
7286                } else {
7287                    set dl($y) 1
7288                    lappend anclist $y
7289                    incr nnh
7290                }
7291            }
7292        }
7293    }
7294    foreach x [array names growanc] {
7295        if {$dl($x)} {
7296            return 0
7297        }
7298        return 0
7299    }
7300    return 1
7301}
7302
7303proc validate_arctags {a} {
7304    global arctags idtags
7305
7306    set i -1
7307    set na $arctags($a)
7308    foreach id $arctags($a) {
7309        incr i
7310        if {![info exists idtags($id)]} {
7311            set na [lreplace $na $i $i]
7312            incr i -1
7313        }
7314    }
7315    set arctags($a) $na
7316}
7317
7318proc validate_archeads {a} {
7319    global archeads idheads
7320
7321    set i -1
7322    set na $archeads($a)
7323    foreach id $archeads($a) {
7324        incr i
7325        if {![info exists idheads($id)]} {
7326            set na [lreplace $na $i $i]
7327            incr i -1
7328        }
7329    }
7330    set archeads($a) $na
7331}
7332
7333# Return the list of IDs that have tags that are descendents of id,
7334# ignoring IDs that are descendents of IDs already reported.
7335proc desctags {id} {
7336    global arcnos arcstart arcids arctags idtags allparents
7337    global growing cached_dtags
7338
7339    if {![info exists allparents($id)]} {
7340        return {}
7341    }
7342    set t1 [clock clicks -milliseconds]
7343    set argid $id
7344    if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
7345        # part-way along an arc; check that arc first
7346        set a [lindex $arcnos($id) 0]
7347        if {$arctags($a) ne {}} {
7348            validate_arctags $a
7349            set i [lsearch -exact $arcids($a) $id]
7350            set tid {}
7351            foreach t $arctags($a) {
7352                set j [lsearch -exact $arcids($a) $t]
7353                if {$j >= $i} break
7354                set tid $t
7355            }
7356            if {$tid ne {}} {
7357                return $tid
7358            }
7359        }
7360        set id $arcstart($a)
7361        if {[info exists idtags($id)]} {
7362            return $id
7363        }
7364    }
7365    if {[info exists cached_dtags($id)]} {
7366        return $cached_dtags($id)
7367    }
7368
7369    set origid $id
7370    set todo [list $id]
7371    set queued($id) 1
7372    set nc 1
7373    for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
7374        set id [lindex $todo $i]
7375        set done($id) 1
7376        set ta [info exists hastaggedancestor($id)]
7377        if {!$ta} {
7378            incr nc -1
7379        }
7380        # ignore tags on starting node
7381        if {!$ta && $i > 0} {
7382            if {[info exists idtags($id)]} {
7383                set tagloc($id) $id
7384                set ta 1
7385            } elseif {[info exists cached_dtags($id)]} {
7386                set tagloc($id) $cached_dtags($id)
7387                set ta 1
7388            }
7389        }
7390        foreach a $arcnos($id) {
7391            set d $arcstart($a)
7392            if {!$ta && $arctags($a) ne {}} {
7393                validate_arctags $a
7394                if {$arctags($a) ne {}} {
7395                    lappend tagloc($id) [lindex $arctags($a) end]
7396                }
7397            }
7398            if {$ta || $arctags($a) ne {}} {
7399                set tomark [list $d]
7400                for {set j 0} {$j < [llength $tomark]} {incr j} {
7401                    set dd [lindex $tomark $j]
7402                    if {![info exists hastaggedancestor($dd)]} {
7403                        if {[info exists done($dd)]} {
7404                            foreach b $arcnos($dd) {
7405                                lappend tomark $arcstart($b)
7406                            }
7407                            if {[info exists tagloc($dd)]} {
7408                                unset tagloc($dd)
7409                            }
7410                        } elseif {[info exists queued($dd)]} {
7411                            incr nc -1
7412                        }
7413                        set hastaggedancestor($dd) 1
7414                    }
7415                }
7416            }
7417            if {![info exists queued($d)]} {
7418                lappend todo $d
7419                set queued($d) 1
7420                if {![info exists hastaggedancestor($d)]} {
7421                    incr nc
7422                }
7423            }
7424        }
7425    }
7426    set tags {}
7427    foreach id [array names tagloc] {
7428        if {![info exists hastaggedancestor($id)]} {
7429            foreach t $tagloc($id) {
7430                if {[lsearch -exact $tags $t] < 0} {
7431                    lappend tags $t
7432                }
7433            }
7434        }
7435    }
7436    set t2 [clock clicks -milliseconds]
7437    set loopix $i
7438
7439    # remove tags that are descendents of other tags
7440    for {set i 0} {$i < [llength $tags]} {incr i} {
7441        set a [lindex $tags $i]
7442        for {set j 0} {$j < $i} {incr j} {
7443            set b [lindex $tags $j]
7444            set r [anc_or_desc $a $b]
7445            if {$r == 1} {
7446                set tags [lreplace $tags $j $j]
7447                incr j -1
7448                incr i -1
7449            } elseif {$r == -1} {
7450                set tags [lreplace $tags $i $i]
7451                incr i -1
7452                break
7453            }
7454        }
7455    }
7456
7457    if {[array names growing] ne {}} {
7458        # graph isn't finished, need to check if any tag could get
7459        # eclipsed by another tag coming later.  Simply ignore any
7460        # tags that could later get eclipsed.
7461        set ctags {}
7462        foreach t $tags {
7463            if {[is_certain $t $origid]} {
7464                lappend ctags $t
7465            }
7466        }
7467        if {$tags eq $ctags} {
7468            set cached_dtags($origid) $tags
7469        } else {
7470            set tags $ctags
7471        }
7472    } else {
7473        set cached_dtags($origid) $tags
7474    }
7475    set t3 [clock clicks -milliseconds]
7476    if {0 && $t3 - $t1 >= 100} {
7477        puts "iterating descendents ($loopix/[llength $todo] nodes) took\
7478            [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
7479    }
7480    return $tags
7481}
7482
7483proc anctags {id} {
7484    global arcnos arcids arcout arcend arctags idtags allparents
7485    global growing cached_atags
7486
7487    if {![info exists allparents($id)]} {
7488        return {}
7489    }
7490    set t1 [clock clicks -milliseconds]
7491    set argid $id
7492    if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
7493        # part-way along an arc; check that arc first
7494        set a [lindex $arcnos($id) 0]
7495        if {$arctags($a) ne {}} {
7496            validate_arctags $a
7497            set i [lsearch -exact $arcids($a) $id]
7498            foreach t $arctags($a) {
7499                set j [lsearch -exact $arcids($a) $t]
7500                if {$j > $i} {
7501                    return $t
7502                }
7503            }
7504        }
7505        if {![info exists arcend($a)]} {
7506            return {}
7507        }
7508        set id $arcend($a)
7509        if {[info exists idtags($id)]} {
7510            return $id
7511        }
7512    }
7513    if {[info exists cached_atags($id)]} {
7514        return $cached_atags($id)
7515    }
7516
7517    set origid $id
7518    set todo [list $id]
7519    set queued($id) 1
7520    set taglist {}
7521    set nc 1
7522    for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
7523        set id [lindex $todo $i]
7524        set done($id) 1
7525        set td [info exists hastaggeddescendent($id)]
7526        if {!$td} {
7527            incr nc -1
7528        }
7529        # ignore tags on starting node
7530        if {!$td && $i > 0} {
7531            if {[info exists idtags($id)]} {
7532                set tagloc($id) $id
7533                set td 1
7534            } elseif {[info exists cached_atags($id)]} {
7535                set tagloc($id) $cached_atags($id)
7536                set td 1
7537            }
7538        }
7539        foreach a $arcout($id) {
7540            if {!$td && $arctags($a) ne {}} {
7541                validate_arctags $a
7542                if {$arctags($a) ne {}} {
7543                    lappend tagloc($id) [lindex $arctags($a) 0]
7544                }
7545            }
7546            if {![info exists arcend($a)]} continue
7547            set d $arcend($a)
7548            if {$td || $arctags($a) ne {}} {
7549                set tomark [list $d]
7550                for {set j 0} {$j < [llength $tomark]} {incr j} {
7551                    set dd [lindex $tomark $j]
7552                    if {![info exists hastaggeddescendent($dd)]} {
7553                        if {[info exists done($dd)]} {
7554                            foreach b $arcout($dd) {
7555                                if {[info exists arcend($b)]} {
7556                                    lappend tomark $arcend($b)
7557                                }
7558                            }
7559                            if {[info exists tagloc($dd)]} {
7560                                unset tagloc($dd)
7561                            }
7562                        } elseif {[info exists queued($dd)]} {
7563                            incr nc -1
7564                        }
7565                        set hastaggeddescendent($dd) 1
7566                    }
7567                }
7568            }
7569            if {![info exists queued($d)]} {
7570                lappend todo $d
7571                set queued($d) 1
7572                if {![info exists hastaggeddescendent($d)]} {
7573                    incr nc
7574                }
7575            }
7576        }
7577    }
7578    set t2 [clock clicks -milliseconds]
7579    set loopix $i
7580    set tags {}
7581    foreach id [array names tagloc] {
7582        if {![info exists hastaggeddescendent($id)]} {
7583            foreach t $tagloc($id) {
7584                if {[lsearch -exact $tags $t] < 0} {
7585                    lappend tags $t
7586                }
7587            }
7588        }
7589    }
7590
7591    # remove tags that are ancestors of other tags
7592    for {set i 0} {$i < [llength $tags]} {incr i} {
7593        set a [lindex $tags $i]
7594        for {set j 0} {$j < $i} {incr j} {
7595            set b [lindex $tags $j]
7596            set r [anc_or_desc $a $b]
7597            if {$r == -1} {
7598                set tags [lreplace $tags $j $j]
7599                incr j -1
7600                incr i -1
7601            } elseif {$r == 1} {
7602                set tags [lreplace $tags $i $i]
7603                incr i -1
7604                break
7605            }
7606        }
7607    }
7608
7609    if {[array names growing] ne {}} {
7610        # graph isn't finished, need to check if any tag could get
7611        # eclipsed by another tag coming later.  Simply ignore any
7612        # tags that could later get eclipsed.
7613        set ctags {}
7614        foreach t $tags {
7615            if {[is_certain $origid $t]} {
7616                lappend ctags $t
7617            }
7618        }
7619        if {$tags eq $ctags} {
7620            set cached_atags($origid) $tags
7621        } else {
7622            set tags $ctags
7623        }
7624    } else {
7625        set cached_atags($origid) $tags
7626    }
7627    set t3 [clock clicks -milliseconds]
7628    if {0 && $t3 - $t1 >= 100} {
7629        puts "iterating ancestors ($loopix/[llength $todo] nodes) took\
7630            [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
7631    }
7632    return $tags
7633}
7634
7635# Return the list of IDs that have heads that are descendents of id,
7636# including id itself if it has a head.
7637proc descheads {id} {
7638    global arcnos arcstart arcids archeads idheads cached_dheads
7639    global allparents
7640
7641    if {![info exists allparents($id)]} {
7642        return {}
7643    }
7644    set aret {}
7645    if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
7646        # part-way along an arc; check it first
7647        set a [lindex $arcnos($id) 0]
7648        if {$archeads($a) ne {}} {
7649            validate_archeads $a
7650            set i [lsearch -exact $arcids($a) $id]
7651            foreach t $archeads($a) {
7652                set j [lsearch -exact $arcids($a) $t]
7653                if {$j > $i} break
7654                lappend aret $t
7655            }
7656        }
7657        set id $arcstart($a)
7658    }
7659    set origid $id
7660    set todo [list $id]
7661    set seen($id) 1
7662    set ret {}
7663    for {set i 0} {$i < [llength $todo]} {incr i} {
7664        set id [lindex $todo $i]
7665        if {[info exists cached_dheads($id)]} {
7666            set ret [concat $ret $cached_dheads($id)]
7667        } else {
7668            if {[info exists idheads($id)]} {
7669                lappend ret $id
7670            }
7671            foreach a $arcnos($id) {
7672                if {$archeads($a) ne {}} {
7673                    validate_archeads $a
7674                    if {$archeads($a) ne {}} {
7675                        set ret [concat $ret $archeads($a)]
7676                    }
7677                }
7678                set d $arcstart($a)
7679                if {![info exists seen($d)]} {
7680                    lappend todo $d
7681                    set seen($d) 1
7682                }
7683            }
7684        }
7685    }
7686    set ret [lsort -unique $ret]
7687    set cached_dheads($origid) $ret
7688    return [concat $ret $aret]
7689}
7690
7691proc addedtag {id} {
7692    global arcnos arcout cached_dtags cached_atags
7693
7694    if {![info exists arcnos($id)]} return
7695    if {![info exists arcout($id)]} {
7696        recalcarc [lindex $arcnos($id) 0]
7697    }
7698    catch {unset cached_dtags}
7699    catch {unset cached_atags}
7700}
7701
7702proc addedhead {hid head} {
7703    global arcnos arcout cached_dheads
7704
7705    if {![info exists arcnos($hid)]} return
7706    if {![info exists arcout($hid)]} {
7707        recalcarc [lindex $arcnos($hid) 0]
7708    }
7709    catch {unset cached_dheads}
7710}
7711
7712proc removedhead {hid head} {
7713    global cached_dheads
7714
7715    catch {unset cached_dheads}
7716}
7717
7718proc movedhead {hid head} {
7719    global arcnos arcout cached_dheads
7720
7721    if {![info exists arcnos($hid)]} return
7722    if {![info exists arcout($hid)]} {
7723        recalcarc [lindex $arcnos($hid) 0]
7724    }
7725    catch {unset cached_dheads}
7726}
7727
7728proc changedrefs {} {
7729    global cached_dheads cached_dtags cached_atags
7730    global arctags archeads arcnos arcout idheads idtags
7731
7732    foreach id [concat [array names idheads] [array names idtags]] {
7733        if {[info exists arcnos($id)] && ![info exists arcout($id)]} {
7734            set a [lindex $arcnos($id) 0]
7735            if {![info exists donearc($a)]} {
7736                recalcarc $a
7737                set donearc($a) 1
7738            }
7739        }
7740    }
7741    catch {unset cached_dtags}
7742    catch {unset cached_atags}
7743    catch {unset cached_dheads}
7744}
7745
7746proc rereadrefs {} {
7747    global idtags idheads idotherrefs mainhead
7748
7749    set refids [concat [array names idtags] \
7750                    [array names idheads] [array names idotherrefs]]
7751    foreach id $refids {
7752        if {![info exists ref($id)]} {
7753            set ref($id) [listrefs $id]
7754        }
7755    }
7756    set oldmainhead $mainhead
7757    readrefs
7758    changedrefs
7759    set refids [lsort -unique [concat $refids [array names idtags] \
7760                        [array names idheads] [array names idotherrefs]]]
7761    foreach id $refids {
7762        set v [listrefs $id]
7763        if {![info exists ref($id)] || $ref($id) != $v ||
7764            ($id eq $oldmainhead && $id ne $mainhead) ||
7765            ($id eq $mainhead && $id ne $oldmainhead)} {
7766            redrawtags $id
7767        }
7768    }
7769    run refill_reflist
7770}
7771
7772proc listrefs {id} {
7773    global idtags idheads idotherrefs
7774
7775    set x {}
7776    if {[info exists idtags($id)]} {
7777        set x $idtags($id)
7778    }
7779    set y {}
7780    if {[info exists idheads($id)]} {
7781        set y $idheads($id)
7782    }
7783    set z {}
7784    if {[info exists idotherrefs($id)]} {
7785        set z $idotherrefs($id)
7786    }
7787    return [list $x $y $z]
7788}
7789
7790proc showtag {tag isnew} {
7791    global ctext tagcontents tagids linknum tagobjid
7792
7793    if {$isnew} {
7794        addtohistory [list showtag $tag 0]
7795    }
7796    $ctext conf -state normal
7797    clear_ctext
7798    settabs 0
7799    set linknum 0
7800    if {![info exists tagcontents($tag)]} {
7801        catch {
7802            set tagcontents($tag) [exec git cat-file tag $tagobjid($tag)]
7803        }
7804    }
7805    if {[info exists tagcontents($tag)]} {
7806        set text $tagcontents($tag)
7807    } else {
7808        set text "[mc "Tag"]: $tag\n[mc "Id"]:  $tagids($tag)"
7809    }
7810    appendwithlinks $text {}
7811    $ctext conf -state disabled
7812    init_flist {}
7813}
7814
7815proc doquit {} {
7816    global stopped
7817    set stopped 100
7818    savestuff .
7819    destroy .
7820}
7821
7822proc mkfontdisp {font top which} {
7823    global fontattr fontpref $font
7824
7825    set fontpref($font) [set $font]
7826    button $top.${font}but -text $which -font optionfont \
7827        -command [list choosefont $font $which]
7828    label $top.$font -relief flat -font $font \
7829        -text $fontattr($font,family) -justify left
7830    grid x $top.${font}but $top.$font -sticky w
7831}
7832
7833proc choosefont {font which} {
7834    global fontparam fontlist fonttop fontattr
7835
7836    set fontparam(which) $which
7837    set fontparam(font) $font
7838    set fontparam(family) [font actual $font -family]
7839    set fontparam(size) $fontattr($font,size)
7840    set fontparam(weight) $fontattr($font,weight)
7841    set fontparam(slant) $fontattr($font,slant)
7842    set top .gitkfont
7843    set fonttop $top
7844    if {![winfo exists $top]} {
7845        font create sample
7846        eval font config sample [font actual $font]
7847        toplevel $top
7848        wm title $top [mc "Gitk font chooser"]
7849        label $top.l -textvariable fontparam(which)
7850        pack $top.l -side top
7851        set fontlist [lsort [font families]]
7852        frame $top.f
7853        listbox $top.f.fam -listvariable fontlist \
7854            -yscrollcommand [list $top.f.sb set]
7855        bind $top.f.fam <<ListboxSelect>> selfontfam
7856        scrollbar $top.f.sb -command [list $top.f.fam yview]
7857        pack $top.f.sb -side right -fill y
7858        pack $top.f.fam -side left -fill both -expand 1
7859        pack $top.f -side top -fill both -expand 1
7860        frame $top.g
7861        spinbox $top.g.size -from 4 -to 40 -width 4 \
7862            -textvariable fontparam(size) \
7863            -validatecommand {string is integer -strict %s}
7864        checkbutton $top.g.bold -padx 5 \
7865            -font {{Times New Roman} 12 bold} -text [mc "B"] -indicatoron 0 \
7866            -variable fontparam(weight) -onvalue bold -offvalue normal
7867        checkbutton $top.g.ital -padx 5 \
7868            -font {{Times New Roman} 12 italic} -text [mc "I"] -indicatoron 0  \
7869            -variable fontparam(slant) -onvalue italic -offvalue roman
7870        pack $top.g.size $top.g.bold $top.g.ital -side left
7871        pack $top.g -side top
7872        canvas $top.c -width 150 -height 50 -border 2 -relief sunk \
7873            -background white
7874        $top.c create text 100 25 -anchor center -text $which -font sample \
7875            -fill black -tags text
7876        bind $top.c <Configure> [list centertext $top.c]
7877        pack $top.c -side top -fill x
7878        frame $top.buts
7879        button $top.buts.ok -text [mc "OK"] -command fontok -default active
7880        button $top.buts.can -text [mc "Cancel"] -command fontcan -default normal
7881        grid $top.buts.ok $top.buts.can
7882        grid columnconfigure $top.buts 0 -weight 1 -uniform a
7883        grid columnconfigure $top.buts 1 -weight 1 -uniform a
7884        pack $top.buts -side bottom -fill x
7885        trace add variable fontparam write chg_fontparam
7886    } else {
7887        raise $top
7888        $top.c itemconf text -text $which
7889    }
7890    set i [lsearch -exact $fontlist $fontparam(family)]
7891    if {$i >= 0} {
7892        $top.f.fam selection set $i
7893        $top.f.fam see $i
7894    }
7895}
7896
7897proc centertext {w} {
7898    $w coords text [expr {[winfo width $w] / 2}] [expr {[winfo height $w] / 2}]
7899}
7900
7901proc fontok {} {
7902    global fontparam fontpref prefstop
7903
7904    set f $fontparam(font)
7905    set fontpref($f) [list $fontparam(family) $fontparam(size)]
7906    if {$fontparam(weight) eq "bold"} {
7907        lappend fontpref($f) "bold"
7908    }
7909    if {$fontparam(slant) eq "italic"} {
7910        lappend fontpref($f) "italic"
7911    }
7912    set w $prefstop.$f
7913    $w conf -text $fontparam(family) -font $fontpref($f)
7914        
7915    fontcan
7916}
7917
7918proc fontcan {} {
7919    global fonttop fontparam
7920
7921    if {[info exists fonttop]} {
7922        catch {destroy $fonttop}
7923        catch {font delete sample}
7924        unset fonttop
7925        unset fontparam
7926    }
7927}
7928
7929proc selfontfam {} {
7930    global fonttop fontparam
7931
7932    set i [$fonttop.f.fam curselection]
7933    if {$i ne {}} {
7934        set fontparam(family) [$fonttop.f.fam get $i]
7935    }
7936}
7937
7938proc chg_fontparam {v sub op} {
7939    global fontparam
7940
7941    font config sample -$sub $fontparam($sub)
7942}
7943
7944proc doprefs {} {
7945    global maxwidth maxgraphpct
7946    global oldprefs prefstop showneartags showlocalchanges
7947    global bgcolor fgcolor ctext diffcolors selectbgcolor
7948    global tabstop limitdiffs
7949
7950    set top .gitkprefs
7951    set prefstop $top
7952    if {[winfo exists $top]} {
7953        raise $top
7954        return
7955    }
7956    foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
7957                   limitdiffs tabstop} {
7958        set oldprefs($v) [set $v]
7959    }
7960    toplevel $top
7961    wm title $top [mc "Gitk preferences"]
7962    label $top.ldisp -text [mc "Commit list display options"]
7963    grid $top.ldisp - -sticky w -pady 10
7964    label $top.spacer -text " "
7965    label $top.maxwidthl -text [mc "Maximum graph width (lines)"] \
7966        -font optionfont
7967    spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
7968    grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
7969    label $top.maxpctl -text [mc "Maximum graph width (% of pane)"] \
7970        -font optionfont
7971    spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
7972    grid x $top.maxpctl $top.maxpct -sticky w
7973    frame $top.showlocal
7974    label $top.showlocal.l -text [mc "Show local changes"] -font optionfont
7975    checkbutton $top.showlocal.b -variable showlocalchanges
7976    pack $top.showlocal.b $top.showlocal.l -side left
7977    grid x $top.showlocal -sticky w
7978
7979    label $top.ddisp -text [mc "Diff display options"]
7980    grid $top.ddisp - -sticky w -pady 10
7981    label $top.tabstopl -text [mc "Tab spacing"] -font optionfont
7982    spinbox $top.tabstop -from 1 -to 20 -width 4 -textvariable tabstop
7983    grid x $top.tabstopl $top.tabstop -sticky w
7984    frame $top.ntag
7985    label $top.ntag.l -text [mc "Display nearby tags"] -font optionfont
7986    checkbutton $top.ntag.b -variable showneartags
7987    pack $top.ntag.b $top.ntag.l -side left
7988    grid x $top.ntag -sticky w
7989    frame $top.ldiff
7990    label $top.ldiff.l -text [mc "Limit diffs to listed paths"] -font optionfont
7991    checkbutton $top.ldiff.b -variable limitdiffs
7992    pack $top.ldiff.b $top.ldiff.l -side left
7993    grid x $top.ldiff -sticky w
7994
7995    label $top.cdisp -text [mc "Colors: press to choose"]
7996    grid $top.cdisp - -sticky w -pady 10
7997    label $top.bg -padx 40 -relief sunk -background $bgcolor
7998    button $top.bgbut -text [mc "Background"] -font optionfont \
7999        -command [list choosecolor bgcolor 0 $top.bg background setbg]
8000    grid x $top.bgbut $top.bg -sticky w
8001    label $top.fg -padx 40 -relief sunk -background $fgcolor
8002    button $top.fgbut -text [mc "Foreground"] -font optionfont \
8003        -command [list choosecolor fgcolor 0 $top.fg foreground setfg]
8004    grid x $top.fgbut $top.fg -sticky w
8005    label $top.diffold -padx 40 -relief sunk -background [lindex $diffcolors 0]
8006    button $top.diffoldbut -text [mc "Diff: old lines"] -font optionfont \
8007        -command [list choosecolor diffcolors 0 $top.diffold "diff old lines" \
8008                      [list $ctext tag conf d0 -foreground]]
8009    grid x $top.diffoldbut $top.diffold -sticky w
8010    label $top.diffnew -padx 40 -relief sunk -background [lindex $diffcolors 1]
8011    button $top.diffnewbut -text [mc "Diff: new lines"] -font optionfont \
8012        -command [list choosecolor diffcolors 1 $top.diffnew "diff new lines" \
8013                      [list $ctext tag conf d1 -foreground]]
8014    grid x $top.diffnewbut $top.diffnew -sticky w
8015    label $top.hunksep -padx 40 -relief sunk -background [lindex $diffcolors 2]
8016    button $top.hunksepbut -text [mc "Diff: hunk header"] -font optionfont \
8017        -command [list choosecolor diffcolors 2 $top.hunksep \
8018                      "diff hunk header" \
8019                      [list $ctext tag conf hunksep -foreground]]
8020    grid x $top.hunksepbut $top.hunksep -sticky w
8021    label $top.selbgsep -padx 40 -relief sunk -background $selectbgcolor
8022    button $top.selbgbut -text [mc "Select bg"] -font optionfont \
8023        -command [list choosecolor selectbgcolor 0 $top.selbgsep background setselbg]
8024    grid x $top.selbgbut $top.selbgsep -sticky w
8025
8026    label $top.cfont -text [mc "Fonts: press to choose"]
8027    grid $top.cfont - -sticky w -pady 10
8028    mkfontdisp mainfont $top [mc "Main font"]
8029    mkfontdisp textfont $top [mc "Diff display font"]
8030    mkfontdisp uifont $top [mc "User interface font"]
8031
8032    frame $top.buts
8033    button $top.buts.ok -text [mc "OK"] -command prefsok -default active
8034    button $top.buts.can -text [mc "Cancel"] -command prefscan -default normal
8035    grid $top.buts.ok $top.buts.can
8036    grid columnconfigure $top.buts 0 -weight 1 -uniform a
8037    grid columnconfigure $top.buts 1 -weight 1 -uniform a
8038    grid $top.buts - - -pady 10 -sticky ew
8039    bind $top <Visibility> "focus $top.buts.ok"
8040}
8041
8042proc choosecolor {v vi w x cmd} {
8043    global $v
8044
8045    set c [tk_chooseColor -initialcolor [lindex [set $v] $vi] \
8046               -title [mc "Gitk: choose color for %s" $x]]
8047    if {$c eq {}} return
8048    $w conf -background $c
8049    lset $v $vi $c
8050    eval $cmd $c
8051}
8052
8053proc setselbg {c} {
8054    global bglist cflist
8055    foreach w $bglist {
8056        $w configure -selectbackground $c
8057    }
8058    $cflist tag configure highlight \
8059        -background [$cflist cget -selectbackground]
8060    allcanvs itemconf secsel -fill $c
8061}
8062
8063proc setbg {c} {
8064    global bglist
8065
8066    foreach w $bglist {
8067        $w conf -background $c
8068    }
8069}
8070
8071proc setfg {c} {
8072    global fglist canv
8073
8074    foreach w $fglist {
8075        $w conf -foreground $c
8076    }
8077    allcanvs itemconf text -fill $c
8078    $canv itemconf circle -outline $c
8079}
8080
8081proc prefscan {} {
8082    global oldprefs prefstop
8083
8084    foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
8085                   limitdiffs tabstop} {
8086        global $v
8087        set $v $oldprefs($v)
8088    }
8089    catch {destroy $prefstop}
8090    unset prefstop
8091    fontcan
8092}
8093
8094proc prefsok {} {
8095    global maxwidth maxgraphpct
8096    global oldprefs prefstop showneartags showlocalchanges
8097    global fontpref mainfont textfont uifont
8098    global limitdiffs treediffs
8099
8100    catch {destroy $prefstop}
8101    unset prefstop
8102    fontcan
8103    set fontchanged 0
8104    if {$mainfont ne $fontpref(mainfont)} {
8105        set mainfont $fontpref(mainfont)
8106        parsefont mainfont $mainfont
8107        eval font configure mainfont [fontflags mainfont]
8108        eval font configure mainfontbold [fontflags mainfont 1]
8109        setcoords
8110        set fontchanged 1
8111    }
8112    if {$textfont ne $fontpref(textfont)} {
8113        set textfont $fontpref(textfont)
8114        parsefont textfont $textfont
8115        eval font configure textfont [fontflags textfont]
8116        eval font configure textfontbold [fontflags textfont 1]
8117    }
8118    if {$uifont ne $fontpref(uifont)} {
8119        set uifont $fontpref(uifont)
8120        parsefont uifont $uifont
8121        eval font configure uifont [fontflags uifont]
8122    }
8123    settabs
8124    if {$showlocalchanges != $oldprefs(showlocalchanges)} {
8125        if {$showlocalchanges} {
8126            doshowlocalchanges
8127        } else {
8128            dohidelocalchanges
8129        }
8130    }
8131    if {$limitdiffs != $oldprefs(limitdiffs)} {
8132        # treediffs elements are limited by path
8133        catch {unset treediffs}
8134    }
8135    if {$fontchanged || $maxwidth != $oldprefs(maxwidth)
8136        || $maxgraphpct != $oldprefs(maxgraphpct)} {
8137        redisplay
8138    } elseif {$showneartags != $oldprefs(showneartags) ||
8139          $limitdiffs != $oldprefs(limitdiffs)} {
8140        reselectline
8141    }
8142}
8143
8144proc formatdate {d} {
8145    global datetimeformat
8146    if {$d ne {}} {
8147        set d [clock format $d -format $datetimeformat]
8148    }
8149    return $d
8150}
8151
8152# This list of encoding names and aliases is distilled from
8153# http://www.iana.org/assignments/character-sets.
8154# Not all of them are supported by Tcl.
8155set encoding_aliases {
8156    { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
8157      ISO646-US US-ASCII us IBM367 cp367 csASCII }
8158    { ISO-10646-UTF-1 csISO10646UTF1 }
8159    { ISO_646.basic:1983 ref csISO646basic1983 }
8160    { INVARIANT csINVARIANT }
8161    { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
8162    { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
8163    { NATS-SEFI iso-ir-8-1 csNATSSEFI }
8164    { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
8165    { NATS-DANO iso-ir-9-1 csNATSDANO }
8166    { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
8167    { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
8168    { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
8169    { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
8170    { ISO-2022-KR csISO2022KR }
8171    { EUC-KR csEUCKR }
8172    { ISO-2022-JP csISO2022JP }
8173    { ISO-2022-JP-2 csISO2022JP2 }
8174    { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
8175      csISO13JISC6220jp }
8176    { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
8177    { IT iso-ir-15 ISO646-IT csISO15Italian }
8178    { PT iso-ir-16 ISO646-PT csISO16Portuguese }
8179    { ES iso-ir-17 ISO646-ES csISO17Spanish }
8180    { greek7-old iso-ir-18 csISO18Greek7Old }
8181    { latin-greek iso-ir-19 csISO19LatinGreek }
8182    { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
8183    { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
8184    { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
8185    { ISO_5427 iso-ir-37 csISO5427Cyrillic }
8186    { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
8187    { BS_viewdata iso-ir-47 csISO47BSViewdata }
8188    { INIS iso-ir-49 csISO49INIS }
8189    { INIS-8 iso-ir-50 csISO50INIS8 }
8190    { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
8191    { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
8192    { ISO_5428:1980 iso-ir-55 csISO5428Greek }
8193    { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
8194    { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
8195    { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
8196      csISO60Norwegian1 }
8197    { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
8198    { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
8199    { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
8200    { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
8201    { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
8202    { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
8203    { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
8204    { greek7 iso-ir-88 csISO88Greek7 }
8205    { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
8206    { iso-ir-90 csISO90 }
8207    { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
8208    { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
8209      csISO92JISC62991984b }
8210    { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
8211    { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
8212    { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
8213      csISO95JIS62291984handadd }
8214    { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
8215    { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
8216    { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
8217    { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
8218      CP819 csISOLatin1 }
8219    { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
8220    { T.61-7bit iso-ir-102 csISO102T617bit }
8221    { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
8222    { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
8223    { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
8224    { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
8225    { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
8226    { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
8227    { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
8228    { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
8229      arabic csISOLatinArabic }
8230    { ISO_8859-6-E csISO88596E ISO-8859-6-E }
8231    { ISO_8859-6-I csISO88596I ISO-8859-6-I }
8232    { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
8233      greek greek8 csISOLatinGreek }
8234    { T.101-G2 iso-ir-128 csISO128T101G2 }
8235    { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
8236      csISOLatinHebrew }
8237    { ISO_8859-8-E csISO88598E ISO-8859-8-E }
8238    { ISO_8859-8-I csISO88598I ISO-8859-8-I }
8239    { CSN_369103 iso-ir-139 csISO139CSN369103 }
8240    { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
8241    { ISO_6937-2-add iso-ir-142 csISOTextComm }
8242    { IEC_P27-1 iso-ir-143 csISO143IECP271 }
8243    { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
8244      csISOLatinCyrillic }
8245    { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
8246    { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
8247    { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
8248    { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
8249    { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
8250    { ISO_6937-2-25 iso-ir-152 csISO6937Add }
8251    { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
8252    { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
8253    { ISO_10367-box iso-ir-155 csISO10367Box }
8254    { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
8255    { latin-lap lap iso-ir-158 csISO158Lap }
8256    { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
8257    { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
8258    { us-dk csUSDK }
8259    { dk-us csDKUS }
8260    { JIS_X0201 X0201 csHalfWidthKatakana }
8261    { KSC5636 ISO646-KR csKSC5636 }
8262    { ISO-10646-UCS-2 csUnicode }
8263    { ISO-10646-UCS-4 csUCS4 }
8264    { DEC-MCS dec csDECMCS }
8265    { hp-roman8 roman8 r8 csHPRoman8 }
8266    { macintosh mac csMacintosh }
8267    { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
8268      csIBM037 }
8269    { IBM038 EBCDIC-INT cp038 csIBM038 }
8270    { IBM273 CP273 csIBM273 }
8271    { IBM274 EBCDIC-BE CP274 csIBM274 }
8272    { IBM275 EBCDIC-BR cp275 csIBM275 }
8273    { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
8274    { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
8275    { IBM280 CP280 ebcdic-cp-it csIBM280 }
8276    { IBM281 EBCDIC-JP-E cp281 csIBM281 }
8277    { IBM284 CP284 ebcdic-cp-es csIBM284 }
8278    { IBM285 CP285 ebcdic-cp-gb csIBM285 }
8279    { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
8280    { IBM297 cp297 ebcdic-cp-fr csIBM297 }
8281    { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
8282    { IBM423 cp423 ebcdic-cp-gr csIBM423 }
8283    { IBM424 cp424 ebcdic-cp-he csIBM424 }
8284    { IBM437 cp437 437 csPC8CodePage437 }
8285    { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
8286    { IBM775 cp775 csPC775Baltic }
8287    { IBM850 cp850 850 csPC850Multilingual }
8288    { IBM851 cp851 851 csIBM851 }
8289    { IBM852 cp852 852 csPCp852 }
8290    { IBM855 cp855 855 csIBM855 }
8291    { IBM857 cp857 857 csIBM857 }
8292    { IBM860 cp860 860 csIBM860 }
8293    { IBM861 cp861 861 cp-is csIBM861 }
8294    { IBM862 cp862 862 csPC862LatinHebrew }
8295    { IBM863 cp863 863 csIBM863 }
8296    { IBM864 cp864 csIBM864 }
8297    { IBM865 cp865 865 csIBM865 }
8298    { IBM866 cp866 866 csIBM866 }
8299    { IBM868 CP868 cp-ar csIBM868 }
8300    { IBM869 cp869 869 cp-gr csIBM869 }
8301    { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
8302    { IBM871 CP871 ebcdic-cp-is csIBM871 }
8303    { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
8304    { IBM891 cp891 csIBM891 }
8305    { IBM903 cp903 csIBM903 }
8306    { IBM904 cp904 904 csIBBM904 }
8307    { IBM905 CP905 ebcdic-cp-tr csIBM905 }
8308    { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
8309    { IBM1026 CP1026 csIBM1026 }
8310    { EBCDIC-AT-DE csIBMEBCDICATDE }
8311    { EBCDIC-AT-DE-A csEBCDICATDEA }
8312    { EBCDIC-CA-FR csEBCDICCAFR }
8313    { EBCDIC-DK-NO csEBCDICDKNO }
8314    { EBCDIC-DK-NO-A csEBCDICDKNOA }
8315    { EBCDIC-FI-SE csEBCDICFISE }
8316    { EBCDIC-FI-SE-A csEBCDICFISEA }
8317    { EBCDIC-FR csEBCDICFR }
8318    { EBCDIC-IT csEBCDICIT }
8319    { EBCDIC-PT csEBCDICPT }
8320    { EBCDIC-ES csEBCDICES }
8321    { EBCDIC-ES-A csEBCDICESA }
8322    { EBCDIC-ES-S csEBCDICESS }
8323    { EBCDIC-UK csEBCDICUK }
8324    { EBCDIC-US csEBCDICUS }
8325    { UNKNOWN-8BIT csUnknown8BiT }
8326    { MNEMONIC csMnemonic }
8327    { MNEM csMnem }
8328    { VISCII csVISCII }
8329    { VIQR csVIQR }
8330    { KOI8-R csKOI8R }
8331    { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
8332    { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
8333    { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
8334    { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
8335    { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
8336    { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
8337    { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
8338    { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
8339    { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
8340    { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
8341    { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
8342    { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
8343    { IBM1047 IBM-1047 }
8344    { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
8345    { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
8346    { UNICODE-1-1 csUnicode11 }
8347    { CESU-8 csCESU-8 }
8348    { BOCU-1 csBOCU-1 }
8349    { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
8350    { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
8351      l8 }
8352    { ISO-8859-15 ISO_8859-15 Latin-9 }
8353    { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
8354    { GBK CP936 MS936 windows-936 }
8355    { JIS_Encoding csJISEncoding }
8356    { Shift_JIS MS_Kanji csShiftJIS }
8357    { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
8358      EUC-JP }
8359    { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
8360    { ISO-10646-UCS-Basic csUnicodeASCII }
8361    { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
8362    { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
8363    { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
8364    { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
8365    { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
8366    { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
8367    { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
8368    { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
8369    { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
8370    { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
8371    { Adobe-Standard-Encoding csAdobeStandardEncoding }
8372    { Ventura-US csVenturaUS }
8373    { Ventura-International csVenturaInternational }
8374    { PC8-Danish-Norwegian csPC8DanishNorwegian }
8375    { PC8-Turkish csPC8Turkish }
8376    { IBM-Symbols csIBMSymbols }
8377    { IBM-Thai csIBMThai }
8378    { HP-Legal csHPLegal }
8379    { HP-Pi-font csHPPiFont }
8380    { HP-Math8 csHPMath8 }
8381    { Adobe-Symbol-Encoding csHPPSMath }
8382    { HP-DeskTop csHPDesktop }
8383    { Ventura-Math csVenturaMath }
8384    { Microsoft-Publishing csMicrosoftPublishing }
8385    { Windows-31J csWindows31J }
8386    { GB2312 csGB2312 }
8387    { Big5 csBig5 }
8388}
8389
8390proc tcl_encoding {enc} {
8391    global encoding_aliases
8392    set names [encoding names]
8393    set lcnames [string tolower $names]
8394    set enc [string tolower $enc]
8395    set i [lsearch -exact $lcnames $enc]
8396    if {$i < 0} {
8397        # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
8398        if {[regsub {^iso[-_]} $enc iso encx]} {
8399            set i [lsearch -exact $lcnames $encx]
8400        }
8401    }
8402    if {$i < 0} {
8403        foreach l $encoding_aliases {
8404            set ll [string tolower $l]
8405            if {[lsearch -exact $ll $enc] < 0} continue
8406            # look through the aliases for one that tcl knows about
8407            foreach e $ll {
8408                set i [lsearch -exact $lcnames $e]
8409                if {$i < 0} {
8410                    if {[regsub {^iso[-_]} $e iso ex]} {
8411                        set i [lsearch -exact $lcnames $ex]
8412                    }
8413                }
8414                if {$i >= 0} break
8415            }
8416            break
8417        }
8418    }
8419    if {$i >= 0} {
8420        return [lindex $names $i]
8421    }
8422    return {}
8423}
8424
8425# First check that Tcl/Tk is recent enough
8426if {[catch {package require Tk 8.4} err]} {
8427    show_error {} . [mc "Sorry, gitk cannot run with this version of Tcl/Tk.\n\
8428                     Gitk requires at least Tcl/Tk 8.4."]
8429    exit 1
8430}
8431
8432# defaults...
8433set datemode 0
8434set wrcomcmd "git diff-tree --stdin -p --pretty"
8435
8436set gitencoding {}
8437catch {
8438    set gitencoding [exec git config --get i18n.commitencoding]
8439}
8440if {$gitencoding == ""} {
8441    set gitencoding "utf-8"
8442}
8443set tclencoding [tcl_encoding $gitencoding]
8444if {$tclencoding == {}} {
8445    puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
8446}
8447
8448set mainfont {Helvetica 9}
8449set textfont {Courier 9}
8450set uifont {Helvetica 9 bold}
8451set tabstop 8
8452set findmergefiles 0
8453set maxgraphpct 50
8454set maxwidth 16
8455set revlistorder 0
8456set fastdate 0
8457set uparrowlen 5
8458set downarrowlen 5
8459set mingaplen 100
8460set cmitmode "patch"
8461set wrapcomment "none"
8462set showneartags 1
8463set maxrefs 20
8464set maxlinelen 200
8465set showlocalchanges 1
8466set limitdiffs 1
8467set datetimeformat "%Y-%m-%d %H:%M:%S"
8468
8469set colors {green red blue magenta darkgrey brown orange}
8470set bgcolor white
8471set fgcolor black
8472set diffcolors {red "#00a000" blue}
8473set diffcontext 3
8474set ignorespace 0
8475set selectbgcolor gray85
8476
8477## For msgcat loading, first locate the installation location.
8478if { [info exists ::env(GITK_MSGSDIR)] } {
8479    ## Msgsdir was manually set in the environment.
8480    set gitk_msgsdir $::env(GITK_MSGSDIR)
8481} else {
8482    ## Let's guess the prefix from argv0.
8483    set gitk_prefix [file dirname [file dirname [file normalize $argv0]]]
8484    set gitk_libdir [file join $gitk_prefix share gitk lib]
8485    set gitk_msgsdir [file join $gitk_libdir msgs]
8486    unset gitk_prefix
8487}
8488
8489## Internationalization (i18n) through msgcat and gettext. See
8490## http://www.gnu.org/software/gettext/manual/html_node/Tcl.html
8491package require msgcat
8492namespace import ::msgcat::mc
8493## And eventually load the actual message catalog
8494::msgcat::mcload $gitk_msgsdir
8495
8496catch {source ~/.gitk}
8497
8498font create optionfont -family sans-serif -size -12
8499
8500parsefont mainfont $mainfont
8501eval font create mainfont [fontflags mainfont]
8502eval font create mainfontbold [fontflags mainfont 1]
8503
8504parsefont textfont $textfont
8505eval font create textfont [fontflags textfont]
8506eval font create textfontbold [fontflags textfont 1]
8507
8508parsefont uifont $uifont
8509eval font create uifont [fontflags uifont]
8510
8511setoptions
8512
8513# check that we can find a .git directory somewhere...
8514if {[catch {set gitdir [gitdir]}]} {
8515    show_error {} . [mc "Cannot find a git repository here."]
8516    exit 1
8517}
8518if {![file isdirectory $gitdir]} {
8519    show_error {} . [mc "Cannot find the git directory \"%s\"." $gitdir]
8520    exit 1
8521}
8522
8523set mergeonly 0
8524set revtreeargs {}
8525set cmdline_files {}
8526set i 0
8527foreach arg $argv {
8528    switch -- $arg {
8529        "" { }
8530        "-d" { set datemode 1 }
8531        "--merge" {
8532            set mergeonly 1
8533            lappend revtreeargs $arg
8534        }
8535        "--" {
8536            set cmdline_files [lrange $argv [expr {$i + 1}] end]
8537            break
8538        }
8539        default {
8540            lappend revtreeargs $arg
8541        }
8542    }
8543    incr i
8544}
8545
8546if {$i >= [llength $argv] && $revtreeargs ne {}} {
8547    # no -- on command line, but some arguments (other than -d)
8548    if {[catch {
8549        set f [eval exec git rev-parse --no-revs --no-flags $revtreeargs]
8550        set cmdline_files [split $f "\n"]
8551        set n [llength $cmdline_files]
8552        set revtreeargs [lrange $revtreeargs 0 end-$n]
8553        # Unfortunately git rev-parse doesn't produce an error when
8554        # something is both a revision and a filename.  To be consistent
8555        # with git log and git rev-list, check revtreeargs for filenames.
8556        foreach arg $revtreeargs {
8557            if {[file exists $arg]} {
8558                show_error {} . [mc "Ambiguous argument '%s': both revision\
8559                                 and filename" $arg]
8560                exit 1
8561            }
8562        }
8563    } err]} {
8564        # unfortunately we get both stdout and stderr in $err,
8565        # so look for "fatal:".
8566        set i [string first "fatal:" $err]
8567        if {$i > 0} {
8568            set err [string range $err [expr {$i + 6}] end]
8569        }
8570        show_error {} . "[mc "Bad arguments to gitk:"]\n$err"
8571        exit 1
8572    }
8573}
8574
8575if {$mergeonly} {
8576    # find the list of unmerged files
8577    set mlist {}
8578    set nr_unmerged 0
8579    if {[catch {
8580        set fd [open "| git ls-files -u" r]
8581    } err]} {
8582        show_error {} . "[mc "Couldn't get list of unmerged files:"] $err"
8583        exit 1
8584    }
8585    while {[gets $fd line] >= 0} {
8586        set i [string first "\t" $line]
8587        if {$i < 0} continue
8588        set fname [string range $line [expr {$i+1}] end]
8589        if {[lsearch -exact $mlist $fname] >= 0} continue
8590        incr nr_unmerged
8591        if {$cmdline_files eq {} || [path_filter $cmdline_files $fname]} {
8592            lappend mlist $fname
8593        }
8594    }
8595    catch {close $fd}
8596    if {$mlist eq {}} {
8597        if {$nr_unmerged == 0} {
8598            show_error {} . [mc "No files selected: --merge specified but\
8599                             no files are unmerged."]
8600        } else {
8601            show_error {} . [mc "No files selected: --merge specified but\
8602                             no unmerged files are within file limit."]
8603        }
8604        exit 1
8605    }
8606    set cmdline_files $mlist
8607}
8608
8609set nullid "0000000000000000000000000000000000000000"
8610set nullid2 "0000000000000000000000000000000000000001"
8611
8612set have_tk85 [expr {[package vcompare $tk_version "8.5"] >= 0}]
8613
8614set runq {}
8615set history {}
8616set historyindex 0
8617set fh_serial 0
8618set nhl_names {}
8619set highlight_paths {}
8620set findpattern {}
8621set searchdirn -forwards
8622set boldrows {}
8623set boldnamerows {}
8624set diffelide {0 0}
8625set markingmatches 0
8626set linkentercount 0
8627set need_redisplay 0
8628set nrows_drawn 0
8629set firsttabstop 0
8630
8631set nextviewnum 1
8632set curview 0
8633set selectedview 0
8634set selectedhlview [mc "None"]
8635set highlight_related [mc "None"]
8636set highlight_files {}
8637set viewfiles(0) {}
8638set viewperm(0) 0
8639set viewargs(0) {}
8640
8641set cmdlineok 0
8642set stopped 0
8643set stuffsaved 0
8644set patchnum 0
8645set localirow -1
8646set localfrow -1
8647set lserial 0
8648setcoords
8649makewindow
8650# wait for the window to become visible
8651tkwait visibility .
8652wm title . "[file tail $argv0]: [file tail [pwd]]"
8653readrefs
8654
8655if {$cmdline_files ne {} || $revtreeargs ne {}} {
8656    # create a view for the files/dirs specified on the command line
8657    set curview 1
8658    set selectedview 1
8659    set nextviewnum 2
8660    set viewname(1) [mc "Command line"]
8661    set viewfiles(1) $cmdline_files
8662    set viewargs(1) $revtreeargs
8663    set viewperm(1) 0
8664    addviewmenu 1
8665    .bar.view entryconf [mc "Edit view..."] -state normal
8666    .bar.view entryconf [mc "Delete view"] -state normal
8667}
8668
8669if {[info exists permviews]} {
8670    foreach v $permviews {
8671        set n $nextviewnum
8672        incr nextviewnum
8673        set viewname($n) [lindex $v 0]
8674        set viewfiles($n) [lindex $v 1]
8675        set viewargs($n) [lindex $v 2]
8676        set viewperm($n) 1
8677        addviewmenu $n
8678    }
8679}
8680getcommits