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