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