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