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