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