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