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