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