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