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