gitkon commit gitk: Fix some problems with the display of ids as links (9764568)
   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 rowchk
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        catch {unset rowchk}
2031    }
2032
2033    catch {unset colormap}
2034    catch {unset rowtextx}
2035    set nextcolor 0
2036    set canvxmax [$canv cget -width]
2037    set curview $n
2038    set row 0
2039    setcanvscroll
2040    set yf 0
2041    set row {}
2042    set selectfirst 0
2043    if {$selid ne {} && [info exists commitrow($n,$selid)]} {
2044        set row $commitrow($n,$selid)
2045        # try to get the selected row in the same position on the screen
2046        set ymax [lindex [$canv cget -scrollregion] 3]
2047        set ytop [expr {[yc $row] - $yscreen}]
2048        if {$ytop < 0} {
2049            set ytop 0
2050        }
2051        set yf [expr {$ytop * 1.0 / $ymax}]
2052    }
2053    allcanvs yview moveto $yf
2054    drawvisible
2055    if {$row ne {}} {
2056        selectline $row 0
2057    } elseif {$selid ne {}} {
2058        set pending_select $selid
2059    } else {
2060        set row [first_real_row]
2061        if {$row < $numcommits} {
2062            selectline $row 0
2063        } else {
2064            set selectfirst 1
2065        }
2066    }
2067    if {$phase ne {}} {
2068        if {$phase eq "getcommits"} {
2069            show_status "Reading commits..."
2070        }
2071        run chewcommits $n
2072    } elseif {$numcommits == 0} {
2073        show_status "No commits selected"
2074    }
2075    run refill_reflist
2076}
2077
2078# Stuff relating to the highlighting facility
2079
2080proc ishighlighted {row} {
2081    global vhighlights fhighlights nhighlights rhighlights
2082
2083    if {[info exists nhighlights($row)] && $nhighlights($row) > 0} {
2084        return $nhighlights($row)
2085    }
2086    if {[info exists vhighlights($row)] && $vhighlights($row) > 0} {
2087        return $vhighlights($row)
2088    }
2089    if {[info exists fhighlights($row)] && $fhighlights($row) > 0} {
2090        return $fhighlights($row)
2091    }
2092    if {[info exists rhighlights($row)] && $rhighlights($row) > 0} {
2093        return $rhighlights($row)
2094    }
2095    return 0
2096}
2097
2098proc bolden {row font} {
2099    global canv linehtag selectedline boldrows
2100
2101    lappend boldrows $row
2102    $canv itemconf $linehtag($row) -font $font
2103    if {[info exists selectedline] && $row == $selectedline} {
2104        $canv delete secsel
2105        set t [eval $canv create rect [$canv bbox $linehtag($row)] \
2106                   -outline {{}} -tags secsel \
2107                   -fill [$canv cget -selectbackground]]
2108        $canv lower $t
2109    }
2110}
2111
2112proc bolden_name {row font} {
2113    global canv2 linentag selectedline boldnamerows
2114
2115    lappend boldnamerows $row
2116    $canv2 itemconf $linentag($row) -font $font
2117    if {[info exists selectedline] && $row == $selectedline} {
2118        $canv2 delete secsel
2119        set t [eval $canv2 create rect [$canv2 bbox $linentag($row)] \
2120                   -outline {{}} -tags secsel \
2121                   -fill [$canv2 cget -selectbackground]]
2122        $canv2 lower $t
2123    }
2124}
2125
2126proc unbolden {} {
2127    global mainfont boldrows
2128
2129    set stillbold {}
2130    foreach row $boldrows {
2131        if {![ishighlighted $row]} {
2132            bolden $row $mainfont
2133        } else {
2134            lappend stillbold $row
2135        }
2136    }
2137    set boldrows $stillbold
2138}
2139
2140proc addvhighlight {n} {
2141    global hlview curview viewdata vhl_done vhighlights commitidx
2142
2143    if {[info exists hlview]} {
2144        delvhighlight
2145    }
2146    set hlview $n
2147    if {$n != $curview && ![info exists viewdata($n)]} {
2148        set viewdata($n) [list getcommits {{}} 0 0 0]
2149        set vparentlist($n) {}
2150        set vdisporder($n) {}
2151        set vcmitlisted($n) {}
2152        start_rev_list $n
2153    }
2154    set vhl_done $commitidx($hlview)
2155    if {$vhl_done > 0} {
2156        drawvisible
2157    }
2158}
2159
2160proc delvhighlight {} {
2161    global hlview vhighlights
2162
2163    if {![info exists hlview]} return
2164    unset hlview
2165    catch {unset vhighlights}
2166    unbolden
2167}
2168
2169proc vhighlightmore {} {
2170    global hlview vhl_done commitidx vhighlights
2171    global displayorder vdisporder curview mainfont
2172
2173    set font [concat $mainfont bold]
2174    set max $commitidx($hlview)
2175    if {$hlview == $curview} {
2176        set disp $displayorder
2177    } else {
2178        set disp $vdisporder($hlview)
2179    }
2180    set vr [visiblerows]
2181    set r0 [lindex $vr 0]
2182    set r1 [lindex $vr 1]
2183    for {set i $vhl_done} {$i < $max} {incr i} {
2184        set id [lindex $disp $i]
2185        if {[info exists commitrow($curview,$id)]} {
2186            set row $commitrow($curview,$id)
2187            if {$r0 <= $row && $row <= $r1} {
2188                if {![highlighted $row]} {
2189                    bolden $row $font
2190                }
2191                set vhighlights($row) 1
2192            }
2193        }
2194    }
2195    set vhl_done $max
2196}
2197
2198proc askvhighlight {row id} {
2199    global hlview vhighlights commitrow iddrawn mainfont
2200
2201    if {[info exists commitrow($hlview,$id)]} {
2202        if {[info exists iddrawn($id)] && ![ishighlighted $row]} {
2203            bolden $row [concat $mainfont bold]
2204        }
2205        set vhighlights($row) 1
2206    } else {
2207        set vhighlights($row) 0
2208    }
2209}
2210
2211proc hfiles_change {name ix op} {
2212    global highlight_files filehighlight fhighlights fh_serial
2213    global mainfont highlight_paths
2214
2215    if {[info exists filehighlight]} {
2216        # delete previous highlights
2217        catch {close $filehighlight}
2218        unset filehighlight
2219        catch {unset fhighlights}
2220        unbolden
2221        unhighlight_filelist
2222    }
2223    set highlight_paths {}
2224    after cancel do_file_hl $fh_serial
2225    incr fh_serial
2226    if {$highlight_files ne {}} {
2227        after 300 do_file_hl $fh_serial
2228    }
2229}
2230
2231proc makepatterns {l} {
2232    set ret {}
2233    foreach e $l {
2234        set ee [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} $e]
2235        if {[string index $ee end] eq "/"} {
2236            lappend ret "$ee*"
2237        } else {
2238            lappend ret $ee
2239            lappend ret "$ee/*"
2240        }
2241    }
2242    return $ret
2243}
2244
2245proc do_file_hl {serial} {
2246    global highlight_files filehighlight highlight_paths gdttype fhl_list
2247
2248    if {$gdttype eq "touching paths:"} {
2249        if {[catch {set paths [shellsplit $highlight_files]}]} return
2250        set highlight_paths [makepatterns $paths]
2251        highlight_filelist
2252        set gdtargs [concat -- $paths]
2253    } else {
2254        set gdtargs [list "-S$highlight_files"]
2255    }
2256    set cmd [concat | git diff-tree -r -s --stdin $gdtargs]
2257    set filehighlight [open $cmd r+]
2258    fconfigure $filehighlight -blocking 0
2259    filerun $filehighlight readfhighlight
2260    set fhl_list {}
2261    drawvisible
2262    flushhighlights
2263}
2264
2265proc flushhighlights {} {
2266    global filehighlight fhl_list
2267
2268    if {[info exists filehighlight]} {
2269        lappend fhl_list {}
2270        puts $filehighlight ""
2271        flush $filehighlight
2272    }
2273}
2274
2275proc askfilehighlight {row id} {
2276    global filehighlight fhighlights fhl_list
2277
2278    lappend fhl_list $id
2279    set fhighlights($row) -1
2280    puts $filehighlight $id
2281}
2282
2283proc readfhighlight {} {
2284    global filehighlight fhighlights commitrow curview mainfont iddrawn
2285    global fhl_list
2286
2287    if {![info exists filehighlight]} {
2288        return 0
2289    }
2290    set nr 0
2291    while {[incr nr] <= 100 && [gets $filehighlight line] >= 0} {
2292        set line [string trim $line]
2293        set i [lsearch -exact $fhl_list $line]
2294        if {$i < 0} continue
2295        for {set j 0} {$j < $i} {incr j} {
2296            set id [lindex $fhl_list $j]
2297            if {[info exists commitrow($curview,$id)]} {
2298                set fhighlights($commitrow($curview,$id)) 0
2299            }
2300        }
2301        set fhl_list [lrange $fhl_list [expr {$i+1}] end]
2302        if {$line eq {}} continue
2303        if {![info exists commitrow($curview,$line)]} continue
2304        set row $commitrow($curview,$line)
2305        if {[info exists iddrawn($line)] && ![ishighlighted $row]} {
2306            bolden $row [concat $mainfont bold]
2307        }
2308        set fhighlights($row) 1
2309    }
2310    if {[eof $filehighlight]} {
2311        # strange...
2312        puts "oops, git diff-tree died"
2313        catch {close $filehighlight}
2314        unset filehighlight
2315        return 0
2316    }
2317    next_hlcont
2318    return 1
2319}
2320
2321proc find_change {name ix op} {
2322    global nhighlights mainfont boldnamerows
2323    global findstring findpattern findtype
2324
2325    # delete previous highlights, if any
2326    foreach row $boldnamerows {
2327        bolden_name $row $mainfont
2328    }
2329    set boldnamerows {}
2330    catch {unset nhighlights}
2331    unbolden
2332    unmarkmatches
2333    if {$findtype ne "Regexp"} {
2334        set e [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} \
2335                   $findstring]
2336        set findpattern "*$e*"
2337    }
2338    drawvisible
2339}
2340
2341proc doesmatch {f} {
2342    global findtype findstring findpattern
2343
2344    if {$findtype eq "Regexp"} {
2345        return [regexp $findstring $f]
2346    } elseif {$findtype eq "IgnCase"} {
2347        return [string match -nocase $findpattern $f]
2348    } else {
2349        return [string match $findpattern $f]
2350    }
2351}
2352
2353proc askfindhighlight {row id} {
2354    global nhighlights commitinfo iddrawn mainfont
2355    global findloc
2356    global markingmatches
2357
2358    if {![info exists commitinfo($id)]} {
2359        getcommit $id
2360    }
2361    set info $commitinfo($id)
2362    set isbold 0
2363    set fldtypes {Headline Author Date Committer CDate Comments}
2364    foreach f $info ty $fldtypes {
2365        if {($findloc eq "All fields" || $findloc eq $ty) &&
2366            [doesmatch $f]} {
2367            if {$ty eq "Author"} {
2368                set isbold 2
2369                break
2370            }
2371            set isbold 1
2372        }
2373    }
2374    if {$isbold && [info exists iddrawn($id)]} {
2375        set f [concat $mainfont bold]
2376        if {![ishighlighted $row]} {
2377            bolden $row $f
2378            if {$isbold > 1} {
2379                bolden_name $row $f
2380            }
2381        }
2382        if {$markingmatches} {
2383            markrowmatches $row $id
2384        }
2385    }
2386    set nhighlights($row) $isbold
2387}
2388
2389proc markrowmatches {row id} {
2390    global canv canv2 linehtag linentag commitinfo findloc
2391
2392    set headline [lindex $commitinfo($id) 0]
2393    set author [lindex $commitinfo($id) 1]
2394    $canv delete match$row
2395    $canv2 delete match$row
2396    if {$findloc eq "All fields" || $findloc eq "Headline"} {
2397        set m [findmatches $headline]
2398        if {$m ne {}} {
2399            markmatches $canv $row $headline $linehtag($row) $m \
2400                [$canv itemcget $linehtag($row) -font] $row
2401        }
2402    }
2403    if {$findloc eq "All fields" || $findloc eq "Author"} {
2404        set m [findmatches $author]
2405        if {$m ne {}} {
2406            markmatches $canv2 $row $author $linentag($row) $m \
2407                [$canv2 itemcget $linentag($row) -font] $row
2408        }
2409    }
2410}
2411
2412proc vrel_change {name ix op} {
2413    global highlight_related
2414
2415    rhighlight_none
2416    if {$highlight_related ne "None"} {
2417        run drawvisible
2418    }
2419}
2420
2421# prepare for testing whether commits are descendents or ancestors of a
2422proc rhighlight_sel {a} {
2423    global descendent desc_todo ancestor anc_todo
2424    global highlight_related rhighlights
2425
2426    catch {unset descendent}
2427    set desc_todo [list $a]
2428    catch {unset ancestor}
2429    set anc_todo [list $a]
2430    if {$highlight_related ne "None"} {
2431        rhighlight_none
2432        run drawvisible
2433    }
2434}
2435
2436proc rhighlight_none {} {
2437    global rhighlights
2438
2439    catch {unset rhighlights}
2440    unbolden
2441}
2442
2443proc is_descendent {a} {
2444    global curview children commitrow descendent desc_todo
2445
2446    set v $curview
2447    set la $commitrow($v,$a)
2448    set todo $desc_todo
2449    set leftover {}
2450    set done 0
2451    for {set i 0} {$i < [llength $todo]} {incr i} {
2452        set do [lindex $todo $i]
2453        if {$commitrow($v,$do) < $la} {
2454            lappend leftover $do
2455            continue
2456        }
2457        foreach nk $children($v,$do) {
2458            if {![info exists descendent($nk)]} {
2459                set descendent($nk) 1
2460                lappend todo $nk
2461                if {$nk eq $a} {
2462                    set done 1
2463                }
2464            }
2465        }
2466        if {$done} {
2467            set desc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
2468            return
2469        }
2470    }
2471    set descendent($a) 0
2472    set desc_todo $leftover
2473}
2474
2475proc is_ancestor {a} {
2476    global curview parentlist commitrow ancestor anc_todo
2477
2478    set v $curview
2479    set la $commitrow($v,$a)
2480    set todo $anc_todo
2481    set leftover {}
2482    set done 0
2483    for {set i 0} {$i < [llength $todo]} {incr i} {
2484        set do [lindex $todo $i]
2485        if {![info exists commitrow($v,$do)] || $commitrow($v,$do) > $la} {
2486            lappend leftover $do
2487            continue
2488        }
2489        foreach np [lindex $parentlist $commitrow($v,$do)] {
2490            if {![info exists ancestor($np)]} {
2491                set ancestor($np) 1
2492                lappend todo $np
2493                if {$np eq $a} {
2494                    set done 1
2495                }
2496            }
2497        }
2498        if {$done} {
2499            set anc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
2500            return
2501        }
2502    }
2503    set ancestor($a) 0
2504    set anc_todo $leftover
2505}
2506
2507proc askrelhighlight {row id} {
2508    global descendent highlight_related iddrawn mainfont rhighlights
2509    global selectedline ancestor
2510
2511    if {![info exists selectedline]} return
2512    set isbold 0
2513    if {$highlight_related eq "Descendent" ||
2514        $highlight_related eq "Not descendent"} {
2515        if {![info exists descendent($id)]} {
2516            is_descendent $id
2517        }
2518        if {$descendent($id) == ($highlight_related eq "Descendent")} {
2519            set isbold 1
2520        }
2521    } elseif {$highlight_related eq "Ancestor" ||
2522              $highlight_related eq "Not ancestor"} {
2523        if {![info exists ancestor($id)]} {
2524            is_ancestor $id
2525        }
2526        if {$ancestor($id) == ($highlight_related eq "Ancestor")} {
2527            set isbold 1
2528        }
2529    }
2530    if {[info exists iddrawn($id)]} {
2531        if {$isbold && ![ishighlighted $row]} {
2532            bolden $row [concat $mainfont bold]
2533        }
2534    }
2535    set rhighlights($row) $isbold
2536}
2537
2538proc next_hlcont {} {
2539    global fhl_row fhl_dirn displayorder numcommits
2540    global vhighlights fhighlights nhighlights rhighlights
2541    global hlview filehighlight findstring highlight_related
2542
2543    if {![info exists fhl_dirn] || $fhl_dirn == 0} return
2544    set row $fhl_row
2545    while {1} {
2546        if {$row < 0 || $row >= $numcommits} {
2547            bell
2548            set fhl_dirn 0
2549            return
2550        }
2551        set id [lindex $displayorder $row]
2552        if {[info exists hlview]} {
2553            if {![info exists vhighlights($row)]} {
2554                askvhighlight $row $id
2555            }
2556            if {$vhighlights($row) > 0} break
2557        }
2558        if {$findstring ne {}} {
2559            if {![info exists nhighlights($row)]} {
2560                askfindhighlight $row $id
2561            }
2562            if {$nhighlights($row) > 0} break
2563        }
2564        if {$highlight_related ne "None"} {
2565            if {![info exists rhighlights($row)]} {
2566                askrelhighlight $row $id
2567            }
2568            if {$rhighlights($row) > 0} break
2569        }
2570        if {[info exists filehighlight]} {
2571            if {![info exists fhighlights($row)]} {
2572                # ask for a few more while we're at it...
2573                set r $row
2574                for {set n 0} {$n < 100} {incr n} {
2575                    if {![info exists fhighlights($r)]} {
2576                        askfilehighlight $r [lindex $displayorder $r]
2577                    }
2578                    incr r $fhl_dirn
2579                    if {$r < 0 || $r >= $numcommits} break
2580                }
2581                flushhighlights
2582            }
2583            if {$fhighlights($row) < 0} {
2584                set fhl_row $row
2585                return
2586            }
2587            if {$fhighlights($row) > 0} break
2588        }
2589        incr row $fhl_dirn
2590    }
2591    set fhl_dirn 0
2592    selectline $row 1
2593}
2594
2595proc next_highlight {dirn} {
2596    global selectedline fhl_row fhl_dirn
2597    global hlview filehighlight findstring highlight_related
2598
2599    if {![info exists selectedline]} return
2600    if {!([info exists hlview] || $findstring ne {} ||
2601          $highlight_related ne "None" || [info exists filehighlight])} return
2602    set fhl_row [expr {$selectedline + $dirn}]
2603    set fhl_dirn $dirn
2604    next_hlcont
2605}
2606
2607proc cancel_next_highlight {} {
2608    global fhl_dirn
2609
2610    set fhl_dirn 0
2611}
2612
2613# Graph layout functions
2614
2615proc shortids {ids} {
2616    set res {}
2617    foreach id $ids {
2618        if {[llength $id] > 1} {
2619            lappend res [shortids $id]
2620        } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
2621            lappend res [string range $id 0 7]
2622        } else {
2623            lappend res $id
2624        }
2625    }
2626    return $res
2627}
2628
2629proc incrange {l x o} {
2630    set n [llength $l]
2631    while {$x < $n} {
2632        set e [lindex $l $x]
2633        if {$e ne {}} {
2634            lset l $x [expr {$e + $o}]
2635        }
2636        incr x
2637    }
2638    return $l
2639}
2640
2641proc ntimes {n o} {
2642    set ret {}
2643    for {} {$n > 0} {incr n -1} {
2644        lappend ret $o
2645    }
2646    return $ret
2647}
2648
2649proc usedinrange {id l1 l2} {
2650    global children commitrow curview
2651
2652    if {[info exists commitrow($curview,$id)]} {
2653        set r $commitrow($curview,$id)
2654        if {$l1 <= $r && $r <= $l2} {
2655            return [expr {$r - $l1 + 1}]
2656        }
2657    }
2658    set kids $children($curview,$id)
2659    foreach c $kids {
2660        if {[info exists commitrow($curview,$c)]} {
2661            set r $commitrow($curview,$c)
2662            if {$l1 <= $r && $r <= $l2} {
2663                return [expr {$r - $l1 + 1}]
2664            }
2665        }
2666    }
2667    return 0
2668}
2669
2670# Work out where id should go in idlist so that order-token
2671# values increase from left to right
2672proc idcol {idlist id {i 0}} {
2673    global ordertok curview
2674
2675    set t $ordertok($curview,$id)
2676    if {$i >= [llength $idlist] ||
2677        $t < $ordertok($curview,[lindex $idlist $i])} {
2678        if {$i > [llength $idlist]} {
2679            set i [llength $idlist]
2680        }
2681        while {[incr i -1] >= 0 &&
2682               $t < $ordertok($curview,[lindex $idlist $i])} {}
2683        incr i
2684    } else {
2685        if {$t > $ordertok($curview,[lindex $idlist $i])} {
2686            while {[incr i] < [llength $idlist] &&
2687                   $t >= $ordertok($curview,[lindex $idlist $i])} {}
2688        }
2689    }
2690    return $i
2691}
2692
2693proc makeuparrow {oid y x} {
2694    global rowidlist uparrowlen displayorder
2695
2696    for {set i 0} {$i < $uparrowlen && $y > 1} {incr i} {
2697        incr y -1
2698        set idl [lindex $rowidlist $y]
2699        set x [idcol $idl $oid $x]
2700        lset rowidlist $y [linsert $idl $x $oid]
2701    }
2702}
2703
2704proc initlayout {} {
2705    global rowidlist displayorder commitlisted
2706    global rowlaidout rowoptim
2707    global rowchk
2708    global numcommits canvxmax canv
2709    global nextcolor
2710    global parentlist
2711    global colormap rowtextx
2712    global selectfirst
2713
2714    set numcommits 0
2715    set displayorder {}
2716    set commitlisted {}
2717    set parentlist {}
2718    set nextcolor 0
2719    set rowidlist {{}}
2720    catch {unset rowchk}
2721    set rowlaidout 0
2722    set rowoptim 0
2723    set canvxmax [$canv cget -width]
2724    catch {unset colormap}
2725    catch {unset rowtextx}
2726    set selectfirst 1
2727}
2728
2729proc setcanvscroll {} {
2730    global canv canv2 canv3 numcommits linespc canvxmax canvy0
2731
2732    set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
2733    $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
2734    $canv2 conf -scrollregion [list 0 0 0 $ymax]
2735    $canv3 conf -scrollregion [list 0 0 0 $ymax]
2736}
2737
2738proc visiblerows {} {
2739    global canv numcommits linespc
2740
2741    set ymax [lindex [$canv cget -scrollregion] 3]
2742    if {$ymax eq {} || $ymax == 0} return
2743    set f [$canv yview]
2744    set y0 [expr {int([lindex $f 0] * $ymax)}]
2745    set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
2746    if {$r0 < 0} {
2747        set r0 0
2748    }
2749    set y1 [expr {int([lindex $f 1] * $ymax)}]
2750    set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
2751    if {$r1 >= $numcommits} {
2752        set r1 [expr {$numcommits - 1}]
2753    }
2754    return [list $r0 $r1]
2755}
2756
2757proc layoutmore {tmax allread} {
2758    global rowlaidout rowoptim commitidx numcommits optim_delay
2759    global uparrowlen curview rowidlist
2760
2761    set showlast 0
2762    set showdelay $optim_delay
2763    set optdelay [expr {$uparrowlen + 1}]
2764    while {1} {
2765        if {$rowoptim - $showdelay > $numcommits} {
2766            showstuff [expr {$rowoptim - $showdelay}] $showlast
2767        } elseif {$rowlaidout - $optdelay > $rowoptim} {
2768            set nr [expr {$rowlaidout - $optdelay - $rowoptim}]
2769            if {$nr > 100} {
2770                set nr 100
2771            }
2772            optimize_rows $rowoptim 0 [expr {$rowoptim + $nr}]
2773            incr rowoptim $nr
2774        } elseif {$commitidx($curview) > $rowlaidout} {
2775            set nr [expr {$commitidx($curview) - $rowlaidout}]
2776            # may need to increase this threshold if uparrowlen or
2777            # mingaplen are increased...
2778            if {$nr > 200} {
2779                set nr 200
2780            }
2781            set row $rowlaidout
2782            set rowlaidout [layoutrows $row [expr {$row + $nr}] $allread]
2783            if {$rowlaidout == $row} {
2784                return 0
2785            }
2786        } elseif {$allread} {
2787            set optdelay 0
2788            set nrows $commitidx($curview)
2789            if {[lindex $rowidlist $nrows] ne {}} {
2790                layouttail
2791                set rowlaidout $commitidx($curview)
2792            } elseif {$rowoptim == $nrows} {
2793                set showdelay 0
2794                set showlast 1
2795                if {$numcommits == $nrows} {
2796                    return 0
2797                }
2798            }
2799        } else {
2800            return 0
2801        }
2802        if {$tmax ne {} && [clock clicks -milliseconds] >= $tmax} {
2803            return 1
2804        }
2805    }
2806}
2807
2808proc showstuff {canshow last} {
2809    global numcommits commitrow pending_select selectedline curview
2810    global lookingforhead mainheadid displayorder selectfirst
2811    global lastscrollset commitinterest
2812
2813    if {$numcommits == 0} {
2814        global phase
2815        set phase "incrdraw"
2816        allcanvs delete all
2817    }
2818    for {set l $numcommits} {$l < $canshow} {incr l} {
2819        set id [lindex $displayorder $l]
2820        if {[info exists commitinterest($id)]} {
2821            foreach script $commitinterest($id) {
2822                eval [string map [list "%I" $id] $script]
2823            }
2824            unset commitinterest($id)
2825        }
2826    }
2827    set r0 $numcommits
2828    set prev $numcommits
2829    set numcommits $canshow
2830    set t [clock clicks -milliseconds]
2831    if {$prev < 100 || $last || $t - $lastscrollset > 500} {
2832        set lastscrollset $t
2833        setcanvscroll
2834    }
2835    set rows [visiblerows]
2836    set r1 [lindex $rows 1]
2837    if {$r1 >= $canshow} {
2838        set r1 [expr {$canshow - 1}]
2839    }
2840    if {$r0 <= $r1} {
2841        drawcommits $r0 $r1
2842    }
2843    if {[info exists pending_select] &&
2844        [info exists commitrow($curview,$pending_select)] &&
2845        $commitrow($curview,$pending_select) < $numcommits} {
2846        selectline $commitrow($curview,$pending_select) 1
2847    }
2848    if {$selectfirst} {
2849        if {[info exists selectedline] || [info exists pending_select]} {
2850            set selectfirst 0
2851        } else {
2852            set l [first_real_row]
2853            selectline $l 1
2854            set selectfirst 0
2855        }
2856    }
2857    if {$lookingforhead && [info exists commitrow($curview,$mainheadid)]
2858        && ($last || $commitrow($curview,$mainheadid) < $numcommits - 1)} {
2859        set lookingforhead 0
2860        dodiffindex
2861    }
2862}
2863
2864proc doshowlocalchanges {} {
2865    global lookingforhead curview mainheadid phase commitrow
2866
2867    if {[info exists commitrow($curview,$mainheadid)] &&
2868        ($phase eq {} || $commitrow($curview,$mainheadid) < $numcommits - 1)} {
2869        dodiffindex
2870    } elseif {$phase ne {}} {
2871        set lookingforhead 1
2872    }
2873}
2874
2875proc dohidelocalchanges {} {
2876    global lookingforhead localfrow localirow lserial
2877
2878    set lookingforhead 0
2879    if {$localfrow >= 0} {
2880        removerow $localfrow
2881        set localfrow -1
2882        if {$localirow > 0} {
2883            incr localirow -1
2884        }
2885    }
2886    if {$localirow >= 0} {
2887        removerow $localirow
2888        set localirow -1
2889    }
2890    incr lserial
2891}
2892
2893# spawn off a process to do git diff-index --cached HEAD
2894proc dodiffindex {} {
2895    global localirow localfrow lserial
2896
2897    incr lserial
2898    set localfrow -1
2899    set localirow -1
2900    set fd [open "|git diff-index --cached HEAD" r]
2901    fconfigure $fd -blocking 0
2902    filerun $fd [list readdiffindex $fd $lserial]
2903}
2904
2905proc readdiffindex {fd serial} {
2906    global localirow commitrow mainheadid nullid2 curview
2907    global commitinfo commitdata lserial
2908
2909    set isdiff 1
2910    if {[gets $fd line] < 0} {
2911        if {![eof $fd]} {
2912            return 1
2913        }
2914        set isdiff 0
2915    }
2916    # we only need to see one line and we don't really care what it says...
2917    close $fd
2918
2919    # now see if there are any local changes not checked in to the index
2920    if {$serial == $lserial} {
2921        set fd [open "|git diff-files" r]
2922        fconfigure $fd -blocking 0
2923        filerun $fd [list readdifffiles $fd $serial]
2924    }
2925
2926    if {$isdiff && $serial == $lserial && $localirow == -1} {
2927        # add the line for the changes in the index to the graph
2928        set localirow $commitrow($curview,$mainheadid)
2929        set hl "Local changes checked in to index but not committed"
2930        set commitinfo($nullid2) [list  $hl {} {} {} {} "    $hl\n"]
2931        set commitdata($nullid2) "\n    $hl\n"
2932        insertrow $localirow $nullid2
2933    }
2934    return 0
2935}
2936
2937proc readdifffiles {fd serial} {
2938    global localirow localfrow commitrow mainheadid nullid curview
2939    global commitinfo commitdata lserial
2940
2941    set isdiff 1
2942    if {[gets $fd line] < 0} {
2943        if {![eof $fd]} {
2944            return 1
2945        }
2946        set isdiff 0
2947    }
2948    # we only need to see one line and we don't really care what it says...
2949    close $fd
2950
2951    if {$isdiff && $serial == $lserial && $localfrow == -1} {
2952        # add the line for the local diff to the graph
2953        if {$localirow >= 0} {
2954            set localfrow $localirow
2955            incr localirow
2956        } else {
2957            set localfrow $commitrow($curview,$mainheadid)
2958        }
2959        set hl "Local uncommitted changes, not checked in to index"
2960        set commitinfo($nullid) [list  $hl {} {} {} {} "    $hl\n"]
2961        set commitdata($nullid) "\n    $hl\n"
2962        insertrow $localfrow $nullid
2963    }
2964    return 0
2965}
2966
2967proc layoutrows {row endrow last} {
2968    global rowidlist displayorder
2969    global uparrowlen downarrowlen maxwidth mingaplen
2970    global children parentlist
2971    global commitidx curview
2972    global rowchk
2973
2974    set idlist [lindex $rowidlist $row]
2975    while {$row < $endrow} {
2976        set id [lindex $displayorder $row]
2977        if {1} {
2978            if {!$last &&
2979                $row + $uparrowlen + $mingaplen >= $commitidx($curview)} break
2980            for {set x [llength $idlist]} {[incr x -1] >= 0} {} {
2981                set i [lindex $idlist $x]
2982                if {![info exists rowchk($i)] || $row >= $rowchk($i)} {
2983                    set r [usedinrange $i [expr {$row - $downarrowlen}] \
2984                               [expr {$row + $uparrowlen + $mingaplen}]]
2985                    if {$r == 0} {
2986                        set idlist [lreplace $idlist $x $x]
2987                        continue
2988                    }
2989                    set rowchk($i) [expr {$row + $r}]
2990                }
2991            }
2992            lset rowidlist $row $idlist
2993        }
2994        set oldolds {}
2995        set newolds {}
2996        foreach p [lindex $parentlist $row] {
2997            # is id the first child of this parent?
2998            if {$id eq [lindex $children($curview,$p) 0]} {
2999                lappend newolds $p
3000            } elseif {[lsearch -exact $idlist $p] < 0} {
3001                lappend oldolds $p
3002            }
3003        }
3004        set col [lsearch -exact $idlist $id]
3005        if {$col < 0} {
3006            set col [idcol $idlist $id]
3007            set idlist [linsert $idlist $col $id]
3008            lset rowidlist $row $idlist
3009            if {$children($curview,$id) ne {}} {
3010                makeuparrow $id $row $col
3011            }
3012        }
3013        incr row
3014        set idlist [lreplace $idlist $col $col]
3015        set x $col
3016        foreach i $newolds {
3017            set x [idcol $idlist $i $x]
3018            set idlist [linsert $idlist $x $i]
3019        }
3020        foreach oid $oldolds {
3021            set x [idcol $idlist $oid $x]
3022            set idlist [linsert $idlist $x $oid]
3023            makeuparrow $oid $row $x
3024        }
3025        lappend rowidlist $idlist
3026    }
3027    return $row
3028}
3029
3030proc addextraid {id row} {
3031    global displayorder commitrow commitinfo
3032    global commitidx commitlisted
3033    global parentlist children curview
3034
3035    incr commitidx($curview)
3036    lappend displayorder $id
3037    lappend commitlisted 0
3038    lappend parentlist {}
3039    set commitrow($curview,$id) $row
3040    readcommit $id
3041    if {![info exists commitinfo($id)]} {
3042        set commitinfo($id) {"No commit information available"}
3043    }
3044    if {![info exists children($curview,$id)]} {
3045        set children($curview,$id) {}
3046    }
3047}
3048
3049proc layouttail {} {
3050    global rowidlist commitidx curview
3051
3052    set row $commitidx($curview)
3053    set idlist [lindex $rowidlist $row]
3054    while {$idlist ne {}} {
3055        set col [expr {[llength $idlist] - 1}]
3056        set id [lindex $idlist $col]
3057        addextraid $id $row
3058        incr row
3059        set idlist [lreplace $idlist $col $col]
3060        lappend rowidlist $idlist
3061    }
3062}
3063
3064proc insert_pad {row col npad} {
3065    global rowidlist
3066
3067    set pad [ntimes $npad {}]
3068    set idlist [lindex $rowidlist $row]
3069    set bef [lrange $idlist 0 [expr {$col - 1}]]
3070    set aft [lrange $idlist $col end]
3071    set i [lsearch -exact $aft {}]
3072    if {$i > 0} {
3073        set aft [lreplace $aft $i $i]
3074    }
3075    lset rowidlist $row [concat $bef $pad $aft]
3076}
3077
3078proc optimize_rows {row col endrow} {
3079    global rowidlist displayorder curview children
3080
3081    if {$row < 1} {
3082        set row 1
3083    }
3084    set idlist [lindex $rowidlist [expr {$row - 1}]]
3085    if {$row >= 2} {
3086        set previdlist [lindex $rowidlist [expr {$row - 2}]]
3087    } else {
3088        set previdlist {}
3089    }
3090    for {} {$row < $endrow} {incr row} {
3091        set pprevidlist $previdlist
3092        set previdlist $idlist
3093        set idlist [lindex $rowidlist $row]
3094        set haspad 0
3095        set y0 [expr {$row - 1}]
3096        set ym [expr {$row - 2}]
3097        set x0 -1
3098        set xm -1
3099        for {} {$col < [llength $idlist]} {incr col} {
3100            set id [lindex $idlist $col]
3101            if {[lindex $previdlist $col] eq $id} continue
3102            if {$id eq {}} {
3103                set haspad 1
3104                continue
3105            }
3106            set x0 [lsearch -exact $previdlist $id]
3107            if {$x0 < 0} continue
3108            set z [expr {$x0 - $col}]
3109            set isarrow 0
3110            set z0 {}
3111            if {$ym >= 0} {
3112                set xm [lsearch -exact $pprevidlist $id]
3113                if {$xm >= 0} {
3114                    set z0 [expr {$xm - $x0}]
3115                }
3116            }
3117            if {$z0 eq {}} {
3118                # if row y0 is the first child of $id then it's not an arrow
3119                if {[lindex $children($curview,$id) 0] ne
3120                    [lindex $displayorder $y0]} {
3121                    set isarrow 1
3122                }
3123            }
3124            if {!$isarrow && $id ne [lindex $displayorder $row] &&
3125                [lsearch -exact [lindex $rowidlist [expr {$row+1}]] $id] < 0} {
3126                set isarrow 1
3127            }
3128            # Looking at lines from this row to the previous row,
3129            # make them go straight up if they end in an arrow on
3130            # the previous row; otherwise make them go straight up
3131            # or at 45 degrees.
3132            if {$z < -1 || ($z < 0 && $isarrow)} {
3133                # Line currently goes left too much;
3134                # insert pads in the previous row, then optimize it
3135                set npad [expr {-1 - $z + $isarrow}]
3136                insert_pad $y0 $x0 $npad
3137                if {$y0 > 0} {
3138                    optimize_rows $y0 $x0 $row
3139                }
3140                set previdlist [lindex $rowidlist $y0]
3141                set x0 [lsearch -exact $previdlist $id]
3142                set z [expr {$x0 - $col}]
3143                if {$z0 ne {}} {
3144                    set pprevidlist [lindex $rowidlist $ym]
3145                    set xm [lsearch -exact $pprevidlist $id]
3146                    set z0 [expr {$xm - $x0}]
3147                }
3148            } elseif {$z > 1 || ($z > 0 && $isarrow)} {
3149                # Line currently goes right too much;
3150                # insert pads in this line
3151                set npad [expr {$z - 1 + $isarrow}]
3152                insert_pad $row $col $npad
3153                set idlist [lindex $rowidlist $row]
3154                incr col $npad
3155                set z [expr {$x0 - $col}]
3156                set haspad 1
3157            }
3158            if {$z0 eq {} && !$isarrow && $ym >= 0} {
3159                # this line links to its first child on row $row-2
3160                set id [lindex $displayorder $ym]
3161                set xc [lsearch -exact $pprevidlist $id]
3162                if {$xc >= 0} {
3163                    set z0 [expr {$xc - $x0}]
3164                }
3165            }
3166            # avoid lines jigging left then immediately right
3167            if {$z0 ne {} && $z < 0 && $z0 > 0} {
3168                insert_pad $y0 $x0 1
3169                incr x0
3170                optimize_rows $y0 $x0 $row
3171                set previdlist [lindex $rowidlist $y0]
3172                set pprevidlist [lindex $rowidlist $ym]
3173            }
3174        }
3175        if {!$haspad} {
3176            # Find the first column that doesn't have a line going right
3177            for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
3178                set id [lindex $idlist $col]
3179                if {$id eq {}} break
3180                set x0 [lsearch -exact $previdlist $id]
3181                if {$x0 < 0} {
3182                    # check if this is the link to the first child
3183                    set kid [lindex $displayorder $y0]
3184                    if {[lindex $children($curview,$id) 0] eq $kid} {
3185                        # it is, work out offset to child
3186                        set x0 [lsearch -exact $previdlist $kid]
3187                    }
3188                }
3189                if {$x0 <= $col} break
3190            }
3191            # Insert a pad at that column as long as it has a line and
3192            # isn't the last column
3193            if {$x0 >= 0 && [incr col] < [llength $idlist]} {
3194                set idlist [linsert $idlist $col {}]
3195            }
3196        }
3197        lset rowidlist $row $idlist
3198        set col 0
3199    }
3200}
3201
3202proc xc {row col} {
3203    global canvx0 linespc
3204    return [expr {$canvx0 + $col * $linespc}]
3205}
3206
3207proc yc {row} {
3208    global canvy0 linespc
3209    return [expr {$canvy0 + $row * $linespc}]
3210}
3211
3212proc linewidth {id} {
3213    global thickerline lthickness
3214
3215    set wid $lthickness
3216    if {[info exists thickerline] && $id eq $thickerline} {
3217        set wid [expr {2 * $lthickness}]
3218    }
3219    return $wid
3220}
3221
3222proc rowranges {id} {
3223    global commitrow curview children uparrowlen downarrowlen
3224    global rowidlist
3225
3226    set kids $children($curview,$id)
3227    if {$kids eq {}} {
3228        return {}
3229    }
3230    set ret {}
3231    lappend kids $id
3232    foreach child $kids {
3233        if {![info exists commitrow($curview,$child)]} break
3234        set row $commitrow($curview,$child)
3235        if {![info exists prev]} {
3236            lappend ret [expr {$row + 1}]
3237        } else {
3238            if {$row <= $prevrow} {
3239                puts "oops children out of order [shortids $id] $row < [shortids $prev] $prevrow"
3240            }
3241            # see if the line extends the whole way from prevrow to row
3242            if {$row > $prevrow + $uparrowlen + $downarrowlen &&
3243                [lsearch -exact [lindex $rowidlist \
3244                            [expr {int(($row + $prevrow) / 2)}]] $id] < 0} {
3245                # it doesn't, see where it ends
3246                set r [expr {$prevrow + $downarrowlen}]
3247                if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
3248                    while {[incr r -1] > $prevrow &&
3249                           [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
3250                } else {
3251                    while {[incr r] <= $row &&
3252                           [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
3253                    incr r -1
3254                }
3255                lappend ret $r
3256                # see where it starts up again
3257                set r [expr {$row - $uparrowlen}]
3258                if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
3259                    while {[incr r] < $row &&
3260                           [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
3261                } else {
3262                    while {[incr r -1] >= $prevrow &&
3263                           [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
3264                    incr r
3265                }
3266                lappend ret $r
3267            }
3268        }
3269        if {$child eq $id} {
3270            lappend ret $row
3271        }
3272        set prev $id
3273        set prevrow $row
3274    }
3275    return $ret
3276}
3277
3278proc drawlineseg {id row endrow arrowlow} {
3279    global rowidlist displayorder iddrawn linesegs
3280    global canv colormap linespc curview maxlinelen parentlist
3281
3282    set cols [list [lsearch -exact [lindex $rowidlist $row] $id]]
3283    set le [expr {$row + 1}]
3284    set arrowhigh 1
3285    while {1} {
3286        set c [lsearch -exact [lindex $rowidlist $le] $id]
3287        if {$c < 0} {
3288            incr le -1
3289            break
3290        }
3291        lappend cols $c
3292        set x [lindex $displayorder $le]
3293        if {$x eq $id} {
3294            set arrowhigh 0
3295            break
3296        }
3297        if {[info exists iddrawn($x)] || $le == $endrow} {
3298            set c [lsearch -exact [lindex $rowidlist [expr {$le+1}]] $id]
3299            if {$c >= 0} {
3300                lappend cols $c
3301                set arrowhigh 0
3302            }
3303            break
3304        }
3305        incr le
3306    }
3307    if {$le <= $row} {
3308        return $row
3309    }
3310
3311    set lines {}
3312    set i 0
3313    set joinhigh 0
3314    if {[info exists linesegs($id)]} {
3315        set lines $linesegs($id)
3316        foreach li $lines {
3317            set r0 [lindex $li 0]
3318            if {$r0 > $row} {
3319                if {$r0 == $le && [lindex $li 1] - $row <= $maxlinelen} {
3320                    set joinhigh 1
3321                }
3322                break
3323            }
3324            incr i
3325        }
3326    }
3327    set joinlow 0
3328    if {$i > 0} {
3329        set li [lindex $lines [expr {$i-1}]]
3330        set r1 [lindex $li 1]
3331        if {$r1 == $row && $le - [lindex $li 0] <= $maxlinelen} {
3332            set joinlow 1
3333        }
3334    }
3335
3336    set x [lindex $cols [expr {$le - $row}]]
3337    set xp [lindex $cols [expr {$le - 1 - $row}]]
3338    set dir [expr {$xp - $x}]
3339    if {$joinhigh} {
3340        set ith [lindex $lines $i 2]
3341        set coords [$canv coords $ith]
3342        set ah [$canv itemcget $ith -arrow]
3343        set arrowhigh [expr {$ah eq "first" || $ah eq "both"}]
3344        set x2 [lindex $cols [expr {$le + 1 - $row}]]
3345        if {$x2 ne {} && $x - $x2 == $dir} {
3346            set coords [lrange $coords 0 end-2]
3347        }
3348    } else {
3349        set coords [list [xc $le $x] [yc $le]]
3350    }
3351    if {$joinlow} {
3352        set itl [lindex $lines [expr {$i-1}] 2]
3353        set al [$canv itemcget $itl -arrow]
3354        set arrowlow [expr {$al eq "last" || $al eq "both"}]
3355    } elseif {$arrowlow} {
3356        if {[lsearch -exact [lindex $rowidlist [expr {$row-1}]] $id] >= 0 ||
3357            [lsearch -exact [lindex $parentlist [expr {$row-1}]] $id] >= 0} {
3358            set arrowlow 0
3359        }
3360    }
3361    set arrow [lindex {none first last both} [expr {$arrowhigh + 2*$arrowlow}]]
3362    for {set y $le} {[incr y -1] > $row} {} {
3363        set x $xp
3364        set xp [lindex $cols [expr {$y - 1 - $row}]]
3365        set ndir [expr {$xp - $x}]
3366        if {$dir != $ndir || $xp < 0} {
3367            lappend coords [xc $y $x] [yc $y]
3368        }
3369        set dir $ndir
3370    }
3371    if {!$joinlow} {
3372        if {$xp < 0} {
3373            # join parent line to first child
3374            set ch [lindex $displayorder $row]
3375            set xc [lsearch -exact [lindex $rowidlist $row] $ch]
3376            if {$xc < 0} {
3377                puts "oops: drawlineseg: child $ch not on row $row"
3378            } elseif {$xc != $x} {
3379                if {($arrowhigh && $le == $row + 1) || $dir == 0} {
3380                    set d [expr {int(0.5 * $linespc)}]
3381                    set x1 [xc $row $x]
3382                    if {$xc < $x} {
3383                        set x2 [expr {$x1 - $d}]
3384                    } else {
3385                        set x2 [expr {$x1 + $d}]
3386                    }
3387                    set y2 [yc $row]
3388                    set y1 [expr {$y2 + $d}]
3389                    lappend coords $x1 $y1 $x2 $y2
3390                } elseif {$xc < $x - 1} {
3391                    lappend coords [xc $row [expr {$x-1}]] [yc $row]
3392                } elseif {$xc > $x + 1} {
3393                    lappend coords [xc $row [expr {$x+1}]] [yc $row]
3394                }
3395                set x $xc
3396            }
3397            lappend coords [xc $row $x] [yc $row]
3398        } else {
3399            set xn [xc $row $xp]
3400            set yn [yc $row]
3401            lappend coords $xn $yn
3402        }
3403        if {!$joinhigh} {
3404            assigncolor $id
3405            set t [$canv create line $coords -width [linewidth $id] \
3406                       -fill $colormap($id) -tags lines.$id -arrow $arrow]
3407            $canv lower $t
3408            bindline $t $id
3409            set lines [linsert $lines $i [list $row $le $t]]
3410        } else {
3411            $canv coords $ith $coords
3412            if {$arrow ne $ah} {
3413                $canv itemconf $ith -arrow $arrow
3414            }
3415            lset lines $i 0 $row
3416        }
3417    } else {
3418        set xo [lsearch -exact [lindex $rowidlist [expr {$row - 1}]] $id]
3419        set ndir [expr {$xo - $xp}]
3420        set clow [$canv coords $itl]
3421        if {$dir == $ndir} {
3422            set clow [lrange $clow 2 end]
3423        }
3424        set coords [concat $coords $clow]
3425        if {!$joinhigh} {
3426            lset lines [expr {$i-1}] 1 $le
3427        } else {
3428            # coalesce two pieces
3429            $canv delete $ith
3430            set b [lindex $lines [expr {$i-1}] 0]
3431            set e [lindex $lines $i 1]
3432            set lines [lreplace $lines [expr {$i-1}] $i [list $b $e $itl]]
3433        }
3434        $canv coords $itl $coords
3435        if {$arrow ne $al} {
3436            $canv itemconf $itl -arrow $arrow
3437        }
3438    }
3439
3440    set linesegs($id) $lines
3441    return $le
3442}
3443
3444proc drawparentlinks {id row} {
3445    global rowidlist canv colormap curview parentlist
3446    global idpos linespc
3447
3448    set rowids [lindex $rowidlist $row]
3449    set col [lsearch -exact $rowids $id]
3450    if {$col < 0} return
3451    set olds [lindex $parentlist $row]
3452    set row2 [expr {$row + 1}]
3453    set x [xc $row $col]
3454    set y [yc $row]
3455    set y2 [yc $row2]
3456    set d [expr {int(0.5 * $linespc)}]
3457    set ymid [expr {$y + $d}]
3458    set ids [lindex $rowidlist $row2]
3459    # rmx = right-most X coord used
3460    set rmx 0
3461    foreach p $olds {
3462        set i [lsearch -exact $ids $p]
3463        if {$i < 0} {
3464            puts "oops, parent $p of $id not in list"
3465            continue
3466        }
3467        set x2 [xc $row2 $i]
3468        if {$x2 > $rmx} {
3469            set rmx $x2
3470        }
3471        set j [lsearch -exact $rowids $p]
3472        if {$j < 0} {
3473            # drawlineseg will do this one for us
3474            continue
3475        }
3476        assigncolor $p
3477        # should handle duplicated parents here...
3478        set coords [list $x $y]
3479        if {$i != $col} {
3480            # if attaching to a vertical segment, draw a smaller
3481            # slant for visual distinctness
3482            if {$i == $j} {
3483                if {$i < $col} {
3484                    lappend coords [expr {$x2 + $d}] $y $x2 $ymid
3485                } else {
3486                    lappend coords [expr {$x2 - $d}] $y $x2 $ymid
3487                }
3488            } elseif {$i < $col && $i < $j} {
3489                # segment slants towards us already
3490                lappend coords [xc $row $j] $y
3491            } else {
3492                if {$i < $col - 1} {
3493                    lappend coords [expr {$x2 + $linespc}] $y
3494                } elseif {$i > $col + 1} {
3495                    lappend coords [expr {$x2 - $linespc}] $y
3496                }
3497                lappend coords $x2 $y2
3498            }
3499        } else {
3500            lappend coords $x2 $y2
3501        }
3502        set t [$canv create line $coords -width [linewidth $p] \
3503                   -fill $colormap($p) -tags lines.$p]
3504        $canv lower $t
3505        bindline $t $p
3506    }
3507    if {$rmx > [lindex $idpos($id) 1]} {
3508        lset idpos($id) 1 $rmx
3509        redrawtags $id
3510    }
3511}
3512
3513proc drawlines {id} {
3514    global canv
3515
3516    $canv itemconf lines.$id -width [linewidth $id]
3517}
3518
3519proc drawcmittext {id row col} {
3520    global linespc canv canv2 canv3 canvy0 fgcolor curview
3521    global commitlisted commitinfo rowidlist parentlist
3522    global rowtextx idpos idtags idheads idotherrefs
3523    global linehtag linentag linedtag
3524    global mainfont canvxmax boldrows boldnamerows fgcolor nullid nullid2
3525
3526    # listed is 0 for boundary, 1 for normal, 2 for left, 3 for right
3527    set listed [lindex $commitlisted $row]
3528    if {$id eq $nullid} {
3529        set ofill red
3530    } elseif {$id eq $nullid2} {
3531        set ofill green
3532    } else {
3533        set ofill [expr {$listed != 0? "blue": "white"}]
3534    }
3535    set x [xc $row $col]
3536    set y [yc $row]
3537    set orad [expr {$linespc / 3}]
3538    if {$listed <= 1} {
3539        set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
3540                   [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
3541                   -fill $ofill -outline $fgcolor -width 1 -tags circle]
3542    } elseif {$listed == 2} {
3543        # triangle pointing left for left-side commits
3544        set t [$canv create polygon \
3545                   [expr {$x - $orad}] $y \
3546                   [expr {$x + $orad - 1}] [expr {$y - $orad}] \
3547                   [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
3548                   -fill $ofill -outline $fgcolor -width 1 -tags circle]
3549    } else {
3550        # triangle pointing right for right-side commits
3551        set t [$canv create polygon \
3552                   [expr {$x + $orad - 1}] $y \
3553                   [expr {$x - $orad}] [expr {$y - $orad}] \
3554                   [expr {$x - $orad}] [expr {$y + $orad - 1}] \
3555                   -fill $ofill -outline $fgcolor -width 1 -tags circle]
3556    }
3557    $canv raise $t
3558    $canv bind $t <1> {selcanvline {} %x %y}
3559    set rmx [llength [lindex $rowidlist $row]]
3560    set olds [lindex $parentlist $row]
3561    if {$olds ne {}} {
3562        set nextids [lindex $rowidlist [expr {$row + 1}]]
3563        foreach p $olds {
3564            set i [lsearch -exact $nextids $p]
3565            if {$i > $rmx} {
3566                set rmx $i
3567            }
3568        }
3569    }
3570    set xt [xc $row $rmx]
3571    set rowtextx($row) $xt
3572    set idpos($id) [list $x $xt $y]
3573    if {[info exists idtags($id)] || [info exists idheads($id)]
3574        || [info exists idotherrefs($id)]} {
3575        set xt [drawtags $id $x $xt $y]
3576    }
3577    set headline [lindex $commitinfo($id) 0]
3578    set name [lindex $commitinfo($id) 1]
3579    set date [lindex $commitinfo($id) 2]
3580    set date [formatdate $date]
3581    set font $mainfont
3582    set nfont $mainfont
3583    set isbold [ishighlighted $row]
3584    if {$isbold > 0} {
3585        lappend boldrows $row
3586        lappend font bold
3587        if {$isbold > 1} {
3588            lappend boldnamerows $row
3589            lappend nfont bold
3590        }
3591    }
3592    set linehtag($row) [$canv create text $xt $y -anchor w -fill $fgcolor \
3593                            -text $headline -font $font -tags text]
3594    $canv bind $linehtag($row) <Button-3> "rowmenu %X %Y $id"
3595    set linentag($row) [$canv2 create text 3 $y -anchor w -fill $fgcolor \
3596                            -text $name -font $nfont -tags text]
3597    set linedtag($row) [$canv3 create text 3 $y -anchor w -fill $fgcolor \
3598                            -text $date -font $mainfont -tags text]
3599    set xr [expr {$xt + [font measure $mainfont $headline]}]
3600    if {$xr > $canvxmax} {
3601        set canvxmax $xr
3602        setcanvscroll
3603    }
3604}
3605
3606proc drawcmitrow {row} {
3607    global displayorder rowidlist
3608    global iddrawn markingmatches
3609    global commitinfo parentlist numcommits
3610    global filehighlight fhighlights findstring nhighlights
3611    global hlview vhighlights
3612    global highlight_related rhighlights
3613
3614    if {$row >= $numcommits} return
3615
3616    set id [lindex $displayorder $row]
3617    if {[info exists hlview] && ![info exists vhighlights($row)]} {
3618        askvhighlight $row $id
3619    }
3620    if {[info exists filehighlight] && ![info exists fhighlights($row)]} {
3621        askfilehighlight $row $id
3622    }
3623    if {$findstring ne {} && ![info exists nhighlights($row)]} {
3624        askfindhighlight $row $id
3625    }
3626    if {$highlight_related ne "None" && ![info exists rhighlights($row)]} {
3627        askrelhighlight $row $id
3628    }
3629    if {![info exists iddrawn($id)]} {
3630        set col [lsearch -exact [lindex $rowidlist $row] $id]
3631        if {$col < 0} {
3632            puts "oops, row $row id $id not in list"
3633            return
3634        }
3635        if {![info exists commitinfo($id)]} {
3636            getcommit $id
3637        }
3638        assigncolor $id
3639        drawcmittext $id $row $col
3640        set iddrawn($id) 1
3641    }
3642    if {$markingmatches} {
3643        markrowmatches $row $id
3644    }
3645}
3646
3647proc drawcommits {row {endrow {}}} {
3648    global numcommits iddrawn displayorder curview
3649    global parentlist rowidlist
3650
3651    if {$row < 0} {
3652        set row 0
3653    }
3654    if {$endrow eq {}} {
3655        set endrow $row
3656    }
3657    if {$endrow >= $numcommits} {
3658        set endrow [expr {$numcommits - 1}]
3659    }
3660
3661    # make the lines join to already-drawn rows either side
3662    set r [expr {$row - 1}]
3663    if {$r < 0 || ![info exists iddrawn([lindex $displayorder $r])]} {
3664        set r $row
3665    }
3666    set er [expr {$endrow + 1}]
3667    if {$er >= $numcommits ||
3668        ![info exists iddrawn([lindex $displayorder $er])]} {
3669        set er $endrow
3670    }
3671    for {} {$r <= $er} {incr r} {
3672        set id [lindex $displayorder $r]
3673        set wasdrawn [info exists iddrawn($id)]
3674        drawcmitrow $r
3675        if {$r == $er} break
3676        set nextid [lindex $displayorder [expr {$r + 1}]]
3677        if {$wasdrawn && [info exists iddrawn($nextid)]} {
3678            catch {unset prevlines}
3679            continue
3680        }
3681        drawparentlinks $id $r
3682
3683        if {[info exists lineends($r)]} {
3684            foreach lid $lineends($r) {
3685                unset prevlines($lid)
3686            }
3687        }
3688        set rowids [lindex $rowidlist $r]
3689        foreach lid $rowids {
3690            if {$lid eq {}} continue
3691            if {$lid eq $id} {
3692                # see if this is the first child of any of its parents
3693                foreach p [lindex $parentlist $r] {
3694                    if {[lsearch -exact $rowids $p] < 0} {
3695                        # make this line extend up to the child
3696                        set le [drawlineseg $p $r $er 0]
3697                        lappend lineends($le) $p
3698                        set prevlines($p) 1
3699                    }
3700                }
3701            } elseif {![info exists prevlines($lid)]} {
3702                set le [drawlineseg $lid $r $er 1]
3703                lappend lineends($le) $lid
3704                set prevlines($lid) 1
3705            }
3706        }
3707    }
3708}
3709
3710proc drawfrac {f0 f1} {
3711    global canv linespc
3712
3713    set ymax [lindex [$canv cget -scrollregion] 3]
3714    if {$ymax eq {} || $ymax == 0} return
3715    set y0 [expr {int($f0 * $ymax)}]
3716    set row [expr {int(($y0 - 3) / $linespc) - 1}]
3717    set y1 [expr {int($f1 * $ymax)}]
3718    set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
3719    drawcommits $row $endrow
3720}
3721
3722proc drawvisible {} {
3723    global canv
3724    eval drawfrac [$canv yview]
3725}
3726
3727proc clear_display {} {
3728    global iddrawn linesegs
3729    global vhighlights fhighlights nhighlights rhighlights
3730
3731    allcanvs delete all
3732    catch {unset iddrawn}
3733    catch {unset linesegs}
3734    catch {unset vhighlights}
3735    catch {unset fhighlights}
3736    catch {unset nhighlights}
3737    catch {unset rhighlights}
3738}
3739
3740proc findcrossings {id} {
3741    global rowidlist parentlist numcommits displayorder
3742
3743    set cross {}
3744    set ccross {}
3745    foreach {s e} [rowranges $id] {
3746        if {$e >= $numcommits} {
3747            set e [expr {$numcommits - 1}]
3748        }
3749        if {$e <= $s} continue
3750        for {set row $e} {[incr row -1] >= $s} {} {
3751            set x [lsearch -exact [lindex $rowidlist $row] $id]
3752            if {$x < 0} break
3753            set olds [lindex $parentlist $row]
3754            set kid [lindex $displayorder $row]
3755            set kidx [lsearch -exact [lindex $rowidlist $row] $kid]
3756            if {$kidx < 0} continue
3757            set nextrow [lindex $rowidlist [expr {$row + 1}]]
3758            foreach p $olds {
3759                set px [lsearch -exact $nextrow $p]
3760                if {$px < 0} continue
3761                if {($kidx < $x && $x < $px) || ($px < $x && $x < $kidx)} {
3762                    if {[lsearch -exact $ccross $p] >= 0} continue
3763                    if {$x == $px + ($kidx < $px? -1: 1)} {
3764                        lappend ccross $p
3765                    } elseif {[lsearch -exact $cross $p] < 0} {
3766                        lappend cross $p
3767                    }
3768                }
3769            }
3770        }
3771    }
3772    return [concat $ccross {{}} $cross]
3773}
3774
3775proc assigncolor {id} {
3776    global colormap colors nextcolor
3777    global commitrow parentlist children children curview
3778
3779    if {[info exists colormap($id)]} return
3780    set ncolors [llength $colors]
3781    if {[info exists children($curview,$id)]} {
3782        set kids $children($curview,$id)
3783    } else {
3784        set kids {}
3785    }
3786    if {[llength $kids] == 1} {
3787        set child [lindex $kids 0]
3788        if {[info exists colormap($child)]
3789            && [llength [lindex $parentlist $commitrow($curview,$child)]] == 1} {
3790            set colormap($id) $colormap($child)
3791            return
3792        }
3793    }
3794    set badcolors {}
3795    set origbad {}
3796    foreach x [findcrossings $id] {
3797        if {$x eq {}} {
3798            # delimiter between corner crossings and other crossings
3799            if {[llength $badcolors] >= $ncolors - 1} break
3800            set origbad $badcolors
3801        }
3802        if {[info exists colormap($x)]
3803            && [lsearch -exact $badcolors $colormap($x)] < 0} {
3804            lappend badcolors $colormap($x)
3805        }
3806    }
3807    if {[llength $badcolors] >= $ncolors} {
3808        set badcolors $origbad
3809    }
3810    set origbad $badcolors
3811    if {[llength $badcolors] < $ncolors - 1} {
3812        foreach child $kids {
3813            if {[info exists colormap($child)]
3814                && [lsearch -exact $badcolors $colormap($child)] < 0} {
3815                lappend badcolors $colormap($child)
3816            }
3817            foreach p [lindex $parentlist $commitrow($curview,$child)] {
3818                if {[info exists colormap($p)]
3819                    && [lsearch -exact $badcolors $colormap($p)] < 0} {
3820                    lappend badcolors $colormap($p)
3821                }
3822            }
3823        }
3824        if {[llength $badcolors] >= $ncolors} {
3825            set badcolors $origbad
3826        }
3827    }
3828    for {set i 0} {$i <= $ncolors} {incr i} {
3829        set c [lindex $colors $nextcolor]
3830        if {[incr nextcolor] >= $ncolors} {
3831            set nextcolor 0
3832        }
3833        if {[lsearch -exact $badcolors $c]} break
3834    }
3835    set colormap($id) $c
3836}
3837
3838proc bindline {t id} {
3839    global canv
3840
3841    $canv bind $t <Enter> "lineenter %x %y $id"
3842    $canv bind $t <Motion> "linemotion %x %y $id"
3843    $canv bind $t <Leave> "lineleave $id"
3844    $canv bind $t <Button-1> "lineclick %x %y $id 1"
3845}
3846
3847proc drawtags {id x xt y1} {
3848    global idtags idheads idotherrefs mainhead
3849    global linespc lthickness
3850    global canv mainfont commitrow rowtextx curview fgcolor bgcolor
3851
3852    set marks {}
3853    set ntags 0
3854    set nheads 0
3855    if {[info exists idtags($id)]} {
3856        set marks $idtags($id)
3857        set ntags [llength $marks]
3858    }
3859    if {[info exists idheads($id)]} {
3860        set marks [concat $marks $idheads($id)]
3861        set nheads [llength $idheads($id)]
3862    }
3863    if {[info exists idotherrefs($id)]} {
3864        set marks [concat $marks $idotherrefs($id)]
3865    }
3866    if {$marks eq {}} {
3867        return $xt
3868    }
3869
3870    set delta [expr {int(0.5 * ($linespc - $lthickness))}]
3871    set yt [expr {$y1 - 0.5 * $linespc}]
3872    set yb [expr {$yt + $linespc - 1}]
3873    set xvals {}
3874    set wvals {}
3875    set i -1
3876    foreach tag $marks {
3877        incr i
3878        if {$i >= $ntags && $i < $ntags + $nheads && $tag eq $mainhead} {
3879            set wid [font measure [concat $mainfont bold] $tag]
3880        } else {
3881            set wid [font measure $mainfont $tag]
3882        }
3883        lappend xvals $xt
3884        lappend wvals $wid
3885        set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
3886    }
3887    set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
3888               -width $lthickness -fill black -tags tag.$id]
3889    $canv lower $t
3890    foreach tag $marks x $xvals wid $wvals {
3891        set xl [expr {$x + $delta}]
3892        set xr [expr {$x + $delta + $wid + $lthickness}]
3893        set font $mainfont
3894        if {[incr ntags -1] >= 0} {
3895            # draw a tag
3896            set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
3897                       $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
3898                       -width 1 -outline black -fill yellow -tags tag.$id]
3899            $canv bind $t <1> [list showtag $tag 1]
3900            set rowtextx($commitrow($curview,$id)) [expr {$xr + $linespc}]
3901        } else {
3902            # draw a head or other ref
3903            if {[incr nheads -1] >= 0} {
3904                set col green
3905                if {$tag eq $mainhead} {
3906                    lappend font bold
3907                }
3908            } else {
3909                set col "#ddddff"
3910            }
3911            set xl [expr {$xl - $delta/2}]
3912            $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
3913                -width 1 -outline black -fill $col -tags tag.$id
3914            if {[regexp {^(remotes/.*/|remotes/)} $tag match remoteprefix]} {
3915                set rwid [font measure $mainfont $remoteprefix]
3916                set xi [expr {$x + 1}]
3917                set yti [expr {$yt + 1}]
3918                set xri [expr {$x + $rwid}]
3919                $canv create polygon $xi $yti $xri $yti $xri $yb $xi $yb \
3920                        -width 0 -fill "#ffddaa" -tags tag.$id
3921            }
3922        }
3923        set t [$canv create text $xl $y1 -anchor w -text $tag -fill $fgcolor \
3924                   -font $font -tags [list tag.$id text]]
3925        if {$ntags >= 0} {
3926            $canv bind $t <1> [list showtag $tag 1]
3927        } elseif {$nheads >= 0} {
3928            $canv bind $t <Button-3> [list headmenu %X %Y $id $tag]
3929        }
3930    }
3931    return $xt
3932}
3933
3934proc xcoord {i level ln} {
3935    global canvx0 xspc1 xspc2
3936
3937    set x [expr {$canvx0 + $i * $xspc1($ln)}]
3938    if {$i > 0 && $i == $level} {
3939        set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
3940    } elseif {$i > $level} {
3941        set x [expr {$x + $xspc2 - $xspc1($ln)}]
3942    }
3943    return $x
3944}
3945
3946proc show_status {msg} {
3947    global canv mainfont fgcolor
3948
3949    clear_display
3950    $canv create text 3 3 -anchor nw -text $msg -font $mainfont \
3951        -tags text -fill $fgcolor
3952}
3953
3954# Insert a new commit as the child of the commit on row $row.
3955# The new commit will be displayed on row $row and the commits
3956# on that row and below will move down one row.
3957proc insertrow {row newcmit} {
3958    global displayorder parentlist commitlisted children
3959    global commitrow curview rowidlist numcommits
3960    global rowlaidout rowoptim numcommits
3961    global selectedline rowchk commitidx
3962
3963    if {$row >= $numcommits} {
3964        puts "oops, inserting new row $row but only have $numcommits rows"
3965        return
3966    }
3967    set p [lindex $displayorder $row]
3968    set displayorder [linsert $displayorder $row $newcmit]
3969    set parentlist [linsert $parentlist $row $p]
3970    set kids $children($curview,$p)
3971    lappend kids $newcmit
3972    set children($curview,$p) $kids
3973    set children($curview,$newcmit) {}
3974    set commitlisted [linsert $commitlisted $row 1]
3975    set l [llength $displayorder]
3976    for {set r $row} {$r < $l} {incr r} {
3977        set id [lindex $displayorder $r]
3978        set commitrow($curview,$id) $r
3979    }
3980    incr commitidx($curview)
3981
3982    set idlist [lindex $rowidlist $row]
3983    if {[llength $kids] == 1} {
3984        set col [lsearch -exact $idlist $p]
3985        lset idlist $col $newcmit
3986    } else {
3987        set col [llength $idlist]
3988        lappend idlist $newcmit
3989    }
3990    set rowidlist [linsert $rowidlist $row $idlist]
3991
3992    catch {unset rowchk}
3993
3994    incr rowlaidout
3995    incr rowoptim
3996    incr numcommits
3997
3998    if {[info exists selectedline] && $selectedline >= $row} {
3999        incr selectedline
4000    }
4001    redisplay
4002}
4003
4004# Remove a commit that was inserted with insertrow on row $row.
4005proc removerow {row} {
4006    global displayorder parentlist commitlisted children
4007    global commitrow curview rowidlist numcommits
4008    global rowlaidout rowoptim numcommits
4009    global linesegends selectedline rowchk commitidx
4010
4011    if {$row >= $numcommits} {
4012        puts "oops, removing row $row but only have $numcommits rows"
4013        return
4014    }
4015    set rp1 [expr {$row + 1}]
4016    set id [lindex $displayorder $row]
4017    set p [lindex $parentlist $row]
4018    set displayorder [lreplace $displayorder $row $row]
4019    set parentlist [lreplace $parentlist $row $row]
4020    set commitlisted [lreplace $commitlisted $row $row]
4021    set kids $children($curview,$p)
4022    set i [lsearch -exact $kids $id]
4023    if {$i >= 0} {
4024        set kids [lreplace $kids $i $i]
4025        set children($curview,$p) $kids
4026    }
4027    set l [llength $displayorder]
4028    for {set r $row} {$r < $l} {incr r} {
4029        set id [lindex $displayorder $r]
4030        set commitrow($curview,$id) $r
4031    }
4032    incr commitidx($curview) -1
4033
4034    set rowidlist [lreplace $rowidlist $row $row]
4035
4036    catch {unset rowchk}
4037
4038    incr rowlaidout -1
4039    incr rowoptim -1
4040    incr numcommits -1
4041
4042    if {[info exists selectedline] && $selectedline > $row} {
4043        incr selectedline -1
4044    }
4045    redisplay
4046}
4047
4048# Don't change the text pane cursor if it is currently the hand cursor,
4049# showing that we are over a sha1 ID link.
4050proc settextcursor {c} {
4051    global ctext curtextcursor
4052
4053    if {[$ctext cget -cursor] == $curtextcursor} {
4054        $ctext config -cursor $c
4055    }
4056    set curtextcursor $c
4057}
4058
4059proc nowbusy {what} {
4060    global isbusy
4061
4062    if {[array names isbusy] eq {}} {
4063        . config -cursor watch
4064        settextcursor watch
4065    }
4066    set isbusy($what) 1
4067}
4068
4069proc notbusy {what} {
4070    global isbusy maincursor textcursor
4071
4072    catch {unset isbusy($what)}
4073    if {[array names isbusy] eq {}} {
4074        . config -cursor $maincursor
4075        settextcursor $textcursor
4076    }
4077}
4078
4079proc findmatches {f} {
4080    global findtype findstring
4081    if {$findtype == "Regexp"} {
4082        set matches [regexp -indices -all -inline $findstring $f]
4083    } else {
4084        set fs $findstring
4085        if {$findtype == "IgnCase"} {
4086            set f [string tolower $f]
4087            set fs [string tolower $fs]
4088        }
4089        set matches {}
4090        set i 0
4091        set l [string length $fs]
4092        while {[set j [string first $fs $f $i]] >= 0} {
4093            lappend matches [list $j [expr {$j+$l-1}]]
4094            set i [expr {$j + $l}]
4095        }
4096    }
4097    return $matches
4098}
4099
4100proc dofind {{rev 0}} {
4101    global findstring findstartline findcurline selectedline numcommits
4102
4103    unmarkmatches
4104    cancel_next_highlight
4105    focus .
4106    if {$findstring eq {} || $numcommits == 0} return
4107    if {![info exists selectedline]} {
4108        set findstartline [lindex [visiblerows] $rev]
4109    } else {
4110        set findstartline $selectedline
4111    }
4112    set findcurline $findstartline
4113    nowbusy finding
4114    if {!$rev} {
4115        run findmore
4116    } else {
4117        if {$findcurline == 0} {
4118            set findcurline $numcommits
4119        }
4120        incr findcurline -1
4121        run findmorerev
4122    }
4123}
4124
4125proc findnext {restart} {
4126    global findcurline
4127    if {![info exists findcurline]} {
4128        if {$restart} {
4129            dofind
4130        } else {
4131            bell
4132        }
4133    } else {
4134        run findmore
4135        nowbusy finding
4136    }
4137}
4138
4139proc findprev {} {
4140    global findcurline
4141    if {![info exists findcurline]} {
4142        dofind 1
4143    } else {
4144        run findmorerev
4145        nowbusy finding
4146    }
4147}
4148
4149proc findmore {} {
4150    global commitdata commitinfo numcommits findstring findpattern findloc
4151    global findstartline findcurline displayorder
4152
4153    set fldtypes {Headline Author Date Committer CDate Comments}
4154    set l [expr {$findcurline + 1}]
4155    if {$l >= $numcommits} {
4156        set l 0
4157    }
4158    if {$l <= $findstartline} {
4159        set lim [expr {$findstartline + 1}]
4160    } else {
4161        set lim $numcommits
4162    }
4163    if {$lim - $l > 500} {
4164        set lim [expr {$l + 500}]
4165    }
4166    set last 0
4167    for {} {$l < $lim} {incr l} {
4168        set id [lindex $displayorder $l]
4169        # shouldn't happen unless git log doesn't give all the commits...
4170        if {![info exists commitdata($id)]} continue
4171        if {![doesmatch $commitdata($id)]} continue
4172        if {![info exists commitinfo($id)]} {
4173            getcommit $id
4174        }
4175        set info $commitinfo($id)
4176        foreach f $info ty $fldtypes {
4177            if {($findloc eq "All fields" || $findloc eq $ty) &&
4178                [doesmatch $f]} {
4179                findselectline $l
4180                notbusy finding
4181                return 0
4182            }
4183        }
4184    }
4185    if {$l == $findstartline + 1} {
4186        bell
4187        unset findcurline
4188        notbusy finding
4189        return 0
4190    }
4191    set findcurline [expr {$l - 1}]
4192    return 1
4193}
4194
4195proc findmorerev {} {
4196    global commitdata commitinfo numcommits findstring findpattern findloc
4197    global findstartline findcurline displayorder
4198
4199    set fldtypes {Headline Author Date Committer CDate Comments}
4200    set l $findcurline
4201    if {$l == 0} {
4202        set l $numcommits
4203    }
4204    incr l -1
4205    if {$l >= $findstartline} {
4206        set lim [expr {$findstartline - 1}]
4207    } else {
4208        set lim -1
4209    }
4210    if {$l - $lim > 500} {
4211        set lim [expr {$l - 500}]
4212    }
4213    set last 0
4214    for {} {$l > $lim} {incr l -1} {
4215        set id [lindex $displayorder $l]
4216        if {![info exists commitdata($id)]} continue
4217        if {![doesmatch $commitdata($id)]} continue
4218        if {![info exists commitinfo($id)]} {
4219            getcommit $id
4220        }
4221        set info $commitinfo($id)
4222        foreach f $info ty $fldtypes {
4223            if {($findloc eq "All fields" || $findloc eq $ty) &&
4224                [doesmatch $f]} {
4225                findselectline $l
4226                notbusy finding
4227                return 0
4228            }
4229        }
4230    }
4231    if {$l == -1} {
4232        bell
4233        unset findcurline
4234        notbusy finding
4235        return 0
4236    }
4237    set findcurline [expr {$l + 1}]
4238    return 1
4239}
4240
4241proc findselectline {l} {
4242    global findloc commentend ctext findcurline markingmatches
4243
4244    set markingmatches 1
4245    set findcurline $l
4246    selectline $l 1
4247    if {$findloc == "All fields" || $findloc == "Comments"} {
4248        # highlight the matches in the comments
4249        set f [$ctext get 1.0 $commentend]
4250        set matches [findmatches $f]
4251        foreach match $matches {
4252            set start [lindex $match 0]
4253            set end [expr {[lindex $match 1] + 1}]
4254            $ctext tag add found "1.0 + $start c" "1.0 + $end c"
4255        }
4256    }
4257    drawvisible
4258}
4259
4260# mark the bits of a headline or author that match a find string
4261proc markmatches {canv l str tag matches font row} {
4262    global selectedline
4263
4264    set bbox [$canv bbox $tag]
4265    set x0 [lindex $bbox 0]
4266    set y0 [lindex $bbox 1]
4267    set y1 [lindex $bbox 3]
4268    foreach match $matches {
4269        set start [lindex $match 0]
4270        set end [lindex $match 1]
4271        if {$start > $end} continue
4272        set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
4273        set xlen [font measure $font [string range $str 0 [expr {$end}]]]
4274        set t [$canv create rect [expr {$x0+$xoff}] $y0 \
4275                   [expr {$x0+$xlen+2}] $y1 \
4276                   -outline {} -tags [list match$l matches] -fill yellow]
4277        $canv lower $t
4278        if {[info exists selectedline] && $row == $selectedline} {
4279            $canv raise $t secsel
4280        }
4281    }
4282}
4283
4284proc unmarkmatches {} {
4285    global findids markingmatches findcurline
4286
4287    allcanvs delete matches
4288    catch {unset findids}
4289    set markingmatches 0
4290    catch {unset findcurline}
4291}
4292
4293proc selcanvline {w x y} {
4294    global canv canvy0 ctext linespc
4295    global rowtextx
4296    set ymax [lindex [$canv cget -scrollregion] 3]
4297    if {$ymax == {}} return
4298    set yfrac [lindex [$canv yview] 0]
4299    set y [expr {$y + $yfrac * $ymax}]
4300    set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
4301    if {$l < 0} {
4302        set l 0
4303    }
4304    if {$w eq $canv} {
4305        if {![info exists rowtextx($l)] || $x < $rowtextx($l)} return
4306    }
4307    unmarkmatches
4308    selectline $l 1
4309}
4310
4311proc commit_descriptor {p} {
4312    global commitinfo
4313    if {![info exists commitinfo($p)]} {
4314        getcommit $p
4315    }
4316    set l "..."
4317    if {[llength $commitinfo($p)] > 1} {
4318        set l [lindex $commitinfo($p) 0]
4319    }
4320    return "$p ($l)\n"
4321}
4322
4323# append some text to the ctext widget, and make any SHA1 ID
4324# that we know about be a clickable link.
4325proc appendwithlinks {text tags} {
4326    global ctext commitrow linknum curview pendinglinks
4327
4328    set start [$ctext index "end - 1c"]
4329    $ctext insert end $text $tags
4330    set links [regexp -indices -all -inline {[0-9a-f]{40}} $text]
4331    foreach l $links {
4332        set s [lindex $l 0]
4333        set e [lindex $l 1]
4334        set linkid [string range $text $s $e]
4335        incr e
4336        $ctext tag add link$linknum "$start + $s c" "$start + $e c"
4337        setlink $linkid link$linknum
4338        incr linknum
4339    }
4340}
4341
4342proc setlink {id lk} {
4343    global curview commitrow ctext pendinglinks commitinterest
4344
4345    if {[info exists commitrow($curview,$id)]} {
4346        $ctext tag conf $lk -foreground blue -underline 1
4347        $ctext tag bind $lk <1> [list selectline $commitrow($curview,$id) 1]
4348        $ctext tag bind $lk <Enter> {linkcursor %W 1}
4349        $ctext tag bind $lk <Leave> {linkcursor %W -1}
4350    } else {
4351        lappend pendinglinks($id) $lk
4352        lappend commitinterest($id) {makelink %I}
4353    }
4354}
4355
4356proc makelink {id} {
4357    global pendinglinks
4358
4359    if {![info exists pendinglinks($id)]} return
4360    foreach lk $pendinglinks($id) {
4361        setlink $id $lk
4362    }
4363    unset pendinglinks($id)
4364}
4365
4366proc linkcursor {w inc} {
4367    global linkentercount curtextcursor
4368
4369    if {[incr linkentercount $inc] > 0} {
4370        $w configure -cursor hand2
4371    } else {
4372        $w configure -cursor $curtextcursor
4373        if {$linkentercount < 0} {
4374            set linkentercount 0
4375        }
4376    }
4377}
4378
4379proc viewnextline {dir} {
4380    global canv linespc
4381
4382    $canv delete hover
4383    set ymax [lindex [$canv cget -scrollregion] 3]
4384    set wnow [$canv yview]
4385    set wtop [expr {[lindex $wnow 0] * $ymax}]
4386    set newtop [expr {$wtop + $dir * $linespc}]
4387    if {$newtop < 0} {
4388        set newtop 0
4389    } elseif {$newtop > $ymax} {
4390        set newtop $ymax
4391    }
4392    allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
4393}
4394
4395# add a list of tag or branch names at position pos
4396# returns the number of names inserted
4397proc appendrefs {pos ids var} {
4398    global ctext commitrow linknum curview $var maxrefs
4399
4400    if {[catch {$ctext index $pos}]} {
4401        return 0
4402    }
4403    $ctext conf -state normal
4404    $ctext delete $pos "$pos lineend"
4405    set tags {}
4406    foreach id $ids {
4407        foreach tag [set $var\($id\)] {
4408            lappend tags [list $tag $id]
4409        }
4410    }
4411    if {[llength $tags] > $maxrefs} {
4412        $ctext insert $pos "many ([llength $tags])"
4413    } else {
4414        set tags [lsort -index 0 -decreasing $tags]
4415        set sep {}
4416        foreach ti $tags {
4417            set id [lindex $ti 1]
4418            set lk link$linknum
4419            incr linknum
4420            $ctext tag delete $lk
4421            $ctext insert $pos $sep
4422            $ctext insert $pos [lindex $ti 0] $lk
4423            setlink $id $lk
4424            set sep ", "
4425        }
4426    }
4427    $ctext conf -state disabled
4428    return [llength $tags]
4429}
4430
4431# called when we have finished computing the nearby tags
4432proc dispneartags {delay} {
4433    global selectedline currentid showneartags tagphase
4434
4435    if {![info exists selectedline] || !$showneartags} return
4436    after cancel dispnexttag
4437    if {$delay} {
4438        after 200 dispnexttag
4439        set tagphase -1
4440    } else {
4441        after idle dispnexttag
4442        set tagphase 0
4443    }
4444}
4445
4446proc dispnexttag {} {
4447    global selectedline currentid showneartags tagphase ctext
4448
4449    if {![info exists selectedline] || !$showneartags} return
4450    switch -- $tagphase {
4451        0 {
4452            set dtags [desctags $currentid]
4453            if {$dtags ne {}} {
4454                appendrefs precedes $dtags idtags
4455            }
4456        }
4457        1 {
4458            set atags [anctags $currentid]
4459            if {$atags ne {}} {
4460                appendrefs follows $atags idtags
4461            }
4462        }
4463        2 {
4464            set dheads [descheads $currentid]
4465            if {$dheads ne {}} {
4466                if {[appendrefs branch $dheads idheads] > 1
4467                    && [$ctext get "branch -3c"] eq "h"} {
4468                    # turn "Branch" into "Branches"
4469                    $ctext conf -state normal
4470                    $ctext insert "branch -2c" "es"
4471                    $ctext conf -state disabled
4472                }
4473            }
4474        }
4475    }
4476    if {[incr tagphase] <= 2} {
4477        after idle dispnexttag
4478    }
4479}
4480
4481proc selectline {l isnew} {
4482    global canv canv2 canv3 ctext commitinfo selectedline
4483    global displayorder linehtag linentag linedtag
4484    global canvy0 linespc parentlist children curview
4485    global currentid sha1entry
4486    global commentend idtags linknum
4487    global mergemax numcommits pending_select
4488    global cmitmode showneartags allcommits
4489
4490    catch {unset pending_select}
4491    $canv delete hover
4492    normalline
4493    cancel_next_highlight
4494    unsel_reflist
4495    if {$l < 0 || $l >= $numcommits} return
4496    set y [expr {$canvy0 + $l * $linespc}]
4497    set ymax [lindex [$canv cget -scrollregion] 3]
4498    set ytop [expr {$y - $linespc - 1}]
4499    set ybot [expr {$y + $linespc + 1}]
4500    set wnow [$canv yview]
4501    set wtop [expr {[lindex $wnow 0] * $ymax}]
4502    set wbot [expr {[lindex $wnow 1] * $ymax}]
4503    set wh [expr {$wbot - $wtop}]
4504    set newtop $wtop
4505    if {$ytop < $wtop} {
4506        if {$ybot < $wtop} {
4507            set newtop [expr {$y - $wh / 2.0}]
4508        } else {
4509            set newtop $ytop
4510            if {$newtop > $wtop - $linespc} {
4511                set newtop [expr {$wtop - $linespc}]
4512            }
4513        }
4514    } elseif {$ybot > $wbot} {
4515        if {$ytop > $wbot} {
4516            set newtop [expr {$y - $wh / 2.0}]
4517        } else {
4518            set newtop [expr {$ybot - $wh}]
4519            if {$newtop < $wtop + $linespc} {
4520                set newtop [expr {$wtop + $linespc}]
4521            }
4522        }
4523    }
4524    if {$newtop != $wtop} {
4525        if {$newtop < 0} {
4526            set newtop 0
4527        }
4528        allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
4529        drawvisible
4530    }
4531
4532    if {![info exists linehtag($l)]} return
4533    $canv delete secsel
4534    set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
4535               -tags secsel -fill [$canv cget -selectbackground]]
4536    $canv lower $t
4537    $canv2 delete secsel
4538    set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
4539               -tags secsel -fill [$canv2 cget -selectbackground]]
4540    $canv2 lower $t
4541    $canv3 delete secsel
4542    set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
4543               -tags secsel -fill [$canv3 cget -selectbackground]]
4544    $canv3 lower $t
4545
4546    if {$isnew} {
4547        addtohistory [list selectline $l 0]
4548    }
4549
4550    set selectedline $l
4551
4552    set id [lindex $displayorder $l]
4553    set currentid $id
4554    $sha1entry delete 0 end
4555    $sha1entry insert 0 $id
4556    $sha1entry selection from 0
4557    $sha1entry selection to end
4558    rhighlight_sel $id
4559
4560    $ctext conf -state normal
4561    clear_ctext
4562    set linknum 0
4563    set info $commitinfo($id)
4564    set date [formatdate [lindex $info 2]]
4565    $ctext insert end "Author: [lindex $info 1]  $date\n"
4566    set date [formatdate [lindex $info 4]]
4567    $ctext insert end "Committer: [lindex $info 3]  $date\n"
4568    if {[info exists idtags($id)]} {
4569        $ctext insert end "Tags:"
4570        foreach tag $idtags($id) {
4571            $ctext insert end " $tag"
4572        }
4573        $ctext insert end "\n"
4574    }
4575
4576    set headers {}
4577    set olds [lindex $parentlist $l]
4578    if {[llength $olds] > 1} {
4579        set np 0
4580        foreach p $olds {
4581            if {$np >= $mergemax} {
4582                set tag mmax
4583            } else {
4584                set tag m$np
4585            }
4586            $ctext insert end "Parent: " $tag
4587            appendwithlinks [commit_descriptor $p] {}
4588            incr np
4589        }
4590    } else {
4591        foreach p $olds {
4592            append headers "Parent: [commit_descriptor $p]"
4593        }
4594    }
4595
4596    foreach c $children($curview,$id) {
4597        append headers "Child:  [commit_descriptor $c]"
4598    }
4599
4600    # make anything that looks like a SHA1 ID be a clickable link
4601    appendwithlinks $headers {}
4602    if {$showneartags} {
4603        if {![info exists allcommits]} {
4604            getallcommits
4605        }
4606        $ctext insert end "Branch: "
4607        $ctext mark set branch "end -1c"
4608        $ctext mark gravity branch left
4609        $ctext insert end "\nFollows: "
4610        $ctext mark set follows "end -1c"
4611        $ctext mark gravity follows left
4612        $ctext insert end "\nPrecedes: "
4613        $ctext mark set precedes "end -1c"
4614        $ctext mark gravity precedes left
4615        $ctext insert end "\n"
4616        dispneartags 1
4617    }
4618    $ctext insert end "\n"
4619    set comment [lindex $info 5]
4620    if {[string first "\r" $comment] >= 0} {
4621        set comment [string map {"\r" "\n    "} $comment]
4622    }
4623    appendwithlinks $comment {comment}
4624
4625    $ctext tag remove found 1.0 end
4626    $ctext conf -state disabled
4627    set commentend [$ctext index "end - 1c"]
4628
4629    init_flist "Comments"
4630    if {$cmitmode eq "tree"} {
4631        gettree $id
4632    } elseif {[llength $olds] <= 1} {
4633        startdiff $id
4634    } else {
4635        mergediff $id $l
4636    }
4637}
4638
4639proc selfirstline {} {
4640    unmarkmatches
4641    selectline 0 1
4642}
4643
4644proc sellastline {} {
4645    global numcommits
4646    unmarkmatches
4647    set l [expr {$numcommits - 1}]
4648    selectline $l 1
4649}
4650
4651proc selnextline {dir} {
4652    global selectedline
4653    focus .
4654    if {![info exists selectedline]} return
4655    set l [expr {$selectedline + $dir}]
4656    unmarkmatches
4657    selectline $l 1
4658}
4659
4660proc selnextpage {dir} {
4661    global canv linespc selectedline numcommits
4662
4663    set lpp [expr {([winfo height $canv] - 2) / $linespc}]
4664    if {$lpp < 1} {
4665        set lpp 1
4666    }
4667    allcanvs yview scroll [expr {$dir * $lpp}] units
4668    drawvisible
4669    if {![info exists selectedline]} return
4670    set l [expr {$selectedline + $dir * $lpp}]
4671    if {$l < 0} {
4672        set l 0
4673    } elseif {$l >= $numcommits} {
4674        set l [expr $numcommits - 1]
4675    }
4676    unmarkmatches
4677    selectline $l 1
4678}
4679
4680proc unselectline {} {
4681    global selectedline currentid
4682
4683    catch {unset selectedline}
4684    catch {unset currentid}
4685    allcanvs delete secsel
4686    rhighlight_none
4687    cancel_next_highlight
4688}
4689
4690proc reselectline {} {
4691    global selectedline
4692
4693    if {[info exists selectedline]} {
4694        selectline $selectedline 0
4695    }
4696}
4697
4698proc addtohistory {cmd} {
4699    global history historyindex curview
4700
4701    set elt [list $curview $cmd]
4702    if {$historyindex > 0
4703        && [lindex $history [expr {$historyindex - 1}]] == $elt} {
4704        return
4705    }
4706
4707    if {$historyindex < [llength $history]} {
4708        set history [lreplace $history $historyindex end $elt]
4709    } else {
4710        lappend history $elt
4711    }
4712    incr historyindex
4713    if {$historyindex > 1} {
4714        .tf.bar.leftbut conf -state normal
4715    } else {
4716        .tf.bar.leftbut conf -state disabled
4717    }
4718    .tf.bar.rightbut conf -state disabled
4719}
4720
4721proc godo {elt} {
4722    global curview
4723
4724    set view [lindex $elt 0]
4725    set cmd [lindex $elt 1]
4726    if {$curview != $view} {
4727        showview $view
4728    }
4729    eval $cmd
4730}
4731
4732proc goback {} {
4733    global history historyindex
4734    focus .
4735
4736    if {$historyindex > 1} {
4737        incr historyindex -1
4738        godo [lindex $history [expr {$historyindex - 1}]]
4739        .tf.bar.rightbut conf -state normal
4740    }
4741    if {$historyindex <= 1} {
4742        .tf.bar.leftbut conf -state disabled
4743    }
4744}
4745
4746proc goforw {} {
4747    global history historyindex
4748    focus .
4749
4750    if {$historyindex < [llength $history]} {
4751        set cmd [lindex $history $historyindex]
4752        incr historyindex
4753        godo $cmd
4754        .tf.bar.leftbut conf -state normal
4755    }
4756    if {$historyindex >= [llength $history]} {
4757        .tf.bar.rightbut conf -state disabled
4758    }
4759}
4760
4761proc gettree {id} {
4762    global treefilelist treeidlist diffids diffmergeid treepending
4763    global nullid nullid2
4764
4765    set diffids $id
4766    catch {unset diffmergeid}
4767    if {![info exists treefilelist($id)]} {
4768        if {![info exists treepending]} {
4769            if {$id eq $nullid} {
4770                set cmd [list | git ls-files]
4771            } elseif {$id eq $nullid2} {
4772                set cmd [list | git ls-files --stage -t]
4773            } else {
4774                set cmd [list | git ls-tree -r $id]
4775            }
4776            if {[catch {set gtf [open $cmd r]}]} {
4777                return
4778            }
4779            set treepending $id
4780            set treefilelist($id) {}
4781            set treeidlist($id) {}
4782            fconfigure $gtf -blocking 0
4783            filerun $gtf [list gettreeline $gtf $id]
4784        }
4785    } else {
4786        setfilelist $id
4787    }
4788}
4789
4790proc gettreeline {gtf id} {
4791    global treefilelist treeidlist treepending cmitmode diffids nullid nullid2
4792
4793    set nl 0
4794    while {[incr nl] <= 1000 && [gets $gtf line] >= 0} {
4795        if {$diffids eq $nullid} {
4796            set fname $line
4797        } else {
4798            if {$diffids ne $nullid2 && [lindex $line 1] ne "blob"} continue
4799            set i [string first "\t" $line]
4800            if {$i < 0} continue
4801            set sha1 [lindex $line 2]
4802            set fname [string range $line [expr {$i+1}] end]
4803            if {[string index $fname 0] eq "\""} {
4804                set fname [lindex $fname 0]
4805            }
4806            lappend treeidlist($id) $sha1
4807        }
4808        lappend treefilelist($id) $fname
4809    }
4810    if {![eof $gtf]} {
4811        return [expr {$nl >= 1000? 2: 1}]
4812    }
4813    close $gtf
4814    unset treepending
4815    if {$cmitmode ne "tree"} {
4816        if {![info exists diffmergeid]} {
4817            gettreediffs $diffids
4818        }
4819    } elseif {$id ne $diffids} {
4820        gettree $diffids
4821    } else {
4822        setfilelist $id
4823    }
4824    return 0
4825}
4826
4827proc showfile {f} {
4828    global treefilelist treeidlist diffids nullid nullid2
4829    global ctext commentend
4830
4831    set i [lsearch -exact $treefilelist($diffids) $f]
4832    if {$i < 0} {
4833        puts "oops, $f not in list for id $diffids"
4834        return
4835    }
4836    if {$diffids eq $nullid} {
4837        if {[catch {set bf [open $f r]} err]} {
4838            puts "oops, can't read $f: $err"
4839            return
4840        }
4841    } else {
4842        set blob [lindex $treeidlist($diffids) $i]
4843        if {[catch {set bf [open [concat | git cat-file blob $blob] r]} err]} {
4844            puts "oops, error reading blob $blob: $err"
4845            return
4846        }
4847    }
4848    fconfigure $bf -blocking 0
4849    filerun $bf [list getblobline $bf $diffids]
4850    $ctext config -state normal
4851    clear_ctext $commentend
4852    $ctext insert end "\n"
4853    $ctext insert end "$f\n" filesep
4854    $ctext config -state disabled
4855    $ctext yview $commentend
4856}
4857
4858proc getblobline {bf id} {
4859    global diffids cmitmode ctext
4860
4861    if {$id ne $diffids || $cmitmode ne "tree"} {
4862        catch {close $bf}
4863        return 0
4864    }
4865    $ctext config -state normal
4866    set nl 0
4867    while {[incr nl] <= 1000 && [gets $bf line] >= 0} {
4868        $ctext insert end "$line\n"
4869    }
4870    if {[eof $bf]} {
4871        # delete last newline
4872        $ctext delete "end - 2c" "end - 1c"
4873        close $bf
4874        return 0
4875    }
4876    $ctext config -state disabled
4877    return [expr {$nl >= 1000? 2: 1}]
4878}
4879
4880proc mergediff {id l} {
4881    global diffmergeid diffopts mdifffd
4882    global diffids
4883    global parentlist
4884
4885    set diffmergeid $id
4886    set diffids $id
4887    # this doesn't seem to actually affect anything...
4888    set env(GIT_DIFF_OPTS) $diffopts
4889    set cmd [concat | git diff-tree --no-commit-id --cc $id]
4890    if {[catch {set mdf [open $cmd r]} err]} {
4891        error_popup "Error getting merge diffs: $err"
4892        return
4893    }
4894    fconfigure $mdf -blocking 0
4895    set mdifffd($id) $mdf
4896    set np [llength [lindex $parentlist $l]]
4897    filerun $mdf [list getmergediffline $mdf $id $np]
4898}
4899
4900proc getmergediffline {mdf id np} {
4901    global diffmergeid ctext cflist mergemax
4902    global difffilestart mdifffd
4903
4904    $ctext conf -state normal
4905    set nr 0
4906    while {[incr nr] <= 1000 && [gets $mdf line] >= 0} {
4907        if {![info exists diffmergeid] || $id != $diffmergeid
4908            || $mdf != $mdifffd($id)} {
4909            close $mdf
4910            return 0
4911        }
4912        if {[regexp {^diff --cc (.*)} $line match fname]} {
4913            # start of a new file
4914            $ctext insert end "\n"
4915            set here [$ctext index "end - 1c"]
4916            lappend difffilestart $here
4917            add_flist [list $fname]
4918            set l [expr {(78 - [string length $fname]) / 2}]
4919            set pad [string range "----------------------------------------" 1 $l]
4920            $ctext insert end "$pad $fname $pad\n" filesep
4921        } elseif {[regexp {^@@} $line]} {
4922            $ctext insert end "$line\n" hunksep
4923        } elseif {[regexp {^[0-9a-f]{40}$} $line] || [regexp {^index} $line]} {
4924            # do nothing
4925        } else {
4926            # parse the prefix - one ' ', '-' or '+' for each parent
4927            set spaces {}
4928            set minuses {}
4929            set pluses {}
4930            set isbad 0
4931            for {set j 0} {$j < $np} {incr j} {
4932                set c [string range $line $j $j]
4933                if {$c == " "} {
4934                    lappend spaces $j
4935                } elseif {$c == "-"} {
4936                    lappend minuses $j
4937                } elseif {$c == "+"} {
4938                    lappend pluses $j
4939                } else {
4940                    set isbad 1
4941                    break
4942                }
4943            }
4944            set tags {}
4945            set num {}
4946            if {!$isbad && $minuses ne {} && $pluses eq {}} {
4947                # line doesn't appear in result, parents in $minuses have the line
4948                set num [lindex $minuses 0]
4949            } elseif {!$isbad && $pluses ne {} && $minuses eq {}} {
4950                # line appears in result, parents in $pluses don't have the line
4951                lappend tags mresult
4952                set num [lindex $spaces 0]
4953            }
4954            if {$num ne {}} {
4955                if {$num >= $mergemax} {
4956                    set num "max"
4957                }
4958                lappend tags m$num
4959            }
4960            $ctext insert end "$line\n" $tags
4961        }
4962    }
4963    $ctext conf -state disabled
4964    if {[eof $mdf]} {
4965        close $mdf
4966        return 0
4967    }
4968    return [expr {$nr >= 1000? 2: 1}]
4969}
4970
4971proc startdiff {ids} {
4972    global treediffs diffids treepending diffmergeid nullid nullid2
4973
4974    set diffids $ids
4975    catch {unset diffmergeid}
4976    if {![info exists treediffs($ids)] ||
4977        [lsearch -exact $ids $nullid] >= 0 ||
4978        [lsearch -exact $ids $nullid2] >= 0} {
4979        if {![info exists treepending]} {
4980            gettreediffs $ids
4981        }
4982    } else {
4983        addtocflist $ids
4984    }
4985}
4986
4987proc addtocflist {ids} {
4988    global treediffs cflist
4989    add_flist $treediffs($ids)
4990    getblobdiffs $ids
4991}
4992
4993proc diffcmd {ids flags} {
4994    global nullid nullid2
4995
4996    set i [lsearch -exact $ids $nullid]
4997    set j [lsearch -exact $ids $nullid2]
4998    if {$i >= 0} {
4999        if {[llength $ids] > 1 && $j < 0} {
5000            # comparing working directory with some specific revision
5001            set cmd [concat | git diff-index $flags]
5002            if {$i == 0} {
5003                lappend cmd -R [lindex $ids 1]
5004            } else {
5005                lappend cmd [lindex $ids 0]
5006            }
5007        } else {
5008            # comparing working directory with index
5009            set cmd [concat | git diff-files $flags]
5010            if {$j == 1} {
5011                lappend cmd -R
5012            }
5013        }
5014    } elseif {$j >= 0} {
5015        set cmd [concat | git diff-index --cached $flags]
5016        if {[llength $ids] > 1} {
5017            # comparing index with specific revision
5018            if {$i == 0} {
5019                lappend cmd -R [lindex $ids 1]
5020            } else {
5021                lappend cmd [lindex $ids 0]
5022            }
5023        } else {
5024            # comparing index with HEAD
5025            lappend cmd HEAD
5026        }
5027    } else {
5028        set cmd [concat | git diff-tree -r $flags $ids]
5029    }
5030    return $cmd
5031}
5032
5033proc gettreediffs {ids} {
5034    global treediff treepending
5035
5036    set treepending $ids
5037    set treediff {}
5038    if {[catch {set gdtf [open [diffcmd $ids {--no-commit-id}] r]}]} return
5039    fconfigure $gdtf -blocking 0
5040    filerun $gdtf [list gettreediffline $gdtf $ids]
5041}
5042
5043proc gettreediffline {gdtf ids} {
5044    global treediff treediffs treepending diffids diffmergeid
5045    global cmitmode
5046
5047    set nr 0
5048    while {[incr nr] <= 1000 && [gets $gdtf line] >= 0} {
5049        set i [string first "\t" $line]
5050        if {$i >= 0} {
5051            set file [string range $line [expr {$i+1}] end]
5052            if {[string index $file 0] eq "\""} {
5053                set file [lindex $file 0]
5054            }
5055            lappend treediff $file
5056        }
5057    }
5058    if {![eof $gdtf]} {
5059        return [expr {$nr >= 1000? 2: 1}]
5060    }
5061    close $gdtf
5062    set treediffs($ids) $treediff
5063    unset treepending
5064    if {$cmitmode eq "tree"} {
5065        gettree $diffids
5066    } elseif {$ids != $diffids} {
5067        if {![info exists diffmergeid]} {
5068            gettreediffs $diffids
5069        }
5070    } else {
5071        addtocflist $ids
5072    }
5073    return 0
5074}
5075
5076# empty string or positive integer
5077proc diffcontextvalidate {v} {
5078    return [regexp {^(|[1-9][0-9]*)$} $v]
5079}
5080
5081proc diffcontextchange {n1 n2 op} {
5082    global diffcontextstring diffcontext
5083
5084    if {[string is integer -strict $diffcontextstring]} {
5085        if {$diffcontextstring > 0} {
5086            set diffcontext $diffcontextstring
5087            reselectline
5088        }
5089    }
5090}
5091
5092proc getblobdiffs {ids} {
5093    global diffopts blobdifffd diffids env
5094    global diffinhdr treediffs
5095    global diffcontext
5096
5097    set env(GIT_DIFF_OPTS) $diffopts
5098    if {[catch {set bdf [open [diffcmd $ids "-p -C --no-commit-id -U$diffcontext"] r]} err]} {
5099        puts "error getting diffs: $err"
5100        return
5101    }
5102    set diffinhdr 0
5103    fconfigure $bdf -blocking 0
5104    set blobdifffd($ids) $bdf
5105    filerun $bdf [list getblobdiffline $bdf $diffids]
5106}
5107
5108proc setinlist {var i val} {
5109    global $var
5110
5111    while {[llength [set $var]] < $i} {
5112        lappend $var {}
5113    }
5114    if {[llength [set $var]] == $i} {
5115        lappend $var $val
5116    } else {
5117        lset $var $i $val
5118    }
5119}
5120
5121proc makediffhdr {fname ids} {
5122    global ctext curdiffstart treediffs
5123
5124    set i [lsearch -exact $treediffs($ids) $fname]
5125    if {$i >= 0} {
5126        setinlist difffilestart $i $curdiffstart
5127    }
5128    set l [expr {(78 - [string length $fname]) / 2}]
5129    set pad [string range "----------------------------------------" 1 $l]
5130    $ctext insert $curdiffstart "$pad $fname $pad" filesep
5131}
5132
5133proc getblobdiffline {bdf ids} {
5134    global diffids blobdifffd ctext curdiffstart
5135    global diffnexthead diffnextnote difffilestart
5136    global diffinhdr treediffs
5137
5138    set nr 0
5139    $ctext conf -state normal
5140    while {[incr nr] <= 1000 && [gets $bdf line] >= 0} {
5141        if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
5142            close $bdf
5143            return 0
5144        }
5145        if {![string compare -length 11 "diff --git " $line]} {
5146            # trim off "diff --git "
5147            set line [string range $line 11 end]
5148            set diffinhdr 1
5149            # start of a new file
5150            $ctext insert end "\n"
5151            set curdiffstart [$ctext index "end - 1c"]
5152            $ctext insert end "\n" filesep
5153            # If the name hasn't changed the length will be odd,
5154            # the middle char will be a space, and the two bits either
5155            # side will be a/name and b/name, or "a/name" and "b/name".
5156            # If the name has changed we'll get "rename from" and
5157            # "rename to" or "copy from" and "copy to" lines following this,
5158            # and we'll use them to get the filenames.
5159            # This complexity is necessary because spaces in the filename(s)
5160            # don't get escaped.
5161            set l [string length $line]
5162            set i [expr {$l / 2}]
5163            if {!(($l & 1) && [string index $line $i] eq " " &&
5164                  [string range $line 2 [expr {$i - 1}]] eq \
5165                      [string range $line [expr {$i + 3}] end])} {
5166                continue
5167            }
5168            # unescape if quoted and chop off the a/ from the front
5169            if {[string index $line 0] eq "\""} {
5170                set fname [string range [lindex $line 0] 2 end]
5171            } else {
5172                set fname [string range $line 2 [expr {$i - 1}]]
5173            }
5174            makediffhdr $fname $ids
5175
5176        } elseif {[regexp {^@@ -([0-9]+)(,[0-9]+)? \+([0-9]+)(,[0-9]+)? @@(.*)} \
5177                       $line match f1l f1c f2l f2c rest]} {
5178            $ctext insert end "$line\n" hunksep
5179            set diffinhdr 0
5180
5181        } elseif {$diffinhdr} {
5182            if {![string compare -length 12 "rename from " $line] ||
5183                ![string compare -length 10 "copy from " $line]} {
5184                set fname [string range $line [expr 6 + [string first " from " $line] ] end]
5185                if {[string index $fname 0] eq "\""} {
5186                    set fname [lindex $fname 0]
5187                }
5188                set i [lsearch -exact $treediffs($ids) $fname]
5189                if {$i >= 0} {
5190                    setinlist difffilestart $i $curdiffstart
5191                }
5192            } elseif {![string compare -length 10 $line "rename to "] ||
5193                      ![string compare -length 8 $line "copy to "]} {
5194                set fname [string range $line [expr 4 + [string first " to " $line] ] end]
5195                if {[string index $fname 0] eq "\""} {
5196                    set fname [lindex $fname 0]
5197                }
5198                makediffhdr $fname $ids
5199            } elseif {[string compare -length 3 $line "---"] == 0} {
5200                # do nothing
5201                continue
5202            } elseif {[string compare -length 3 $line "+++"] == 0} {
5203                set diffinhdr 0
5204                continue
5205            }
5206            $ctext insert end "$line\n" filesep
5207
5208        } else {
5209            set x [string range $line 0 0]
5210            if {$x == "-" || $x == "+"} {
5211                set tag [expr {$x == "+"}]
5212                $ctext insert end "$line\n" d$tag
5213            } elseif {$x == " "} {
5214                $ctext insert end "$line\n"
5215            } else {
5216                # "\ No newline at end of file",
5217                # or something else we don't recognize
5218                $ctext insert end "$line\n" hunksep
5219            }
5220        }
5221    }
5222    $ctext conf -state disabled
5223    if {[eof $bdf]} {
5224        close $bdf
5225        return 0
5226    }
5227    return [expr {$nr >= 1000? 2: 1}]
5228}
5229
5230proc changediffdisp {} {
5231    global ctext diffelide
5232
5233    $ctext tag conf d0 -elide [lindex $diffelide 0]
5234    $ctext tag conf d1 -elide [lindex $diffelide 1]
5235}
5236
5237proc prevfile {} {
5238    global difffilestart ctext
5239    set prev [lindex $difffilestart 0]
5240    set here [$ctext index @0,0]
5241    foreach loc $difffilestart {
5242        if {[$ctext compare $loc >= $here]} {
5243            $ctext yview $prev
5244            return
5245        }
5246        set prev $loc
5247    }
5248    $ctext yview $prev
5249}
5250
5251proc nextfile {} {
5252    global difffilestart ctext
5253    set here [$ctext index @0,0]
5254    foreach loc $difffilestart {
5255        if {[$ctext compare $loc > $here]} {
5256            $ctext yview $loc
5257            return
5258        }
5259    }
5260}
5261
5262proc clear_ctext {{first 1.0}} {
5263    global ctext smarktop smarkbot
5264    global pendinglinks
5265
5266    set l [lindex [split $first .] 0]
5267    if {![info exists smarktop] || [$ctext compare $first < $smarktop.0]} {
5268        set smarktop $l
5269    }
5270    if {![info exists smarkbot] || [$ctext compare $first < $smarkbot.0]} {
5271        set smarkbot $l
5272    }
5273    $ctext delete $first end
5274    if {$first eq "1.0"} {
5275        catch {unset pendinglinks}
5276    }
5277}
5278
5279proc incrsearch {name ix op} {
5280    global ctext searchstring searchdirn
5281
5282    $ctext tag remove found 1.0 end
5283    if {[catch {$ctext index anchor}]} {
5284        # no anchor set, use start of selection, or of visible area
5285        set sel [$ctext tag ranges sel]
5286        if {$sel ne {}} {
5287            $ctext mark set anchor [lindex $sel 0]
5288        } elseif {$searchdirn eq "-forwards"} {
5289            $ctext mark set anchor @0,0
5290        } else {
5291            $ctext mark set anchor @0,[winfo height $ctext]
5292        }
5293    }
5294    if {$searchstring ne {}} {
5295        set here [$ctext search $searchdirn -- $searchstring anchor]
5296        if {$here ne {}} {
5297            $ctext see $here
5298        }
5299        searchmarkvisible 1
5300    }
5301}
5302
5303proc dosearch {} {
5304    global sstring ctext searchstring searchdirn
5305
5306    focus $sstring
5307    $sstring icursor end
5308    set searchdirn -forwards
5309    if {$searchstring ne {}} {
5310        set sel [$ctext tag ranges sel]
5311        if {$sel ne {}} {
5312            set start "[lindex $sel 0] + 1c"
5313        } elseif {[catch {set start [$ctext index anchor]}]} {
5314            set start "@0,0"
5315        }
5316        set match [$ctext search -count mlen -- $searchstring $start]
5317        $ctext tag remove sel 1.0 end
5318        if {$match eq {}} {
5319            bell
5320            return
5321        }
5322        $ctext see $match
5323        set mend "$match + $mlen c"
5324        $ctext tag add sel $match $mend
5325        $ctext mark unset anchor
5326    }
5327}
5328
5329proc dosearchback {} {
5330    global sstring ctext searchstring searchdirn
5331
5332    focus $sstring
5333    $sstring icursor end
5334    set searchdirn -backwards
5335    if {$searchstring ne {}} {
5336        set sel [$ctext tag ranges sel]
5337        if {$sel ne {}} {
5338            set start [lindex $sel 0]
5339        } elseif {[catch {set start [$ctext index anchor]}]} {
5340            set start @0,[winfo height $ctext]
5341        }
5342        set match [$ctext search -backwards -count ml -- $searchstring $start]
5343        $ctext tag remove sel 1.0 end
5344        if {$match eq {}} {
5345            bell
5346            return
5347        }
5348        $ctext see $match
5349        set mend "$match + $ml c"
5350        $ctext tag add sel $match $mend
5351        $ctext mark unset anchor
5352    }
5353}
5354
5355proc searchmark {first last} {
5356    global ctext searchstring
5357
5358    set mend $first.0
5359    while {1} {
5360        set match [$ctext search -count mlen -- $searchstring $mend $last.end]
5361        if {$match eq {}} break
5362        set mend "$match + $mlen c"
5363        $ctext tag add found $match $mend
5364    }
5365}
5366
5367proc searchmarkvisible {doall} {
5368    global ctext smarktop smarkbot
5369
5370    set topline [lindex [split [$ctext index @0,0] .] 0]
5371    set botline [lindex [split [$ctext index @0,[winfo height $ctext]] .] 0]
5372    if {$doall || $botline < $smarktop || $topline > $smarkbot} {
5373        # no overlap with previous
5374        searchmark $topline $botline
5375        set smarktop $topline
5376        set smarkbot $botline
5377    } else {
5378        if {$topline < $smarktop} {
5379            searchmark $topline [expr {$smarktop-1}]
5380            set smarktop $topline
5381        }
5382        if {$botline > $smarkbot} {
5383            searchmark [expr {$smarkbot+1}] $botline
5384            set smarkbot $botline
5385        }
5386    }
5387}
5388
5389proc scrolltext {f0 f1} {
5390    global searchstring
5391
5392    .bleft.sb set $f0 $f1
5393    if {$searchstring ne {}} {
5394        searchmarkvisible 0
5395    }
5396}
5397
5398proc setcoords {} {
5399    global linespc charspc canvx0 canvy0 mainfont
5400    global xspc1 xspc2 lthickness
5401
5402    set linespc [font metrics $mainfont -linespace]
5403    set charspc [font measure $mainfont "m"]
5404    set canvy0 [expr {int(3 + 0.5 * $linespc)}]
5405    set canvx0 [expr {int(3 + 0.5 * $linespc)}]
5406    set lthickness [expr {int($linespc / 9) + 1}]
5407    set xspc1(0) $linespc
5408    set xspc2 $linespc
5409}
5410
5411proc redisplay {} {
5412    global canv
5413    global selectedline
5414
5415    set ymax [lindex [$canv cget -scrollregion] 3]
5416    if {$ymax eq {} || $ymax == 0} return
5417    set span [$canv yview]
5418    clear_display
5419    setcanvscroll
5420    allcanvs yview moveto [lindex $span 0]
5421    drawvisible
5422    if {[info exists selectedline]} {
5423        selectline $selectedline 0
5424        allcanvs yview moveto [lindex $span 0]
5425    }
5426}
5427
5428proc incrfont {inc} {
5429    global mainfont textfont ctext canv phase cflist showrefstop
5430    global charspc tabstop
5431    global stopped entries
5432    unmarkmatches
5433    set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
5434    set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
5435    setcoords
5436    $ctext conf -font $textfont -tabs "[expr {$tabstop * $charspc}]"
5437    $cflist conf -font $textfont
5438    $ctext tag conf filesep -font [concat $textfont bold]
5439    foreach e $entries {
5440        $e conf -font $mainfont
5441    }
5442    if {$phase eq "getcommits"} {
5443        $canv itemconf textitems -font $mainfont
5444    }
5445    if {[info exists showrefstop] && [winfo exists $showrefstop]} {
5446        $showrefstop.list conf -font $mainfont
5447    }
5448    redisplay
5449}
5450
5451proc clearsha1 {} {
5452    global sha1entry sha1string
5453    if {[string length $sha1string] == 40} {
5454        $sha1entry delete 0 end
5455    }
5456}
5457
5458proc sha1change {n1 n2 op} {
5459    global sha1string currentid sha1but
5460    if {$sha1string == {}
5461        || ([info exists currentid] && $sha1string == $currentid)} {
5462        set state disabled
5463    } else {
5464        set state normal
5465    }
5466    if {[$sha1but cget -state] == $state} return
5467    if {$state == "normal"} {
5468        $sha1but conf -state normal -relief raised -text "Goto: "
5469    } else {
5470        $sha1but conf -state disabled -relief flat -text "SHA1 ID: "
5471    }
5472}
5473
5474proc gotocommit {} {
5475    global sha1string currentid commitrow tagids headids
5476    global displayorder numcommits curview
5477
5478    if {$sha1string == {}
5479        || ([info exists currentid] && $sha1string == $currentid)} return
5480    if {[info exists tagids($sha1string)]} {
5481        set id $tagids($sha1string)
5482    } elseif {[info exists headids($sha1string)]} {
5483        set id $headids($sha1string)
5484    } else {
5485        set id [string tolower $sha1string]
5486        if {[regexp {^[0-9a-f]{4,39}$} $id]} {
5487            set matches {}
5488            foreach i $displayorder {
5489                if {[string match $id* $i]} {
5490                    lappend matches $i
5491                }
5492            }
5493            if {$matches ne {}} {
5494                if {[llength $matches] > 1} {
5495                    error_popup "Short SHA1 id $id is ambiguous"
5496                    return
5497                }
5498                set id [lindex $matches 0]
5499            }
5500        }
5501    }
5502    if {[info exists commitrow($curview,$id)]} {
5503        selectline $commitrow($curview,$id) 1
5504        return
5505    }
5506    if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
5507        set type "SHA1 id"
5508    } else {
5509        set type "Tag/Head"
5510    }
5511    error_popup "$type $sha1string is not known"
5512}
5513
5514proc lineenter {x y id} {
5515    global hoverx hovery hoverid hovertimer
5516    global commitinfo canv
5517
5518    if {![info exists commitinfo($id)] && ![getcommit $id]} return
5519    set hoverx $x
5520    set hovery $y
5521    set hoverid $id
5522    if {[info exists hovertimer]} {
5523        after cancel $hovertimer
5524    }
5525    set hovertimer [after 500 linehover]
5526    $canv delete hover
5527}
5528
5529proc linemotion {x y id} {
5530    global hoverx hovery hoverid hovertimer
5531
5532    if {[info exists hoverid] && $id == $hoverid} {
5533        set hoverx $x
5534        set hovery $y
5535        if {[info exists hovertimer]} {
5536            after cancel $hovertimer
5537        }
5538        set hovertimer [after 500 linehover]
5539    }
5540}
5541
5542proc lineleave {id} {
5543    global hoverid hovertimer canv
5544
5545    if {[info exists hoverid] && $id == $hoverid} {
5546        $canv delete hover
5547        if {[info exists hovertimer]} {
5548            after cancel $hovertimer
5549            unset hovertimer
5550        }
5551        unset hoverid
5552    }
5553}
5554
5555proc linehover {} {
5556    global hoverx hovery hoverid hovertimer
5557    global canv linespc lthickness
5558    global commitinfo mainfont
5559
5560    set text [lindex $commitinfo($hoverid) 0]
5561    set ymax [lindex [$canv cget -scrollregion] 3]
5562    if {$ymax == {}} return
5563    set yfrac [lindex [$canv yview] 0]
5564    set x [expr {$hoverx + 2 * $linespc}]
5565    set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
5566    set x0 [expr {$x - 2 * $lthickness}]
5567    set y0 [expr {$y - 2 * $lthickness}]
5568    set x1 [expr {$x + [font measure $mainfont $text] + 2 * $lthickness}]
5569    set y1 [expr {$y + $linespc + 2 * $lthickness}]
5570    set t [$canv create rectangle $x0 $y0 $x1 $y1 \
5571               -fill \#ffff80 -outline black -width 1 -tags hover]
5572    $canv raise $t
5573    set t [$canv create text $x $y -anchor nw -text $text -tags hover \
5574               -font $mainfont]
5575    $canv raise $t
5576}
5577
5578proc clickisonarrow {id y} {
5579    global lthickness
5580
5581    set ranges [rowranges $id]
5582    set thresh [expr {2 * $lthickness + 6}]
5583    set n [expr {[llength $ranges] - 1}]
5584    for {set i 1} {$i < $n} {incr i} {
5585        set row [lindex $ranges $i]
5586        if {abs([yc $row] - $y) < $thresh} {
5587            return $i
5588        }
5589    }
5590    return {}
5591}
5592
5593proc arrowjump {id n y} {
5594    global canv
5595
5596    # 1 <-> 2, 3 <-> 4, etc...
5597    set n [expr {(($n - 1) ^ 1) + 1}]
5598    set row [lindex [rowranges $id] $n]
5599    set yt [yc $row]
5600    set ymax [lindex [$canv cget -scrollregion] 3]
5601    if {$ymax eq {} || $ymax <= 0} return
5602    set view [$canv yview]
5603    set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
5604    set yfrac [expr {$yt / $ymax - $yspan / 2}]
5605    if {$yfrac < 0} {
5606        set yfrac 0
5607    }
5608    allcanvs yview moveto $yfrac
5609}
5610
5611proc lineclick {x y id isnew} {
5612    global ctext commitinfo children canv thickerline curview
5613
5614    if {![info exists commitinfo($id)] && ![getcommit $id]} return
5615    unmarkmatches
5616    unselectline
5617    normalline
5618    $canv delete hover
5619    # draw this line thicker than normal
5620    set thickerline $id
5621    drawlines $id
5622    if {$isnew} {
5623        set ymax [lindex [$canv cget -scrollregion] 3]
5624        if {$ymax eq {}} return
5625        set yfrac [lindex [$canv yview] 0]
5626        set y [expr {$y + $yfrac * $ymax}]
5627    }
5628    set dirn [clickisonarrow $id $y]
5629    if {$dirn ne {}} {
5630        arrowjump $id $dirn $y
5631        return
5632    }
5633
5634    if {$isnew} {
5635        addtohistory [list lineclick $x $y $id 0]
5636    }
5637    # fill the details pane with info about this line
5638    $ctext conf -state normal
5639    clear_ctext
5640    $ctext insert end "Parent:\t"
5641    $ctext insert end $id link0
5642    setlink $id link0
5643    set info $commitinfo($id)
5644    $ctext insert end "\n\t[lindex $info 0]\n"
5645    $ctext insert end "\tAuthor:\t[lindex $info 1]\n"
5646    set date [formatdate [lindex $info 2]]
5647    $ctext insert end "\tDate:\t$date\n"
5648    set kids $children($curview,$id)
5649    if {$kids ne {}} {
5650        $ctext insert end "\nChildren:"
5651        set i 0
5652        foreach child $kids {
5653            incr i
5654            if {![info exists commitinfo($child)] && ![getcommit $child]} continue
5655            set info $commitinfo($child)
5656            $ctext insert end "\n\t"
5657            $ctext insert end $child link$i
5658            setlink $child link$i
5659            $ctext insert end "\n\t[lindex $info 0]"
5660            $ctext insert end "\n\tAuthor:\t[lindex $info 1]"
5661            set date [formatdate [lindex $info 2]]
5662            $ctext insert end "\n\tDate:\t$date\n"
5663        }
5664    }
5665    $ctext conf -state disabled
5666    init_flist {}
5667}
5668
5669proc normalline {} {
5670    global thickerline
5671    if {[info exists thickerline]} {
5672        set id $thickerline
5673        unset thickerline
5674        drawlines $id
5675    }
5676}
5677
5678proc selbyid {id} {
5679    global commitrow curview
5680    if {[info exists commitrow($curview,$id)]} {
5681        selectline $commitrow($curview,$id) 1
5682    }
5683}
5684
5685proc mstime {} {
5686    global startmstime
5687    if {![info exists startmstime]} {
5688        set startmstime [clock clicks -milliseconds]
5689    }
5690    return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
5691}
5692
5693proc rowmenu {x y id} {
5694    global rowctxmenu commitrow selectedline rowmenuid curview
5695    global nullid nullid2 fakerowmenu mainhead
5696
5697    set rowmenuid $id
5698    if {![info exists selectedline]
5699        || $commitrow($curview,$id) eq $selectedline} {
5700        set state disabled
5701    } else {
5702        set state normal
5703    }
5704    if {$id ne $nullid && $id ne $nullid2} {
5705        set menu $rowctxmenu
5706        $menu entryconfigure 7 -label "Reset $mainhead branch to here"
5707    } else {
5708        set menu $fakerowmenu
5709    }
5710    $menu entryconfigure "Diff this*" -state $state
5711    $menu entryconfigure "Diff selected*" -state $state
5712    $menu entryconfigure "Make patch" -state $state
5713    tk_popup $menu $x $y
5714}
5715
5716proc diffvssel {dirn} {
5717    global rowmenuid selectedline displayorder
5718
5719    if {![info exists selectedline]} return
5720    if {$dirn} {
5721        set oldid [lindex $displayorder $selectedline]
5722        set newid $rowmenuid
5723    } else {
5724        set oldid $rowmenuid
5725        set newid [lindex $displayorder $selectedline]
5726    }
5727    addtohistory [list doseldiff $oldid $newid]
5728    doseldiff $oldid $newid
5729}
5730
5731proc doseldiff {oldid newid} {
5732    global ctext
5733    global commitinfo
5734
5735    $ctext conf -state normal
5736    clear_ctext
5737    init_flist "Top"
5738    $ctext insert end "From "
5739    $ctext insert end $oldid link0
5740    setlink $oldid link0
5741    $ctext insert end "\n     "
5742    $ctext insert end [lindex $commitinfo($oldid) 0]
5743    $ctext insert end "\n\nTo   "
5744    $ctext insert end $newid link1
5745    setlink $newid link1
5746    $ctext insert end "\n     "
5747    $ctext insert end [lindex $commitinfo($newid) 0]
5748    $ctext insert end "\n"
5749    $ctext conf -state disabled
5750    $ctext tag remove found 1.0 end
5751    startdiff [list $oldid $newid]
5752}
5753
5754proc mkpatch {} {
5755    global rowmenuid currentid commitinfo patchtop patchnum
5756
5757    if {![info exists currentid]} return
5758    set oldid $currentid
5759    set oldhead [lindex $commitinfo($oldid) 0]
5760    set newid $rowmenuid
5761    set newhead [lindex $commitinfo($newid) 0]
5762    set top .patch
5763    set patchtop $top
5764    catch {destroy $top}
5765    toplevel $top
5766    label $top.title -text "Generate patch"
5767    grid $top.title - -pady 10
5768    label $top.from -text "From:"
5769    entry $top.fromsha1 -width 40 -relief flat
5770    $top.fromsha1 insert 0 $oldid
5771    $top.fromsha1 conf -state readonly
5772    grid $top.from $top.fromsha1 -sticky w
5773    entry $top.fromhead -width 60 -relief flat
5774    $top.fromhead insert 0 $oldhead
5775    $top.fromhead conf -state readonly
5776    grid x $top.fromhead -sticky w
5777    label $top.to -text "To:"
5778    entry $top.tosha1 -width 40 -relief flat
5779    $top.tosha1 insert 0 $newid
5780    $top.tosha1 conf -state readonly
5781    grid $top.to $top.tosha1 -sticky w
5782    entry $top.tohead -width 60 -relief flat
5783    $top.tohead insert 0 $newhead
5784    $top.tohead conf -state readonly
5785    grid x $top.tohead -sticky w
5786    button $top.rev -text "Reverse" -command mkpatchrev -padx 5
5787    grid $top.rev x -pady 10
5788    label $top.flab -text "Output file:"
5789    entry $top.fname -width 60
5790    $top.fname insert 0 [file normalize "patch$patchnum.patch"]
5791    incr patchnum
5792    grid $top.flab $top.fname -sticky w
5793    frame $top.buts
5794    button $top.buts.gen -text "Generate" -command mkpatchgo
5795    button $top.buts.can -text "Cancel" -command mkpatchcan
5796    grid $top.buts.gen $top.buts.can
5797    grid columnconfigure $top.buts 0 -weight 1 -uniform a
5798    grid columnconfigure $top.buts 1 -weight 1 -uniform a
5799    grid $top.buts - -pady 10 -sticky ew
5800    focus $top.fname
5801}
5802
5803proc mkpatchrev {} {
5804    global patchtop
5805
5806    set oldid [$patchtop.fromsha1 get]
5807    set oldhead [$patchtop.fromhead get]
5808    set newid [$patchtop.tosha1 get]
5809    set newhead [$patchtop.tohead get]
5810    foreach e [list fromsha1 fromhead tosha1 tohead] \
5811            v [list $newid $newhead $oldid $oldhead] {
5812        $patchtop.$e conf -state normal
5813        $patchtop.$e delete 0 end
5814        $patchtop.$e insert 0 $v
5815        $patchtop.$e conf -state readonly
5816    }
5817}
5818
5819proc mkpatchgo {} {
5820    global patchtop nullid nullid2
5821
5822    set oldid [$patchtop.fromsha1 get]
5823    set newid [$patchtop.tosha1 get]
5824    set fname [$patchtop.fname get]
5825    set cmd [diffcmd [list $oldid $newid] -p]
5826    lappend cmd >$fname &
5827    if {[catch {eval exec $cmd} err]} {
5828        error_popup "Error creating patch: $err"
5829    }
5830    catch {destroy $patchtop}
5831    unset patchtop
5832}
5833
5834proc mkpatchcan {} {
5835    global patchtop
5836
5837    catch {destroy $patchtop}
5838    unset patchtop
5839}
5840
5841proc mktag {} {
5842    global rowmenuid mktagtop commitinfo
5843
5844    set top .maketag
5845    set mktagtop $top
5846    catch {destroy $top}
5847    toplevel $top
5848    label $top.title -text "Create tag"
5849    grid $top.title - -pady 10
5850    label $top.id -text "ID:"
5851    entry $top.sha1 -width 40 -relief flat
5852    $top.sha1 insert 0 $rowmenuid
5853    $top.sha1 conf -state readonly
5854    grid $top.id $top.sha1 -sticky w
5855    entry $top.head -width 60 -relief flat
5856    $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
5857    $top.head conf -state readonly
5858    grid x $top.head -sticky w
5859    label $top.tlab -text "Tag name:"
5860    entry $top.tag -width 60
5861    grid $top.tlab $top.tag -sticky w
5862    frame $top.buts
5863    button $top.buts.gen -text "Create" -command mktaggo
5864    button $top.buts.can -text "Cancel" -command mktagcan
5865    grid $top.buts.gen $top.buts.can
5866    grid columnconfigure $top.buts 0 -weight 1 -uniform a
5867    grid columnconfigure $top.buts 1 -weight 1 -uniform a
5868    grid $top.buts - -pady 10 -sticky ew
5869    focus $top.tag
5870}
5871
5872proc domktag {} {
5873    global mktagtop env tagids idtags
5874
5875    set id [$mktagtop.sha1 get]
5876    set tag [$mktagtop.tag get]
5877    if {$tag == {}} {
5878        error_popup "No tag name specified"
5879        return
5880    }
5881    if {[info exists tagids($tag)]} {
5882        error_popup "Tag \"$tag\" already exists"
5883        return
5884    }
5885    if {[catch {
5886        set dir [gitdir]
5887        set fname [file join $dir "refs/tags" $tag]
5888        set f [open $fname w]
5889        puts $f $id
5890        close $f
5891    } err]} {
5892        error_popup "Error creating tag: $err"
5893        return
5894    }
5895
5896    set tagids($tag) $id
5897    lappend idtags($id) $tag
5898    redrawtags $id
5899    addedtag $id
5900    dispneartags 0
5901    run refill_reflist
5902}
5903
5904proc redrawtags {id} {
5905    global canv linehtag commitrow idpos selectedline curview
5906    global mainfont canvxmax iddrawn
5907
5908    if {![info exists commitrow($curview,$id)]} return
5909    if {![info exists iddrawn($id)]} return
5910    drawcommits $commitrow($curview,$id)
5911    $canv delete tag.$id
5912    set xt [eval drawtags $id $idpos($id)]
5913    $canv coords $linehtag($commitrow($curview,$id)) $xt [lindex $idpos($id) 2]
5914    set text [$canv itemcget $linehtag($commitrow($curview,$id)) -text]
5915    set xr [expr {$xt + [font measure $mainfont $text]}]
5916    if {$xr > $canvxmax} {
5917        set canvxmax $xr
5918        setcanvscroll
5919    }
5920    if {[info exists selectedline]
5921        && $selectedline == $commitrow($curview,$id)} {
5922        selectline $selectedline 0
5923    }
5924}
5925
5926proc mktagcan {} {
5927    global mktagtop
5928
5929    catch {destroy $mktagtop}
5930    unset mktagtop
5931}
5932
5933proc mktaggo {} {
5934    domktag
5935    mktagcan
5936}
5937
5938proc writecommit {} {
5939    global rowmenuid wrcomtop commitinfo wrcomcmd
5940
5941    set top .writecommit
5942    set wrcomtop $top
5943    catch {destroy $top}
5944    toplevel $top
5945    label $top.title -text "Write commit to file"
5946    grid $top.title - -pady 10
5947    label $top.id -text "ID:"
5948    entry $top.sha1 -width 40 -relief flat
5949    $top.sha1 insert 0 $rowmenuid
5950    $top.sha1 conf -state readonly
5951    grid $top.id $top.sha1 -sticky w
5952    entry $top.head -width 60 -relief flat
5953    $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
5954    $top.head conf -state readonly
5955    grid x $top.head -sticky w
5956    label $top.clab -text "Command:"
5957    entry $top.cmd -width 60 -textvariable wrcomcmd
5958    grid $top.clab $top.cmd -sticky w -pady 10
5959    label $top.flab -text "Output file:"
5960    entry $top.fname -width 60
5961    $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
5962    grid $top.flab $top.fname -sticky w
5963    frame $top.buts
5964    button $top.buts.gen -text "Write" -command wrcomgo
5965    button $top.buts.can -text "Cancel" -command wrcomcan
5966    grid $top.buts.gen $top.buts.can
5967    grid columnconfigure $top.buts 0 -weight 1 -uniform a
5968    grid columnconfigure $top.buts 1 -weight 1 -uniform a
5969    grid $top.buts - -pady 10 -sticky ew
5970    focus $top.fname
5971}
5972
5973proc wrcomgo {} {
5974    global wrcomtop
5975
5976    set id [$wrcomtop.sha1 get]
5977    set cmd "echo $id | [$wrcomtop.cmd get]"
5978    set fname [$wrcomtop.fname get]
5979    if {[catch {exec sh -c $cmd >$fname &} err]} {
5980        error_popup "Error writing commit: $err"
5981    }
5982    catch {destroy $wrcomtop}
5983    unset wrcomtop
5984}
5985
5986proc wrcomcan {} {
5987    global wrcomtop
5988
5989    catch {destroy $wrcomtop}
5990    unset wrcomtop
5991}
5992
5993proc mkbranch {} {
5994    global rowmenuid mkbrtop
5995
5996    set top .makebranch
5997    catch {destroy $top}
5998    toplevel $top
5999    label $top.title -text "Create new branch"
6000    grid $top.title - -pady 10
6001    label $top.id -text "ID:"
6002    entry $top.sha1 -width 40 -relief flat
6003    $top.sha1 insert 0 $rowmenuid
6004    $top.sha1 conf -state readonly
6005    grid $top.id $top.sha1 -sticky w
6006    label $top.nlab -text "Name:"
6007    entry $top.name -width 40
6008    grid $top.nlab $top.name -sticky w
6009    frame $top.buts
6010    button $top.buts.go -text "Create" -command [list mkbrgo $top]
6011    button $top.buts.can -text "Cancel" -command "catch {destroy $top}"
6012    grid $top.buts.go $top.buts.can
6013    grid columnconfigure $top.buts 0 -weight 1 -uniform a
6014    grid columnconfigure $top.buts 1 -weight 1 -uniform a
6015    grid $top.buts - -pady 10 -sticky ew
6016    focus $top.name
6017}
6018
6019proc mkbrgo {top} {
6020    global headids idheads
6021
6022    set name [$top.name get]
6023    set id [$top.sha1 get]
6024    if {$name eq {}} {
6025        error_popup "Please specify a name for the new branch"
6026        return
6027    }
6028    catch {destroy $top}
6029    nowbusy newbranch
6030    update
6031    if {[catch {
6032        exec git branch $name $id
6033    } err]} {
6034        notbusy newbranch
6035        error_popup $err
6036    } else {
6037        set headids($name) $id
6038        lappend idheads($id) $name
6039        addedhead $id $name
6040        notbusy newbranch
6041        redrawtags $id
6042        dispneartags 0
6043        run refill_reflist
6044    }
6045}
6046
6047proc cherrypick {} {
6048    global rowmenuid curview commitrow
6049    global mainhead
6050
6051    set oldhead [exec git rev-parse HEAD]
6052    set dheads [descheads $rowmenuid]
6053    if {$dheads ne {} && [lsearch -exact $dheads $oldhead] >= 0} {
6054        set ok [confirm_popup "Commit [string range $rowmenuid 0 7] is already\
6055                        included in branch $mainhead -- really re-apply it?"]
6056        if {!$ok} return
6057    }
6058    nowbusy cherrypick
6059    update
6060    # Unfortunately git-cherry-pick writes stuff to stderr even when
6061    # no error occurs, and exec takes that as an indication of error...
6062    if {[catch {exec sh -c "git cherry-pick -r $rowmenuid 2>&1"} err]} {
6063        notbusy cherrypick
6064        error_popup $err
6065        return
6066    }
6067    set newhead [exec git rev-parse HEAD]
6068    if {$newhead eq $oldhead} {
6069        notbusy cherrypick
6070        error_popup "No changes committed"
6071        return
6072    }
6073    addnewchild $newhead $oldhead
6074    if {[info exists commitrow($curview,$oldhead)]} {
6075        insertrow $commitrow($curview,$oldhead) $newhead
6076        if {$mainhead ne {}} {
6077            movehead $newhead $mainhead
6078            movedhead $newhead $mainhead
6079        }
6080        redrawtags $oldhead
6081        redrawtags $newhead
6082    }
6083    notbusy cherrypick
6084}
6085
6086proc resethead {} {
6087    global mainheadid mainhead rowmenuid confirm_ok resettype
6088    global showlocalchanges
6089
6090    set confirm_ok 0
6091    set w ".confirmreset"
6092    toplevel $w
6093    wm transient $w .
6094    wm title $w "Confirm reset"
6095    message $w.m -text \
6096        "Reset branch $mainhead to [string range $rowmenuid 0 7]?" \
6097        -justify center -aspect 1000
6098    pack $w.m -side top -fill x -padx 20 -pady 20
6099    frame $w.f -relief sunken -border 2
6100    message $w.f.rt -text "Reset type:" -aspect 1000
6101    grid $w.f.rt -sticky w
6102    set resettype mixed
6103    radiobutton $w.f.soft -value soft -variable resettype -justify left \
6104        -text "Soft: Leave working tree and index untouched"
6105    grid $w.f.soft -sticky w
6106    radiobutton $w.f.mixed -value mixed -variable resettype -justify left \
6107        -text "Mixed: Leave working tree untouched, reset index"
6108    grid $w.f.mixed -sticky w
6109    radiobutton $w.f.hard -value hard -variable resettype -justify left \
6110        -text "Hard: Reset working tree and index\n(discard ALL local changes)"
6111    grid $w.f.hard -sticky w
6112    pack $w.f -side top -fill x
6113    button $w.ok -text OK -command "set confirm_ok 1; destroy $w"
6114    pack $w.ok -side left -fill x -padx 20 -pady 20
6115    button $w.cancel -text Cancel -command "destroy $w"
6116    pack $w.cancel -side right -fill x -padx 20 -pady 20
6117    bind $w <Visibility> "grab $w; focus $w"
6118    tkwait window $w
6119    if {!$confirm_ok} return
6120    if {[catch {set fd [open \
6121            [list | sh -c "git reset --$resettype $rowmenuid 2>&1"] r]} err]} {
6122        error_popup $err
6123    } else {
6124        dohidelocalchanges
6125        set w ".resetprogress"
6126        filerun $fd [list readresetstat $fd $w]
6127        toplevel $w
6128        wm transient $w
6129        wm title $w "Reset progress"
6130        message $w.m -text "Reset in progress, please wait..." \
6131            -justify center -aspect 1000
6132        pack $w.m -side top -fill x -padx 20 -pady 5
6133        canvas $w.c -width 150 -height 20 -bg white
6134        $w.c create rect 0 0 0 20 -fill green -tags rect
6135        pack $w.c -side top -fill x -padx 20 -pady 5 -expand 1
6136        nowbusy reset
6137    }
6138}
6139
6140proc readresetstat {fd w} {
6141    global mainhead mainheadid showlocalchanges
6142
6143    if {[gets $fd line] >= 0} {
6144        if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
6145            set x [expr {($m * 150) / $n}]
6146            $w.c coords rect 0 0 $x 20
6147        }
6148        return 1
6149    }
6150    destroy $w
6151    notbusy reset
6152    if {[catch {close $fd} err]} {
6153        error_popup $err
6154    }
6155    set oldhead $mainheadid
6156    set newhead [exec git rev-parse HEAD]
6157    if {$newhead ne $oldhead} {
6158        movehead $newhead $mainhead
6159        movedhead $newhead $mainhead
6160        set mainheadid $newhead
6161        redrawtags $oldhead
6162        redrawtags $newhead
6163    }
6164    if {$showlocalchanges} {
6165        doshowlocalchanges
6166    }
6167    return 0
6168}
6169
6170# context menu for a head
6171proc headmenu {x y id head} {
6172    global headmenuid headmenuhead headctxmenu mainhead
6173
6174    set headmenuid $id
6175    set headmenuhead $head
6176    set state normal
6177    if {$head eq $mainhead} {
6178        set state disabled
6179    }
6180    $headctxmenu entryconfigure 0 -state $state
6181    $headctxmenu entryconfigure 1 -state $state
6182    tk_popup $headctxmenu $x $y
6183}
6184
6185proc cobranch {} {
6186    global headmenuid headmenuhead mainhead headids
6187    global showlocalchanges mainheadid
6188
6189    # check the tree is clean first??
6190    set oldmainhead $mainhead
6191    nowbusy checkout
6192    update
6193    dohidelocalchanges
6194    if {[catch {
6195        exec git checkout -q $headmenuhead
6196    } err]} {
6197        notbusy checkout
6198        error_popup $err
6199    } else {
6200        notbusy checkout
6201        set mainhead $headmenuhead
6202        set mainheadid $headmenuid
6203        if {[info exists headids($oldmainhead)]} {
6204            redrawtags $headids($oldmainhead)
6205        }
6206        redrawtags $headmenuid
6207    }
6208    if {$showlocalchanges} {
6209        dodiffindex
6210    }
6211}
6212
6213proc rmbranch {} {
6214    global headmenuid headmenuhead mainhead
6215    global idheads
6216
6217    set head $headmenuhead
6218    set id $headmenuid
6219    # this check shouldn't be needed any more...
6220    if {$head eq $mainhead} {
6221        error_popup "Cannot delete the currently checked-out branch"
6222        return
6223    }
6224    set dheads [descheads $id]
6225    if {[llength $dheads] == 1 && $idheads($dheads) eq $head} {
6226        # the stuff on this branch isn't on any other branch
6227        if {![confirm_popup "The commits on branch $head aren't on any other\
6228                        branch.\nReally delete branch $head?"]} return
6229    }
6230    nowbusy rmbranch
6231    update
6232    if {[catch {exec git branch -D $head} err]} {
6233        notbusy rmbranch
6234        error_popup $err
6235        return
6236    }
6237    removehead $id $head
6238    removedhead $id $head
6239    redrawtags $id
6240    notbusy rmbranch
6241    dispneartags 0
6242    run refill_reflist
6243}
6244
6245# Display a list of tags and heads
6246proc showrefs {} {
6247    global showrefstop bgcolor fgcolor selectbgcolor mainfont
6248    global bglist fglist uifont reflistfilter reflist maincursor
6249
6250    set top .showrefs
6251    set showrefstop $top
6252    if {[winfo exists $top]} {
6253        raise $top
6254        refill_reflist
6255        return
6256    }
6257    toplevel $top
6258    wm title $top "Tags and heads: [file tail [pwd]]"
6259    text $top.list -background $bgcolor -foreground $fgcolor \
6260        -selectbackground $selectbgcolor -font $mainfont \
6261        -xscrollcommand "$top.xsb set" -yscrollcommand "$top.ysb set" \
6262        -width 30 -height 20 -cursor $maincursor \
6263        -spacing1 1 -spacing3 1 -state disabled
6264    $top.list tag configure highlight -background $selectbgcolor
6265    lappend bglist $top.list
6266    lappend fglist $top.list
6267    scrollbar $top.ysb -command "$top.list yview" -orient vertical
6268    scrollbar $top.xsb -command "$top.list xview" -orient horizontal
6269    grid $top.list $top.ysb -sticky nsew
6270    grid $top.xsb x -sticky ew
6271    frame $top.f
6272    label $top.f.l -text "Filter: " -font $uifont
6273    entry $top.f.e -width 20 -textvariable reflistfilter -font $uifont
6274    set reflistfilter "*"
6275    trace add variable reflistfilter write reflistfilter_change
6276    pack $top.f.e -side right -fill x -expand 1
6277    pack $top.f.l -side left
6278    grid $top.f - -sticky ew -pady 2
6279    button $top.close -command [list destroy $top] -text "Close" \
6280        -font $uifont
6281    grid $top.close -
6282    grid columnconfigure $top 0 -weight 1
6283    grid rowconfigure $top 0 -weight 1
6284    bind $top.list <1> {break}
6285    bind $top.list <B1-Motion> {break}
6286    bind $top.list <ButtonRelease-1> {sel_reflist %W %x %y; break}
6287    set reflist {}
6288    refill_reflist
6289}
6290
6291proc sel_reflist {w x y} {
6292    global showrefstop reflist headids tagids otherrefids
6293
6294    if {![winfo exists $showrefstop]} return
6295    set l [lindex [split [$w index "@$x,$y"] "."] 0]
6296    set ref [lindex $reflist [expr {$l-1}]]
6297    set n [lindex $ref 0]
6298    switch -- [lindex $ref 1] {
6299        "H" {selbyid $headids($n)}
6300        "T" {selbyid $tagids($n)}
6301        "o" {selbyid $otherrefids($n)}
6302    }
6303    $showrefstop.list tag add highlight $l.0 "$l.0 lineend"
6304}
6305
6306proc unsel_reflist {} {
6307    global showrefstop
6308
6309    if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
6310    $showrefstop.list tag remove highlight 0.0 end
6311}
6312
6313proc reflistfilter_change {n1 n2 op} {
6314    global reflistfilter
6315
6316    after cancel refill_reflist
6317    after 200 refill_reflist
6318}
6319
6320proc refill_reflist {} {
6321    global reflist reflistfilter showrefstop headids tagids otherrefids
6322    global commitrow curview commitinterest
6323
6324    if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
6325    set refs {}
6326    foreach n [array names headids] {
6327        if {[string match $reflistfilter $n]} {
6328            if {[info exists commitrow($curview,$headids($n))]} {
6329                lappend refs [list $n H]
6330            } else {
6331                set commitinterest($headids($n)) {run refill_reflist}
6332            }
6333        }
6334    }
6335    foreach n [array names tagids] {
6336        if {[string match $reflistfilter $n]} {
6337            if {[info exists commitrow($curview,$tagids($n))]} {
6338                lappend refs [list $n T]
6339            } else {
6340                set commitinterest($tagids($n)) {run refill_reflist}
6341            }
6342        }
6343    }
6344    foreach n [array names otherrefids] {
6345        if {[string match $reflistfilter $n]} {
6346            if {[info exists commitrow($curview,$otherrefids($n))]} {
6347                lappend refs [list $n o]
6348            } else {
6349                set commitinterest($otherrefids($n)) {run refill_reflist}
6350            }
6351        }
6352    }
6353    set refs [lsort -index 0 $refs]
6354    if {$refs eq $reflist} return
6355
6356    # Update the contents of $showrefstop.list according to the
6357    # differences between $reflist (old) and $refs (new)
6358    $showrefstop.list conf -state normal
6359    $showrefstop.list insert end "\n"
6360    set i 0
6361    set j 0
6362    while {$i < [llength $reflist] || $j < [llength $refs]} {
6363        if {$i < [llength $reflist]} {
6364            if {$j < [llength $refs]} {
6365                set cmp [string compare [lindex $reflist $i 0] \
6366                             [lindex $refs $j 0]]
6367                if {$cmp == 0} {
6368                    set cmp [string compare [lindex $reflist $i 1] \
6369                                 [lindex $refs $j 1]]
6370                }
6371            } else {
6372                set cmp -1
6373            }
6374        } else {
6375            set cmp 1
6376        }
6377        switch -- $cmp {
6378            -1 {
6379                $showrefstop.list delete "[expr {$j+1}].0" "[expr {$j+2}].0"
6380                incr i
6381            }
6382            0 {
6383                incr i
6384                incr j
6385            }
6386            1 {
6387                set l [expr {$j + 1}]
6388                $showrefstop.list image create $l.0 -align baseline \
6389                    -image reficon-[lindex $refs $j 1] -padx 2
6390                $showrefstop.list insert $l.1 "[lindex $refs $j 0]\n"
6391                incr j
6392            }
6393        }
6394    }
6395    set reflist $refs
6396    # delete last newline
6397    $showrefstop.list delete end-2c end-1c
6398    $showrefstop.list conf -state disabled
6399}
6400
6401# Stuff for finding nearby tags
6402proc getallcommits {} {
6403    global allcommits allids nbmp nextarc seeds
6404
6405    if {![info exists allcommits]} {
6406        set allids {}
6407        set nbmp 0
6408        set nextarc 0
6409        set allcommits 0
6410        set seeds {}
6411    }
6412
6413    set cmd [concat | git rev-list --all --parents]
6414    foreach id $seeds {
6415        lappend cmd "^$id"
6416    }
6417    set fd [open $cmd r]
6418    fconfigure $fd -blocking 0
6419    incr allcommits
6420    nowbusy allcommits
6421    filerun $fd [list getallclines $fd]
6422}
6423
6424# Since most commits have 1 parent and 1 child, we group strings of
6425# such commits into "arcs" joining branch/merge points (BMPs), which
6426# are commits that either don't have 1 parent or don't have 1 child.
6427#
6428# arcnos(id) - incoming arcs for BMP, arc we're on for other nodes
6429# arcout(id) - outgoing arcs for BMP
6430# arcids(a) - list of IDs on arc including end but not start
6431# arcstart(a) - BMP ID at start of arc
6432# arcend(a) - BMP ID at end of arc
6433# growing(a) - arc a is still growing
6434# arctags(a) - IDs out of arcids (excluding end) that have tags
6435# archeads(a) - IDs out of arcids (excluding end) that have heads
6436# The start of an arc is at the descendent end, so "incoming" means
6437# coming from descendents, and "outgoing" means going towards ancestors.
6438
6439proc getallclines {fd} {
6440    global allids allparents allchildren idtags idheads nextarc nbmp
6441    global arcnos arcids arctags arcout arcend arcstart archeads growing
6442    global seeds allcommits
6443
6444    set nid 0
6445    while {[incr nid] <= 1000 && [gets $fd line] >= 0} {
6446        set id [lindex $line 0]
6447        if {[info exists allparents($id)]} {
6448            # seen it already
6449            continue
6450        }
6451        lappend allids $id
6452        set olds [lrange $line 1 end]
6453        set allparents($id) $olds
6454        if {![info exists allchildren($id)]} {
6455            set allchildren($id) {}
6456            set arcnos($id) {}
6457            lappend seeds $id
6458        } else {
6459            set a $arcnos($id)
6460            if {[llength $olds] == 1 && [llength $a] == 1} {
6461                lappend arcids($a) $id
6462                if {[info exists idtags($id)]} {
6463                    lappend arctags($a) $id
6464                }
6465                if {[info exists idheads($id)]} {
6466                    lappend archeads($a) $id
6467                }
6468                if {[info exists allparents($olds)]} {
6469                    # seen parent already
6470                    if {![info exists arcout($olds)]} {
6471                        splitarc $olds
6472                    }
6473                    lappend arcids($a) $olds
6474                    set arcend($a) $olds
6475                    unset growing($a)
6476                }
6477                lappend allchildren($olds) $id
6478                lappend arcnos($olds) $a
6479                continue
6480            }
6481        }
6482        incr nbmp
6483        foreach a $arcnos($id) {
6484            lappend arcids($a) $id
6485            set arcend($a) $id
6486            unset growing($a)
6487        }
6488
6489        set ao {}
6490        foreach p $olds {
6491            lappend allchildren($p) $id
6492            set a [incr nextarc]
6493            set arcstart($a) $id
6494            set archeads($a) {}
6495            set arctags($a) {}
6496            set archeads($a) {}
6497            set arcids($a) {}
6498            lappend ao $a
6499            set growing($a) 1
6500            if {[info exists allparents($p)]} {
6501                # seen it already, may need to make a new branch
6502                if {![info exists arcout($p)]} {
6503                    splitarc $p
6504                }
6505                lappend arcids($a) $p
6506                set arcend($a) $p
6507                unset growing($a)
6508            }
6509            lappend arcnos($p) $a
6510        }
6511        set arcout($id) $ao
6512    }
6513    if {$nid > 0} {
6514        global cached_dheads cached_dtags cached_atags
6515        catch {unset cached_dheads}
6516        catch {unset cached_dtags}
6517        catch {unset cached_atags}
6518    }
6519    if {![eof $fd]} {
6520        return [expr {$nid >= 1000? 2: 1}]
6521    }
6522    close $fd
6523    if {[incr allcommits -1] == 0} {
6524        notbusy allcommits
6525    }
6526    dispneartags 0
6527    return 0
6528}
6529
6530proc recalcarc {a} {
6531    global arctags archeads arcids idtags idheads
6532
6533    set at {}
6534    set ah {}
6535    foreach id [lrange $arcids($a) 0 end-1] {
6536        if {[info exists idtags($id)]} {
6537            lappend at $id
6538        }
6539        if {[info exists idheads($id)]} {
6540            lappend ah $id
6541        }
6542    }
6543    set arctags($a) $at
6544    set archeads($a) $ah
6545}
6546
6547proc splitarc {p} {
6548    global arcnos arcids nextarc nbmp arctags archeads idtags idheads
6549    global arcstart arcend arcout allparents growing
6550
6551    set a $arcnos($p)
6552    if {[llength $a] != 1} {
6553        puts "oops splitarc called but [llength $a] arcs already"
6554        return
6555    }
6556    set a [lindex $a 0]
6557    set i [lsearch -exact $arcids($a) $p]
6558    if {$i < 0} {
6559        puts "oops splitarc $p not in arc $a"
6560        return
6561    }
6562    set na [incr nextarc]
6563    if {[info exists arcend($a)]} {
6564        set arcend($na) $arcend($a)
6565    } else {
6566        set l [lindex $allparents([lindex $arcids($a) end]) 0]
6567        set j [lsearch -exact $arcnos($l) $a]
6568        set arcnos($l) [lreplace $arcnos($l) $j $j $na]
6569    }
6570    set tail [lrange $arcids($a) [expr {$i+1}] end]
6571    set arcids($a) [lrange $arcids($a) 0 $i]
6572    set arcend($a) $p
6573    set arcstart($na) $p
6574    set arcout($p) $na
6575    set arcids($na) $tail
6576    if {[info exists growing($a)]} {
6577        set growing($na) 1
6578        unset growing($a)
6579    }
6580    incr nbmp
6581
6582    foreach id $tail {
6583        if {[llength $arcnos($id)] == 1} {
6584            set arcnos($id) $na
6585        } else {
6586            set j [lsearch -exact $arcnos($id) $a]
6587            set arcnos($id) [lreplace $arcnos($id) $j $j $na]
6588        }
6589    }
6590
6591    # reconstruct tags and heads lists
6592    if {$arctags($a) ne {} || $archeads($a) ne {}} {
6593        recalcarc $a
6594        recalcarc $na
6595    } else {
6596        set arctags($na) {}
6597        set archeads($na) {}
6598    }
6599}
6600
6601# Update things for a new commit added that is a child of one
6602# existing commit.  Used when cherry-picking.
6603proc addnewchild {id p} {
6604    global allids allparents allchildren idtags nextarc nbmp
6605    global arcnos arcids arctags arcout arcend arcstart archeads growing
6606    global seeds
6607
6608    lappend allids $id
6609    set allparents($id) [list $p]
6610    set allchildren($id) {}
6611    set arcnos($id) {}
6612    lappend seeds $id
6613    incr nbmp
6614    lappend allchildren($p) $id
6615    set a [incr nextarc]
6616    set arcstart($a) $id
6617    set archeads($a) {}
6618    set arctags($a) {}
6619    set arcids($a) [list $p]
6620    set arcend($a) $p
6621    if {![info exists arcout($p)]} {
6622        splitarc $p
6623    }
6624    lappend arcnos($p) $a
6625    set arcout($id) [list $a]
6626}
6627
6628# Returns 1 if a is an ancestor of b, -1 if b is an ancestor of a,
6629# or 0 if neither is true.
6630proc anc_or_desc {a b} {
6631    global arcout arcstart arcend arcnos cached_isanc
6632
6633    if {$arcnos($a) eq $arcnos($b)} {
6634        # Both are on the same arc(s); either both are the same BMP,
6635        # or if one is not a BMP, the other is also not a BMP or is
6636        # the BMP at end of the arc (and it only has 1 incoming arc).
6637        # Or both can be BMPs with no incoming arcs.
6638        if {$a eq $b || $arcnos($a) eq {}} {
6639            return 0
6640        }
6641        # assert {[llength $arcnos($a)] == 1}
6642        set arc [lindex $arcnos($a) 0]
6643        set i [lsearch -exact $arcids($arc) $a]
6644        set j [lsearch -exact $arcids($arc) $b]
6645        if {$i < 0 || $i > $j} {
6646            return 1
6647        } else {
6648            return -1
6649        }
6650    }
6651
6652    if {![info exists arcout($a)]} {
6653        set arc [lindex $arcnos($a) 0]
6654        if {[info exists arcend($arc)]} {
6655            set aend $arcend($arc)
6656        } else {
6657            set aend {}
6658        }
6659        set a $arcstart($arc)
6660    } else {
6661        set aend $a
6662    }
6663    if {![info exists arcout($b)]} {
6664        set arc [lindex $arcnos($b) 0]
6665        if {[info exists arcend($arc)]} {
6666            set bend $arcend($arc)
6667        } else {
6668            set bend {}
6669        }
6670        set b $arcstart($arc)
6671    } else {
6672        set bend $b
6673    }
6674    if {$a eq $bend} {
6675        return 1
6676    }
6677    if {$b eq $aend} {
6678        return -1
6679    }
6680    if {[info exists cached_isanc($a,$bend)]} {
6681        if {$cached_isanc($a,$bend)} {
6682            return 1
6683        }
6684    }
6685    if {[info exists cached_isanc($b,$aend)]} {
6686        if {$cached_isanc($b,$aend)} {
6687            return -1
6688        }
6689        if {[info exists cached_isanc($a,$bend)]} {
6690            return 0
6691        }
6692    }
6693
6694    set todo [list $a $b]
6695    set anc($a) a
6696    set anc($b) b
6697    for {set i 0} {$i < [llength $todo]} {incr i} {
6698        set x [lindex $todo $i]
6699        if {$anc($x) eq {}} {
6700            continue
6701        }
6702        foreach arc $arcnos($x) {
6703            set xd $arcstart($arc)
6704            if {$xd eq $bend} {
6705                set cached_isanc($a,$bend) 1
6706                set cached_isanc($b,$aend) 0
6707                return 1
6708            } elseif {$xd eq $aend} {
6709                set cached_isanc($b,$aend) 1
6710                set cached_isanc($a,$bend) 0
6711                return -1
6712            }
6713            if {![info exists anc($xd)]} {
6714                set anc($xd) $anc($x)
6715                lappend todo $xd
6716            } elseif {$anc($xd) ne $anc($x)} {
6717                set anc($xd) {}
6718            }
6719        }
6720    }
6721    set cached_isanc($a,$bend) 0
6722    set cached_isanc($b,$aend) 0
6723    return 0
6724}
6725
6726# This identifies whether $desc has an ancestor that is
6727# a growing tip of the graph and which is not an ancestor of $anc
6728# and returns 0 if so and 1 if not.
6729# If we subsequently discover a tag on such a growing tip, and that
6730# turns out to be a descendent of $anc (which it could, since we
6731# don't necessarily see children before parents), then $desc
6732# isn't a good choice to display as a descendent tag of
6733# $anc (since it is the descendent of another tag which is
6734# a descendent of $anc).  Similarly, $anc isn't a good choice to
6735# display as a ancestor tag of $desc.
6736#
6737proc is_certain {desc anc} {
6738    global arcnos arcout arcstart arcend growing problems
6739
6740    set certain {}
6741    if {[llength $arcnos($anc)] == 1} {
6742        # tags on the same arc are certain
6743        if {$arcnos($desc) eq $arcnos($anc)} {
6744            return 1
6745        }
6746        if {![info exists arcout($anc)]} {
6747            # if $anc is partway along an arc, use the start of the arc instead
6748            set a [lindex $arcnos($anc) 0]
6749            set anc $arcstart($a)
6750        }
6751    }
6752    if {[llength $arcnos($desc)] > 1 || [info exists arcout($desc)]} {
6753        set x $desc
6754    } else {
6755        set a [lindex $arcnos($desc) 0]
6756        set x $arcend($a)
6757    }
6758    if {$x == $anc} {
6759        return 1
6760    }
6761    set anclist [list $x]
6762    set dl($x) 1
6763    set nnh 1
6764    set ngrowanc 0
6765    for {set i 0} {$i < [llength $anclist] && ($nnh > 0 || $ngrowanc > 0)} {incr i} {
6766        set x [lindex $anclist $i]
6767        if {$dl($x)} {
6768            incr nnh -1
6769        }
6770        set done($x) 1
6771        foreach a $arcout($x) {
6772            if {[info exists growing($a)]} {
6773                if {![info exists growanc($x)] && $dl($x)} {
6774                    set growanc($x) 1
6775                    incr ngrowanc
6776                }
6777            } else {
6778                set y $arcend($a)
6779                if {[info exists dl($y)]} {
6780                    if {$dl($y)} {
6781                        if {!$dl($x)} {
6782                            set dl($y) 0
6783                            if {![info exists done($y)]} {
6784                                incr nnh -1
6785                            }
6786                            if {[info exists growanc($x)]} {
6787                                incr ngrowanc -1
6788                            }
6789                            set xl [list $y]
6790                            for {set k 0} {$k < [llength $xl]} {incr k} {
6791                                set z [lindex $xl $k]
6792                                foreach c $arcout($z) {
6793                                    if {[info exists arcend($c)]} {
6794                                        set v $arcend($c)
6795                                        if {[info exists dl($v)] && $dl($v)} {
6796                                            set dl($v) 0
6797                                            if {![info exists done($v)]} {
6798                                                incr nnh -1
6799                                            }
6800                                            if {[info exists growanc($v)]} {
6801                                                incr ngrowanc -1
6802                                            }
6803                                            lappend xl $v
6804                                        }
6805                                    }
6806                                }
6807                            }
6808                        }
6809                    }
6810                } elseif {$y eq $anc || !$dl($x)} {
6811                    set dl($y) 0
6812                    lappend anclist $y
6813                } else {
6814                    set dl($y) 1
6815                    lappend anclist $y
6816                    incr nnh
6817                }
6818            }
6819        }
6820    }
6821    foreach x [array names growanc] {
6822        if {$dl($x)} {
6823            return 0
6824        }
6825        return 0
6826    }
6827    return 1
6828}
6829
6830proc validate_arctags {a} {
6831    global arctags idtags
6832
6833    set i -1
6834    set na $arctags($a)
6835    foreach id $arctags($a) {
6836        incr i
6837        if {![info exists idtags($id)]} {
6838            set na [lreplace $na $i $i]
6839            incr i -1
6840        }
6841    }
6842    set arctags($a) $na
6843}
6844
6845proc validate_archeads {a} {
6846    global archeads idheads
6847
6848    set i -1
6849    set na $archeads($a)
6850    foreach id $archeads($a) {
6851        incr i
6852        if {![info exists idheads($id)]} {
6853            set na [lreplace $na $i $i]
6854            incr i -1
6855        }
6856    }
6857    set archeads($a) $na
6858}
6859
6860# Return the list of IDs that have tags that are descendents of id,
6861# ignoring IDs that are descendents of IDs already reported.
6862proc desctags {id} {
6863    global arcnos arcstart arcids arctags idtags allparents
6864    global growing cached_dtags
6865
6866    if {![info exists allparents($id)]} {
6867        return {}
6868    }
6869    set t1 [clock clicks -milliseconds]
6870    set argid $id
6871    if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
6872        # part-way along an arc; check that arc first
6873        set a [lindex $arcnos($id) 0]
6874        if {$arctags($a) ne {}} {
6875            validate_arctags $a
6876            set i [lsearch -exact $arcids($a) $id]
6877            set tid {}
6878            foreach t $arctags($a) {
6879                set j [lsearch -exact $arcids($a) $t]
6880                if {$j >= $i} break
6881                set tid $t
6882            }
6883            if {$tid ne {}} {
6884                return $tid
6885            }
6886        }
6887        set id $arcstart($a)
6888        if {[info exists idtags($id)]} {
6889            return $id
6890        }
6891    }
6892    if {[info exists cached_dtags($id)]} {
6893        return $cached_dtags($id)
6894    }
6895
6896    set origid $id
6897    set todo [list $id]
6898    set queued($id) 1
6899    set nc 1
6900    for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
6901        set id [lindex $todo $i]
6902        set done($id) 1
6903        set ta [info exists hastaggedancestor($id)]
6904        if {!$ta} {
6905            incr nc -1
6906        }
6907        # ignore tags on starting node
6908        if {!$ta && $i > 0} {
6909            if {[info exists idtags($id)]} {
6910                set tagloc($id) $id
6911                set ta 1
6912            } elseif {[info exists cached_dtags($id)]} {
6913                set tagloc($id) $cached_dtags($id)
6914                set ta 1
6915            }
6916        }
6917        foreach a $arcnos($id) {
6918            set d $arcstart($a)
6919            if {!$ta && $arctags($a) ne {}} {
6920                validate_arctags $a
6921                if {$arctags($a) ne {}} {
6922                    lappend tagloc($id) [lindex $arctags($a) end]
6923                }
6924            }
6925            if {$ta || $arctags($a) ne {}} {
6926                set tomark [list $d]
6927                for {set j 0} {$j < [llength $tomark]} {incr j} {
6928                    set dd [lindex $tomark $j]
6929                    if {![info exists hastaggedancestor($dd)]} {
6930                        if {[info exists done($dd)]} {
6931                            foreach b $arcnos($dd) {
6932                                lappend tomark $arcstart($b)
6933                            }
6934                            if {[info exists tagloc($dd)]} {
6935                                unset tagloc($dd)
6936                            }
6937                        } elseif {[info exists queued($dd)]} {
6938                            incr nc -1
6939                        }
6940                        set hastaggedancestor($dd) 1
6941                    }
6942                }
6943            }
6944            if {![info exists queued($d)]} {
6945                lappend todo $d
6946                set queued($d) 1
6947                if {![info exists hastaggedancestor($d)]} {
6948                    incr nc
6949                }
6950            }
6951        }
6952    }
6953    set tags {}
6954    foreach id [array names tagloc] {
6955        if {![info exists hastaggedancestor($id)]} {
6956            foreach t $tagloc($id) {
6957                if {[lsearch -exact $tags $t] < 0} {
6958                    lappend tags $t
6959                }
6960            }
6961        }
6962    }
6963    set t2 [clock clicks -milliseconds]
6964    set loopix $i
6965
6966    # remove tags that are descendents of other tags
6967    for {set i 0} {$i < [llength $tags]} {incr i} {
6968        set a [lindex $tags $i]
6969        for {set j 0} {$j < $i} {incr j} {
6970            set b [lindex $tags $j]
6971            set r [anc_or_desc $a $b]
6972            if {$r == 1} {
6973                set tags [lreplace $tags $j $j]
6974                incr j -1
6975                incr i -1
6976            } elseif {$r == -1} {
6977                set tags [lreplace $tags $i $i]
6978                incr i -1
6979                break
6980            }
6981        }
6982    }
6983
6984    if {[array names growing] ne {}} {
6985        # graph isn't finished, need to check if any tag could get
6986        # eclipsed by another tag coming later.  Simply ignore any
6987        # tags that could later get eclipsed.
6988        set ctags {}
6989        foreach t $tags {
6990            if {[is_certain $t $origid]} {
6991                lappend ctags $t
6992            }
6993        }
6994        if {$tags eq $ctags} {
6995            set cached_dtags($origid) $tags
6996        } else {
6997            set tags $ctags
6998        }
6999    } else {
7000        set cached_dtags($origid) $tags
7001    }
7002    set t3 [clock clicks -milliseconds]
7003    if {0 && $t3 - $t1 >= 100} {
7004        puts "iterating descendents ($loopix/[llength $todo] nodes) took\
7005            [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
7006    }
7007    return $tags
7008}
7009
7010proc anctags {id} {
7011    global arcnos arcids arcout arcend arctags idtags allparents
7012    global growing cached_atags
7013
7014    if {![info exists allparents($id)]} {
7015        return {}
7016    }
7017    set t1 [clock clicks -milliseconds]
7018    set argid $id
7019    if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
7020        # part-way along an arc; check that arc first
7021        set a [lindex $arcnos($id) 0]
7022        if {$arctags($a) ne {}} {
7023            validate_arctags $a
7024            set i [lsearch -exact $arcids($a) $id]
7025            foreach t $arctags($a) {
7026                set j [lsearch -exact $arcids($a) $t]
7027                if {$j > $i} {
7028                    return $t
7029                }
7030            }
7031        }
7032        if {![info exists arcend($a)]} {
7033            return {}
7034        }
7035        set id $arcend($a)
7036        if {[info exists idtags($id)]} {
7037            return $id
7038        }
7039    }
7040    if {[info exists cached_atags($id)]} {
7041        return $cached_atags($id)
7042    }
7043
7044    set origid $id
7045    set todo [list $id]
7046    set queued($id) 1
7047    set taglist {}
7048    set nc 1
7049    for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
7050        set id [lindex $todo $i]
7051        set done($id) 1
7052        set td [info exists hastaggeddescendent($id)]
7053        if {!$td} {
7054            incr nc -1
7055        }
7056        # ignore tags on starting node
7057        if {!$td && $i > 0} {
7058            if {[info exists idtags($id)]} {
7059                set tagloc($id) $id
7060                set td 1
7061            } elseif {[info exists cached_atags($id)]} {
7062                set tagloc($id) $cached_atags($id)
7063                set td 1
7064            }
7065        }
7066        foreach a $arcout($id) {
7067            if {!$td && $arctags($a) ne {}} {
7068                validate_arctags $a
7069                if {$arctags($a) ne {}} {
7070                    lappend tagloc($id) [lindex $arctags($a) 0]
7071                }
7072            }
7073            if {![info exists arcend($a)]} continue
7074            set d $arcend($a)
7075            if {$td || $arctags($a) ne {}} {
7076                set tomark [list $d]
7077                for {set j 0} {$j < [llength $tomark]} {incr j} {
7078                    set dd [lindex $tomark $j]
7079                    if {![info exists hastaggeddescendent($dd)]} {
7080                        if {[info exists done($dd)]} {
7081                            foreach b $arcout($dd) {
7082                                if {[info exists arcend($b)]} {
7083                                    lappend tomark $arcend($b)
7084                                }
7085                            }
7086                            if {[info exists tagloc($dd)]} {
7087                                unset tagloc($dd)
7088                            }
7089                        } elseif {[info exists queued($dd)]} {
7090                            incr nc -1
7091                        }
7092                        set hastaggeddescendent($dd) 1
7093                    }
7094                }
7095            }
7096            if {![info exists queued($d)]} {
7097                lappend todo $d
7098                set queued($d) 1
7099                if {![info exists hastaggeddescendent($d)]} {
7100                    incr nc
7101                }
7102            }
7103        }
7104    }
7105    set t2 [clock clicks -milliseconds]
7106    set loopix $i
7107    set tags {}
7108    foreach id [array names tagloc] {
7109        if {![info exists hastaggeddescendent($id)]} {
7110            foreach t $tagloc($id) {
7111                if {[lsearch -exact $tags $t] < 0} {
7112                    lappend tags $t
7113                }
7114            }
7115        }
7116    }
7117
7118    # remove tags that are ancestors of other tags
7119    for {set i 0} {$i < [llength $tags]} {incr i} {
7120        set a [lindex $tags $i]
7121        for {set j 0} {$j < $i} {incr j} {
7122            set b [lindex $tags $j]
7123            set r [anc_or_desc $a $b]
7124            if {$r == -1} {
7125                set tags [lreplace $tags $j $j]
7126                incr j -1
7127                incr i -1
7128            } elseif {$r == 1} {
7129                set tags [lreplace $tags $i $i]
7130                incr i -1
7131                break
7132            }
7133        }
7134    }
7135
7136    if {[array names growing] ne {}} {
7137        # graph isn't finished, need to check if any tag could get
7138        # eclipsed by another tag coming later.  Simply ignore any
7139        # tags that could later get eclipsed.
7140        set ctags {}
7141        foreach t $tags {
7142            if {[is_certain $origid $t]} {
7143                lappend ctags $t
7144            }
7145        }
7146        if {$tags eq $ctags} {
7147            set cached_atags($origid) $tags
7148        } else {
7149            set tags $ctags
7150        }
7151    } else {
7152        set cached_atags($origid) $tags
7153    }
7154    set t3 [clock clicks -milliseconds]
7155    if {0 && $t3 - $t1 >= 100} {
7156        puts "iterating ancestors ($loopix/[llength $todo] nodes) took\
7157            [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
7158    }
7159    return $tags
7160}
7161
7162# Return the list of IDs that have heads that are descendents of id,
7163# including id itself if it has a head.
7164proc descheads {id} {
7165    global arcnos arcstart arcids archeads idheads cached_dheads
7166    global allparents
7167
7168    if {![info exists allparents($id)]} {
7169        return {}
7170    }
7171    set aret {}
7172    if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
7173        # part-way along an arc; check it first
7174        set a [lindex $arcnos($id) 0]
7175        if {$archeads($a) ne {}} {
7176            validate_archeads $a
7177            set i [lsearch -exact $arcids($a) $id]
7178            foreach t $archeads($a) {
7179                set j [lsearch -exact $arcids($a) $t]
7180                if {$j > $i} break
7181                lappend aret $t
7182            }
7183        }
7184        set id $arcstart($a)
7185    }
7186    set origid $id
7187    set todo [list $id]
7188    set seen($id) 1
7189    set ret {}
7190    for {set i 0} {$i < [llength $todo]} {incr i} {
7191        set id [lindex $todo $i]
7192        if {[info exists cached_dheads($id)]} {
7193            set ret [concat $ret $cached_dheads($id)]
7194        } else {
7195            if {[info exists idheads($id)]} {
7196                lappend ret $id
7197            }
7198            foreach a $arcnos($id) {
7199                if {$archeads($a) ne {}} {
7200                    validate_archeads $a
7201                    if {$archeads($a) ne {}} {
7202                        set ret [concat $ret $archeads($a)]
7203                    }
7204                }
7205                set d $arcstart($a)
7206                if {![info exists seen($d)]} {
7207                    lappend todo $d
7208                    set seen($d) 1
7209                }
7210            }
7211        }
7212    }
7213    set ret [lsort -unique $ret]
7214    set cached_dheads($origid) $ret
7215    return [concat $ret $aret]
7216}
7217
7218proc addedtag {id} {
7219    global arcnos arcout cached_dtags cached_atags
7220
7221    if {![info exists arcnos($id)]} return
7222    if {![info exists arcout($id)]} {
7223        recalcarc [lindex $arcnos($id) 0]
7224    }
7225    catch {unset cached_dtags}
7226    catch {unset cached_atags}
7227}
7228
7229proc addedhead {hid head} {
7230    global arcnos arcout cached_dheads
7231
7232    if {![info exists arcnos($hid)]} return
7233    if {![info exists arcout($hid)]} {
7234        recalcarc [lindex $arcnos($hid) 0]
7235    }
7236    catch {unset cached_dheads}
7237}
7238
7239proc removedhead {hid head} {
7240    global cached_dheads
7241
7242    catch {unset cached_dheads}
7243}
7244
7245proc movedhead {hid head} {
7246    global arcnos arcout cached_dheads
7247
7248    if {![info exists arcnos($hid)]} return
7249    if {![info exists arcout($hid)]} {
7250        recalcarc [lindex $arcnos($hid) 0]
7251    }
7252    catch {unset cached_dheads}
7253}
7254
7255proc changedrefs {} {
7256    global cached_dheads cached_dtags cached_atags
7257    global arctags archeads arcnos arcout idheads idtags
7258
7259    foreach id [concat [array names idheads] [array names idtags]] {
7260        if {[info exists arcnos($id)] && ![info exists arcout($id)]} {
7261            set a [lindex $arcnos($id) 0]
7262            if {![info exists donearc($a)]} {
7263                recalcarc $a
7264                set donearc($a) 1
7265            }
7266        }
7267    }
7268    catch {unset cached_dtags}
7269    catch {unset cached_atags}
7270    catch {unset cached_dheads}
7271}
7272
7273proc rereadrefs {} {
7274    global idtags idheads idotherrefs mainhead
7275
7276    set refids [concat [array names idtags] \
7277                    [array names idheads] [array names idotherrefs]]
7278    foreach id $refids {
7279        if {![info exists ref($id)]} {
7280            set ref($id) [listrefs $id]
7281        }
7282    }
7283    set oldmainhead $mainhead
7284    readrefs
7285    changedrefs
7286    set refids [lsort -unique [concat $refids [array names idtags] \
7287                        [array names idheads] [array names idotherrefs]]]
7288    foreach id $refids {
7289        set v [listrefs $id]
7290        if {![info exists ref($id)] || $ref($id) != $v ||
7291            ($id eq $oldmainhead && $id ne $mainhead) ||
7292            ($id eq $mainhead && $id ne $oldmainhead)} {
7293            redrawtags $id
7294        }
7295    }
7296    run refill_reflist
7297}
7298
7299proc listrefs {id} {
7300    global idtags idheads idotherrefs
7301
7302    set x {}
7303    if {[info exists idtags($id)]} {
7304        set x $idtags($id)
7305    }
7306    set y {}
7307    if {[info exists idheads($id)]} {
7308        set y $idheads($id)
7309    }
7310    set z {}
7311    if {[info exists idotherrefs($id)]} {
7312        set z $idotherrefs($id)
7313    }
7314    return [list $x $y $z]
7315}
7316
7317proc showtag {tag isnew} {
7318    global ctext tagcontents tagids linknum tagobjid
7319
7320    if {$isnew} {
7321        addtohistory [list showtag $tag 0]
7322    }
7323    $ctext conf -state normal
7324    clear_ctext
7325    set linknum 0
7326    if {![info exists tagcontents($tag)]} {
7327        catch {
7328            set tagcontents($tag) [exec git cat-file tag $tagobjid($tag)]
7329        }
7330    }
7331    if {[info exists tagcontents($tag)]} {
7332        set text $tagcontents($tag)
7333    } else {
7334        set text "Tag: $tag\nId:  $tagids($tag)"
7335    }
7336    appendwithlinks $text {}
7337    $ctext conf -state disabled
7338    init_flist {}
7339}
7340
7341proc doquit {} {
7342    global stopped
7343    set stopped 100
7344    savestuff .
7345    destroy .
7346}
7347
7348proc doprefs {} {
7349    global maxwidth maxgraphpct diffopts
7350    global oldprefs prefstop showneartags showlocalchanges
7351    global bgcolor fgcolor ctext diffcolors selectbgcolor
7352    global uifont tabstop
7353
7354    set top .gitkprefs
7355    set prefstop $top
7356    if {[winfo exists $top]} {
7357        raise $top
7358        return
7359    }
7360    foreach v {maxwidth maxgraphpct diffopts showneartags showlocalchanges} {
7361        set oldprefs($v) [set $v]
7362    }
7363    toplevel $top
7364    wm title $top "Gitk preferences"
7365    label $top.ldisp -text "Commit list display options"
7366    $top.ldisp configure -font $uifont
7367    grid $top.ldisp - -sticky w -pady 10
7368    label $top.spacer -text " "
7369    label $top.maxwidthl -text "Maximum graph width (lines)" \
7370        -font optionfont
7371    spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
7372    grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
7373    label $top.maxpctl -text "Maximum graph width (% of pane)" \
7374        -font optionfont
7375    spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
7376    grid x $top.maxpctl $top.maxpct -sticky w
7377    frame $top.showlocal
7378    label $top.showlocal.l -text "Show local changes" -font optionfont
7379    checkbutton $top.showlocal.b -variable showlocalchanges
7380    pack $top.showlocal.b $top.showlocal.l -side left
7381    grid x $top.showlocal -sticky w
7382
7383    label $top.ddisp -text "Diff display options"
7384    $top.ddisp configure -font $uifont
7385    grid $top.ddisp - -sticky w -pady 10
7386    label $top.diffoptl -text "Options for diff program" \
7387        -font optionfont
7388    entry $top.diffopt -width 20 -textvariable diffopts
7389    grid x $top.diffoptl $top.diffopt -sticky w
7390    frame $top.ntag
7391    label $top.ntag.l -text "Display nearby tags" -font optionfont
7392    checkbutton $top.ntag.b -variable showneartags
7393    pack $top.ntag.b $top.ntag.l -side left
7394    grid x $top.ntag -sticky w
7395    label $top.tabstopl -text "tabstop" -font optionfont
7396    spinbox $top.tabstop -from 1 -to 20 -width 4 -textvariable tabstop
7397    grid x $top.tabstopl $top.tabstop -sticky w
7398
7399    label $top.cdisp -text "Colors: press to choose"
7400    $top.cdisp configure -font $uifont
7401    grid $top.cdisp - -sticky w -pady 10
7402    label $top.bg -padx 40 -relief sunk -background $bgcolor
7403    button $top.bgbut -text "Background" -font optionfont \
7404        -command [list choosecolor bgcolor 0 $top.bg background setbg]
7405    grid x $top.bgbut $top.bg -sticky w
7406    label $top.fg -padx 40 -relief sunk -background $fgcolor
7407    button $top.fgbut -text "Foreground" -font optionfont \
7408        -command [list choosecolor fgcolor 0 $top.fg foreground setfg]
7409    grid x $top.fgbut $top.fg -sticky w
7410    label $top.diffold -padx 40 -relief sunk -background [lindex $diffcolors 0]
7411    button $top.diffoldbut -text "Diff: old lines" -font optionfont \
7412        -command [list choosecolor diffcolors 0 $top.diffold "diff old lines" \
7413                      [list $ctext tag conf d0 -foreground]]
7414    grid x $top.diffoldbut $top.diffold -sticky w
7415    label $top.diffnew -padx 40 -relief sunk -background [lindex $diffcolors 1]
7416    button $top.diffnewbut -text "Diff: new lines" -font optionfont \
7417        -command [list choosecolor diffcolors 1 $top.diffnew "diff new lines" \
7418                      [list $ctext tag conf d1 -foreground]]
7419    grid x $top.diffnewbut $top.diffnew -sticky w
7420    label $top.hunksep -padx 40 -relief sunk -background [lindex $diffcolors 2]
7421    button $top.hunksepbut -text "Diff: hunk header" -font optionfont \
7422        -command [list choosecolor diffcolors 2 $top.hunksep \
7423                      "diff hunk header" \
7424                      [list $ctext tag conf hunksep -foreground]]
7425    grid x $top.hunksepbut $top.hunksep -sticky w
7426    label $top.selbgsep -padx 40 -relief sunk -background $selectbgcolor
7427    button $top.selbgbut -text "Select bg" -font optionfont \
7428        -command [list choosecolor selectbgcolor 0 $top.selbgsep background setselbg]
7429    grid x $top.selbgbut $top.selbgsep -sticky w
7430
7431    frame $top.buts
7432    button $top.buts.ok -text "OK" -command prefsok -default active
7433    $top.buts.ok configure -font $uifont
7434    button $top.buts.can -text "Cancel" -command prefscan -default normal
7435    $top.buts.can configure -font $uifont
7436    grid $top.buts.ok $top.buts.can
7437    grid columnconfigure $top.buts 0 -weight 1 -uniform a
7438    grid columnconfigure $top.buts 1 -weight 1 -uniform a
7439    grid $top.buts - - -pady 10 -sticky ew
7440    bind $top <Visibility> "focus $top.buts.ok"
7441}
7442
7443proc choosecolor {v vi w x cmd} {
7444    global $v
7445
7446    set c [tk_chooseColor -initialcolor [lindex [set $v] $vi] \
7447               -title "Gitk: choose color for $x"]
7448    if {$c eq {}} return
7449    $w conf -background $c
7450    lset $v $vi $c
7451    eval $cmd $c
7452}
7453
7454proc setselbg {c} {
7455    global bglist cflist
7456    foreach w $bglist {
7457        $w configure -selectbackground $c
7458    }
7459    $cflist tag configure highlight \
7460        -background [$cflist cget -selectbackground]
7461    allcanvs itemconf secsel -fill $c
7462}
7463
7464proc setbg {c} {
7465    global bglist
7466
7467    foreach w $bglist {
7468        $w conf -background $c
7469    }
7470}
7471
7472proc setfg {c} {
7473    global fglist canv
7474
7475    foreach w $fglist {
7476        $w conf -foreground $c
7477    }
7478    allcanvs itemconf text -fill $c
7479    $canv itemconf circle -outline $c
7480}
7481
7482proc prefscan {} {
7483    global maxwidth maxgraphpct diffopts
7484    global oldprefs prefstop showneartags showlocalchanges
7485
7486    foreach v {maxwidth maxgraphpct diffopts showneartags showlocalchanges} {
7487        set $v $oldprefs($v)
7488    }
7489    catch {destroy $prefstop}
7490    unset prefstop
7491}
7492
7493proc prefsok {} {
7494    global maxwidth maxgraphpct
7495    global oldprefs prefstop showneartags showlocalchanges
7496    global charspc ctext tabstop
7497
7498    catch {destroy $prefstop}
7499    unset prefstop
7500    $ctext configure -tabs "[expr {$tabstop * $charspc}]"
7501    if {$showlocalchanges != $oldprefs(showlocalchanges)} {
7502        if {$showlocalchanges} {
7503            doshowlocalchanges
7504        } else {
7505            dohidelocalchanges
7506        }
7507    }
7508    if {$maxwidth != $oldprefs(maxwidth)
7509        || $maxgraphpct != $oldprefs(maxgraphpct)} {
7510        redisplay
7511    } elseif {$showneartags != $oldprefs(showneartags)} {
7512        reselectline
7513    }
7514}
7515
7516proc formatdate {d} {
7517    global datetimeformat
7518    if {$d ne {}} {
7519        set d [clock format $d -format $datetimeformat]
7520    }
7521    return $d
7522}
7523
7524# This list of encoding names and aliases is distilled from
7525# http://www.iana.org/assignments/character-sets.
7526# Not all of them are supported by Tcl.
7527set encoding_aliases {
7528    { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
7529      ISO646-US US-ASCII us IBM367 cp367 csASCII }
7530    { ISO-10646-UTF-1 csISO10646UTF1 }
7531    { ISO_646.basic:1983 ref csISO646basic1983 }
7532    { INVARIANT csINVARIANT }
7533    { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
7534    { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
7535    { NATS-SEFI iso-ir-8-1 csNATSSEFI }
7536    { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
7537    { NATS-DANO iso-ir-9-1 csNATSDANO }
7538    { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
7539    { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
7540    { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
7541    { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
7542    { ISO-2022-KR csISO2022KR }
7543    { EUC-KR csEUCKR }
7544    { ISO-2022-JP csISO2022JP }
7545    { ISO-2022-JP-2 csISO2022JP2 }
7546    { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
7547      csISO13JISC6220jp }
7548    { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
7549    { IT iso-ir-15 ISO646-IT csISO15Italian }
7550    { PT iso-ir-16 ISO646-PT csISO16Portuguese }
7551    { ES iso-ir-17 ISO646-ES csISO17Spanish }
7552    { greek7-old iso-ir-18 csISO18Greek7Old }
7553    { latin-greek iso-ir-19 csISO19LatinGreek }
7554    { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
7555    { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
7556    { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
7557    { ISO_5427 iso-ir-37 csISO5427Cyrillic }
7558    { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
7559    { BS_viewdata iso-ir-47 csISO47BSViewdata }
7560    { INIS iso-ir-49 csISO49INIS }
7561    { INIS-8 iso-ir-50 csISO50INIS8 }
7562    { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
7563    { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
7564    { ISO_5428:1980 iso-ir-55 csISO5428Greek }
7565    { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
7566    { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
7567    { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
7568      csISO60Norwegian1 }
7569    { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
7570    { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
7571    { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
7572    { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
7573    { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
7574    { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
7575    { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
7576    { greek7 iso-ir-88 csISO88Greek7 }
7577    { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
7578    { iso-ir-90 csISO90 }
7579    { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
7580    { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
7581      csISO92JISC62991984b }
7582    { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
7583    { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
7584    { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
7585      csISO95JIS62291984handadd }
7586    { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
7587    { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
7588    { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
7589    { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
7590      CP819 csISOLatin1 }
7591    { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
7592    { T.61-7bit iso-ir-102 csISO102T617bit }
7593    { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
7594    { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
7595    { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
7596    { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
7597    { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
7598    { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
7599    { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
7600    { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
7601      arabic csISOLatinArabic }
7602    { ISO_8859-6-E csISO88596E ISO-8859-6-E }
7603    { ISO_8859-6-I csISO88596I ISO-8859-6-I }
7604    { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
7605      greek greek8 csISOLatinGreek }
7606    { T.101-G2 iso-ir-128 csISO128T101G2 }
7607    { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
7608      csISOLatinHebrew }
7609    { ISO_8859-8-E csISO88598E ISO-8859-8-E }
7610    { ISO_8859-8-I csISO88598I ISO-8859-8-I }
7611    { CSN_369103 iso-ir-139 csISO139CSN369103 }
7612    { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
7613    { ISO_6937-2-add iso-ir-142 csISOTextComm }
7614    { IEC_P27-1 iso-ir-143 csISO143IECP271 }
7615    { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
7616      csISOLatinCyrillic }
7617    { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
7618    { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
7619    { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
7620    { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
7621    { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
7622    { ISO_6937-2-25 iso-ir-152 csISO6937Add }
7623    { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
7624    { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
7625    { ISO_10367-box iso-ir-155 csISO10367Box }
7626    { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
7627    { latin-lap lap iso-ir-158 csISO158Lap }
7628    { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
7629    { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
7630    { us-dk csUSDK }
7631    { dk-us csDKUS }
7632    { JIS_X0201 X0201 csHalfWidthKatakana }
7633    { KSC5636 ISO646-KR csKSC5636 }
7634    { ISO-10646-UCS-2 csUnicode }
7635    { ISO-10646-UCS-4 csUCS4 }
7636    { DEC-MCS dec csDECMCS }
7637    { hp-roman8 roman8 r8 csHPRoman8 }
7638    { macintosh mac csMacintosh }
7639    { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
7640      csIBM037 }
7641    { IBM038 EBCDIC-INT cp038 csIBM038 }
7642    { IBM273 CP273 csIBM273 }
7643    { IBM274 EBCDIC-BE CP274 csIBM274 }
7644    { IBM275 EBCDIC-BR cp275 csIBM275 }
7645    { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
7646    { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
7647    { IBM280 CP280 ebcdic-cp-it csIBM280 }
7648    { IBM281 EBCDIC-JP-E cp281 csIBM281 }
7649    { IBM284 CP284 ebcdic-cp-es csIBM284 }
7650    { IBM285 CP285 ebcdic-cp-gb csIBM285 }
7651    { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
7652    { IBM297 cp297 ebcdic-cp-fr csIBM297 }
7653    { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
7654    { IBM423 cp423 ebcdic-cp-gr csIBM423 }
7655    { IBM424 cp424 ebcdic-cp-he csIBM424 }
7656    { IBM437 cp437 437 csPC8CodePage437 }
7657    { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
7658    { IBM775 cp775 csPC775Baltic }
7659    { IBM850 cp850 850 csPC850Multilingual }
7660    { IBM851 cp851 851 csIBM851 }
7661    { IBM852 cp852 852 csPCp852 }
7662    { IBM855 cp855 855 csIBM855 }
7663    { IBM857 cp857 857 csIBM857 }
7664    { IBM860 cp860 860 csIBM860 }
7665    { IBM861 cp861 861 cp-is csIBM861 }
7666    { IBM862 cp862 862 csPC862LatinHebrew }
7667    { IBM863 cp863 863 csIBM863 }
7668    { IBM864 cp864 csIBM864 }
7669    { IBM865 cp865 865 csIBM865 }
7670    { IBM866 cp866 866 csIBM866 }
7671    { IBM868 CP868 cp-ar csIBM868 }
7672    { IBM869 cp869 869 cp-gr csIBM869 }
7673    { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
7674    { IBM871 CP871 ebcdic-cp-is csIBM871 }
7675    { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
7676    { IBM891 cp891 csIBM891 }
7677    { IBM903 cp903 csIBM903 }
7678    { IBM904 cp904 904 csIBBM904 }
7679    { IBM905 CP905 ebcdic-cp-tr csIBM905 }
7680    { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
7681    { IBM1026 CP1026 csIBM1026 }
7682    { EBCDIC-AT-DE csIBMEBCDICATDE }
7683    { EBCDIC-AT-DE-A csEBCDICATDEA }
7684    { EBCDIC-CA-FR csEBCDICCAFR }
7685    { EBCDIC-DK-NO csEBCDICDKNO }
7686    { EBCDIC-DK-NO-A csEBCDICDKNOA }
7687    { EBCDIC-FI-SE csEBCDICFISE }
7688    { EBCDIC-FI-SE-A csEBCDICFISEA }
7689    { EBCDIC-FR csEBCDICFR }
7690    { EBCDIC-IT csEBCDICIT }
7691    { EBCDIC-PT csEBCDICPT }
7692    { EBCDIC-ES csEBCDICES }
7693    { EBCDIC-ES-A csEBCDICESA }
7694    { EBCDIC-ES-S csEBCDICESS }
7695    { EBCDIC-UK csEBCDICUK }
7696    { EBCDIC-US csEBCDICUS }
7697    { UNKNOWN-8BIT csUnknown8BiT }
7698    { MNEMONIC csMnemonic }
7699    { MNEM csMnem }
7700    { VISCII csVISCII }
7701    { VIQR csVIQR }
7702    { KOI8-R csKOI8R }
7703    { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
7704    { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
7705    { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
7706    { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
7707    { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
7708    { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
7709    { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
7710    { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
7711    { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
7712    { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
7713    { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
7714    { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
7715    { IBM1047 IBM-1047 }
7716    { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
7717    { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
7718    { UNICODE-1-1 csUnicode11 }
7719    { CESU-8 csCESU-8 }
7720    { BOCU-1 csBOCU-1 }
7721    { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
7722    { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
7723      l8 }
7724    { ISO-8859-15 ISO_8859-15 Latin-9 }
7725    { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
7726    { GBK CP936 MS936 windows-936 }
7727    { JIS_Encoding csJISEncoding }
7728    { Shift_JIS MS_Kanji csShiftJIS }
7729    { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
7730      EUC-JP }
7731    { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
7732    { ISO-10646-UCS-Basic csUnicodeASCII }
7733    { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
7734    { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
7735    { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
7736    { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
7737    { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
7738    { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
7739    { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
7740    { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
7741    { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
7742    { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
7743    { Adobe-Standard-Encoding csAdobeStandardEncoding }
7744    { Ventura-US csVenturaUS }
7745    { Ventura-International csVenturaInternational }
7746    { PC8-Danish-Norwegian csPC8DanishNorwegian }
7747    { PC8-Turkish csPC8Turkish }
7748    { IBM-Symbols csIBMSymbols }
7749    { IBM-Thai csIBMThai }
7750    { HP-Legal csHPLegal }
7751    { HP-Pi-font csHPPiFont }
7752    { HP-Math8 csHPMath8 }
7753    { Adobe-Symbol-Encoding csHPPSMath }
7754    { HP-DeskTop csHPDesktop }
7755    { Ventura-Math csVenturaMath }
7756    { Microsoft-Publishing csMicrosoftPublishing }
7757    { Windows-31J csWindows31J }
7758    { GB2312 csGB2312 }
7759    { Big5 csBig5 }
7760}
7761
7762proc tcl_encoding {enc} {
7763    global encoding_aliases
7764    set names [encoding names]
7765    set lcnames [string tolower $names]
7766    set enc [string tolower $enc]
7767    set i [lsearch -exact $lcnames $enc]
7768    if {$i < 0} {
7769        # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
7770        if {[regsub {^iso[-_]} $enc iso encx]} {
7771            set i [lsearch -exact $lcnames $encx]
7772        }
7773    }
7774    if {$i < 0} {
7775        foreach l $encoding_aliases {
7776            set ll [string tolower $l]
7777            if {[lsearch -exact $ll $enc] < 0} continue
7778            # look through the aliases for one that tcl knows about
7779            foreach e $ll {
7780                set i [lsearch -exact $lcnames $e]
7781                if {$i < 0} {
7782                    if {[regsub {^iso[-_]} $e iso ex]} {
7783                        set i [lsearch -exact $lcnames $ex]
7784                    }
7785                }
7786                if {$i >= 0} break
7787            }
7788            break
7789        }
7790    }
7791    if {$i >= 0} {
7792        return [lindex $names $i]
7793    }
7794    return {}
7795}
7796
7797# defaults...
7798set datemode 0
7799set diffopts "-U 5 -p"
7800set wrcomcmd "git diff-tree --stdin -p --pretty"
7801
7802set gitencoding {}
7803catch {
7804    set gitencoding [exec git config --get i18n.commitencoding]
7805}
7806if {$gitencoding == ""} {
7807    set gitencoding "utf-8"
7808}
7809set tclencoding [tcl_encoding $gitencoding]
7810if {$tclencoding == {}} {
7811    puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
7812}
7813
7814set mainfont {Helvetica 9}
7815set textfont {Courier 9}
7816set uifont {Helvetica 9 bold}
7817set tabstop 8
7818set findmergefiles 0
7819set maxgraphpct 50
7820set maxwidth 16
7821set revlistorder 0
7822set fastdate 0
7823set uparrowlen 5
7824set downarrowlen 5
7825set mingaplen 100
7826set cmitmode "patch"
7827set wrapcomment "none"
7828set showneartags 1
7829set maxrefs 20
7830set maxlinelen 200
7831set showlocalchanges 1
7832set datetimeformat "%Y-%m-%d %H:%M:%S"
7833
7834set colors {green red blue magenta darkgrey brown orange}
7835set bgcolor white
7836set fgcolor black
7837set diffcolors {red "#00a000" blue}
7838set diffcontext 3
7839set selectbgcolor gray85
7840
7841catch {source ~/.gitk}
7842
7843font create optionfont -family sans-serif -size -12
7844
7845# check that we can find a .git directory somewhere...
7846if {[catch {set gitdir [gitdir]}]} {
7847    show_error {} . "Cannot find a git repository here."
7848    exit 1
7849}
7850if {![file isdirectory $gitdir]} {
7851    show_error {} . "Cannot find the git directory \"$gitdir\"."
7852    exit 1
7853}
7854
7855set revtreeargs {}
7856set cmdline_files {}
7857set i 0
7858foreach arg $argv {
7859    switch -- $arg {
7860        "" { }
7861        "-d" { set datemode 1 }
7862        "--" {
7863            set cmdline_files [lrange $argv [expr {$i + 1}] end]
7864            break
7865        }
7866        default {
7867            lappend revtreeargs $arg
7868        }
7869    }
7870    incr i
7871}
7872
7873if {$i >= [llength $argv] && $revtreeargs ne {}} {
7874    # no -- on command line, but some arguments (other than -d)
7875    if {[catch {
7876        set f [eval exec git rev-parse --no-revs --no-flags $revtreeargs]
7877        set cmdline_files [split $f "\n"]
7878        set n [llength $cmdline_files]
7879        set revtreeargs [lrange $revtreeargs 0 end-$n]
7880        # Unfortunately git rev-parse doesn't produce an error when
7881        # something is both a revision and a filename.  To be consistent
7882        # with git log and git rev-list, check revtreeargs for filenames.
7883        foreach arg $revtreeargs {
7884            if {[file exists $arg]} {
7885                show_error {} . "Ambiguous argument '$arg': both revision\
7886                                 and filename"
7887                exit 1
7888            }
7889        }
7890    } err]} {
7891        # unfortunately we get both stdout and stderr in $err,
7892        # so look for "fatal:".
7893        set i [string first "fatal:" $err]
7894        if {$i > 0} {
7895            set err [string range $err [expr {$i + 6}] end]
7896        }
7897        show_error {} . "Bad arguments to gitk:\n$err"
7898        exit 1
7899    }
7900}
7901
7902set nullid "0000000000000000000000000000000000000000"
7903set nullid2 "0000000000000000000000000000000000000001"
7904
7905
7906set runq {}
7907set history {}
7908set historyindex 0
7909set fh_serial 0
7910set nhl_names {}
7911set highlight_paths {}
7912set searchdirn -forwards
7913set boldrows {}
7914set boldnamerows {}
7915set diffelide {0 0}
7916set markingmatches 0
7917set linkentercount 0
7918
7919set optim_delay 16
7920
7921set nextviewnum 1
7922set curview 0
7923set selectedview 0
7924set selectedhlview None
7925set viewfiles(0) {}
7926set viewperm(0) 0
7927set viewargs(0) {}
7928
7929set cmdlineok 0
7930set stopped 0
7931set stuffsaved 0
7932set patchnum 0
7933set lookingforhead 0
7934set localirow -1
7935set localfrow -1
7936set lserial 0
7937setcoords
7938makewindow
7939# wait for the window to become visible
7940tkwait visibility .
7941wm title . "[file tail $argv0]: [file tail [pwd]]"
7942readrefs
7943
7944if {$cmdline_files ne {} || $revtreeargs ne {}} {
7945    # create a view for the files/dirs specified on the command line
7946    set curview 1
7947    set selectedview 1
7948    set nextviewnum 2
7949    set viewname(1) "Command line"
7950    set viewfiles(1) $cmdline_files
7951    set viewargs(1) $revtreeargs
7952    set viewperm(1) 0
7953    addviewmenu 1
7954    .bar.view entryconf Edit* -state normal
7955    .bar.view entryconf Delete* -state normal
7956}
7957
7958if {[info exists permviews]} {
7959    foreach v $permviews {
7960        set n $nextviewnum
7961        incr nextviewnum
7962        set viewname($n) [lindex $v 0]
7963        set viewfiles($n) [lindex $v 1]
7964        set viewargs($n) [lindex $v 2]
7965        set viewperm($n) 1
7966        addviewmenu $n
7967    }
7968}
7969getcommits