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