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