6c2be3b7278927198bd937cbfb2dd7b0e3a0c481
   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        }
2884        set nev [expr {[llength $idlist] + [llength $newolds]
2885                       + [llength $oldolds] - $maxwidth + 1}]
2886        if {$nev > 0} {
2887            if {!$last &&
2888                $row + $uparrowlen + $mingaplen >= $commitidx($curview)} break
2889            for {set x [llength $idlist]} {[incr x -1] >= 0} {} {
2890                set i [lindex $idlist $x]
2891                if {![info exists rowchk($i)] || $row >= $rowchk($i)} {
2892                    set r [usedinrange $i [expr {$row - $downarrowlen}] \
2893                               [expr {$row + $uparrowlen + $mingaplen}]]
2894                    if {$r == 0} {
2895                        set idlist [lreplace $idlist $x $x]
2896                        set offs [lreplace $offs $x $x]
2897                        set offs [incrange $offs $x 1]
2898                        set idinlist($i) 0
2899                        set rm1 [expr {$row - 1}]
2900                        lappend idrowranges($i) [lindex $displayorder $rm1]
2901                        if {[incr nev -1] <= 0} break
2902                        continue
2903                    }
2904                    set rowchk($id) [expr {$row + $r}]
2905                }
2906            }
2907            lset rowidlist $row $idlist
2908            lset rowoffsets $row $offs
2909        }
2910        set col [lsearch -exact $idlist $id]
2911        if {$col < 0} {
2912            set col [llength $idlist]
2913            lappend idlist $id
2914            lset rowidlist $row $idlist
2915            set z {}
2916            if {$children($curview,$id) ne {}} {
2917                set z [expr {[llength [lindex $rowidlist [expr {$row-1}]]] - $col}]
2918                unset idinlist($id)
2919            }
2920            lappend offs $z
2921            lset rowoffsets $row $offs
2922            if {$z ne {}} {
2923                makeuparrow $id $col $row $z
2924            }
2925        } else {
2926            unset idinlist($id)
2927        }
2928        set ranges {}
2929        if {[info exists idrowranges($id)]} {
2930            set ranges $idrowranges($id)
2931            lappend ranges $id
2932            unset idrowranges($id)
2933        }
2934        lappend rowrangelist $ranges
2935        incr row
2936        set offs [ntimes [llength $idlist] 0]
2937        set l [llength $newolds]
2938        set idlist [eval lreplace \$idlist $col $col $newolds]
2939        set o 0
2940        if {$l != 1} {
2941            set offs [lrange $offs 0 [expr {$col - 1}]]
2942            foreach x $newolds {
2943                lappend offs {}
2944                incr o -1
2945            }
2946            incr o
2947            set tmp [expr {[llength $idlist] - [llength $offs]}]
2948            if {$tmp > 0} {
2949                set offs [concat $offs [ntimes $tmp $o]]
2950            }
2951        } else {
2952            lset offs $col {}
2953        }
2954        foreach i $newolds {
2955            set idinlist($i) 1
2956            set idrowranges($i) $id
2957        }
2958        incr col $l
2959        foreach oid $oldolds {
2960            set idinlist($oid) 1
2961            set idlist [linsert $idlist $col $oid]
2962            set offs [linsert $offs $col $o]
2963            makeuparrow $oid $col $row $o
2964            incr col
2965        }
2966        lappend rowidlist $idlist
2967        lappend rowoffsets $offs
2968    }
2969    return $row
2970}
2971
2972proc addextraid {id row} {
2973    global displayorder commitrow commitinfo
2974    global commitidx commitlisted
2975    global parentlist children curview
2976
2977    incr commitidx($curview)
2978    lappend displayorder $id
2979    lappend commitlisted 0
2980    lappend parentlist {}
2981    set commitrow($curview,$id) $row
2982    readcommit $id
2983    if {![info exists commitinfo($id)]} {
2984        set commitinfo($id) {"No commit information available"}
2985    }
2986    if {![info exists children($curview,$id)]} {
2987        set children($curview,$id) {}
2988    }
2989}
2990
2991proc layouttail {} {
2992    global rowidlist rowoffsets idinlist commitidx curview
2993    global idrowranges rowrangelist
2994
2995    set row $commitidx($curview)
2996    set idlist [lindex $rowidlist $row]
2997    while {$idlist ne {}} {
2998        set col [expr {[llength $idlist] - 1}]
2999        set id [lindex $idlist $col]
3000        addextraid $id $row
3001        unset idinlist($id)
3002        lappend idrowranges($id) $id
3003        lappend rowrangelist $idrowranges($id)
3004        unset idrowranges($id)
3005        incr row
3006        set offs [ntimes $col 0]
3007        set idlist [lreplace $idlist $col $col]
3008        lappend rowidlist $idlist
3009        lappend rowoffsets $offs
3010    }
3011
3012    foreach id [array names idinlist] {
3013        unset idinlist($id)
3014        addextraid $id $row
3015        lset rowidlist $row [list $id]
3016        lset rowoffsets $row 0
3017        makeuparrow $id 0 $row 0
3018        lappend idrowranges($id) $id
3019        lappend rowrangelist $idrowranges($id)
3020        unset idrowranges($id)
3021        incr row
3022        lappend rowidlist {}
3023        lappend rowoffsets {}
3024    }
3025}
3026
3027proc insert_pad {row col npad} {
3028    global rowidlist rowoffsets
3029
3030    set pad [ntimes $npad {}]
3031    lset rowidlist $row [eval linsert [list [lindex $rowidlist $row]] $col $pad]
3032    set tmp [eval linsert [list [lindex $rowoffsets $row]] $col $pad]
3033    lset rowoffsets $row [incrange $tmp [expr {$col + $npad}] [expr {-$npad}]]
3034}
3035
3036proc optimize_rows {row col endrow} {
3037    global rowidlist rowoffsets displayorder
3038
3039    for {} {$row < $endrow} {incr row} {
3040        set idlist [lindex $rowidlist $row]
3041        set offs [lindex $rowoffsets $row]
3042        set haspad 0
3043        for {} {$col < [llength $offs]} {incr col} {
3044            if {[lindex $idlist $col] eq {}} {
3045                set haspad 1
3046                continue
3047            }
3048            set z [lindex $offs $col]
3049            if {$z eq {}} continue
3050            set isarrow 0
3051            set x0 [expr {$col + $z}]
3052            set y0 [expr {$row - 1}]
3053            set z0 [lindex $rowoffsets $y0 $x0]
3054            if {$z0 eq {}} {
3055                set id [lindex $idlist $col]
3056                set ranges [rowranges $id]
3057                if {$ranges ne {} && $y0 > [lindex $ranges 0]} {
3058                    set isarrow 1
3059                }
3060            }
3061            # Looking at lines from this row to the previous row,
3062            # make them go straight up if they end in an arrow on
3063            # the previous row; otherwise make them go straight up
3064            # or at 45 degrees.
3065            if {$z < -1 || ($z < 0 && $isarrow)} {
3066                # Line currently goes left too much;
3067                # insert pads in the previous row, then optimize it
3068                set npad [expr {-1 - $z + $isarrow}]
3069                set offs [incrange $offs $col $npad]
3070                insert_pad $y0 $x0 $npad
3071                if {$y0 > 0} {
3072                    optimize_rows $y0 $x0 $row
3073                }
3074                set z [lindex $offs $col]
3075                set x0 [expr {$col + $z}]
3076                set z0 [lindex $rowoffsets $y0 $x0]
3077            } elseif {$z > 1 || ($z > 0 && $isarrow)} {
3078                # Line currently goes right too much;
3079                # insert pads in this line and adjust the next's rowoffsets
3080                set npad [expr {$z - 1 + $isarrow}]
3081                set y1 [expr {$row + 1}]
3082                set offs2 [lindex $rowoffsets $y1]
3083                set x1 -1
3084                foreach z $offs2 {
3085                    incr x1
3086                    if {$z eq {} || $x1 + $z < $col} continue
3087                    if {$x1 + $z > $col} {
3088                        incr npad
3089                    }
3090                    lset rowoffsets $y1 [incrange $offs2 $x1 $npad]
3091                    break
3092                }
3093                set pad [ntimes $npad {}]
3094                set idlist [eval linsert \$idlist $col $pad]
3095                set tmp [eval linsert \$offs $col $pad]
3096                incr col $npad
3097                set offs [incrange $tmp $col [expr {-$npad}]]
3098                set z [lindex $offs $col]
3099                set haspad 1
3100            }
3101            if {$z0 eq {} && !$isarrow} {
3102                # this line links to its first child on row $row-2
3103                set rm2 [expr {$row - 2}]
3104                set id [lindex $displayorder $rm2]
3105                set xc [lsearch -exact [lindex $rowidlist $rm2] $id]
3106                if {$xc >= 0} {
3107                    set z0 [expr {$xc - $x0}]
3108                }
3109            }
3110            # avoid lines jigging left then immediately right
3111            if {$z0 ne {} && $z < 0 && $z0 > 0} {
3112                insert_pad $y0 $x0 1
3113                set offs [incrange $offs $col 1]
3114                optimize_rows $y0 [expr {$x0 + 1}] $row
3115            }
3116        }
3117        if {!$haspad} {
3118            set o {}
3119            # Find the first column that doesn't have a line going right
3120            for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
3121                set o [lindex $offs $col]
3122                if {$o eq {}} {
3123                    # check if this is the link to the first child
3124                    set id [lindex $idlist $col]
3125                    set ranges [rowranges $id]
3126                    if {$ranges ne {} && $row == [lindex $ranges 0]} {
3127                        # it is, work out offset to child
3128                        set y0 [expr {$row - 1}]
3129                        set id [lindex $displayorder $y0]
3130                        set x0 [lsearch -exact [lindex $rowidlist $y0] $id]
3131                        if {$x0 >= 0} {
3132                            set o [expr {$x0 - $col}]
3133                        }
3134                    }
3135                }
3136                if {$o eq {} || $o <= 0} break
3137            }
3138            # Insert a pad at that column as long as it has a line and
3139            # isn't the last column, and adjust the next row' offsets
3140            if {$o ne {} && [incr col] < [llength $idlist]} {
3141                set y1 [expr {$row + 1}]
3142                set offs2 [lindex $rowoffsets $y1]
3143                set x1 -1
3144                foreach z $offs2 {
3145                    incr x1
3146                    if {$z eq {} || $x1 + $z < $col} continue
3147                    lset rowoffsets $y1 [incrange $offs2 $x1 1]
3148                    break
3149                }
3150                set idlist [linsert $idlist $col {}]
3151                set tmp [linsert $offs $col {}]
3152                incr col
3153                set offs [incrange $tmp $col -1]
3154            }
3155        }
3156        lset rowidlist $row $idlist
3157        lset rowoffsets $row $offs
3158        set col 0
3159    }
3160}
3161
3162proc xc {row col} {
3163    global canvx0 linespc
3164    return [expr {$canvx0 + $col * $linespc}]
3165}
3166
3167proc yc {row} {
3168    global canvy0 linespc
3169    return [expr {$canvy0 + $row * $linespc}]
3170}
3171
3172proc linewidth {id} {
3173    global thickerline lthickness
3174
3175    set wid $lthickness
3176    if {[info exists thickerline] && $id eq $thickerline} {
3177        set wid [expr {2 * $lthickness}]
3178    }
3179    return $wid
3180}
3181
3182proc rowranges {id} {
3183    global phase idrowranges commitrow rowlaidout rowrangelist curview
3184
3185    set ranges {}
3186    if {$phase eq {} ||
3187        ([info exists commitrow($curview,$id)]
3188         && $commitrow($curview,$id) < $rowlaidout)} {
3189        set ranges [lindex $rowrangelist $commitrow($curview,$id)]
3190    } elseif {[info exists idrowranges($id)]} {
3191        set ranges $idrowranges($id)
3192    }
3193    set linenos {}
3194    foreach rid $ranges {
3195        lappend linenos $commitrow($curview,$rid)
3196    }
3197    if {$linenos ne {}} {
3198        lset linenos 0 [expr {[lindex $linenos 0] + 1}]
3199    }
3200    return $linenos
3201}
3202
3203# work around tk8.4 refusal to draw arrows on diagonal segments
3204proc adjarrowhigh {coords} {
3205    global linespc
3206
3207    set x0 [lindex $coords 0]
3208    set x1 [lindex $coords 2]
3209    if {$x0 != $x1} {
3210        set y0 [lindex $coords 1]
3211        set y1 [lindex $coords 3]
3212        if {$y0 - $y1 <= 2 * $linespc && $x1 == [lindex $coords 4]} {
3213            # we have a nearby vertical segment, just trim off the diag bit
3214            set coords [lrange $coords 2 end]
3215        } else {
3216            set slope [expr {($x0 - $x1) / ($y0 - $y1)}]
3217            set xi [expr {$x0 - $slope * $linespc / 2}]
3218            set yi [expr {$y0 - $linespc / 2}]
3219            set coords [lreplace $coords 0 1 $xi $y0 $xi $yi]
3220        }
3221    }
3222    return $coords
3223}
3224
3225proc drawlineseg {id row endrow arrowlow} {
3226    global rowidlist displayorder iddrawn linesegs
3227    global canv colormap linespc curview maxlinelen
3228
3229    set cols [list [lsearch -exact [lindex $rowidlist $row] $id]]
3230    set le [expr {$row + 1}]
3231    set arrowhigh 1
3232    while {1} {
3233        set c [lsearch -exact [lindex $rowidlist $le] $id]
3234        if {$c < 0} {
3235            incr le -1
3236            break
3237        }
3238        lappend cols $c
3239        set x [lindex $displayorder $le]
3240        if {$x eq $id} {
3241            set arrowhigh 0
3242            break
3243        }
3244        if {[info exists iddrawn($x)] || $le == $endrow} {
3245            set c [lsearch -exact [lindex $rowidlist [expr {$le+1}]] $id]
3246            if {$c >= 0} {
3247                lappend cols $c
3248                set arrowhigh 0
3249            }
3250            break
3251        }
3252        incr le
3253    }
3254    if {$le <= $row} {
3255        return $row
3256    }
3257
3258    set lines {}
3259    set i 0
3260    set joinhigh 0
3261    if {[info exists linesegs($id)]} {
3262        set lines $linesegs($id)
3263        foreach li $lines {
3264            set r0 [lindex $li 0]
3265            if {$r0 > $row} {
3266                if {$r0 == $le && [lindex $li 1] - $row <= $maxlinelen} {
3267                    set joinhigh 1
3268                }
3269                break
3270            }
3271            incr i
3272        }
3273    }
3274    set joinlow 0
3275    if {$i > 0} {
3276        set li [lindex $lines [expr {$i-1}]]
3277        set r1 [lindex $li 1]
3278        if {$r1 == $row && $le - [lindex $li 0] <= $maxlinelen} {
3279            set joinlow 1
3280        }
3281    }
3282
3283    set x [lindex $cols [expr {$le - $row}]]
3284    set xp [lindex $cols [expr {$le - 1 - $row}]]
3285    set dir [expr {$xp - $x}]
3286    if {$joinhigh} {
3287        set ith [lindex $lines $i 2]
3288        set coords [$canv coords $ith]
3289        set ah [$canv itemcget $ith -arrow]
3290        set arrowhigh [expr {$ah eq "first" || $ah eq "both"}]
3291        set x2 [lindex $cols [expr {$le + 1 - $row}]]
3292        if {$x2 ne {} && $x - $x2 == $dir} {
3293            set coords [lrange $coords 0 end-2]
3294        }
3295    } else {
3296        set coords [list [xc $le $x] [yc $le]]
3297    }
3298    if {$joinlow} {
3299        set itl [lindex $lines [expr {$i-1}] 2]
3300        set al [$canv itemcget $itl -arrow]
3301        set arrowlow [expr {$al eq "last" || $al eq "both"}]
3302    } elseif {$arrowlow &&
3303              [lsearch -exact [lindex $rowidlist [expr {$row-1}]] $id] >= 0} {
3304        set arrowlow 0
3305    }
3306    set arrow [lindex {none first last both} [expr {$arrowhigh + 2*$arrowlow}]]
3307    for {set y $le} {[incr y -1] > $row} {} {
3308        set x $xp
3309        set xp [lindex $cols [expr {$y - 1 - $row}]]
3310        set ndir [expr {$xp - $x}]
3311        if {$dir != $ndir || $xp < 0} {
3312            lappend coords [xc $y $x] [yc $y]
3313        }
3314        set dir $ndir
3315    }
3316    if {!$joinlow} {
3317        if {$xp < 0} {
3318            # join parent line to first child
3319            set ch [lindex $displayorder $row]
3320            set xc [lsearch -exact [lindex $rowidlist $row] $ch]
3321            if {$xc < 0} {
3322                puts "oops: drawlineseg: child $ch not on row $row"
3323            } else {
3324                if {$xc < $x - 1} {
3325                    lappend coords [xc $row [expr {$x-1}]] [yc $row]
3326                } elseif {$xc > $x + 1} {
3327                    lappend coords [xc $row [expr {$x+1}]] [yc $row]
3328                }
3329                set x $xc
3330            }
3331            lappend coords [xc $row $x] [yc $row]
3332        } else {
3333            set xn [xc $row $xp]
3334            set yn [yc $row]
3335            # work around tk8.4 refusal to draw arrows on diagonal segments
3336            if {$arrowlow && $xn != [lindex $coords end-1]} {
3337                if {[llength $coords] < 4 ||
3338                    [lindex $coords end-3] != [lindex $coords end-1] ||
3339                    [lindex $coords end] - $yn > 2 * $linespc} {
3340                    set xn [xc $row [expr {$xp - 0.5 * $dir}]]
3341                    set yo [yc [expr {$row + 0.5}]]
3342                    lappend coords $xn $yo $xn $yn
3343                }
3344            } else {
3345                lappend coords $xn $yn
3346            }
3347        }
3348        if {!$joinhigh} {
3349            if {$arrowhigh} {
3350                set coords [adjarrowhigh $coords]
3351            }
3352            assigncolor $id
3353            set t [$canv create line $coords -width [linewidth $id] \
3354                       -fill $colormap($id) -tags lines.$id -arrow $arrow]
3355            $canv lower $t
3356            bindline $t $id
3357            set lines [linsert $lines $i [list $row $le $t]]
3358        } else {
3359            $canv coords $ith $coords
3360            if {$arrow ne $ah} {
3361                $canv itemconf $ith -arrow $arrow
3362            }
3363            lset lines $i 0 $row
3364        }
3365    } else {
3366        set xo [lsearch -exact [lindex $rowidlist [expr {$row - 1}]] $id]
3367        set ndir [expr {$xo - $xp}]
3368        set clow [$canv coords $itl]
3369        if {$dir == $ndir} {
3370            set clow [lrange $clow 2 end]
3371        }
3372        set coords [concat $coords $clow]
3373        if {!$joinhigh} {
3374            lset lines [expr {$i-1}] 1 $le
3375            if {$arrowhigh} {
3376                set coords [adjarrowhigh $coords]
3377            }
3378        } else {
3379            # coalesce two pieces
3380            $canv delete $ith
3381            set b [lindex $lines [expr {$i-1}] 0]
3382            set e [lindex $lines $i 1]
3383            set lines [lreplace $lines [expr {$i-1}] $i [list $b $e $itl]]
3384        }
3385        $canv coords $itl $coords
3386        if {$arrow ne $al} {
3387            $canv itemconf $itl -arrow $arrow
3388        }
3389    }
3390
3391    set linesegs($id) $lines
3392    return $le
3393}
3394
3395proc drawparentlinks {id row} {
3396    global rowidlist canv colormap curview parentlist
3397    global idpos
3398
3399    set rowids [lindex $rowidlist $row]
3400    set col [lsearch -exact $rowids $id]
3401    if {$col < 0} return
3402    set olds [lindex $parentlist $row]
3403    set row2 [expr {$row + 1}]
3404    set x [xc $row $col]
3405    set y [yc $row]
3406    set y2 [yc $row2]
3407    set ids [lindex $rowidlist $row2]
3408    # rmx = right-most X coord used
3409    set rmx 0
3410    foreach p $olds {
3411        set i [lsearch -exact $ids $p]
3412        if {$i < 0} {
3413            puts "oops, parent $p of $id not in list"
3414            continue
3415        }
3416        set x2 [xc $row2 $i]
3417        if {$x2 > $rmx} {
3418            set rmx $x2
3419        }
3420        if {[lsearch -exact $rowids $p] < 0} {
3421            # drawlineseg will do this one for us
3422            continue
3423        }
3424        assigncolor $p
3425        # should handle duplicated parents here...
3426        set coords [list $x $y]
3427        if {$i < $col - 1} {
3428            lappend coords [xc $row [expr {$i + 1}]] $y
3429        } elseif {$i > $col + 1} {
3430            lappend coords [xc $row [expr {$i - 1}]] $y
3431        }
3432        lappend coords $x2 $y2
3433        set t [$canv create line $coords -width [linewidth $p] \
3434                   -fill $colormap($p) -tags lines.$p]
3435        $canv lower $t
3436        bindline $t $p
3437    }
3438    if {$rmx > [lindex $idpos($id) 1]} {
3439        lset idpos($id) 1 $rmx
3440        redrawtags $id
3441    }
3442}
3443
3444proc drawlines {id} {
3445    global canv
3446
3447    $canv itemconf lines.$id -width [linewidth $id]
3448}
3449
3450proc drawcmittext {id row col} {
3451    global linespc canv canv2 canv3 canvy0 fgcolor curview
3452    global commitlisted commitinfo rowidlist parentlist
3453    global rowtextx idpos idtags idheads idotherrefs
3454    global linehtag linentag linedtag
3455    global mainfont canvxmax boldrows boldnamerows fgcolor nullid nullid2
3456
3457    # listed is 0 for boundary, 1 for normal, 2 for left, 3 for right
3458    set listed [lindex $commitlisted $row]
3459    if {$id eq $nullid} {
3460        set ofill red
3461    } elseif {$id eq $nullid2} {
3462        set ofill green
3463    } else {
3464        set ofill [expr {$listed != 0? "blue": "white"}]
3465    }
3466    set x [xc $row $col]
3467    set y [yc $row]
3468    set orad [expr {$linespc / 3}]
3469    if {$listed <= 1} {
3470        set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
3471                   [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
3472                   -fill $ofill -outline $fgcolor -width 1 -tags circle]
3473    } elseif {$listed == 2} {
3474        # triangle pointing left for left-side commits
3475        set t [$canv create polygon \
3476                   [expr {$x - $orad}] $y \
3477                   [expr {$x + $orad - 1}] [expr {$y - $orad}] \
3478                   [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
3479                   -fill $ofill -outline $fgcolor -width 1 -tags circle]
3480    } else {
3481        # triangle pointing right for right-side commits
3482        set t [$canv create polygon \
3483                   [expr {$x + $orad - 1}] $y \
3484                   [expr {$x - $orad}] [expr {$y - $orad}] \
3485                   [expr {$x - $orad}] [expr {$y + $orad - 1}] \
3486                   -fill $ofill -outline $fgcolor -width 1 -tags circle]
3487    }
3488    $canv raise $t
3489    $canv bind $t <1> {selcanvline {} %x %y}
3490    set rmx [llength [lindex $rowidlist $row]]
3491    set olds [lindex $parentlist $row]
3492    if {$olds ne {}} {
3493        set nextids [lindex $rowidlist [expr {$row + 1}]]
3494        foreach p $olds {
3495            set i [lsearch -exact $nextids $p]
3496            if {$i > $rmx} {
3497                set rmx $i
3498            }
3499        }
3500    }
3501    set xt [xc $row $rmx]
3502    set rowtextx($row) $xt
3503    set idpos($id) [list $x $xt $y]
3504    if {[info exists idtags($id)] || [info exists idheads($id)]
3505        || [info exists idotherrefs($id)]} {
3506        set xt [drawtags $id $x $xt $y]
3507    }
3508    set headline [lindex $commitinfo($id) 0]
3509    set name [lindex $commitinfo($id) 1]
3510    set date [lindex $commitinfo($id) 2]
3511    set date [formatdate $date]
3512    set font $mainfont
3513    set nfont $mainfont
3514    set isbold [ishighlighted $row]
3515    if {$isbold > 0} {
3516        lappend boldrows $row
3517        lappend font bold
3518        if {$isbold > 1} {
3519            lappend boldnamerows $row
3520            lappend nfont bold
3521        }
3522    }
3523    set linehtag($row) [$canv create text $xt $y -anchor w -fill $fgcolor \
3524                            -text $headline -font $font -tags text]
3525    $canv bind $linehtag($row) <Button-3> "rowmenu %X %Y $id"
3526    set linentag($row) [$canv2 create text 3 $y -anchor w -fill $fgcolor \
3527                            -text $name -font $nfont -tags text]
3528    set linedtag($row) [$canv3 create text 3 $y -anchor w -fill $fgcolor \
3529                            -text $date -font $mainfont -tags text]
3530    set xr [expr {$xt + [font measure $mainfont $headline]}]
3531    if {$xr > $canvxmax} {
3532        set canvxmax $xr
3533        setcanvscroll
3534    }
3535}
3536
3537proc drawcmitrow {row} {
3538    global displayorder rowidlist
3539    global iddrawn markingmatches
3540    global commitinfo parentlist numcommits
3541    global filehighlight fhighlights findstring nhighlights
3542    global hlview vhighlights
3543    global highlight_related rhighlights
3544
3545    if {$row >= $numcommits} return
3546
3547    set id [lindex $displayorder $row]
3548    if {[info exists hlview] && ![info exists vhighlights($row)]} {
3549        askvhighlight $row $id
3550    }
3551    if {[info exists filehighlight] && ![info exists fhighlights($row)]} {
3552        askfilehighlight $row $id
3553    }
3554    if {$findstring ne {} && ![info exists nhighlights($row)]} {
3555        askfindhighlight $row $id
3556    }
3557    if {$highlight_related ne "None" && ![info exists rhighlights($row)]} {
3558        askrelhighlight $row $id
3559    }
3560    if {![info exists iddrawn($id)]} {
3561        set col [lsearch -exact [lindex $rowidlist $row] $id]
3562        if {$col < 0} {
3563            puts "oops, row $row id $id not in list"
3564            return
3565        }
3566        if {![info exists commitinfo($id)]} {
3567            getcommit $id
3568        }
3569        assigncolor $id
3570        drawcmittext $id $row $col
3571        set iddrawn($id) 1
3572    }
3573    if {$markingmatches} {
3574        markrowmatches $row $id
3575    }
3576}
3577
3578proc drawcommits {row {endrow {}}} {
3579    global numcommits iddrawn displayorder curview
3580    global parentlist rowidlist
3581
3582    if {$row < 0} {
3583        set row 0
3584    }
3585    if {$endrow eq {}} {
3586        set endrow $row
3587    }
3588    if {$endrow >= $numcommits} {
3589        set endrow [expr {$numcommits - 1}]
3590    }
3591
3592    # make the lines join to already-drawn rows either side
3593    set r [expr {$row - 1}]
3594    if {$r < 0 || ![info exists iddrawn([lindex $displayorder $r])]} {
3595        set r $row
3596    }
3597    set er [expr {$endrow + 1}]
3598    if {$er >= $numcommits ||
3599        ![info exists iddrawn([lindex $displayorder $er])]} {
3600        set er $endrow
3601    }
3602    for {} {$r <= $er} {incr r} {
3603        set id [lindex $displayorder $r]
3604        set wasdrawn [info exists iddrawn($id)]
3605        drawcmitrow $r
3606        if {$r == $er} break
3607        set nextid [lindex $displayorder [expr {$r + 1}]]
3608        if {$wasdrawn && [info exists iddrawn($nextid)]} {
3609            catch {unset prevlines}
3610            continue
3611        }
3612        drawparentlinks $id $r
3613
3614        if {[info exists lineends($r)]} {
3615            foreach lid $lineends($r) {
3616                unset prevlines($lid)
3617            }
3618        }
3619        set rowids [lindex $rowidlist $r]
3620        foreach lid $rowids {
3621            if {$lid eq {}} continue
3622            if {$lid eq $id} {
3623                # see if this is the first child of any of its parents
3624                foreach p [lindex $parentlist $r] {
3625                    if {[lsearch -exact $rowids $p] < 0} {
3626                        # make this line extend up to the child
3627                        set le [drawlineseg $p $r $er 0]
3628                        lappend lineends($le) $p
3629                        set prevlines($p) 1
3630                    }
3631                }
3632            } elseif {![info exists prevlines($lid)]} {
3633                set le [drawlineseg $lid $r $er 1]
3634                lappend lineends($le) $lid
3635                set prevlines($lid) 1
3636            }
3637        }
3638    }
3639}
3640
3641proc drawfrac {f0 f1} {
3642    global canv linespc
3643
3644    set ymax [lindex [$canv cget -scrollregion] 3]
3645    if {$ymax eq {} || $ymax == 0} return
3646    set y0 [expr {int($f0 * $ymax)}]
3647    set row [expr {int(($y0 - 3) / $linespc) - 1}]
3648    set y1 [expr {int($f1 * $ymax)}]
3649    set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
3650    drawcommits $row $endrow
3651}
3652
3653proc drawvisible {} {
3654    global canv
3655    eval drawfrac [$canv yview]
3656}
3657
3658proc clear_display {} {
3659    global iddrawn linesegs
3660    global vhighlights fhighlights nhighlights rhighlights
3661
3662    allcanvs delete all
3663    catch {unset iddrawn}
3664    catch {unset linesegs}
3665    catch {unset vhighlights}
3666    catch {unset fhighlights}
3667    catch {unset nhighlights}
3668    catch {unset rhighlights}
3669}
3670
3671proc findcrossings {id} {
3672    global rowidlist parentlist numcommits rowoffsets displayorder
3673
3674    set cross {}
3675    set ccross {}
3676    foreach {s e} [rowranges $id] {
3677        if {$e >= $numcommits} {
3678            set e [expr {$numcommits - 1}]
3679        }
3680        if {$e <= $s} continue
3681        set x [lsearch -exact [lindex $rowidlist $e] $id]
3682        if {$x < 0} {
3683            puts "findcrossings: oops, no [shortids $id] in row $e"
3684            continue
3685        }
3686        for {set row $e} {[incr row -1] >= $s} {} {
3687            set olds [lindex $parentlist $row]
3688            set kid [lindex $displayorder $row]
3689            set kidx [lsearch -exact [lindex $rowidlist $row] $kid]
3690            if {$kidx < 0} continue
3691            set nextrow [lindex $rowidlist [expr {$row + 1}]]
3692            foreach p $olds {
3693                set px [lsearch -exact $nextrow $p]
3694                if {$px < 0} continue
3695                if {($kidx < $x && $x < $px) || ($px < $x && $x < $kidx)} {
3696                    if {[lsearch -exact $ccross $p] >= 0} continue
3697                    if {$x == $px + ($kidx < $px? -1: 1)} {
3698                        lappend ccross $p
3699                    } elseif {[lsearch -exact $cross $p] < 0} {
3700                        lappend cross $p
3701                    }
3702                }
3703            }
3704            set inc [lindex $rowoffsets $row $x]
3705            if {$inc eq {}} break
3706            incr x $inc
3707        }
3708    }
3709    return [concat $ccross {{}} $cross]
3710}
3711
3712proc assigncolor {id} {
3713    global colormap colors nextcolor
3714    global commitrow parentlist children children curview
3715
3716    if {[info exists colormap($id)]} return
3717    set ncolors [llength $colors]
3718    if {[info exists children($curview,$id)]} {
3719        set kids $children($curview,$id)
3720    } else {
3721        set kids {}
3722    }
3723    if {[llength $kids] == 1} {
3724        set child [lindex $kids 0]
3725        if {[info exists colormap($child)]
3726            && [llength [lindex $parentlist $commitrow($curview,$child)]] == 1} {
3727            set colormap($id) $colormap($child)
3728            return
3729        }
3730    }
3731    set badcolors {}
3732    set origbad {}
3733    foreach x [findcrossings $id] {
3734        if {$x eq {}} {
3735            # delimiter between corner crossings and other crossings
3736            if {[llength $badcolors] >= $ncolors - 1} break
3737            set origbad $badcolors
3738        }
3739        if {[info exists colormap($x)]
3740            && [lsearch -exact $badcolors $colormap($x)] < 0} {
3741            lappend badcolors $colormap($x)
3742        }
3743    }
3744    if {[llength $badcolors] >= $ncolors} {
3745        set badcolors $origbad
3746    }
3747    set origbad $badcolors
3748    if {[llength $badcolors] < $ncolors - 1} {
3749        foreach child $kids {
3750            if {[info exists colormap($child)]
3751                && [lsearch -exact $badcolors $colormap($child)] < 0} {
3752                lappend badcolors $colormap($child)
3753            }
3754            foreach p [lindex $parentlist $commitrow($curview,$child)] {
3755                if {[info exists colormap($p)]
3756                    && [lsearch -exact $badcolors $colormap($p)] < 0} {
3757                    lappend badcolors $colormap($p)
3758                }
3759            }
3760        }
3761        if {[llength $badcolors] >= $ncolors} {
3762            set badcolors $origbad
3763        }
3764    }
3765    for {set i 0} {$i <= $ncolors} {incr i} {
3766        set c [lindex $colors $nextcolor]
3767        if {[incr nextcolor] >= $ncolors} {
3768            set nextcolor 0
3769        }
3770        if {[lsearch -exact $badcolors $c]} break
3771    }
3772    set colormap($id) $c
3773}
3774
3775proc bindline {t id} {
3776    global canv
3777
3778    $canv bind $t <Enter> "lineenter %x %y $id"
3779    $canv bind $t <Motion> "linemotion %x %y $id"
3780    $canv bind $t <Leave> "lineleave $id"
3781    $canv bind $t <Button-1> "lineclick %x %y $id 1"
3782}
3783
3784proc drawtags {id x xt y1} {
3785    global idtags idheads idotherrefs mainhead
3786    global linespc lthickness
3787    global canv mainfont commitrow rowtextx curview fgcolor bgcolor
3788
3789    set marks {}
3790    set ntags 0
3791    set nheads 0
3792    if {[info exists idtags($id)]} {
3793        set marks $idtags($id)
3794        set ntags [llength $marks]
3795    }
3796    if {[info exists idheads($id)]} {
3797        set marks [concat $marks $idheads($id)]
3798        set nheads [llength $idheads($id)]
3799    }
3800    if {[info exists idotherrefs($id)]} {
3801        set marks [concat $marks $idotherrefs($id)]
3802    }
3803    if {$marks eq {}} {
3804        return $xt
3805    }
3806
3807    set delta [expr {int(0.5 * ($linespc - $lthickness))}]
3808    set yt [expr {$y1 - 0.5 * $linespc}]
3809    set yb [expr {$yt + $linespc - 1}]
3810    set xvals {}
3811    set wvals {}
3812    set i -1
3813    foreach tag $marks {
3814        incr i
3815        if {$i >= $ntags && $i < $ntags + $nheads && $tag eq $mainhead} {
3816            set wid [font measure [concat $mainfont bold] $tag]
3817        } else {
3818            set wid [font measure $mainfont $tag]
3819        }
3820        lappend xvals $xt
3821        lappend wvals $wid
3822        set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
3823    }
3824    set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
3825               -width $lthickness -fill black -tags tag.$id]
3826    $canv lower $t
3827    foreach tag $marks x $xvals wid $wvals {
3828        set xl [expr {$x + $delta}]
3829        set xr [expr {$x + $delta + $wid + $lthickness}]
3830        set font $mainfont
3831        if {[incr ntags -1] >= 0} {
3832            # draw a tag
3833            set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
3834                       $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
3835                       -width 1 -outline black -fill yellow -tags tag.$id]
3836            $canv bind $t <1> [list showtag $tag 1]
3837            set rowtextx($commitrow($curview,$id)) [expr {$xr + $linespc}]
3838        } else {
3839            # draw a head or other ref
3840            if {[incr nheads -1] >= 0} {
3841                set col green
3842                if {$tag eq $mainhead} {
3843                    lappend font bold
3844                }
3845            } else {
3846                set col "#ddddff"
3847            }
3848            set xl [expr {$xl - $delta/2}]
3849            $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
3850                -width 1 -outline black -fill $col -tags tag.$id
3851            if {[regexp {^(remotes/.*/|remotes/)} $tag match remoteprefix]} {
3852                set rwid [font measure $mainfont $remoteprefix]
3853                set xi [expr {$x + 1}]
3854                set yti [expr {$yt + 1}]
3855                set xri [expr {$x + $rwid}]
3856                $canv create polygon $xi $yti $xri $yti $xri $yb $xi $yb \
3857                        -width 0 -fill "#ffddaa" -tags tag.$id
3858            }
3859        }
3860        set t [$canv create text $xl $y1 -anchor w -text $tag -fill $fgcolor \
3861                   -font $font -tags [list tag.$id text]]
3862        if {$ntags >= 0} {
3863            $canv bind $t <1> [list showtag $tag 1]
3864        } elseif {$nheads >= 0} {
3865            $canv bind $t <Button-3> [list headmenu %X %Y $id $tag]
3866        }
3867    }
3868    return $xt
3869}
3870
3871proc xcoord {i level ln} {
3872    global canvx0 xspc1 xspc2
3873
3874    set x [expr {$canvx0 + $i * $xspc1($ln)}]
3875    if {$i > 0 && $i == $level} {
3876        set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
3877    } elseif {$i > $level} {
3878        set x [expr {$x + $xspc2 - $xspc1($ln)}]
3879    }
3880    return $x
3881}
3882
3883proc show_status {msg} {
3884    global canv mainfont fgcolor
3885
3886    clear_display
3887    $canv create text 3 3 -anchor nw -text $msg -font $mainfont \
3888        -tags text -fill $fgcolor
3889}
3890
3891# Insert a new commit as the child of the commit on row $row.
3892# The new commit will be displayed on row $row and the commits
3893# on that row and below will move down one row.
3894proc insertrow {row newcmit} {
3895    global displayorder parentlist commitlisted children
3896    global commitrow curview rowidlist rowoffsets numcommits
3897    global rowrangelist rowlaidout rowoptim numcommits
3898    global selectedline rowchk commitidx
3899
3900    if {$row >= $numcommits} {
3901        puts "oops, inserting new row $row but only have $numcommits rows"
3902        return
3903    }
3904    set p [lindex $displayorder $row]
3905    set displayorder [linsert $displayorder $row $newcmit]
3906    set parentlist [linsert $parentlist $row $p]
3907    set kids $children($curview,$p)
3908    lappend kids $newcmit
3909    set children($curview,$p) $kids
3910    set children($curview,$newcmit) {}
3911    set commitlisted [linsert $commitlisted $row 1]
3912    set l [llength $displayorder]
3913    for {set r $row} {$r < $l} {incr r} {
3914        set id [lindex $displayorder $r]
3915        set commitrow($curview,$id) $r
3916    }
3917    incr commitidx($curview)
3918
3919    set idlist [lindex $rowidlist $row]
3920    set offs [lindex $rowoffsets $row]
3921    set newoffs {}
3922    foreach x $idlist {
3923        if {$x eq {} || ($x eq $p && [llength $kids] == 1)} {
3924            lappend newoffs {}
3925        } else {
3926            lappend newoffs 0
3927        }
3928    }
3929    if {[llength $kids] == 1} {
3930        set col [lsearch -exact $idlist $p]
3931        lset idlist $col $newcmit
3932    } else {
3933        set col [llength $idlist]
3934        lappend idlist $newcmit
3935        lappend offs {}
3936        lset rowoffsets $row $offs
3937    }
3938    set rowidlist [linsert $rowidlist $row $idlist]
3939    set rowoffsets [linsert $rowoffsets [expr {$row+1}] $newoffs]
3940
3941    set rowrangelist [linsert $rowrangelist $row {}]
3942    if {[llength $kids] > 1} {
3943        set rp1 [expr {$row + 1}]
3944        set ranges [lindex $rowrangelist $rp1]
3945        if {$ranges eq {}} {
3946            set ranges [list $newcmit $p]
3947        } elseif {[lindex $ranges end-1] eq $p} {
3948            lset ranges end-1 $newcmit
3949        }
3950        lset rowrangelist $rp1 $ranges
3951    }
3952
3953    catch {unset rowchk}
3954
3955    incr rowlaidout
3956    incr rowoptim
3957    incr numcommits
3958
3959    if {[info exists selectedline] && $selectedline >= $row} {
3960        incr selectedline
3961    }
3962    redisplay
3963}
3964
3965# Remove a commit that was inserted with insertrow on row $row.
3966proc removerow {row} {
3967    global displayorder parentlist commitlisted children
3968    global commitrow curview rowidlist rowoffsets numcommits
3969    global rowrangelist idrowranges rowlaidout rowoptim numcommits
3970    global linesegends selectedline rowchk commitidx
3971
3972    if {$row >= $numcommits} {
3973        puts "oops, removing row $row but only have $numcommits rows"
3974        return
3975    }
3976    set rp1 [expr {$row + 1}]
3977    set id [lindex $displayorder $row]
3978    set p [lindex $parentlist $row]
3979    set displayorder [lreplace $displayorder $row $row]
3980    set parentlist [lreplace $parentlist $row $row]
3981    set commitlisted [lreplace $commitlisted $row $row]
3982    set kids $children($curview,$p)
3983    set i [lsearch -exact $kids $id]
3984    if {$i >= 0} {
3985        set kids [lreplace $kids $i $i]
3986        set children($curview,$p) $kids
3987    }
3988    set l [llength $displayorder]
3989    for {set r $row} {$r < $l} {incr r} {
3990        set id [lindex $displayorder $r]
3991        set commitrow($curview,$id) $r
3992    }
3993    incr commitidx($curview) -1
3994
3995    set rowidlist [lreplace $rowidlist $row $row]
3996    set rowoffsets [lreplace $rowoffsets $rp1 $rp1]
3997    if {$kids ne {}} {
3998        set offs [lindex $rowoffsets $row]
3999        set offs [lreplace $offs end end]
4000        lset rowoffsets $row $offs
4001    }
4002
4003    set rowrangelist [lreplace $rowrangelist $row $row]
4004    if {[llength $kids] > 0} {
4005        set ranges [lindex $rowrangelist $row]
4006        if {[lindex $ranges end-1] eq $id} {
4007            set ranges [lreplace $ranges end-1 end]
4008            lset rowrangelist $row $ranges
4009        }
4010    }
4011
4012    catch {unset rowchk}
4013
4014    incr rowlaidout -1
4015    incr rowoptim -1
4016    incr numcommits -1
4017
4018    if {[info exists selectedline] && $selectedline > $row} {
4019        incr selectedline -1
4020    }
4021    redisplay
4022}
4023
4024# Don't change the text pane cursor if it is currently the hand cursor,
4025# showing that we are over a sha1 ID link.
4026proc settextcursor {c} {
4027    global ctext curtextcursor
4028
4029    if {[$ctext cget -cursor] == $curtextcursor} {
4030        $ctext config -cursor $c
4031    }
4032    set curtextcursor $c
4033}
4034
4035proc nowbusy {what} {
4036    global isbusy
4037
4038    if {[array names isbusy] eq {}} {
4039        . config -cursor watch
4040        settextcursor watch
4041    }
4042    set isbusy($what) 1
4043}
4044
4045proc notbusy {what} {
4046    global isbusy maincursor textcursor
4047
4048    catch {unset isbusy($what)}
4049    if {[array names isbusy] eq {}} {
4050        . config -cursor $maincursor
4051        settextcursor $textcursor
4052    }
4053}
4054
4055proc findmatches {f} {
4056    global findtype findstring
4057    if {$findtype == "Regexp"} {
4058        set matches [regexp -indices -all -inline $findstring $f]
4059    } else {
4060        set fs $findstring
4061        if {$findtype == "IgnCase"} {
4062            set f [string tolower $f]
4063            set fs [string tolower $fs]
4064        }
4065        set matches {}
4066        set i 0
4067        set l [string length $fs]
4068        while {[set j [string first $fs $f $i]] >= 0} {
4069            lappend matches [list $j [expr {$j+$l-1}]]
4070            set i [expr {$j + $l}]
4071        }
4072    }
4073    return $matches
4074}
4075
4076proc dofind {{rev 0}} {
4077    global findstring findstartline findcurline selectedline numcommits
4078
4079    unmarkmatches
4080    cancel_next_highlight
4081    focus .
4082    if {$findstring eq {} || $numcommits == 0} return
4083    if {![info exists selectedline]} {
4084        set findstartline [lindex [visiblerows] $rev]
4085    } else {
4086        set findstartline $selectedline
4087    }
4088    set findcurline $findstartline
4089    nowbusy finding
4090    if {!$rev} {
4091        run findmore
4092    } else {
4093        if {$findcurline == 0} {
4094            set findcurline $numcommits
4095        }
4096        incr findcurline -1
4097        run findmorerev
4098    }
4099}
4100
4101proc findnext {restart} {
4102    global findcurline
4103    if {![info exists findcurline]} {
4104        if {$restart} {
4105            dofind
4106        } else {
4107            bell
4108        }
4109    } else {
4110        run findmore
4111        nowbusy finding
4112    }
4113}
4114
4115proc findprev {} {
4116    global findcurline
4117    if {![info exists findcurline]} {
4118        dofind 1
4119    } else {
4120        run findmorerev
4121        nowbusy finding
4122    }
4123}
4124
4125proc findmore {} {
4126    global commitdata commitinfo numcommits findstring findpattern findloc
4127    global findstartline findcurline displayorder
4128
4129    set fldtypes {Headline Author Date Committer CDate Comments}
4130    set l [expr {$findcurline + 1}]
4131    if {$l >= $numcommits} {
4132        set l 0
4133    }
4134    if {$l <= $findstartline} {
4135        set lim [expr {$findstartline + 1}]
4136    } else {
4137        set lim $numcommits
4138    }
4139    if {$lim - $l > 500} {
4140        set lim [expr {$l + 500}]
4141    }
4142    set last 0
4143    for {} {$l < $lim} {incr l} {
4144        set id [lindex $displayorder $l]
4145        # shouldn't happen unless git log doesn't give all the commits...
4146        if {![info exists commitdata($id)]} continue
4147        if {![doesmatch $commitdata($id)]} continue
4148        if {![info exists commitinfo($id)]} {
4149            getcommit $id
4150        }
4151        set info $commitinfo($id)
4152        foreach f $info ty $fldtypes {
4153            if {($findloc eq "All fields" || $findloc eq $ty) &&
4154                [doesmatch $f]} {
4155                findselectline $l
4156                notbusy finding
4157                return 0
4158            }
4159        }
4160    }
4161    if {$l == $findstartline + 1} {
4162        bell
4163        unset findcurline
4164        notbusy finding
4165        return 0
4166    }
4167    set findcurline [expr {$l - 1}]
4168    return 1
4169}
4170
4171proc findmorerev {} {
4172    global commitdata commitinfo numcommits findstring findpattern findloc
4173    global findstartline findcurline displayorder
4174
4175    set fldtypes {Headline Author Date Committer CDate Comments}
4176    set l $findcurline
4177    if {$l == 0} {
4178        set l $numcommits
4179    }
4180    incr l -1
4181    if {$l >= $findstartline} {
4182        set lim [expr {$findstartline - 1}]
4183    } else {
4184        set lim -1
4185    }
4186    if {$l - $lim > 500} {
4187        set lim [expr {$l - 500}]
4188    }
4189    set last 0
4190    for {} {$l > $lim} {incr l -1} {
4191        set id [lindex $displayorder $l]
4192        if {![doesmatch $commitdata($id)]} continue
4193        if {![info exists commitinfo($id)]} {
4194            getcommit $id
4195        }
4196        set info $commitinfo($id)
4197        foreach f $info ty $fldtypes {
4198            if {($findloc eq "All fields" || $findloc eq $ty) &&
4199                [doesmatch $f]} {
4200                findselectline $l
4201                notbusy finding
4202                return 0
4203            }
4204        }
4205    }
4206    if {$l == -1} {
4207        bell
4208        unset findcurline
4209        notbusy finding
4210        return 0
4211    }
4212    set findcurline [expr {$l + 1}]
4213    return 1
4214}
4215
4216proc findselectline {l} {
4217    global findloc commentend ctext findcurline markingmatches
4218
4219    set markingmatches 1
4220    set findcurline $l
4221    selectline $l 1
4222    if {$findloc == "All fields" || $findloc == "Comments"} {
4223        # highlight the matches in the comments
4224        set f [$ctext get 1.0 $commentend]
4225        set matches [findmatches $f]
4226        foreach match $matches {
4227            set start [lindex $match 0]
4228            set end [expr {[lindex $match 1] + 1}]
4229            $ctext tag add found "1.0 + $start c" "1.0 + $end c"
4230        }
4231    }
4232    drawvisible
4233}
4234
4235# mark the bits of a headline or author that match a find string
4236proc markmatches {canv l str tag matches font row} {
4237    global selectedline
4238
4239    set bbox [$canv bbox $tag]
4240    set x0 [lindex $bbox 0]
4241    set y0 [lindex $bbox 1]
4242    set y1 [lindex $bbox 3]
4243    foreach match $matches {
4244        set start [lindex $match 0]
4245        set end [lindex $match 1]
4246        if {$start > $end} continue
4247        set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
4248        set xlen [font measure $font [string range $str 0 [expr {$end}]]]
4249        set t [$canv create rect [expr {$x0+$xoff}] $y0 \
4250                   [expr {$x0+$xlen+2}] $y1 \
4251                   -outline {} -tags [list match$l matches] -fill yellow]
4252        $canv lower $t
4253        if {[info exists selectedline] && $row == $selectedline} {
4254            $canv raise $t secsel
4255        }
4256    }
4257}
4258
4259proc unmarkmatches {} {
4260    global findids markingmatches findcurline
4261
4262    allcanvs delete matches
4263    catch {unset findids}
4264    set markingmatches 0
4265    catch {unset findcurline}
4266}
4267
4268proc selcanvline {w x y} {
4269    global canv canvy0 ctext linespc
4270    global rowtextx
4271    set ymax [lindex [$canv cget -scrollregion] 3]
4272    if {$ymax == {}} return
4273    set yfrac [lindex [$canv yview] 0]
4274    set y [expr {$y + $yfrac * $ymax}]
4275    set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
4276    if {$l < 0} {
4277        set l 0
4278    }
4279    if {$w eq $canv} {
4280        if {![info exists rowtextx($l)] || $x < $rowtextx($l)} return
4281    }
4282    unmarkmatches
4283    selectline $l 1
4284}
4285
4286proc commit_descriptor {p} {
4287    global commitinfo
4288    if {![info exists commitinfo($p)]} {
4289        getcommit $p
4290    }
4291    set l "..."
4292    if {[llength $commitinfo($p)] > 1} {
4293        set l [lindex $commitinfo($p) 0]
4294    }
4295    return "$p ($l)\n"
4296}
4297
4298# append some text to the ctext widget, and make any SHA1 ID
4299# that we know about be a clickable link.
4300proc appendwithlinks {text tags} {
4301    global ctext commitrow linknum curview
4302
4303    set start [$ctext index "end - 1c"]
4304    $ctext insert end $text $tags
4305    set links [regexp -indices -all -inline {[0-9a-f]{40}} $text]
4306    foreach l $links {
4307        set s [lindex $l 0]
4308        set e [lindex $l 1]
4309        set linkid [string range $text $s $e]
4310        if {![info exists commitrow($curview,$linkid)]} continue
4311        incr e
4312        $ctext tag add link "$start + $s c" "$start + $e c"
4313        $ctext tag add link$linknum "$start + $s c" "$start + $e c"
4314        $ctext tag bind link$linknum <1> \
4315            [list selectline $commitrow($curview,$linkid) 1]
4316        incr linknum
4317    }
4318    $ctext tag conf link -foreground blue -underline 1
4319    $ctext tag bind link <Enter> { %W configure -cursor hand2 }
4320    $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
4321}
4322
4323proc viewnextline {dir} {
4324    global canv linespc
4325
4326    $canv delete hover
4327    set ymax [lindex [$canv cget -scrollregion] 3]
4328    set wnow [$canv yview]
4329    set wtop [expr {[lindex $wnow 0] * $ymax}]
4330    set newtop [expr {$wtop + $dir * $linespc}]
4331    if {$newtop < 0} {
4332        set newtop 0
4333    } elseif {$newtop > $ymax} {
4334        set newtop $ymax
4335    }
4336    allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
4337}
4338
4339# add a list of tag or branch names at position pos
4340# returns the number of names inserted
4341proc appendrefs {pos ids var} {
4342    global ctext commitrow linknum curview $var maxrefs
4343
4344    if {[catch {$ctext index $pos}]} {
4345        return 0
4346    }
4347    $ctext conf -state normal
4348    $ctext delete $pos "$pos lineend"
4349    set tags {}
4350    foreach id $ids {
4351        foreach tag [set $var\($id\)] {
4352            lappend tags [list $tag $id]
4353        }
4354    }
4355    if {[llength $tags] > $maxrefs} {
4356        $ctext insert $pos "many ([llength $tags])"
4357    } else {
4358        set tags [lsort -index 0 -decreasing $tags]
4359        set sep {}
4360        foreach ti $tags {
4361            set id [lindex $ti 1]
4362            set lk link$linknum
4363            incr linknum
4364            $ctext tag delete $lk
4365            $ctext insert $pos $sep
4366            $ctext insert $pos [lindex $ti 0] $lk
4367            if {[info exists commitrow($curview,$id)]} {
4368                $ctext tag conf $lk -foreground blue
4369                $ctext tag bind $lk <1> \
4370                    [list selectline $commitrow($curview,$id) 1]
4371                $ctext tag conf $lk -underline 1
4372                $ctext tag bind $lk <Enter> { %W configure -cursor hand2 }
4373                $ctext tag bind $lk <Leave> \
4374                    { %W configure -cursor $curtextcursor }
4375            }
4376            set sep ", "
4377        }
4378    }
4379    $ctext conf -state disabled
4380    return [llength $tags]
4381}
4382
4383# called when we have finished computing the nearby tags
4384proc dispneartags {delay} {
4385    global selectedline currentid showneartags tagphase
4386
4387    if {![info exists selectedline] || !$showneartags} return
4388    after cancel dispnexttag
4389    if {$delay} {
4390        after 200 dispnexttag
4391        set tagphase -1
4392    } else {
4393        after idle dispnexttag
4394        set tagphase 0
4395    }
4396}
4397
4398proc dispnexttag {} {
4399    global selectedline currentid showneartags tagphase ctext
4400
4401    if {![info exists selectedline] || !$showneartags} return
4402    switch -- $tagphase {
4403        0 {
4404            set dtags [desctags $currentid]
4405            if {$dtags ne {}} {
4406                appendrefs precedes $dtags idtags
4407            }
4408        }
4409        1 {
4410            set atags [anctags $currentid]
4411            if {$atags ne {}} {
4412                appendrefs follows $atags idtags
4413            }
4414        }
4415        2 {
4416            set dheads [descheads $currentid]
4417            if {$dheads ne {}} {
4418                if {[appendrefs branch $dheads idheads] > 1
4419                    && [$ctext get "branch -3c"] eq "h"} {
4420                    # turn "Branch" into "Branches"
4421                    $ctext conf -state normal
4422                    $ctext insert "branch -2c" "es"
4423                    $ctext conf -state disabled
4424                }
4425            }
4426        }
4427    }
4428    if {[incr tagphase] <= 2} {
4429        after idle dispnexttag
4430    }
4431}
4432
4433proc selectline {l isnew} {
4434    global canv canv2 canv3 ctext commitinfo selectedline
4435    global displayorder linehtag linentag linedtag
4436    global canvy0 linespc parentlist children curview
4437    global currentid sha1entry
4438    global commentend idtags linknum
4439    global mergemax numcommits pending_select
4440    global cmitmode showneartags allcommits
4441
4442    catch {unset pending_select}
4443    $canv delete hover
4444    normalline
4445    cancel_next_highlight
4446    if {$l < 0 || $l >= $numcommits} return
4447    set y [expr {$canvy0 + $l * $linespc}]
4448    set ymax [lindex [$canv cget -scrollregion] 3]
4449    set ytop [expr {$y - $linespc - 1}]
4450    set ybot [expr {$y + $linespc + 1}]
4451    set wnow [$canv yview]
4452    set wtop [expr {[lindex $wnow 0] * $ymax}]
4453    set wbot [expr {[lindex $wnow 1] * $ymax}]
4454    set wh [expr {$wbot - $wtop}]
4455    set newtop $wtop
4456    if {$ytop < $wtop} {
4457        if {$ybot < $wtop} {
4458            set newtop [expr {$y - $wh / 2.0}]
4459        } else {
4460            set newtop $ytop
4461            if {$newtop > $wtop - $linespc} {
4462                set newtop [expr {$wtop - $linespc}]
4463            }
4464        }
4465    } elseif {$ybot > $wbot} {
4466        if {$ytop > $wbot} {
4467            set newtop [expr {$y - $wh / 2.0}]
4468        } else {
4469            set newtop [expr {$ybot - $wh}]
4470            if {$newtop < $wtop + $linespc} {
4471                set newtop [expr {$wtop + $linespc}]
4472            }
4473        }
4474    }
4475    if {$newtop != $wtop} {
4476        if {$newtop < 0} {
4477            set newtop 0
4478        }
4479        allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
4480        drawvisible
4481    }
4482
4483    if {![info exists linehtag($l)]} return
4484    $canv delete secsel
4485    set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
4486               -tags secsel -fill [$canv cget -selectbackground]]
4487    $canv lower $t
4488    $canv2 delete secsel
4489    set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
4490               -tags secsel -fill [$canv2 cget -selectbackground]]
4491    $canv2 lower $t
4492    $canv3 delete secsel
4493    set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
4494               -tags secsel -fill [$canv3 cget -selectbackground]]
4495    $canv3 lower $t
4496
4497    if {$isnew} {
4498        addtohistory [list selectline $l 0]
4499    }
4500
4501    set selectedline $l
4502
4503    set id [lindex $displayorder $l]
4504    set currentid $id
4505    $sha1entry delete 0 end
4506    $sha1entry insert 0 $id
4507    $sha1entry selection from 0
4508    $sha1entry selection to end
4509    rhighlight_sel $id
4510
4511    $ctext conf -state normal
4512    clear_ctext
4513    set linknum 0
4514    set info $commitinfo($id)
4515    set date [formatdate [lindex $info 2]]
4516    $ctext insert end "Author: [lindex $info 1]  $date\n"
4517    set date [formatdate [lindex $info 4]]
4518    $ctext insert end "Committer: [lindex $info 3]  $date\n"
4519    if {[info exists idtags($id)]} {
4520        $ctext insert end "Tags:"
4521        foreach tag $idtags($id) {
4522            $ctext insert end " $tag"
4523        }
4524        $ctext insert end "\n"
4525    }
4526
4527    set headers {}
4528    set olds [lindex $parentlist $l]
4529    if {[llength $olds] > 1} {
4530        set np 0
4531        foreach p $olds {
4532            if {$np >= $mergemax} {
4533                set tag mmax
4534            } else {
4535                set tag m$np
4536            }
4537            $ctext insert end "Parent: " $tag
4538            appendwithlinks [commit_descriptor $p] {}
4539            incr np
4540        }
4541    } else {
4542        foreach p $olds {
4543            append headers "Parent: [commit_descriptor $p]"
4544        }
4545    }
4546
4547    foreach c $children($curview,$id) {
4548        append headers "Child:  [commit_descriptor $c]"
4549    }
4550
4551    # make anything that looks like a SHA1 ID be a clickable link
4552    appendwithlinks $headers {}
4553    if {$showneartags} {
4554        if {![info exists allcommits]} {
4555            getallcommits
4556        }
4557        $ctext insert end "Branch: "
4558        $ctext mark set branch "end -1c"
4559        $ctext mark gravity branch left
4560        $ctext insert end "\nFollows: "
4561        $ctext mark set follows "end -1c"
4562        $ctext mark gravity follows left
4563        $ctext insert end "\nPrecedes: "
4564        $ctext mark set precedes "end -1c"
4565        $ctext mark gravity precedes left
4566        $ctext insert end "\n"
4567        dispneartags 1
4568    }
4569    $ctext insert end "\n"
4570    set comment [lindex $info 5]
4571    if {[string first "\r" $comment] >= 0} {
4572        set comment [string map {"\r" "\n    "} $comment]
4573    }
4574    appendwithlinks $comment {comment}
4575
4576    $ctext tag remove found 1.0 end
4577    $ctext conf -state disabled
4578    set commentend [$ctext index "end - 1c"]
4579
4580    init_flist "Comments"
4581    if {$cmitmode eq "tree"} {
4582        gettree $id
4583    } elseif {[llength $olds] <= 1} {
4584        startdiff $id
4585    } else {
4586        mergediff $id $l
4587    }
4588}
4589
4590proc selfirstline {} {
4591    unmarkmatches
4592    selectline 0 1
4593}
4594
4595proc sellastline {} {
4596    global numcommits
4597    unmarkmatches
4598    set l [expr {$numcommits - 1}]
4599    selectline $l 1
4600}
4601
4602proc selnextline {dir} {
4603    global selectedline
4604    if {![info exists selectedline]} return
4605    set l [expr {$selectedline + $dir}]
4606    unmarkmatches
4607    selectline $l 1
4608}
4609
4610proc selnextpage {dir} {
4611    global canv linespc selectedline numcommits
4612
4613    set lpp [expr {([winfo height $canv] - 2) / $linespc}]
4614    if {$lpp < 1} {
4615        set lpp 1
4616    }
4617    allcanvs yview scroll [expr {$dir * $lpp}] units
4618    drawvisible
4619    if {![info exists selectedline]} return
4620    set l [expr {$selectedline + $dir * $lpp}]
4621    if {$l < 0} {
4622        set l 0
4623    } elseif {$l >= $numcommits} {
4624        set l [expr $numcommits - 1]
4625    }
4626    unmarkmatches
4627    selectline $l 1
4628}
4629
4630proc unselectline {} {
4631    global selectedline currentid
4632
4633    catch {unset selectedline}
4634    catch {unset currentid}
4635    allcanvs delete secsel
4636    rhighlight_none
4637    cancel_next_highlight
4638}
4639
4640proc reselectline {} {
4641    global selectedline
4642
4643    if {[info exists selectedline]} {
4644        selectline $selectedline 0
4645    }
4646}
4647
4648proc addtohistory {cmd} {
4649    global history historyindex curview
4650
4651    set elt [list $curview $cmd]
4652    if {$historyindex > 0
4653        && [lindex $history [expr {$historyindex - 1}]] == $elt} {
4654        return
4655    }
4656
4657    if {$historyindex < [llength $history]} {
4658        set history [lreplace $history $historyindex end $elt]
4659    } else {
4660        lappend history $elt
4661    }
4662    incr historyindex
4663    if {$historyindex > 1} {
4664        .tf.bar.leftbut conf -state normal
4665    } else {
4666        .tf.bar.leftbut conf -state disabled
4667    }
4668    .tf.bar.rightbut conf -state disabled
4669}
4670
4671proc godo {elt} {
4672    global curview
4673
4674    set view [lindex $elt 0]
4675    set cmd [lindex $elt 1]
4676    if {$curview != $view} {
4677        showview $view
4678    }
4679    eval $cmd
4680}
4681
4682proc goback {} {
4683    global history historyindex
4684
4685    if {$historyindex > 1} {
4686        incr historyindex -1
4687        godo [lindex $history [expr {$historyindex - 1}]]
4688        .tf.bar.rightbut conf -state normal
4689    }
4690    if {$historyindex <= 1} {
4691        .tf.bar.leftbut conf -state disabled
4692    }
4693}
4694
4695proc goforw {} {
4696    global history historyindex
4697
4698    if {$historyindex < [llength $history]} {
4699        set cmd [lindex $history $historyindex]
4700        incr historyindex
4701        godo $cmd
4702        .tf.bar.leftbut conf -state normal
4703    }
4704    if {$historyindex >= [llength $history]} {
4705        .tf.bar.rightbut conf -state disabled
4706    }
4707}
4708
4709proc gettree {id} {
4710    global treefilelist treeidlist diffids diffmergeid treepending
4711    global nullid nullid2
4712
4713    set diffids $id
4714    catch {unset diffmergeid}
4715    if {![info exists treefilelist($id)]} {
4716        if {![info exists treepending]} {
4717            if {$id eq $nullid} {
4718                set cmd [list | git ls-files]
4719            } elseif {$id eq $nullid2} {
4720                set cmd [list | git ls-files --stage -t]
4721            } else {
4722                set cmd [list | git ls-tree -r $id]
4723            }
4724            if {[catch {set gtf [open $cmd r]}]} {
4725                return
4726            }
4727            set treepending $id
4728            set treefilelist($id) {}
4729            set treeidlist($id) {}
4730            fconfigure $gtf -blocking 0
4731            filerun $gtf [list gettreeline $gtf $id]
4732        }
4733    } else {
4734        setfilelist $id
4735    }
4736}
4737
4738proc gettreeline {gtf id} {
4739    global treefilelist treeidlist treepending cmitmode diffids nullid nullid2
4740
4741    set nl 0
4742    while {[incr nl] <= 1000 && [gets $gtf line] >= 0} {
4743        if {$diffids eq $nullid} {
4744            set fname $line
4745        } else {
4746            if {$diffids ne $nullid2 && [lindex $line 1] ne "blob"} continue
4747            set i [string first "\t" $line]
4748            if {$i < 0} continue
4749            set sha1 [lindex $line 2]
4750            set fname [string range $line [expr {$i+1}] end]
4751            if {[string index $fname 0] eq "\""} {
4752                set fname [lindex $fname 0]
4753            }
4754            lappend treeidlist($id) $sha1
4755        }
4756        lappend treefilelist($id) $fname
4757    }
4758    if {![eof $gtf]} {
4759        return [expr {$nl >= 1000? 2: 1}]
4760    }
4761    close $gtf
4762    unset treepending
4763    if {$cmitmode ne "tree"} {
4764        if {![info exists diffmergeid]} {
4765            gettreediffs $diffids
4766        }
4767    } elseif {$id ne $diffids} {
4768        gettree $diffids
4769    } else {
4770        setfilelist $id
4771    }
4772    return 0
4773}
4774
4775proc showfile {f} {
4776    global treefilelist treeidlist diffids nullid nullid2
4777    global ctext commentend
4778
4779    set i [lsearch -exact $treefilelist($diffids) $f]
4780    if {$i < 0} {
4781        puts "oops, $f not in list for id $diffids"
4782        return
4783    }
4784    if {$diffids eq $nullid} {
4785        if {[catch {set bf [open $f r]} err]} {
4786            puts "oops, can't read $f: $err"
4787            return
4788        }
4789    } else {
4790        set blob [lindex $treeidlist($diffids) $i]
4791        if {[catch {set bf [open [concat | git cat-file blob $blob] r]} err]} {
4792            puts "oops, error reading blob $blob: $err"
4793            return
4794        }
4795    }
4796    fconfigure $bf -blocking 0
4797    filerun $bf [list getblobline $bf $diffids]
4798    $ctext config -state normal
4799    clear_ctext $commentend
4800    $ctext insert end "\n"
4801    $ctext insert end "$f\n" filesep
4802    $ctext config -state disabled
4803    $ctext yview $commentend
4804}
4805
4806proc getblobline {bf id} {
4807    global diffids cmitmode ctext
4808
4809    if {$id ne $diffids || $cmitmode ne "tree"} {
4810        catch {close $bf}
4811        return 0
4812    }
4813    $ctext config -state normal
4814    set nl 0
4815    while {[incr nl] <= 1000 && [gets $bf line] >= 0} {
4816        $ctext insert end "$line\n"
4817    }
4818    if {[eof $bf]} {
4819        # delete last newline
4820        $ctext delete "end - 2c" "end - 1c"
4821        close $bf
4822        return 0
4823    }
4824    $ctext config -state disabled
4825    return [expr {$nl >= 1000? 2: 1}]
4826}
4827
4828proc mergediff {id l} {
4829    global diffmergeid diffopts mdifffd
4830    global diffids
4831    global parentlist
4832
4833    set diffmergeid $id
4834    set diffids $id
4835    # this doesn't seem to actually affect anything...
4836    set env(GIT_DIFF_OPTS) $diffopts
4837    set cmd [concat | git diff-tree --no-commit-id --cc $id]
4838    if {[catch {set mdf [open $cmd r]} err]} {
4839        error_popup "Error getting merge diffs: $err"
4840        return
4841    }
4842    fconfigure $mdf -blocking 0
4843    set mdifffd($id) $mdf
4844    set np [llength [lindex $parentlist $l]]
4845    filerun $mdf [list getmergediffline $mdf $id $np]
4846}
4847
4848proc getmergediffline {mdf id np} {
4849    global diffmergeid ctext cflist mergemax
4850    global difffilestart mdifffd
4851
4852    $ctext conf -state normal
4853    set nr 0
4854    while {[incr nr] <= 1000 && [gets $mdf line] >= 0} {
4855        if {![info exists diffmergeid] || $id != $diffmergeid
4856            || $mdf != $mdifffd($id)} {
4857            close $mdf
4858            return 0
4859        }
4860        if {[regexp {^diff --cc (.*)} $line match fname]} {
4861            # start of a new file
4862            $ctext insert end "\n"
4863            set here [$ctext index "end - 1c"]
4864            lappend difffilestart $here
4865            add_flist [list $fname]
4866            set l [expr {(78 - [string length $fname]) / 2}]
4867            set pad [string range "----------------------------------------" 1 $l]
4868            $ctext insert end "$pad $fname $pad\n" filesep
4869        } elseif {[regexp {^@@} $line]} {
4870            $ctext insert end "$line\n" hunksep
4871        } elseif {[regexp {^[0-9a-f]{40}$} $line] || [regexp {^index} $line]} {
4872            # do nothing
4873        } else {
4874            # parse the prefix - one ' ', '-' or '+' for each parent
4875            set spaces {}
4876            set minuses {}
4877            set pluses {}
4878            set isbad 0
4879            for {set j 0} {$j < $np} {incr j} {
4880                set c [string range $line $j $j]
4881                if {$c == " "} {
4882                    lappend spaces $j
4883                } elseif {$c == "-"} {
4884                    lappend minuses $j
4885                } elseif {$c == "+"} {
4886                    lappend pluses $j
4887                } else {
4888                    set isbad 1
4889                    break
4890                }
4891            }
4892            set tags {}
4893            set num {}
4894            if {!$isbad && $minuses ne {} && $pluses eq {}} {
4895                # line doesn't appear in result, parents in $minuses have the line
4896                set num [lindex $minuses 0]
4897            } elseif {!$isbad && $pluses ne {} && $minuses eq {}} {
4898                # line appears in result, parents in $pluses don't have the line
4899                lappend tags mresult
4900                set num [lindex $spaces 0]
4901            }
4902            if {$num ne {}} {
4903                if {$num >= $mergemax} {
4904                    set num "max"
4905                }
4906                lappend tags m$num
4907            }
4908            $ctext insert end "$line\n" $tags
4909        }
4910    }
4911    $ctext conf -state disabled
4912    if {[eof $mdf]} {
4913        close $mdf
4914        return 0
4915    }
4916    return [expr {$nr >= 1000? 2: 1}]
4917}
4918
4919proc startdiff {ids} {
4920    global treediffs diffids treepending diffmergeid nullid nullid2
4921
4922    set diffids $ids
4923    catch {unset diffmergeid}
4924    if {![info exists treediffs($ids)] ||
4925        [lsearch -exact $ids $nullid] >= 0 ||
4926        [lsearch -exact $ids $nullid2] >= 0} {
4927        if {![info exists treepending]} {
4928            gettreediffs $ids
4929        }
4930    } else {
4931        addtocflist $ids
4932    }
4933}
4934
4935proc addtocflist {ids} {
4936    global treediffs cflist
4937    add_flist $treediffs($ids)
4938    getblobdiffs $ids
4939}
4940
4941proc diffcmd {ids flags} {
4942    global nullid nullid2
4943
4944    set i [lsearch -exact $ids $nullid]
4945    set j [lsearch -exact $ids $nullid2]
4946    if {$i >= 0} {
4947        if {[llength $ids] > 1 && $j < 0} {
4948            # comparing working directory with some specific revision
4949            set cmd [concat | git diff-index $flags]
4950            if {$i == 0} {
4951                lappend cmd -R [lindex $ids 1]
4952            } else {
4953                lappend cmd [lindex $ids 0]
4954            }
4955        } else {
4956            # comparing working directory with index
4957            set cmd [concat | git diff-files $flags]
4958            if {$j == 1} {
4959                lappend cmd -R
4960            }
4961        }
4962    } elseif {$j >= 0} {
4963        set cmd [concat | git diff-index --cached $flags]
4964        if {[llength $ids] > 1} {
4965            # comparing index with specific revision
4966            if {$i == 0} {
4967                lappend cmd -R [lindex $ids 1]
4968            } else {
4969                lappend cmd [lindex $ids 0]
4970            }
4971        } else {
4972            # comparing index with HEAD
4973            lappend cmd HEAD
4974        }
4975    } else {
4976        set cmd [concat | git diff-tree -r $flags $ids]
4977    }
4978    return $cmd
4979}
4980
4981proc gettreediffs {ids} {
4982    global treediff treepending
4983
4984    set treepending $ids
4985    set treediff {}
4986    if {[catch {set gdtf [open [diffcmd $ids {--no-commit-id}] r]}]} return
4987    fconfigure $gdtf -blocking 0
4988    filerun $gdtf [list gettreediffline $gdtf $ids]
4989}
4990
4991proc gettreediffline {gdtf ids} {
4992    global treediff treediffs treepending diffids diffmergeid
4993    global cmitmode
4994
4995    set nr 0
4996    while {[incr nr] <= 1000 && [gets $gdtf line] >= 0} {
4997        set i [string first "\t" $line]
4998        if {$i >= 0} {
4999            set file [string range $line [expr {$i+1}] end]
5000            if {[string index $file 0] eq "\""} {
5001                set file [lindex $file 0]
5002            }
5003            lappend treediff $file
5004        }
5005    }
5006    if {![eof $gdtf]} {
5007        return [expr {$nr >= 1000? 2: 1}]
5008    }
5009    close $gdtf
5010    set treediffs($ids) $treediff
5011    unset treepending
5012    if {$cmitmode eq "tree"} {
5013        gettree $diffids
5014    } elseif {$ids != $diffids} {
5015        if {![info exists diffmergeid]} {
5016            gettreediffs $diffids
5017        }
5018    } else {
5019        addtocflist $ids
5020    }
5021    return 0
5022}
5023
5024proc getblobdiffs {ids} {
5025    global diffopts blobdifffd diffids env
5026    global diffinhdr treediffs
5027
5028    set env(GIT_DIFF_OPTS) $diffopts
5029    if {[catch {set bdf [open [diffcmd $ids {-p -C --no-commit-id}] r]} err]} {
5030        puts "error getting diffs: $err"
5031        return
5032    }
5033    set diffinhdr 0
5034    fconfigure $bdf -blocking 0
5035    set blobdifffd($ids) $bdf
5036    filerun $bdf [list getblobdiffline $bdf $diffids]
5037}
5038
5039proc setinlist {var i val} {
5040    global $var
5041
5042    while {[llength [set $var]] < $i} {
5043        lappend $var {}
5044    }
5045    if {[llength [set $var]] == $i} {
5046        lappend $var $val
5047    } else {
5048        lset $var $i $val
5049    }
5050}
5051
5052proc makediffhdr {fname ids} {
5053    global ctext curdiffstart treediffs
5054
5055    set i [lsearch -exact $treediffs($ids) $fname]
5056    if {$i >= 0} {
5057        setinlist difffilestart $i $curdiffstart
5058    }
5059    set l [expr {(78 - [string length $fname]) / 2}]
5060    set pad [string range "----------------------------------------" 1 $l]
5061    $ctext insert $curdiffstart "$pad $fname $pad" filesep
5062}
5063
5064proc getblobdiffline {bdf ids} {
5065    global diffids blobdifffd ctext curdiffstart
5066    global diffnexthead diffnextnote difffilestart
5067    global diffinhdr treediffs
5068
5069    set nr 0
5070    $ctext conf -state normal
5071    while {[incr nr] <= 1000 && [gets $bdf line] >= 0} {
5072        if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
5073            close $bdf
5074            return 0
5075        }
5076        if {![string compare -length 11 "diff --git " $line]} {
5077            # trim off "diff --git "
5078            set line [string range $line 11 end]
5079            set diffinhdr 1
5080            # start of a new file
5081            $ctext insert end "\n"
5082            set curdiffstart [$ctext index "end - 1c"]
5083            $ctext insert end "\n" filesep
5084            # If the name hasn't changed the length will be odd,
5085            # the middle char will be a space, and the two bits either
5086            # side will be a/name and b/name, or "a/name" and "b/name".
5087            # If the name has changed we'll get "rename from" and
5088            # "rename to" lines following this, and we'll use them
5089            # to get the filenames.
5090            # This complexity is necessary because spaces in the filename(s)
5091            # don't get escaped.
5092            set l [string length $line]
5093            set i [expr {$l / 2}]
5094            if {!(($l & 1) && [string index $line $i] eq " " &&
5095                  [string range $line 2 [expr {$i - 1}]] eq \
5096                      [string range $line [expr {$i + 3}] end])} {
5097                continue
5098            }
5099            # unescape if quoted and chop off the a/ from the front
5100            if {[string index $line 0] eq "\""} {
5101                set fname [string range [lindex $line 0] 2 end]
5102            } else {
5103                set fname [string range $line 2 [expr {$i - 1}]]
5104            }
5105            makediffhdr $fname $ids
5106
5107        } elseif {[regexp {^@@ -([0-9]+)(,[0-9]+)? \+([0-9]+)(,[0-9]+)? @@(.*)} \
5108                       $line match f1l f1c f2l f2c rest]} {
5109            $ctext insert end "$line\n" hunksep
5110            set diffinhdr 0
5111
5112        } elseif {$diffinhdr} {
5113            if {![string compare -length 12 "rename from " $line]} {
5114                set fname [string range $line 12 end]
5115                if {[string index $fname 0] eq "\""} {
5116                    set fname [lindex $fname 0]
5117                }
5118                set i [lsearch -exact $treediffs($ids) $fname]
5119                if {$i >= 0} {
5120                    setinlist difffilestart $i $curdiffstart
5121                }
5122            } elseif {![string compare -length 10 $line "rename to "]} {
5123                set fname [string range $line 10 end]
5124                if {[string index $fname 0] eq "\""} {
5125                    set fname [lindex $fname 0]
5126                }
5127                makediffhdr $fname $ids
5128            } elseif {[string compare -length 3 $line "---"] == 0} {
5129                # do nothing
5130                continue
5131            } elseif {[string compare -length 3 $line "+++"] == 0} {
5132                set diffinhdr 0
5133                continue
5134            }
5135            $ctext insert end "$line\n" filesep
5136
5137        } else {
5138            set x [string range $line 0 0]
5139            if {$x == "-" || $x == "+"} {
5140                set tag [expr {$x == "+"}]
5141                $ctext insert end "$line\n" d$tag
5142            } elseif {$x == " "} {
5143                $ctext insert end "$line\n"
5144            } else {
5145                # "\ No newline at end of file",
5146                # or something else we don't recognize
5147                $ctext insert end "$line\n" hunksep
5148            }
5149        }
5150    }
5151    $ctext conf -state disabled
5152    if {[eof $bdf]} {
5153        close $bdf
5154        return 0
5155    }
5156    return [expr {$nr >= 1000? 2: 1}]
5157}
5158
5159proc changediffdisp {} {
5160    global ctext diffelide
5161
5162    $ctext tag conf d0 -elide [lindex $diffelide 0]
5163    $ctext tag conf d1 -elide [lindex $diffelide 1]
5164}
5165
5166proc prevfile {} {
5167    global difffilestart ctext
5168    set prev [lindex $difffilestart 0]
5169    set here [$ctext index @0,0]
5170    foreach loc $difffilestart {
5171        if {[$ctext compare $loc >= $here]} {
5172            $ctext yview $prev
5173            return
5174        }
5175        set prev $loc
5176    }
5177    $ctext yview $prev
5178}
5179
5180proc nextfile {} {
5181    global difffilestart ctext
5182    set here [$ctext index @0,0]
5183    foreach loc $difffilestart {
5184        if {[$ctext compare $loc > $here]} {
5185            $ctext yview $loc
5186            return
5187        }
5188    }
5189}
5190
5191proc clear_ctext {{first 1.0}} {
5192    global ctext smarktop smarkbot
5193
5194    set l [lindex [split $first .] 0]
5195    if {![info exists smarktop] || [$ctext compare $first < $smarktop.0]} {
5196        set smarktop $l
5197    }
5198    if {![info exists smarkbot] || [$ctext compare $first < $smarkbot.0]} {
5199        set smarkbot $l
5200    }
5201    $ctext delete $first end
5202}
5203
5204proc incrsearch {name ix op} {
5205    global ctext searchstring searchdirn
5206
5207    $ctext tag remove found 1.0 end
5208    if {[catch {$ctext index anchor}]} {
5209        # no anchor set, use start of selection, or of visible area
5210        set sel [$ctext tag ranges sel]
5211        if {$sel ne {}} {
5212            $ctext mark set anchor [lindex $sel 0]
5213        } elseif {$searchdirn eq "-forwards"} {
5214            $ctext mark set anchor @0,0
5215        } else {
5216            $ctext mark set anchor @0,[winfo height $ctext]
5217        }
5218    }
5219    if {$searchstring ne {}} {
5220        set here [$ctext search $searchdirn -- $searchstring anchor]
5221        if {$here ne {}} {
5222            $ctext see $here
5223        }
5224        searchmarkvisible 1
5225    }
5226}
5227
5228proc dosearch {} {
5229    global sstring ctext searchstring searchdirn
5230
5231    focus $sstring
5232    $sstring icursor end
5233    set searchdirn -forwards
5234    if {$searchstring ne {}} {
5235        set sel [$ctext tag ranges sel]
5236        if {$sel ne {}} {
5237            set start "[lindex $sel 0] + 1c"
5238        } elseif {[catch {set start [$ctext index anchor]}]} {
5239            set start "@0,0"
5240        }
5241        set match [$ctext search -count mlen -- $searchstring $start]
5242        $ctext tag remove sel 1.0 end
5243        if {$match eq {}} {
5244            bell
5245            return
5246        }
5247        $ctext see $match
5248        set mend "$match + $mlen c"
5249        $ctext tag add sel $match $mend
5250        $ctext mark unset anchor
5251    }
5252}
5253
5254proc dosearchback {} {
5255    global sstring ctext searchstring searchdirn
5256
5257    focus $sstring
5258    $sstring icursor end
5259    set searchdirn -backwards
5260    if {$searchstring ne {}} {
5261        set sel [$ctext tag ranges sel]
5262        if {$sel ne {}} {
5263            set start [lindex $sel 0]
5264        } elseif {[catch {set start [$ctext index anchor]}]} {
5265            set start @0,[winfo height $ctext]
5266        }
5267        set match [$ctext search -backwards -count ml -- $searchstring $start]
5268        $ctext tag remove sel 1.0 end
5269        if {$match eq {}} {
5270            bell
5271            return
5272        }
5273        $ctext see $match
5274        set mend "$match + $ml c"
5275        $ctext tag add sel $match $mend
5276        $ctext mark unset anchor
5277    }
5278}
5279
5280proc searchmark {first last} {
5281    global ctext searchstring
5282
5283    set mend $first.0
5284    while {1} {
5285        set match [$ctext search -count mlen -- $searchstring $mend $last.end]
5286        if {$match eq {}} break
5287        set mend "$match + $mlen c"
5288        $ctext tag add found $match $mend
5289    }
5290}
5291
5292proc searchmarkvisible {doall} {
5293    global ctext smarktop smarkbot
5294
5295    set topline [lindex [split [$ctext index @0,0] .] 0]
5296    set botline [lindex [split [$ctext index @0,[winfo height $ctext]] .] 0]
5297    if {$doall || $botline < $smarktop || $topline > $smarkbot} {
5298        # no overlap with previous
5299        searchmark $topline $botline
5300        set smarktop $topline
5301        set smarkbot $botline
5302    } else {
5303        if {$topline < $smarktop} {
5304            searchmark $topline [expr {$smarktop-1}]
5305            set smarktop $topline
5306        }
5307        if {$botline > $smarkbot} {
5308            searchmark [expr {$smarkbot+1}] $botline
5309            set smarkbot $botline
5310        }
5311    }
5312}
5313
5314proc scrolltext {f0 f1} {
5315    global searchstring
5316
5317    .bleft.sb set $f0 $f1
5318    if {$searchstring ne {}} {
5319        searchmarkvisible 0
5320    }
5321}
5322
5323proc setcoords {} {
5324    global linespc charspc canvx0 canvy0 mainfont
5325    global xspc1 xspc2 lthickness
5326
5327    set linespc [font metrics $mainfont -linespace]
5328    set charspc [font measure $mainfont "m"]
5329    set canvy0 [expr {int(3 + 0.5 * $linespc)}]
5330    set canvx0 [expr {int(3 + 0.5 * $linespc)}]
5331    set lthickness [expr {int($linespc / 9) + 1}]
5332    set xspc1(0) $linespc
5333    set xspc2 $linespc
5334}
5335
5336proc redisplay {} {
5337    global canv
5338    global selectedline
5339
5340    set ymax [lindex [$canv cget -scrollregion] 3]
5341    if {$ymax eq {} || $ymax == 0} return
5342    set span [$canv yview]
5343    clear_display
5344    setcanvscroll
5345    allcanvs yview moveto [lindex $span 0]
5346    drawvisible
5347    if {[info exists selectedline]} {
5348        selectline $selectedline 0
5349        allcanvs yview moveto [lindex $span 0]
5350    }
5351}
5352
5353proc incrfont {inc} {
5354    global mainfont textfont ctext canv phase cflist
5355    global charspc tabstop
5356    global stopped entries
5357    unmarkmatches
5358    set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
5359    set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
5360    setcoords
5361    $ctext conf -font $textfont -tabs "[expr {$tabstop * $charspc}]"
5362    $cflist conf -font $textfont
5363    $ctext tag conf filesep -font [concat $textfont bold]
5364    foreach e $entries {
5365        $e conf -font $mainfont
5366    }
5367    if {$phase eq "getcommits"} {
5368        $canv itemconf textitems -font $mainfont
5369    }
5370    redisplay
5371}
5372
5373proc clearsha1 {} {
5374    global sha1entry sha1string
5375    if {[string length $sha1string] == 40} {
5376        $sha1entry delete 0 end
5377    }
5378}
5379
5380proc sha1change {n1 n2 op} {
5381    global sha1string currentid sha1but
5382    if {$sha1string == {}
5383        || ([info exists currentid] && $sha1string == $currentid)} {
5384        set state disabled
5385    } else {
5386        set state normal
5387    }
5388    if {[$sha1but cget -state] == $state} return
5389    if {$state == "normal"} {
5390        $sha1but conf -state normal -relief raised -text "Goto: "
5391    } else {
5392        $sha1but conf -state disabled -relief flat -text "SHA1 ID: "
5393    }
5394}
5395
5396proc gotocommit {} {
5397    global sha1string currentid commitrow tagids headids
5398    global displayorder numcommits curview
5399
5400    if {$sha1string == {}
5401        || ([info exists currentid] && $sha1string == $currentid)} return
5402    if {[info exists tagids($sha1string)]} {
5403        set id $tagids($sha1string)
5404    } elseif {[info exists headids($sha1string)]} {
5405        set id $headids($sha1string)
5406    } else {
5407        set id [string tolower $sha1string]
5408        if {[regexp {^[0-9a-f]{4,39}$} $id]} {
5409            set matches {}
5410            foreach i $displayorder {
5411                if {[string match $id* $i]} {
5412                    lappend matches $i
5413                }
5414            }
5415            if {$matches ne {}} {
5416                if {[llength $matches] > 1} {
5417                    error_popup "Short SHA1 id $id is ambiguous"
5418                    return
5419                }
5420                set id [lindex $matches 0]
5421            }
5422        }
5423    }
5424    if {[info exists commitrow($curview,$id)]} {
5425        selectline $commitrow($curview,$id) 1
5426        return
5427    }
5428    if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
5429        set type "SHA1 id"
5430    } else {
5431        set type "Tag/Head"
5432    }
5433    error_popup "$type $sha1string is not known"
5434}
5435
5436proc lineenter {x y id} {
5437    global hoverx hovery hoverid hovertimer
5438    global commitinfo canv
5439
5440    if {![info exists commitinfo($id)] && ![getcommit $id]} return
5441    set hoverx $x
5442    set hovery $y
5443    set hoverid $id
5444    if {[info exists hovertimer]} {
5445        after cancel $hovertimer
5446    }
5447    set hovertimer [after 500 linehover]
5448    $canv delete hover
5449}
5450
5451proc linemotion {x y id} {
5452    global hoverx hovery hoverid hovertimer
5453
5454    if {[info exists hoverid] && $id == $hoverid} {
5455        set hoverx $x
5456        set hovery $y
5457        if {[info exists hovertimer]} {
5458            after cancel $hovertimer
5459        }
5460        set hovertimer [after 500 linehover]
5461    }
5462}
5463
5464proc lineleave {id} {
5465    global hoverid hovertimer canv
5466
5467    if {[info exists hoverid] && $id == $hoverid} {
5468        $canv delete hover
5469        if {[info exists hovertimer]} {
5470            after cancel $hovertimer
5471            unset hovertimer
5472        }
5473        unset hoverid
5474    }
5475}
5476
5477proc linehover {} {
5478    global hoverx hovery hoverid hovertimer
5479    global canv linespc lthickness
5480    global commitinfo mainfont
5481
5482    set text [lindex $commitinfo($hoverid) 0]
5483    set ymax [lindex [$canv cget -scrollregion] 3]
5484    if {$ymax == {}} return
5485    set yfrac [lindex [$canv yview] 0]
5486    set x [expr {$hoverx + 2 * $linespc}]
5487    set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
5488    set x0 [expr {$x - 2 * $lthickness}]
5489    set y0 [expr {$y - 2 * $lthickness}]
5490    set x1 [expr {$x + [font measure $mainfont $text] + 2 * $lthickness}]
5491    set y1 [expr {$y + $linespc + 2 * $lthickness}]
5492    set t [$canv create rectangle $x0 $y0 $x1 $y1 \
5493               -fill \#ffff80 -outline black -width 1 -tags hover]
5494    $canv raise $t
5495    set t [$canv create text $x $y -anchor nw -text $text -tags hover \
5496               -font $mainfont]
5497    $canv raise $t
5498}
5499
5500proc clickisonarrow {id y} {
5501    global lthickness
5502
5503    set ranges [rowranges $id]
5504    set thresh [expr {2 * $lthickness + 6}]
5505    set n [expr {[llength $ranges] - 1}]
5506    for {set i 1} {$i < $n} {incr i} {
5507        set row [lindex $ranges $i]
5508        if {abs([yc $row] - $y) < $thresh} {
5509            return $i
5510        }
5511    }
5512    return {}
5513}
5514
5515proc arrowjump {id n y} {
5516    global canv
5517
5518    # 1 <-> 2, 3 <-> 4, etc...
5519    set n [expr {(($n - 1) ^ 1) + 1}]
5520    set row [lindex [rowranges $id] $n]
5521    set yt [yc $row]
5522    set ymax [lindex [$canv cget -scrollregion] 3]
5523    if {$ymax eq {} || $ymax <= 0} return
5524    set view [$canv yview]
5525    set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
5526    set yfrac [expr {$yt / $ymax - $yspan / 2}]
5527    if {$yfrac < 0} {
5528        set yfrac 0
5529    }
5530    allcanvs yview moveto $yfrac
5531}
5532
5533proc lineclick {x y id isnew} {
5534    global ctext commitinfo children canv thickerline curview
5535
5536    if {![info exists commitinfo($id)] && ![getcommit $id]} return
5537    unmarkmatches
5538    unselectline
5539    normalline
5540    $canv delete hover
5541    # draw this line thicker than normal
5542    set thickerline $id
5543    drawlines $id
5544    if {$isnew} {
5545        set ymax [lindex [$canv cget -scrollregion] 3]
5546        if {$ymax eq {}} return
5547        set yfrac [lindex [$canv yview] 0]
5548        set y [expr {$y + $yfrac * $ymax}]
5549    }
5550    set dirn [clickisonarrow $id $y]
5551    if {$dirn ne {}} {
5552        arrowjump $id $dirn $y
5553        return
5554    }
5555
5556    if {$isnew} {
5557        addtohistory [list lineclick $x $y $id 0]
5558    }
5559    # fill the details pane with info about this line
5560    $ctext conf -state normal
5561    clear_ctext
5562    $ctext tag conf link -foreground blue -underline 1
5563    $ctext tag bind link <Enter> { %W configure -cursor hand2 }
5564    $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
5565    $ctext insert end "Parent:\t"
5566    $ctext insert end $id [list link link0]
5567    $ctext tag bind link0 <1> [list selbyid $id]
5568    set info $commitinfo($id)
5569    $ctext insert end "\n\t[lindex $info 0]\n"
5570    $ctext insert end "\tAuthor:\t[lindex $info 1]\n"
5571    set date [formatdate [lindex $info 2]]
5572    $ctext insert end "\tDate:\t$date\n"
5573    set kids $children($curview,$id)
5574    if {$kids ne {}} {
5575        $ctext insert end "\nChildren:"
5576        set i 0
5577        foreach child $kids {
5578            incr i
5579            if {![info exists commitinfo($child)] && ![getcommit $child]} continue
5580            set info $commitinfo($child)
5581            $ctext insert end "\n\t"
5582            $ctext insert end $child [list link link$i]
5583            $ctext tag bind link$i <1> [list selbyid $child]
5584            $ctext insert end "\n\t[lindex $info 0]"
5585            $ctext insert end "\n\tAuthor:\t[lindex $info 1]"
5586            set date [formatdate [lindex $info 2]]
5587            $ctext insert end "\n\tDate:\t$date\n"
5588        }
5589    }
5590    $ctext conf -state disabled
5591    init_flist {}
5592}
5593
5594proc normalline {} {
5595    global thickerline
5596    if {[info exists thickerline]} {
5597        set id $thickerline
5598        unset thickerline
5599        drawlines $id
5600    }
5601}
5602
5603proc selbyid {id} {
5604    global commitrow curview
5605    if {[info exists commitrow($curview,$id)]} {
5606        selectline $commitrow($curview,$id) 1
5607    }
5608}
5609
5610proc mstime {} {
5611    global startmstime
5612    if {![info exists startmstime]} {
5613        set startmstime [clock clicks -milliseconds]
5614    }
5615    return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
5616}
5617
5618proc rowmenu {x y id} {
5619    global rowctxmenu commitrow selectedline rowmenuid curview
5620    global nullid nullid2 fakerowmenu mainhead
5621
5622    set rowmenuid $id
5623    if {![info exists selectedline]
5624        || $commitrow($curview,$id) eq $selectedline} {
5625        set state disabled
5626    } else {
5627        set state normal
5628    }
5629    if {$id ne $nullid && $id ne $nullid2} {
5630        set menu $rowctxmenu
5631        $menu entryconfigure 7 -label "Reset $mainhead branch to here"
5632    } else {
5633        set menu $fakerowmenu
5634    }
5635    $menu entryconfigure "Diff this*" -state $state
5636    $menu entryconfigure "Diff selected*" -state $state
5637    $menu entryconfigure "Make patch" -state $state
5638    tk_popup $menu $x $y
5639}
5640
5641proc diffvssel {dirn} {
5642    global rowmenuid selectedline displayorder
5643
5644    if {![info exists selectedline]} return
5645    if {$dirn} {
5646        set oldid [lindex $displayorder $selectedline]
5647        set newid $rowmenuid
5648    } else {
5649        set oldid $rowmenuid
5650        set newid [lindex $displayorder $selectedline]
5651    }
5652    addtohistory [list doseldiff $oldid $newid]
5653    doseldiff $oldid $newid
5654}
5655
5656proc doseldiff {oldid newid} {
5657    global ctext
5658    global commitinfo
5659
5660    $ctext conf -state normal
5661    clear_ctext
5662    init_flist "Top"
5663    $ctext insert end "From "
5664    $ctext tag conf link -foreground blue -underline 1
5665    $ctext tag bind link <Enter> { %W configure -cursor hand2 }
5666    $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
5667    $ctext tag bind link0 <1> [list selbyid $oldid]
5668    $ctext insert end $oldid [list link link0]
5669    $ctext insert end "\n     "
5670    $ctext insert end [lindex $commitinfo($oldid) 0]
5671    $ctext insert end "\n\nTo   "
5672    $ctext tag bind link1 <1> [list selbyid $newid]
5673    $ctext insert end $newid [list link link1]
5674    $ctext insert end "\n     "
5675    $ctext insert end [lindex $commitinfo($newid) 0]
5676    $ctext insert end "\n"
5677    $ctext conf -state disabled
5678    $ctext tag remove found 1.0 end
5679    startdiff [list $oldid $newid]
5680}
5681
5682proc mkpatch {} {
5683    global rowmenuid currentid commitinfo patchtop patchnum
5684
5685    if {![info exists currentid]} return
5686    set oldid $currentid
5687    set oldhead [lindex $commitinfo($oldid) 0]
5688    set newid $rowmenuid
5689    set newhead [lindex $commitinfo($newid) 0]
5690    set top .patch
5691    set patchtop $top
5692    catch {destroy $top}
5693    toplevel $top
5694    label $top.title -text "Generate patch"
5695    grid $top.title - -pady 10
5696    label $top.from -text "From:"
5697    entry $top.fromsha1 -width 40 -relief flat
5698    $top.fromsha1 insert 0 $oldid
5699    $top.fromsha1 conf -state readonly
5700    grid $top.from $top.fromsha1 -sticky w
5701    entry $top.fromhead -width 60 -relief flat
5702    $top.fromhead insert 0 $oldhead
5703    $top.fromhead conf -state readonly
5704    grid x $top.fromhead -sticky w
5705    label $top.to -text "To:"
5706    entry $top.tosha1 -width 40 -relief flat
5707    $top.tosha1 insert 0 $newid
5708    $top.tosha1 conf -state readonly
5709    grid $top.to $top.tosha1 -sticky w
5710    entry $top.tohead -width 60 -relief flat
5711    $top.tohead insert 0 $newhead
5712    $top.tohead conf -state readonly
5713    grid x $top.tohead -sticky w
5714    button $top.rev -text "Reverse" -command mkpatchrev -padx 5
5715    grid $top.rev x -pady 10
5716    label $top.flab -text "Output file:"
5717    entry $top.fname -width 60
5718    $top.fname insert 0 [file normalize "patch$patchnum.patch"]
5719    incr patchnum
5720    grid $top.flab $top.fname -sticky w
5721    frame $top.buts
5722    button $top.buts.gen -text "Generate" -command mkpatchgo
5723    button $top.buts.can -text "Cancel" -command mkpatchcan
5724    grid $top.buts.gen $top.buts.can
5725    grid columnconfigure $top.buts 0 -weight 1 -uniform a
5726    grid columnconfigure $top.buts 1 -weight 1 -uniform a
5727    grid $top.buts - -pady 10 -sticky ew
5728    focus $top.fname
5729}
5730
5731proc mkpatchrev {} {
5732    global patchtop
5733
5734    set oldid [$patchtop.fromsha1 get]
5735    set oldhead [$patchtop.fromhead get]
5736    set newid [$patchtop.tosha1 get]
5737    set newhead [$patchtop.tohead get]
5738    foreach e [list fromsha1 fromhead tosha1 tohead] \
5739            v [list $newid $newhead $oldid $oldhead] {
5740        $patchtop.$e conf -state normal
5741        $patchtop.$e delete 0 end
5742        $patchtop.$e insert 0 $v
5743        $patchtop.$e conf -state readonly
5744    }
5745}
5746
5747proc mkpatchgo {} {
5748    global patchtop nullid nullid2
5749
5750    set oldid [$patchtop.fromsha1 get]
5751    set newid [$patchtop.tosha1 get]
5752    set fname [$patchtop.fname get]
5753    set cmd [diffcmd [list $oldid $newid] -p]
5754    lappend cmd >$fname &
5755    if {[catch {eval exec $cmd} err]} {
5756        error_popup "Error creating patch: $err"
5757    }
5758    catch {destroy $patchtop}
5759    unset patchtop
5760}
5761
5762proc mkpatchcan {} {
5763    global patchtop
5764
5765    catch {destroy $patchtop}
5766    unset patchtop
5767}
5768
5769proc mktag {} {
5770    global rowmenuid mktagtop commitinfo
5771
5772    set top .maketag
5773    set mktagtop $top
5774    catch {destroy $top}
5775    toplevel $top
5776    label $top.title -text "Create tag"
5777    grid $top.title - -pady 10
5778    label $top.id -text "ID:"
5779    entry $top.sha1 -width 40 -relief flat
5780    $top.sha1 insert 0 $rowmenuid
5781    $top.sha1 conf -state readonly
5782    grid $top.id $top.sha1 -sticky w
5783    entry $top.head -width 60 -relief flat
5784    $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
5785    $top.head conf -state readonly
5786    grid x $top.head -sticky w
5787    label $top.tlab -text "Tag name:"
5788    entry $top.tag -width 60
5789    grid $top.tlab $top.tag -sticky w
5790    frame $top.buts
5791    button $top.buts.gen -text "Create" -command mktaggo
5792    button $top.buts.can -text "Cancel" -command mktagcan
5793    grid $top.buts.gen $top.buts.can
5794    grid columnconfigure $top.buts 0 -weight 1 -uniform a
5795    grid columnconfigure $top.buts 1 -weight 1 -uniform a
5796    grid $top.buts - -pady 10 -sticky ew
5797    focus $top.tag
5798}
5799
5800proc domktag {} {
5801    global mktagtop env tagids idtags
5802
5803    set id [$mktagtop.sha1 get]
5804    set tag [$mktagtop.tag get]
5805    if {$tag == {}} {
5806        error_popup "No tag name specified"
5807        return
5808    }
5809    if {[info exists tagids($tag)]} {
5810        error_popup "Tag \"$tag\" already exists"
5811        return
5812    }
5813    if {[catch {
5814        set dir [gitdir]
5815        set fname [file join $dir "refs/tags" $tag]
5816        set f [open $fname w]
5817        puts $f $id
5818        close $f
5819    } err]} {
5820        error_popup "Error creating tag: $err"
5821        return
5822    }
5823
5824    set tagids($tag) $id
5825    lappend idtags($id) $tag
5826    redrawtags $id
5827    addedtag $id
5828}
5829
5830proc redrawtags {id} {
5831    global canv linehtag commitrow idpos selectedline curview
5832    global mainfont canvxmax iddrawn
5833
5834    if {![info exists commitrow($curview,$id)]} return
5835    if {![info exists iddrawn($id)]} return
5836    drawcommits $commitrow($curview,$id)
5837    $canv delete tag.$id
5838    set xt [eval drawtags $id $idpos($id)]
5839    $canv coords $linehtag($commitrow($curview,$id)) $xt [lindex $idpos($id) 2]
5840    set text [$canv itemcget $linehtag($commitrow($curview,$id)) -text]
5841    set xr [expr {$xt + [font measure $mainfont $text]}]
5842    if {$xr > $canvxmax} {
5843        set canvxmax $xr
5844        setcanvscroll
5845    }
5846    if {[info exists selectedline]
5847        && $selectedline == $commitrow($curview,$id)} {
5848        selectline $selectedline 0
5849    }
5850}
5851
5852proc mktagcan {} {
5853    global mktagtop
5854
5855    catch {destroy $mktagtop}
5856    unset mktagtop
5857}
5858
5859proc mktaggo {} {
5860    domktag
5861    mktagcan
5862}
5863
5864proc writecommit {} {
5865    global rowmenuid wrcomtop commitinfo wrcomcmd
5866
5867    set top .writecommit
5868    set wrcomtop $top
5869    catch {destroy $top}
5870    toplevel $top
5871    label $top.title -text "Write commit to file"
5872    grid $top.title - -pady 10
5873    label $top.id -text "ID:"
5874    entry $top.sha1 -width 40 -relief flat
5875    $top.sha1 insert 0 $rowmenuid
5876    $top.sha1 conf -state readonly
5877    grid $top.id $top.sha1 -sticky w
5878    entry $top.head -width 60 -relief flat
5879    $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
5880    $top.head conf -state readonly
5881    grid x $top.head -sticky w
5882    label $top.clab -text "Command:"
5883    entry $top.cmd -width 60 -textvariable wrcomcmd
5884    grid $top.clab $top.cmd -sticky w -pady 10
5885    label $top.flab -text "Output file:"
5886    entry $top.fname -width 60
5887    $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
5888    grid $top.flab $top.fname -sticky w
5889    frame $top.buts
5890    button $top.buts.gen -text "Write" -command wrcomgo
5891    button $top.buts.can -text "Cancel" -command wrcomcan
5892    grid $top.buts.gen $top.buts.can
5893    grid columnconfigure $top.buts 0 -weight 1 -uniform a
5894    grid columnconfigure $top.buts 1 -weight 1 -uniform a
5895    grid $top.buts - -pady 10 -sticky ew
5896    focus $top.fname
5897}
5898
5899proc wrcomgo {} {
5900    global wrcomtop
5901
5902    set id [$wrcomtop.sha1 get]
5903    set cmd "echo $id | [$wrcomtop.cmd get]"
5904    set fname [$wrcomtop.fname get]
5905    if {[catch {exec sh -c $cmd >$fname &} err]} {
5906        error_popup "Error writing commit: $err"
5907    }
5908    catch {destroy $wrcomtop}
5909    unset wrcomtop
5910}
5911
5912proc wrcomcan {} {
5913    global wrcomtop
5914
5915    catch {destroy $wrcomtop}
5916    unset wrcomtop
5917}
5918
5919proc mkbranch {} {
5920    global rowmenuid mkbrtop
5921
5922    set top .makebranch
5923    catch {destroy $top}
5924    toplevel $top
5925    label $top.title -text "Create new branch"
5926    grid $top.title - -pady 10
5927    label $top.id -text "ID:"
5928    entry $top.sha1 -width 40 -relief flat
5929    $top.sha1 insert 0 $rowmenuid
5930    $top.sha1 conf -state readonly
5931    grid $top.id $top.sha1 -sticky w
5932    label $top.nlab -text "Name:"
5933    entry $top.name -width 40
5934    grid $top.nlab $top.name -sticky w
5935    frame $top.buts
5936    button $top.buts.go -text "Create" -command [list mkbrgo $top]
5937    button $top.buts.can -text "Cancel" -command "catch {destroy $top}"
5938    grid $top.buts.go $top.buts.can
5939    grid columnconfigure $top.buts 0 -weight 1 -uniform a
5940    grid columnconfigure $top.buts 1 -weight 1 -uniform a
5941    grid $top.buts - -pady 10 -sticky ew
5942    focus $top.name
5943}
5944
5945proc mkbrgo {top} {
5946    global headids idheads
5947
5948    set name [$top.name get]
5949    set id [$top.sha1 get]
5950    if {$name eq {}} {
5951        error_popup "Please specify a name for the new branch"
5952        return
5953    }
5954    catch {destroy $top}
5955    nowbusy newbranch
5956    update
5957    if {[catch {
5958        exec git branch $name $id
5959    } err]} {
5960        notbusy newbranch
5961        error_popup $err
5962    } else {
5963        set headids($name) $id
5964        lappend idheads($id) $name
5965        addedhead $id $name
5966        notbusy newbranch
5967        redrawtags $id
5968        dispneartags 0
5969    }
5970}
5971
5972proc cherrypick {} {
5973    global rowmenuid curview commitrow
5974    global mainhead
5975
5976    set oldhead [exec git rev-parse HEAD]
5977    set dheads [descheads $rowmenuid]
5978    if {$dheads ne {} && [lsearch -exact $dheads $oldhead] >= 0} {
5979        set ok [confirm_popup "Commit [string range $rowmenuid 0 7] is already\
5980                        included in branch $mainhead -- really re-apply it?"]
5981        if {!$ok} return
5982    }
5983    nowbusy cherrypick
5984    update
5985    # Unfortunately git-cherry-pick writes stuff to stderr even when
5986    # no error occurs, and exec takes that as an indication of error...
5987    if {[catch {exec sh -c "git cherry-pick -r $rowmenuid 2>&1"} err]} {
5988        notbusy cherrypick
5989        error_popup $err
5990        return
5991    }
5992    set newhead [exec git rev-parse HEAD]
5993    if {$newhead eq $oldhead} {
5994        notbusy cherrypick
5995        error_popup "No changes committed"
5996        return
5997    }
5998    addnewchild $newhead $oldhead
5999    if {[info exists commitrow($curview,$oldhead)]} {
6000        insertrow $commitrow($curview,$oldhead) $newhead
6001        if {$mainhead ne {}} {
6002            movehead $newhead $mainhead
6003            movedhead $newhead $mainhead
6004        }
6005        redrawtags $oldhead
6006        redrawtags $newhead
6007    }
6008    notbusy cherrypick
6009}
6010
6011proc resethead {} {
6012    global mainheadid mainhead rowmenuid confirm_ok resettype
6013    global showlocalchanges
6014
6015    set confirm_ok 0
6016    set w ".confirmreset"
6017    toplevel $w
6018    wm transient $w .
6019    wm title $w "Confirm reset"
6020    message $w.m -text \
6021        "Reset branch $mainhead to [string range $rowmenuid 0 7]?" \
6022        -justify center -aspect 1000
6023    pack $w.m -side top -fill x -padx 20 -pady 20
6024    frame $w.f -relief sunken -border 2
6025    message $w.f.rt -text "Reset type:" -aspect 1000
6026    grid $w.f.rt -sticky w
6027    set resettype mixed
6028    radiobutton $w.f.soft -value soft -variable resettype -justify left \
6029        -text "Soft: Leave working tree and index untouched"
6030    grid $w.f.soft -sticky w
6031    radiobutton $w.f.mixed -value mixed -variable resettype -justify left \
6032        -text "Mixed: Leave working tree untouched, reset index"
6033    grid $w.f.mixed -sticky w
6034    radiobutton $w.f.hard -value hard -variable resettype -justify left \
6035        -text "Hard: Reset working tree and index\n(discard ALL local changes)"
6036    grid $w.f.hard -sticky w
6037    pack $w.f -side top -fill x
6038    button $w.ok -text OK -command "set confirm_ok 1; destroy $w"
6039    pack $w.ok -side left -fill x -padx 20 -pady 20
6040    button $w.cancel -text Cancel -command "destroy $w"
6041    pack $w.cancel -side right -fill x -padx 20 -pady 20
6042    bind $w <Visibility> "grab $w; focus $w"
6043    tkwait window $w
6044    if {!$confirm_ok} return
6045    if {[catch {set fd [open \
6046            [list | sh -c "git reset --$resettype $rowmenuid 2>&1"] r]} err]} {
6047        error_popup $err
6048    } else {
6049        dohidelocalchanges
6050        set w ".resetprogress"
6051        filerun $fd [list readresetstat $fd $w]
6052        toplevel $w
6053        wm transient $w
6054        wm title $w "Reset progress"
6055        message $w.m -text "Reset in progress, please wait..." \
6056            -justify center -aspect 1000
6057        pack $w.m -side top -fill x -padx 20 -pady 5
6058        canvas $w.c -width 150 -height 20 -bg white
6059        $w.c create rect 0 0 0 20 -fill green -tags rect
6060        pack $w.c -side top -fill x -padx 20 -pady 5 -expand 1
6061        nowbusy reset
6062    }
6063}
6064
6065proc readresetstat {fd w} {
6066    global mainhead mainheadid showlocalchanges
6067
6068    if {[gets $fd line] >= 0} {
6069        if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
6070            set x [expr {($m * 150) / $n}]
6071            $w.c coords rect 0 0 $x 20
6072        }
6073        return 1
6074    }
6075    destroy $w
6076    notbusy reset
6077    if {[catch {close $fd} err]} {
6078        error_popup $err
6079    }
6080    set oldhead $mainheadid
6081    set newhead [exec git rev-parse HEAD]
6082    if {$newhead ne $oldhead} {
6083        movehead $newhead $mainhead
6084        movedhead $newhead $mainhead
6085        set mainheadid $newhead
6086        redrawtags $oldhead
6087        redrawtags $newhead
6088    }
6089    if {$showlocalchanges} {
6090        doshowlocalchanges
6091    }
6092    return 0
6093}
6094
6095# context menu for a head
6096proc headmenu {x y id head} {
6097    global headmenuid headmenuhead headctxmenu mainhead
6098
6099    set headmenuid $id
6100    set headmenuhead $head
6101    set state normal
6102    if {$head eq $mainhead} {
6103        set state disabled
6104    }
6105    $headctxmenu entryconfigure 0 -state $state
6106    $headctxmenu entryconfigure 1 -state $state
6107    tk_popup $headctxmenu $x $y
6108}
6109
6110proc cobranch {} {
6111    global headmenuid headmenuhead mainhead headids
6112    global showlocalchanges mainheadid
6113
6114    # check the tree is clean first??
6115    set oldmainhead $mainhead
6116    nowbusy checkout
6117    update
6118    dohidelocalchanges
6119    if {[catch {
6120        exec git checkout -q $headmenuhead
6121    } err]} {
6122        notbusy checkout
6123        error_popup $err
6124    } else {
6125        notbusy checkout
6126        set mainhead $headmenuhead
6127        set mainheadid $headmenuid
6128        if {[info exists headids($oldmainhead)]} {
6129            redrawtags $headids($oldmainhead)
6130        }
6131        redrawtags $headmenuid
6132    }
6133    if {$showlocalchanges} {
6134        dodiffindex
6135    }
6136}
6137
6138proc rmbranch {} {
6139    global headmenuid headmenuhead mainhead
6140    global headids idheads
6141
6142    set head $headmenuhead
6143    set id $headmenuid
6144    # this check shouldn't be needed any more...
6145    if {$head eq $mainhead} {
6146        error_popup "Cannot delete the currently checked-out branch"
6147        return
6148    }
6149    set dheads [descheads $id]
6150    if {$dheads eq $headids($head)} {
6151        # the stuff on this branch isn't on any other branch
6152        if {![confirm_popup "The commits on branch $head aren't on any other\
6153                        branch.\nReally delete branch $head?"]} return
6154    }
6155    nowbusy rmbranch
6156    update
6157    if {[catch {exec git branch -D $head} err]} {
6158        notbusy rmbranch
6159        error_popup $err
6160        return
6161    }
6162    removehead $id $head
6163    removedhead $id $head
6164    redrawtags $id
6165    notbusy rmbranch
6166    dispneartags 0
6167}
6168
6169# Stuff for finding nearby tags
6170proc getallcommits {} {
6171    global allcommits allids nbmp nextarc seeds
6172
6173    set allids {}
6174    set nbmp 0
6175    set nextarc 0
6176    set allcommits 0
6177    set seeds {}
6178    regetallcommits
6179}
6180
6181# Called when the graph might have changed
6182proc regetallcommits {} {
6183    global allcommits seeds
6184
6185    set cmd [concat | git rev-list --all --parents]
6186    foreach id $seeds {
6187        lappend cmd "^$id"
6188    }
6189    set fd [open $cmd r]
6190    fconfigure $fd -blocking 0
6191    incr allcommits
6192    nowbusy allcommits
6193    filerun $fd [list getallclines $fd]
6194}
6195
6196# Since most commits have 1 parent and 1 child, we group strings of
6197# such commits into "arcs" joining branch/merge points (BMPs), which
6198# are commits that either don't have 1 parent or don't have 1 child.
6199#
6200# arcnos(id) - incoming arcs for BMP, arc we're on for other nodes
6201# arcout(id) - outgoing arcs for BMP
6202# arcids(a) - list of IDs on arc including end but not start
6203# arcstart(a) - BMP ID at start of arc
6204# arcend(a) - BMP ID at end of arc
6205# growing(a) - arc a is still growing
6206# arctags(a) - IDs out of arcids (excluding end) that have tags
6207# archeads(a) - IDs out of arcids (excluding end) that have heads
6208# The start of an arc is at the descendent end, so "incoming" means
6209# coming from descendents, and "outgoing" means going towards ancestors.
6210
6211proc getallclines {fd} {
6212    global allids allparents allchildren idtags idheads nextarc nbmp
6213    global arcnos arcids arctags arcout arcend arcstart archeads growing
6214    global seeds allcommits
6215
6216    set nid 0
6217    while {[incr nid] <= 1000 && [gets $fd line] >= 0} {
6218        set id [lindex $line 0]
6219        if {[info exists allparents($id)]} {
6220            # seen it already
6221            continue
6222        }
6223        lappend allids $id
6224        set olds [lrange $line 1 end]
6225        set allparents($id) $olds
6226        if {![info exists allchildren($id)]} {
6227            set allchildren($id) {}
6228            set arcnos($id) {}
6229            lappend seeds $id
6230        } else {
6231            set a $arcnos($id)
6232            if {[llength $olds] == 1 && [llength $a] == 1} {
6233                lappend arcids($a) $id
6234                if {[info exists idtags($id)]} {
6235                    lappend arctags($a) $id
6236                }
6237                if {[info exists idheads($id)]} {
6238                    lappend archeads($a) $id
6239                }
6240                if {[info exists allparents($olds)]} {
6241                    # seen parent already
6242                    if {![info exists arcout($olds)]} {
6243                        splitarc $olds
6244                    }
6245                    lappend arcids($a) $olds
6246                    set arcend($a) $olds
6247                    unset growing($a)
6248                }
6249                lappend allchildren($olds) $id
6250                lappend arcnos($olds) $a
6251                continue
6252            }
6253        }
6254        incr nbmp
6255        foreach a $arcnos($id) {
6256            lappend arcids($a) $id
6257            set arcend($a) $id
6258            unset growing($a)
6259        }
6260
6261        set ao {}
6262        foreach p $olds {
6263            lappend allchildren($p) $id
6264            set a [incr nextarc]
6265            set arcstart($a) $id
6266            set archeads($a) {}
6267            set arctags($a) {}
6268            set archeads($a) {}
6269            set arcids($a) {}
6270            lappend ao $a
6271            set growing($a) 1
6272            if {[info exists allparents($p)]} {
6273                # seen it already, may need to make a new branch
6274                if {![info exists arcout($p)]} {
6275                    splitarc $p
6276                }
6277                lappend arcids($a) $p
6278                set arcend($a) $p
6279                unset growing($a)
6280            }
6281            lappend arcnos($p) $a
6282        }
6283        set arcout($id) $ao
6284    }
6285    if {$nid > 0} {
6286        global cached_dheads cached_dtags cached_atags
6287        catch {unset cached_dheads}
6288        catch {unset cached_dtags}
6289        catch {unset cached_atags}
6290    }
6291    if {![eof $fd]} {
6292        return [expr {$nid >= 1000? 2: 1}]
6293    }
6294    close $fd
6295    if {[incr allcommits -1] == 0} {
6296        notbusy allcommits
6297    }
6298    dispneartags 0
6299    return 0
6300}
6301
6302proc recalcarc {a} {
6303    global arctags archeads arcids idtags idheads
6304
6305    set at {}
6306    set ah {}
6307    foreach id [lrange $arcids($a) 0 end-1] {
6308        if {[info exists idtags($id)]} {
6309            lappend at $id
6310        }
6311        if {[info exists idheads($id)]} {
6312            lappend ah $id
6313        }
6314    }
6315    set arctags($a) $at
6316    set archeads($a) $ah
6317}
6318
6319proc splitarc {p} {
6320    global arcnos arcids nextarc nbmp arctags archeads idtags idheads
6321    global arcstart arcend arcout allparents growing
6322
6323    set a $arcnos($p)
6324    if {[llength $a] != 1} {
6325        puts "oops splitarc called but [llength $a] arcs already"
6326        return
6327    }
6328    set a [lindex $a 0]
6329    set i [lsearch -exact $arcids($a) $p]
6330    if {$i < 0} {
6331        puts "oops splitarc $p not in arc $a"
6332        return
6333    }
6334    set na [incr nextarc]
6335    if {[info exists arcend($a)]} {
6336        set arcend($na) $arcend($a)
6337    } else {
6338        set l [lindex $allparents([lindex $arcids($a) end]) 0]
6339        set j [lsearch -exact $arcnos($l) $a]
6340        set arcnos($l) [lreplace $arcnos($l) $j $j $na]
6341    }
6342    set tail [lrange $arcids($a) [expr {$i+1}] end]
6343    set arcids($a) [lrange $arcids($a) 0 $i]
6344    set arcend($a) $p
6345    set arcstart($na) $p
6346    set arcout($p) $na
6347    set arcids($na) $tail
6348    if {[info exists growing($a)]} {
6349        set growing($na) 1
6350        unset growing($a)
6351    }
6352    incr nbmp
6353
6354    foreach id $tail {
6355        if {[llength $arcnos($id)] == 1} {
6356            set arcnos($id) $na
6357        } else {
6358            set j [lsearch -exact $arcnos($id) $a]
6359            set arcnos($id) [lreplace $arcnos($id) $j $j $na]
6360        }
6361    }
6362
6363    # reconstruct tags and heads lists
6364    if {$arctags($a) ne {} || $archeads($a) ne {}} {
6365        recalcarc $a
6366        recalcarc $na
6367    } else {
6368        set arctags($na) {}
6369        set archeads($na) {}
6370    }
6371}
6372
6373# Update things for a new commit added that is a child of one
6374# existing commit.  Used when cherry-picking.
6375proc addnewchild {id p} {
6376    global allids allparents allchildren idtags nextarc nbmp
6377    global arcnos arcids arctags arcout arcend arcstart archeads growing
6378    global seeds
6379
6380    lappend allids $id
6381    set allparents($id) [list $p]
6382    set allchildren($id) {}
6383    set arcnos($id) {}
6384    lappend seeds $id
6385    incr nbmp
6386    lappend allchildren($p) $id
6387    set a [incr nextarc]
6388    set arcstart($a) $id
6389    set archeads($a) {}
6390    set arctags($a) {}
6391    set arcids($a) [list $p]
6392    set arcend($a) $p
6393    if {![info exists arcout($p)]} {
6394        splitarc $p
6395    }
6396    lappend arcnos($p) $a
6397    set arcout($id) [list $a]
6398}
6399
6400# Returns 1 if a is an ancestor of b, -1 if b is an ancestor of a,
6401# or 0 if neither is true.
6402proc anc_or_desc {a b} {
6403    global arcout arcstart arcend arcnos cached_isanc
6404
6405    if {$arcnos($a) eq $arcnos($b)} {
6406        # Both are on the same arc(s); either both are the same BMP,
6407        # or if one is not a BMP, the other is also not a BMP or is
6408        # the BMP at end of the arc (and it only has 1 incoming arc).
6409        # Or both can be BMPs with no incoming arcs.
6410        if {$a eq $b || $arcnos($a) eq {}} {
6411            return 0
6412        }
6413        # assert {[llength $arcnos($a)] == 1}
6414        set arc [lindex $arcnos($a) 0]
6415        set i [lsearch -exact $arcids($arc) $a]
6416        set j [lsearch -exact $arcids($arc) $b]
6417        if {$i < 0 || $i > $j} {
6418            return 1
6419        } else {
6420            return -1
6421        }
6422    }
6423
6424    if {![info exists arcout($a)]} {
6425        set arc [lindex $arcnos($a) 0]
6426        if {[info exists arcend($arc)]} {
6427            set aend $arcend($arc)
6428        } else {
6429            set aend {}
6430        }
6431        set a $arcstart($arc)
6432    } else {
6433        set aend $a
6434    }
6435    if {![info exists arcout($b)]} {
6436        set arc [lindex $arcnos($b) 0]
6437        if {[info exists arcend($arc)]} {
6438            set bend $arcend($arc)
6439        } else {
6440            set bend {}
6441        }
6442        set b $arcstart($arc)
6443    } else {
6444        set bend $b
6445    }
6446    if {$a eq $bend} {
6447        return 1
6448    }
6449    if {$b eq $aend} {
6450        return -1
6451    }
6452    if {[info exists cached_isanc($a,$bend)]} {
6453        if {$cached_isanc($a,$bend)} {
6454            return 1
6455        }
6456    }
6457    if {[info exists cached_isanc($b,$aend)]} {
6458        if {$cached_isanc($b,$aend)} {
6459            return -1
6460        }
6461        if {[info exists cached_isanc($a,$bend)]} {
6462            return 0
6463        }
6464    }
6465
6466    set todo [list $a $b]
6467    set anc($a) a
6468    set anc($b) b
6469    for {set i 0} {$i < [llength $todo]} {incr i} {
6470        set x [lindex $todo $i]
6471        if {$anc($x) eq {}} {
6472            continue
6473        }
6474        foreach arc $arcnos($x) {
6475            set xd $arcstart($arc)
6476            if {$xd eq $bend} {
6477                set cached_isanc($a,$bend) 1
6478                set cached_isanc($b,$aend) 0
6479                return 1
6480            } elseif {$xd eq $aend} {
6481                set cached_isanc($b,$aend) 1
6482                set cached_isanc($a,$bend) 0
6483                return -1
6484            }
6485            if {![info exists anc($xd)]} {
6486                set anc($xd) $anc($x)
6487                lappend todo $xd
6488            } elseif {$anc($xd) ne $anc($x)} {
6489                set anc($xd) {}
6490            }
6491        }
6492    }
6493    set cached_isanc($a,$bend) 0
6494    set cached_isanc($b,$aend) 0
6495    return 0
6496}
6497
6498# This identifies whether $desc has an ancestor that is
6499# a growing tip of the graph and which is not an ancestor of $anc
6500# and returns 0 if so and 1 if not.
6501# If we subsequently discover a tag on such a growing tip, and that
6502# turns out to be a descendent of $anc (which it could, since we
6503# don't necessarily see children before parents), then $desc
6504# isn't a good choice to display as a descendent tag of
6505# $anc (since it is the descendent of another tag which is
6506# a descendent of $anc).  Similarly, $anc isn't a good choice to
6507# display as a ancestor tag of $desc.
6508#
6509proc is_certain {desc anc} {
6510    global arcnos arcout arcstart arcend growing problems
6511
6512    set certain {}
6513    if {[llength $arcnos($anc)] == 1} {
6514        # tags on the same arc are certain
6515        if {$arcnos($desc) eq $arcnos($anc)} {
6516            return 1
6517        }
6518        if {![info exists arcout($anc)]} {
6519            # if $anc is partway along an arc, use the start of the arc instead
6520            set a [lindex $arcnos($anc) 0]
6521            set anc $arcstart($a)
6522        }
6523    }
6524    if {[llength $arcnos($desc)] > 1 || [info exists arcout($desc)]} {
6525        set x $desc
6526    } else {
6527        set a [lindex $arcnos($desc) 0]
6528        set x $arcend($a)
6529    }
6530    if {$x == $anc} {
6531        return 1
6532    }
6533    set anclist [list $x]
6534    set dl($x) 1
6535    set nnh 1
6536    set ngrowanc 0
6537    for {set i 0} {$i < [llength $anclist] && ($nnh > 0 || $ngrowanc > 0)} {incr i} {
6538        set x [lindex $anclist $i]
6539        if {$dl($x)} {
6540            incr nnh -1
6541        }
6542        set done($x) 1
6543        foreach a $arcout($x) {
6544            if {[info exists growing($a)]} {
6545                if {![info exists growanc($x)] && $dl($x)} {
6546                    set growanc($x) 1
6547                    incr ngrowanc
6548                }
6549            } else {
6550                set y $arcend($a)
6551                if {[info exists dl($y)]} {
6552                    if {$dl($y)} {
6553                        if {!$dl($x)} {
6554                            set dl($y) 0
6555                            if {![info exists done($y)]} {
6556                                incr nnh -1
6557                            }
6558                            if {[info exists growanc($x)]} {
6559                                incr ngrowanc -1
6560                            }
6561                            set xl [list $y]
6562                            for {set k 0} {$k < [llength $xl]} {incr k} {
6563                                set z [lindex $xl $k]
6564                                foreach c $arcout($z) {
6565                                    if {[info exists arcend($c)]} {
6566                                        set v $arcend($c)
6567                                        if {[info exists dl($v)] && $dl($v)} {
6568                                            set dl($v) 0
6569                                            if {![info exists done($v)]} {
6570                                                incr nnh -1
6571                                            }
6572                                            if {[info exists growanc($v)]} {
6573                                                incr ngrowanc -1
6574                                            }
6575                                            lappend xl $v
6576                                        }
6577                                    }
6578                                }
6579                            }
6580                        }
6581                    }
6582                } elseif {$y eq $anc || !$dl($x)} {
6583                    set dl($y) 0
6584                    lappend anclist $y
6585                } else {
6586                    set dl($y) 1
6587                    lappend anclist $y
6588                    incr nnh
6589                }
6590            }
6591        }
6592    }
6593    foreach x [array names growanc] {
6594        if {$dl($x)} {
6595            return 0
6596        }
6597        return 0
6598    }
6599    return 1
6600}
6601
6602proc validate_arctags {a} {
6603    global arctags idtags
6604
6605    set i -1
6606    set na $arctags($a)
6607    foreach id $arctags($a) {
6608        incr i
6609        if {![info exists idtags($id)]} {
6610            set na [lreplace $na $i $i]
6611            incr i -1
6612        }
6613    }
6614    set arctags($a) $na
6615}
6616
6617proc validate_archeads {a} {
6618    global archeads idheads
6619
6620    set i -1
6621    set na $archeads($a)
6622    foreach id $archeads($a) {
6623        incr i
6624        if {![info exists idheads($id)]} {
6625            set na [lreplace $na $i $i]
6626            incr i -1
6627        }
6628    }
6629    set archeads($a) $na
6630}
6631
6632# Return the list of IDs that have tags that are descendents of id,
6633# ignoring IDs that are descendents of IDs already reported.
6634proc desctags {id} {
6635    global arcnos arcstart arcids arctags idtags allparents
6636    global growing cached_dtags
6637
6638    if {![info exists allparents($id)]} {
6639        return {}
6640    }
6641    set t1 [clock clicks -milliseconds]
6642    set argid $id
6643    if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
6644        # part-way along an arc; check that arc first
6645        set a [lindex $arcnos($id) 0]
6646        if {$arctags($a) ne {}} {
6647            validate_arctags $a
6648            set i [lsearch -exact $arcids($a) $id]
6649            set tid {}
6650            foreach t $arctags($a) {
6651                set j [lsearch -exact $arcids($a) $t]
6652                if {$j >= $i} break
6653                set tid $t
6654            }
6655            if {$tid ne {}} {
6656                return $tid
6657            }
6658        }
6659        set id $arcstart($a)
6660        if {[info exists idtags($id)]} {
6661            return $id
6662        }
6663    }
6664    if {[info exists cached_dtags($id)]} {
6665        return $cached_dtags($id)
6666    }
6667
6668    set origid $id
6669    set todo [list $id]
6670    set queued($id) 1
6671    set nc 1
6672    for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
6673        set id [lindex $todo $i]
6674        set done($id) 1
6675        set ta [info exists hastaggedancestor($id)]
6676        if {!$ta} {
6677            incr nc -1
6678        }
6679        # ignore tags on starting node
6680        if {!$ta && $i > 0} {
6681            if {[info exists idtags($id)]} {
6682                set tagloc($id) $id
6683                set ta 1
6684            } elseif {[info exists cached_dtags($id)]} {
6685                set tagloc($id) $cached_dtags($id)
6686                set ta 1
6687            }
6688        }
6689        foreach a $arcnos($id) {
6690            set d $arcstart($a)
6691            if {!$ta && $arctags($a) ne {}} {
6692                validate_arctags $a
6693                if {$arctags($a) ne {}} {
6694                    lappend tagloc($id) [lindex $arctags($a) end]
6695                }
6696            }
6697            if {$ta || $arctags($a) ne {}} {
6698                set tomark [list $d]
6699                for {set j 0} {$j < [llength $tomark]} {incr j} {
6700                    set dd [lindex $tomark $j]
6701                    if {![info exists hastaggedancestor($dd)]} {
6702                        if {[info exists done($dd)]} {
6703                            foreach b $arcnos($dd) {
6704                                lappend tomark $arcstart($b)
6705                            }
6706                            if {[info exists tagloc($dd)]} {
6707                                unset tagloc($dd)
6708                            }
6709                        } elseif {[info exists queued($dd)]} {
6710                            incr nc -1
6711                        }
6712                        set hastaggedancestor($dd) 1
6713                    }
6714                }
6715            }
6716            if {![info exists queued($d)]} {
6717                lappend todo $d
6718                set queued($d) 1
6719                if {![info exists hastaggedancestor($d)]} {
6720                    incr nc
6721                }
6722            }
6723        }
6724    }
6725    set tags {}
6726    foreach id [array names tagloc] {
6727        if {![info exists hastaggedancestor($id)]} {
6728            foreach t $tagloc($id) {
6729                if {[lsearch -exact $tags $t] < 0} {
6730                    lappend tags $t
6731                }
6732            }
6733        }
6734    }
6735    set t2 [clock clicks -milliseconds]
6736    set loopix $i
6737
6738    # remove tags that are descendents of other tags
6739    for {set i 0} {$i < [llength $tags]} {incr i} {
6740        set a [lindex $tags $i]
6741        for {set j 0} {$j < $i} {incr j} {
6742            set b [lindex $tags $j]
6743            set r [anc_or_desc $a $b]
6744            if {$r == 1} {
6745                set tags [lreplace $tags $j $j]
6746                incr j -1
6747                incr i -1
6748            } elseif {$r == -1} {
6749                set tags [lreplace $tags $i $i]
6750                incr i -1
6751                break
6752            }
6753        }
6754    }
6755
6756    if {[array names growing] ne {}} {
6757        # graph isn't finished, need to check if any tag could get
6758        # eclipsed by another tag coming later.  Simply ignore any
6759        # tags that could later get eclipsed.
6760        set ctags {}
6761        foreach t $tags {
6762            if {[is_certain $t $origid]} {
6763                lappend ctags $t
6764            }
6765        }
6766        if {$tags eq $ctags} {
6767            set cached_dtags($origid) $tags
6768        } else {
6769            set tags $ctags
6770        }
6771    } else {
6772        set cached_dtags($origid) $tags
6773    }
6774    set t3 [clock clicks -milliseconds]
6775    if {0 && $t3 - $t1 >= 100} {
6776        puts "iterating descendents ($loopix/[llength $todo] nodes) took\
6777            [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
6778    }
6779    return $tags
6780}
6781
6782proc anctags {id} {
6783    global arcnos arcids arcout arcend arctags idtags allparents
6784    global growing cached_atags
6785
6786    if {![info exists allparents($id)]} {
6787        return {}
6788    }
6789    set t1 [clock clicks -milliseconds]
6790    set argid $id
6791    if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
6792        # part-way along an arc; check that arc first
6793        set a [lindex $arcnos($id) 0]
6794        if {$arctags($a) ne {}} {
6795            validate_arctags $a
6796            set i [lsearch -exact $arcids($a) $id]
6797            foreach t $arctags($a) {
6798                set j [lsearch -exact $arcids($a) $t]
6799                if {$j > $i} {
6800                    return $t
6801                }
6802            }
6803        }
6804        if {![info exists arcend($a)]} {
6805            return {}
6806        }
6807        set id $arcend($a)
6808        if {[info exists idtags($id)]} {
6809            return $id
6810        }
6811    }
6812    if {[info exists cached_atags($id)]} {
6813        return $cached_atags($id)
6814    }
6815
6816    set origid $id
6817    set todo [list $id]
6818    set queued($id) 1
6819    set taglist {}
6820    set nc 1
6821    for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
6822        set id [lindex $todo $i]
6823        set done($id) 1
6824        set td [info exists hastaggeddescendent($id)]
6825        if {!$td} {
6826            incr nc -1
6827        }
6828        # ignore tags on starting node
6829        if {!$td && $i > 0} {
6830            if {[info exists idtags($id)]} {
6831                set tagloc($id) $id
6832                set td 1
6833            } elseif {[info exists cached_atags($id)]} {
6834                set tagloc($id) $cached_atags($id)
6835                set td 1
6836            }
6837        }
6838        foreach a $arcout($id) {
6839            if {!$td && $arctags($a) ne {}} {
6840                validate_arctags $a
6841                if {$arctags($a) ne {}} {
6842                    lappend tagloc($id) [lindex $arctags($a) 0]
6843                }
6844            }
6845            if {![info exists arcend($a)]} continue
6846            set d $arcend($a)
6847            if {$td || $arctags($a) ne {}} {
6848                set tomark [list $d]
6849                for {set j 0} {$j < [llength $tomark]} {incr j} {
6850                    set dd [lindex $tomark $j]
6851                    if {![info exists hastaggeddescendent($dd)]} {
6852                        if {[info exists done($dd)]} {
6853                            foreach b $arcout($dd) {
6854                                if {[info exists arcend($b)]} {
6855                                    lappend tomark $arcend($b)
6856                                }
6857                            }
6858                            if {[info exists tagloc($dd)]} {
6859                                unset tagloc($dd)
6860                            }
6861                        } elseif {[info exists queued($dd)]} {
6862                            incr nc -1
6863                        }
6864                        set hastaggeddescendent($dd) 1
6865                    }
6866                }
6867            }
6868            if {![info exists queued($d)]} {
6869                lappend todo $d
6870                set queued($d) 1
6871                if {![info exists hastaggeddescendent($d)]} {
6872                    incr nc
6873                }
6874            }
6875        }
6876    }
6877    set t2 [clock clicks -milliseconds]
6878    set loopix $i
6879    set tags {}
6880    foreach id [array names tagloc] {
6881        if {![info exists hastaggeddescendent($id)]} {
6882            foreach t $tagloc($id) {
6883                if {[lsearch -exact $tags $t] < 0} {
6884                    lappend tags $t
6885                }
6886            }
6887        }
6888    }
6889
6890    # remove tags that are ancestors of other tags
6891    for {set i 0} {$i < [llength $tags]} {incr i} {
6892        set a [lindex $tags $i]
6893        for {set j 0} {$j < $i} {incr j} {
6894            set b [lindex $tags $j]
6895            set r [anc_or_desc $a $b]
6896            if {$r == -1} {
6897                set tags [lreplace $tags $j $j]
6898                incr j -1
6899                incr i -1
6900            } elseif {$r == 1} {
6901                set tags [lreplace $tags $i $i]
6902                incr i -1
6903                break
6904            }
6905        }
6906    }
6907
6908    if {[array names growing] ne {}} {
6909        # graph isn't finished, need to check if any tag could get
6910        # eclipsed by another tag coming later.  Simply ignore any
6911        # tags that could later get eclipsed.
6912        set ctags {}
6913        foreach t $tags {
6914            if {[is_certain $origid $t]} {
6915                lappend ctags $t
6916            }
6917        }
6918        if {$tags eq $ctags} {
6919            set cached_atags($origid) $tags
6920        } else {
6921            set tags $ctags
6922        }
6923    } else {
6924        set cached_atags($origid) $tags
6925    }
6926    set t3 [clock clicks -milliseconds]
6927    if {0 && $t3 - $t1 >= 100} {
6928        puts "iterating ancestors ($loopix/[llength $todo] nodes) took\
6929            [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
6930    }
6931    return $tags
6932}
6933
6934# Return the list of IDs that have heads that are descendents of id,
6935# including id itself if it has a head.
6936proc descheads {id} {
6937    global arcnos arcstart arcids archeads idheads cached_dheads
6938    global allparents
6939
6940    if {![info exists allparents($id)]} {
6941        return {}
6942    }
6943    set aret {}
6944    if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
6945        # part-way along an arc; check it first
6946        set a [lindex $arcnos($id) 0]
6947        if {$archeads($a) ne {}} {
6948            validate_archeads $a
6949            set i [lsearch -exact $arcids($a) $id]
6950            foreach t $archeads($a) {
6951                set j [lsearch -exact $arcids($a) $t]
6952                if {$j > $i} break
6953                lappend aret $t
6954            }
6955        }
6956        set id $arcstart($a)
6957    }
6958    set origid $id
6959    set todo [list $id]
6960    set seen($id) 1
6961    set ret {}
6962    for {set i 0} {$i < [llength $todo]} {incr i} {
6963        set id [lindex $todo $i]
6964        if {[info exists cached_dheads($id)]} {
6965            set ret [concat $ret $cached_dheads($id)]
6966        } else {
6967            if {[info exists idheads($id)]} {
6968                lappend ret $id
6969            }
6970            foreach a $arcnos($id) {
6971                if {$archeads($a) ne {}} {
6972                    validate_archeads $a
6973                    if {$archeads($a) ne {}} {
6974                        set ret [concat $ret $archeads($a)]
6975                    }
6976                }
6977                set d $arcstart($a)
6978                if {![info exists seen($d)]} {
6979                    lappend todo $d
6980                    set seen($d) 1
6981                }
6982            }
6983        }
6984    }
6985    set ret [lsort -unique $ret]
6986    set cached_dheads($origid) $ret
6987    return [concat $ret $aret]
6988}
6989
6990proc addedtag {id} {
6991    global arcnos arcout cached_dtags cached_atags
6992
6993    if {![info exists arcnos($id)]} return
6994    if {![info exists arcout($id)]} {
6995        recalcarc [lindex $arcnos($id) 0]
6996    }
6997    catch {unset cached_dtags}
6998    catch {unset cached_atags}
6999}
7000
7001proc addedhead {hid head} {
7002    global arcnos arcout cached_dheads
7003
7004    if {![info exists arcnos($hid)]} return
7005    if {![info exists arcout($hid)]} {
7006        recalcarc [lindex $arcnos($hid) 0]
7007    }
7008    catch {unset cached_dheads}
7009}
7010
7011proc removedhead {hid head} {
7012    global cached_dheads
7013
7014    catch {unset cached_dheads}
7015}
7016
7017proc movedhead {hid head} {
7018    global arcnos arcout cached_dheads
7019
7020    if {![info exists arcnos($hid)]} return
7021    if {![info exists arcout($hid)]} {
7022        recalcarc [lindex $arcnos($hid) 0]
7023    }
7024    catch {unset cached_dheads}
7025}
7026
7027proc changedrefs {} {
7028    global cached_dheads cached_dtags cached_atags
7029    global arctags archeads arcnos arcout idheads idtags
7030
7031    foreach id [concat [array names idheads] [array names idtags]] {
7032        if {[info exists arcnos($id)] && ![info exists arcout($id)]} {
7033            set a [lindex $arcnos($id) 0]
7034            if {![info exists donearc($a)]} {
7035                recalcarc $a
7036                set donearc($a) 1
7037            }
7038        }
7039    }
7040    catch {unset cached_dtags}
7041    catch {unset cached_atags}
7042    catch {unset cached_dheads}
7043}
7044
7045proc rereadrefs {} {
7046    global idtags idheads idotherrefs mainhead
7047
7048    set refids [concat [array names idtags] \
7049                    [array names idheads] [array names idotherrefs]]
7050    foreach id $refids {
7051        if {![info exists ref($id)]} {
7052            set ref($id) [listrefs $id]
7053        }
7054    }
7055    set oldmainhead $mainhead
7056    readrefs
7057    changedrefs
7058    set refids [lsort -unique [concat $refids [array names idtags] \
7059                        [array names idheads] [array names idotherrefs]]]
7060    foreach id $refids {
7061        set v [listrefs $id]
7062        if {![info exists ref($id)] || $ref($id) != $v ||
7063            ($id eq $oldmainhead && $id ne $mainhead) ||
7064            ($id eq $mainhead && $id ne $oldmainhead)} {
7065            redrawtags $id
7066        }
7067    }
7068}
7069
7070proc listrefs {id} {
7071    global idtags idheads idotherrefs
7072
7073    set x {}
7074    if {[info exists idtags($id)]} {
7075        set x $idtags($id)
7076    }
7077    set y {}
7078    if {[info exists idheads($id)]} {
7079        set y $idheads($id)
7080    }
7081    set z {}
7082    if {[info exists idotherrefs($id)]} {
7083        set z $idotherrefs($id)
7084    }
7085    return [list $x $y $z]
7086}
7087
7088proc showtag {tag isnew} {
7089    global ctext tagcontents tagids linknum tagobjid
7090
7091    if {$isnew} {
7092        addtohistory [list showtag $tag 0]
7093    }
7094    $ctext conf -state normal
7095    clear_ctext
7096    set linknum 0
7097    if {![info exists tagcontents($tag)]} {
7098        catch {
7099            set tagcontents($tag) [exec git cat-file tag $tagobjid($tag)]
7100        }
7101    }
7102    if {[info exists tagcontents($tag)]} {
7103        set text $tagcontents($tag)
7104    } else {
7105        set text "Tag: $tag\nId:  $tagids($tag)"
7106    }
7107    appendwithlinks $text {}
7108    $ctext conf -state disabled
7109    init_flist {}
7110}
7111
7112proc doquit {} {
7113    global stopped
7114    set stopped 100
7115    savestuff .
7116    destroy .
7117}
7118
7119proc doprefs {} {
7120    global maxwidth maxgraphpct diffopts
7121    global oldprefs prefstop showneartags showlocalchanges
7122    global bgcolor fgcolor ctext diffcolors selectbgcolor
7123    global uifont tabstop
7124
7125    set top .gitkprefs
7126    set prefstop $top
7127    if {[winfo exists $top]} {
7128        raise $top
7129        return
7130    }
7131    foreach v {maxwidth maxgraphpct diffopts showneartags showlocalchanges} {
7132        set oldprefs($v) [set $v]
7133    }
7134    toplevel $top
7135    wm title $top "Gitk preferences"
7136    label $top.ldisp -text "Commit list display options"
7137    $top.ldisp configure -font $uifont
7138    grid $top.ldisp - -sticky w -pady 10
7139    label $top.spacer -text " "
7140    label $top.maxwidthl -text "Maximum graph width (lines)" \
7141        -font optionfont
7142    spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
7143    grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
7144    label $top.maxpctl -text "Maximum graph width (% of pane)" \
7145        -font optionfont
7146    spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
7147    grid x $top.maxpctl $top.maxpct -sticky w
7148    frame $top.showlocal
7149    label $top.showlocal.l -text "Show local changes" -font optionfont
7150    checkbutton $top.showlocal.b -variable showlocalchanges
7151    pack $top.showlocal.b $top.showlocal.l -side left
7152    grid x $top.showlocal -sticky w
7153
7154    label $top.ddisp -text "Diff display options"
7155    $top.ddisp configure -font $uifont
7156    grid $top.ddisp - -sticky w -pady 10
7157    label $top.diffoptl -text "Options for diff program" \
7158        -font optionfont
7159    entry $top.diffopt -width 20 -textvariable diffopts
7160    grid x $top.diffoptl $top.diffopt -sticky w
7161    frame $top.ntag
7162    label $top.ntag.l -text "Display nearby tags" -font optionfont
7163    checkbutton $top.ntag.b -variable showneartags
7164    pack $top.ntag.b $top.ntag.l -side left
7165    grid x $top.ntag -sticky w
7166    label $top.tabstopl -text "tabstop" -font optionfont
7167    spinbox $top.tabstop -from 1 -to 20 -width 4 -textvariable tabstop
7168    grid x $top.tabstopl $top.tabstop -sticky w
7169
7170    label $top.cdisp -text "Colors: press to choose"
7171    $top.cdisp configure -font $uifont
7172    grid $top.cdisp - -sticky w -pady 10
7173    label $top.bg -padx 40 -relief sunk -background $bgcolor
7174    button $top.bgbut -text "Background" -font optionfont \
7175        -command [list choosecolor bgcolor 0 $top.bg background setbg]
7176    grid x $top.bgbut $top.bg -sticky w
7177    label $top.fg -padx 40 -relief sunk -background $fgcolor
7178    button $top.fgbut -text "Foreground" -font optionfont \
7179        -command [list choosecolor fgcolor 0 $top.fg foreground setfg]
7180    grid x $top.fgbut $top.fg -sticky w
7181    label $top.diffold -padx 40 -relief sunk -background [lindex $diffcolors 0]
7182    button $top.diffoldbut -text "Diff: old lines" -font optionfont \
7183        -command [list choosecolor diffcolors 0 $top.diffold "diff old lines" \
7184                      [list $ctext tag conf d0 -foreground]]
7185    grid x $top.diffoldbut $top.diffold -sticky w
7186    label $top.diffnew -padx 40 -relief sunk -background [lindex $diffcolors 1]
7187    button $top.diffnewbut -text "Diff: new lines" -font optionfont \
7188        -command [list choosecolor diffcolors 1 $top.diffnew "diff new lines" \
7189                      [list $ctext tag conf d1 -foreground]]
7190    grid x $top.diffnewbut $top.diffnew -sticky w
7191    label $top.hunksep -padx 40 -relief sunk -background [lindex $diffcolors 2]
7192    button $top.hunksepbut -text "Diff: hunk header" -font optionfont \
7193        -command [list choosecolor diffcolors 2 $top.hunksep \
7194                      "diff hunk header" \
7195                      [list $ctext tag conf hunksep -foreground]]
7196    grid x $top.hunksepbut $top.hunksep -sticky w
7197    label $top.selbgsep -padx 40 -relief sunk -background $selectbgcolor
7198    button $top.selbgbut -text "Select bg" -font optionfont \
7199        -command [list choosecolor selectbgcolor 0 $top.selbgsep background setselbg]
7200    grid x $top.selbgbut $top.selbgsep -sticky w
7201
7202    frame $top.buts
7203    button $top.buts.ok -text "OK" -command prefsok -default active
7204    $top.buts.ok configure -font $uifont
7205    button $top.buts.can -text "Cancel" -command prefscan -default normal
7206    $top.buts.can configure -font $uifont
7207    grid $top.buts.ok $top.buts.can
7208    grid columnconfigure $top.buts 0 -weight 1 -uniform a
7209    grid columnconfigure $top.buts 1 -weight 1 -uniform a
7210    grid $top.buts - - -pady 10 -sticky ew
7211    bind $top <Visibility> "focus $top.buts.ok"
7212}
7213
7214proc choosecolor {v vi w x cmd} {
7215    global $v
7216
7217    set c [tk_chooseColor -initialcolor [lindex [set $v] $vi] \
7218               -title "Gitk: choose color for $x"]
7219    if {$c eq {}} return
7220    $w conf -background $c
7221    lset $v $vi $c
7222    eval $cmd $c
7223}
7224
7225proc setselbg {c} {
7226    global bglist cflist
7227    foreach w $bglist {
7228        $w configure -selectbackground $c
7229    }
7230    $cflist tag configure highlight \
7231        -background [$cflist cget -selectbackground]
7232    allcanvs itemconf secsel -fill $c
7233}
7234
7235proc setbg {c} {
7236    global bglist
7237
7238    foreach w $bglist {
7239        $w conf -background $c
7240    }
7241}
7242
7243proc setfg {c} {
7244    global fglist canv
7245
7246    foreach w $fglist {
7247        $w conf -foreground $c
7248    }
7249    allcanvs itemconf text -fill $c
7250    $canv itemconf circle -outline $c
7251}
7252
7253proc prefscan {} {
7254    global maxwidth maxgraphpct diffopts
7255    global oldprefs prefstop showneartags showlocalchanges
7256
7257    foreach v {maxwidth maxgraphpct diffopts showneartags showlocalchanges} {
7258        set $v $oldprefs($v)
7259    }
7260    catch {destroy $prefstop}
7261    unset prefstop
7262}
7263
7264proc prefsok {} {
7265    global maxwidth maxgraphpct
7266    global oldprefs prefstop showneartags showlocalchanges
7267    global charspc ctext tabstop
7268
7269    catch {destroy $prefstop}
7270    unset prefstop
7271    $ctext configure -tabs "[expr {$tabstop * $charspc}]"
7272    if {$showlocalchanges != $oldprefs(showlocalchanges)} {
7273        if {$showlocalchanges} {
7274            doshowlocalchanges
7275        } else {
7276            dohidelocalchanges
7277        }
7278    }
7279    if {$maxwidth != $oldprefs(maxwidth)
7280        || $maxgraphpct != $oldprefs(maxgraphpct)} {
7281        redisplay
7282    } elseif {$showneartags != $oldprefs(showneartags)} {
7283        reselectline
7284    }
7285}
7286
7287proc formatdate {d} {
7288    if {$d ne {}} {
7289        set d [clock format $d -format "%Y-%m-%d %H:%M:%S"]
7290    }
7291    return $d
7292}
7293
7294# This list of encoding names and aliases is distilled from
7295# http://www.iana.org/assignments/character-sets.
7296# Not all of them are supported by Tcl.
7297set encoding_aliases {
7298    { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
7299      ISO646-US US-ASCII us IBM367 cp367 csASCII }
7300    { ISO-10646-UTF-1 csISO10646UTF1 }
7301    { ISO_646.basic:1983 ref csISO646basic1983 }
7302    { INVARIANT csINVARIANT }
7303    { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
7304    { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
7305    { NATS-SEFI iso-ir-8-1 csNATSSEFI }
7306    { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
7307    { NATS-DANO iso-ir-9-1 csNATSDANO }
7308    { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
7309    { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
7310    { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
7311    { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
7312    { ISO-2022-KR csISO2022KR }
7313    { EUC-KR csEUCKR }
7314    { ISO-2022-JP csISO2022JP }
7315    { ISO-2022-JP-2 csISO2022JP2 }
7316    { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
7317      csISO13JISC6220jp }
7318    { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
7319    { IT iso-ir-15 ISO646-IT csISO15Italian }
7320    { PT iso-ir-16 ISO646-PT csISO16Portuguese }
7321    { ES iso-ir-17 ISO646-ES csISO17Spanish }
7322    { greek7-old iso-ir-18 csISO18Greek7Old }
7323    { latin-greek iso-ir-19 csISO19LatinGreek }
7324    { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
7325    { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
7326    { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
7327    { ISO_5427 iso-ir-37 csISO5427Cyrillic }
7328    { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
7329    { BS_viewdata iso-ir-47 csISO47BSViewdata }
7330    { INIS iso-ir-49 csISO49INIS }
7331    { INIS-8 iso-ir-50 csISO50INIS8 }
7332    { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
7333    { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
7334    { ISO_5428:1980 iso-ir-55 csISO5428Greek }
7335    { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
7336    { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
7337    { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
7338      csISO60Norwegian1 }
7339    { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
7340    { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
7341    { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
7342    { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
7343    { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
7344    { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
7345    { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
7346    { greek7 iso-ir-88 csISO88Greek7 }
7347    { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
7348    { iso-ir-90 csISO90 }
7349    { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
7350    { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
7351      csISO92JISC62991984b }
7352    { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
7353    { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
7354    { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
7355      csISO95JIS62291984handadd }
7356    { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
7357    { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
7358    { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
7359    { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
7360      CP819 csISOLatin1 }
7361    { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
7362    { T.61-7bit iso-ir-102 csISO102T617bit }
7363    { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
7364    { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
7365    { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
7366    { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
7367    { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
7368    { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
7369    { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
7370    { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
7371      arabic csISOLatinArabic }
7372    { ISO_8859-6-E csISO88596E ISO-8859-6-E }
7373    { ISO_8859-6-I csISO88596I ISO-8859-6-I }
7374    { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
7375      greek greek8 csISOLatinGreek }
7376    { T.101-G2 iso-ir-128 csISO128T101G2 }
7377    { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
7378      csISOLatinHebrew }
7379    { ISO_8859-8-E csISO88598E ISO-8859-8-E }
7380    { ISO_8859-8-I csISO88598I ISO-8859-8-I }
7381    { CSN_369103 iso-ir-139 csISO139CSN369103 }
7382    { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
7383    { ISO_6937-2-add iso-ir-142 csISOTextComm }
7384    { IEC_P27-1 iso-ir-143 csISO143IECP271 }
7385    { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
7386      csISOLatinCyrillic }
7387    { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
7388    { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
7389    { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
7390    { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
7391    { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
7392    { ISO_6937-2-25 iso-ir-152 csISO6937Add }
7393    { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
7394    { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
7395    { ISO_10367-box iso-ir-155 csISO10367Box }
7396    { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
7397    { latin-lap lap iso-ir-158 csISO158Lap }
7398    { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
7399    { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
7400    { us-dk csUSDK }
7401    { dk-us csDKUS }
7402    { JIS_X0201 X0201 csHalfWidthKatakana }
7403    { KSC5636 ISO646-KR csKSC5636 }
7404    { ISO-10646-UCS-2 csUnicode }
7405    { ISO-10646-UCS-4 csUCS4 }
7406    { DEC-MCS dec csDECMCS }
7407    { hp-roman8 roman8 r8 csHPRoman8 }
7408    { macintosh mac csMacintosh }
7409    { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
7410      csIBM037 }
7411    { IBM038 EBCDIC-INT cp038 csIBM038 }
7412    { IBM273 CP273 csIBM273 }
7413    { IBM274 EBCDIC-BE CP274 csIBM274 }
7414    { IBM275 EBCDIC-BR cp275 csIBM275 }
7415    { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
7416    { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
7417    { IBM280 CP280 ebcdic-cp-it csIBM280 }
7418    { IBM281 EBCDIC-JP-E cp281 csIBM281 }
7419    { IBM284 CP284 ebcdic-cp-es csIBM284 }
7420    { IBM285 CP285 ebcdic-cp-gb csIBM285 }
7421    { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
7422    { IBM297 cp297 ebcdic-cp-fr csIBM297 }
7423    { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
7424    { IBM423 cp423 ebcdic-cp-gr csIBM423 }
7425    { IBM424 cp424 ebcdic-cp-he csIBM424 }
7426    { IBM437 cp437 437 csPC8CodePage437 }
7427    { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
7428    { IBM775 cp775 csPC775Baltic }
7429    { IBM850 cp850 850 csPC850Multilingual }
7430    { IBM851 cp851 851 csIBM851 }
7431    { IBM852 cp852 852 csPCp852 }
7432    { IBM855 cp855 855 csIBM855 }
7433    { IBM857 cp857 857 csIBM857 }
7434    { IBM860 cp860 860 csIBM860 }
7435    { IBM861 cp861 861 cp-is csIBM861 }
7436    { IBM862 cp862 862 csPC862LatinHebrew }
7437    { IBM863 cp863 863 csIBM863 }
7438    { IBM864 cp864 csIBM864 }
7439    { IBM865 cp865 865 csIBM865 }
7440    { IBM866 cp866 866 csIBM866 }
7441    { IBM868 CP868 cp-ar csIBM868 }
7442    { IBM869 cp869 869 cp-gr csIBM869 }
7443    { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
7444    { IBM871 CP871 ebcdic-cp-is csIBM871 }
7445    { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
7446    { IBM891 cp891 csIBM891 }
7447    { IBM903 cp903 csIBM903 }
7448    { IBM904 cp904 904 csIBBM904 }
7449    { IBM905 CP905 ebcdic-cp-tr csIBM905 }
7450    { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
7451    { IBM1026 CP1026 csIBM1026 }
7452    { EBCDIC-AT-DE csIBMEBCDICATDE }
7453    { EBCDIC-AT-DE-A csEBCDICATDEA }
7454    { EBCDIC-CA-FR csEBCDICCAFR }
7455    { EBCDIC-DK-NO csEBCDICDKNO }
7456    { EBCDIC-DK-NO-A csEBCDICDKNOA }
7457    { EBCDIC-FI-SE csEBCDICFISE }
7458    { EBCDIC-FI-SE-A csEBCDICFISEA }
7459    { EBCDIC-FR csEBCDICFR }
7460    { EBCDIC-IT csEBCDICIT }
7461    { EBCDIC-PT csEBCDICPT }
7462    { EBCDIC-ES csEBCDICES }
7463    { EBCDIC-ES-A csEBCDICESA }
7464    { EBCDIC-ES-S csEBCDICESS }
7465    { EBCDIC-UK csEBCDICUK }
7466    { EBCDIC-US csEBCDICUS }
7467    { UNKNOWN-8BIT csUnknown8BiT }
7468    { MNEMONIC csMnemonic }
7469    { MNEM csMnem }
7470    { VISCII csVISCII }
7471    { VIQR csVIQR }
7472    { KOI8-R csKOI8R }
7473    { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
7474    { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
7475    { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
7476    { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
7477    { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
7478    { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
7479    { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
7480    { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
7481    { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
7482    { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
7483    { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
7484    { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
7485    { IBM1047 IBM-1047 }
7486    { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
7487    { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
7488    { UNICODE-1-1 csUnicode11 }
7489    { CESU-8 csCESU-8 }
7490    { BOCU-1 csBOCU-1 }
7491    { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
7492    { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
7493      l8 }
7494    { ISO-8859-15 ISO_8859-15 Latin-9 }
7495    { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
7496    { GBK CP936 MS936 windows-936 }
7497    { JIS_Encoding csJISEncoding }
7498    { Shift_JIS MS_Kanji csShiftJIS }
7499    { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
7500      EUC-JP }
7501    { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
7502    { ISO-10646-UCS-Basic csUnicodeASCII }
7503    { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
7504    { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
7505    { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
7506    { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
7507    { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
7508    { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
7509    { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
7510    { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
7511    { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
7512    { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
7513    { Adobe-Standard-Encoding csAdobeStandardEncoding }
7514    { Ventura-US csVenturaUS }
7515    { Ventura-International csVenturaInternational }
7516    { PC8-Danish-Norwegian csPC8DanishNorwegian }
7517    { PC8-Turkish csPC8Turkish }
7518    { IBM-Symbols csIBMSymbols }
7519    { IBM-Thai csIBMThai }
7520    { HP-Legal csHPLegal }
7521    { HP-Pi-font csHPPiFont }
7522    { HP-Math8 csHPMath8 }
7523    { Adobe-Symbol-Encoding csHPPSMath }
7524    { HP-DeskTop csHPDesktop }
7525    { Ventura-Math csVenturaMath }
7526    { Microsoft-Publishing csMicrosoftPublishing }
7527    { Windows-31J csWindows31J }
7528    { GB2312 csGB2312 }
7529    { Big5 csBig5 }
7530}
7531
7532proc tcl_encoding {enc} {
7533    global encoding_aliases
7534    set names [encoding names]
7535    set lcnames [string tolower $names]
7536    set enc [string tolower $enc]
7537    set i [lsearch -exact $lcnames $enc]
7538    if {$i < 0} {
7539        # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
7540        if {[regsub {^iso[-_]} $enc iso encx]} {
7541            set i [lsearch -exact $lcnames $encx]
7542        }
7543    }
7544    if {$i < 0} {
7545        foreach l $encoding_aliases {
7546            set ll [string tolower $l]
7547            if {[lsearch -exact $ll $enc] < 0} continue
7548            # look through the aliases for one that tcl knows about
7549            foreach e $ll {
7550                set i [lsearch -exact $lcnames $e]
7551                if {$i < 0} {
7552                    if {[regsub {^iso[-_]} $e iso ex]} {
7553                        set i [lsearch -exact $lcnames $ex]
7554                    }
7555                }
7556                if {$i >= 0} break
7557            }
7558            break
7559        }
7560    }
7561    if {$i >= 0} {
7562        return [lindex $names $i]
7563    }
7564    return {}
7565}
7566
7567# defaults...
7568set datemode 0
7569set diffopts "-U 5 -p"
7570set wrcomcmd "git diff-tree --stdin -p --pretty"
7571
7572set gitencoding {}
7573catch {
7574    set gitencoding [exec git config --get i18n.commitencoding]
7575}
7576if {$gitencoding == ""} {
7577    set gitencoding "utf-8"
7578}
7579set tclencoding [tcl_encoding $gitencoding]
7580if {$tclencoding == {}} {
7581    puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
7582}
7583
7584set mainfont {Helvetica 9}
7585set textfont {Courier 9}
7586set uifont {Helvetica 9 bold}
7587set tabstop 8
7588set findmergefiles 0
7589set maxgraphpct 50
7590set maxwidth 16
7591set revlistorder 0
7592set fastdate 0
7593set uparrowlen 7
7594set downarrowlen 7
7595set mingaplen 30
7596set cmitmode "patch"
7597set wrapcomment "none"
7598set showneartags 1
7599set maxrefs 20
7600set maxlinelen 200
7601set showlocalchanges 1
7602
7603set colors {green red blue magenta darkgrey brown orange}
7604set bgcolor white
7605set fgcolor black
7606set diffcolors {red "#00a000" blue}
7607set selectbgcolor gray85
7608
7609catch {source ~/.gitk}
7610
7611font create optionfont -family sans-serif -size -12
7612
7613# check that we can find a .git directory somewhere...
7614set gitdir [gitdir]
7615if {![file isdirectory $gitdir]} {
7616    show_error {} . "Cannot find the git directory \"$gitdir\"."
7617    exit 1
7618}
7619
7620set revtreeargs {}
7621set cmdline_files {}
7622set i 0
7623foreach arg $argv {
7624    switch -- $arg {
7625        "" { }
7626        "-d" { set datemode 1 }
7627        "--" {
7628            set cmdline_files [lrange $argv [expr {$i + 1}] end]
7629            break
7630        }
7631        default {
7632            lappend revtreeargs $arg
7633        }
7634    }
7635    incr i
7636}
7637
7638if {$i >= [llength $argv] && $revtreeargs ne {}} {
7639    # no -- on command line, but some arguments (other than -d)
7640    if {[catch {
7641        set f [eval exec git rev-parse --no-revs --no-flags $revtreeargs]
7642        set cmdline_files [split $f "\n"]
7643        set n [llength $cmdline_files]
7644        set revtreeargs [lrange $revtreeargs 0 end-$n]
7645        # Unfortunately git rev-parse doesn't produce an error when
7646        # something is both a revision and a filename.  To be consistent
7647        # with git log and git rev-list, check revtreeargs for filenames.
7648        foreach arg $revtreeargs {
7649            if {[file exists $arg]} {
7650                show_error {} . "Ambiguous argument '$arg': both revision\
7651                                 and filename"
7652                exit 1
7653            }
7654        }
7655    } err]} {
7656        # unfortunately we get both stdout and stderr in $err,
7657        # so look for "fatal:".
7658        set i [string first "fatal:" $err]
7659        if {$i > 0} {
7660            set err [string range $err [expr {$i + 6}] end]
7661        }
7662        show_error {} . "Bad arguments to gitk:\n$err"
7663        exit 1
7664    }
7665}
7666
7667set nullid "0000000000000000000000000000000000000000"
7668set nullid2 "0000000000000000000000000000000000000001"
7669
7670
7671set runq {}
7672set history {}
7673set historyindex 0
7674set fh_serial 0
7675set nhl_names {}
7676set highlight_paths {}
7677set searchdirn -forwards
7678set boldrows {}
7679set boldnamerows {}
7680set diffelide {0 0}
7681set markingmatches 0
7682
7683set optim_delay 16
7684
7685set nextviewnum 1
7686set curview 0
7687set selectedview 0
7688set selectedhlview None
7689set viewfiles(0) {}
7690set viewperm(0) 0
7691set viewargs(0) {}
7692
7693set cmdlineok 0
7694set stopped 0
7695set stuffsaved 0
7696set patchnum 0
7697set lookingforhead 0
7698set localirow -1
7699set localfrow -1
7700set lserial 0
7701setcoords
7702makewindow
7703# wait for the window to become visible
7704tkwait visibility .
7705wm title . "[file tail $argv0]: [file tail [pwd]]"
7706readrefs
7707
7708if {$cmdline_files ne {} || $revtreeargs ne {}} {
7709    # create a view for the files/dirs specified on the command line
7710    set curview 1
7711    set selectedview 1
7712    set nextviewnum 2
7713    set viewname(1) "Command line"
7714    set viewfiles(1) $cmdline_files
7715    set viewargs(1) $revtreeargs
7716    set viewperm(1) 0
7717    addviewmenu 1
7718    .bar.view entryconf Edit* -state normal
7719    .bar.view entryconf Delete* -state normal
7720}
7721
7722if {[info exists permviews]} {
7723    foreach v $permviews {
7724        set n $nextviewnum
7725        incr nextviewnum
7726        set viewname($n) [lindex $v 0]
7727        set viewfiles($n) [lindex $v 1]
7728        set viewargs($n) [lindex $v 2]
7729        set viewperm($n) 1
7730        addviewmenu $n
7731    }
7732}
7733getcommits