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