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