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