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