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