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