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