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