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