gitkon commit gitk: Fix display of "(...)" for parents/children we haven't drawn (b093448)
   1#!/bin/sh
   2# Tcl ignores the next line -*- tcl -*- \
   3exec wish "$0" -- "$@"
   4
   5# Copyright (C) 2005 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 ".git"
  16    }
  17}
  18
  19proc start_rev_list {view} {
  20    global startmsecs nextupdate ncmupdate
  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 ncmupdate 1
  27    set commitidx($view) 0
  28    set args $viewargs($view)
  29    if {$viewfiles($view) ne {}} {
  30        set args [concat $args "--" $viewfiles($view)]
  31    }
  32    set order "--topo-order"
  33    if {$datemode} {
  34        set order "--date-order"
  35    }
  36    if {[catch {
  37        set fd [open [concat | git-rev-list --header $order \
  38                          --parents --boundary --default HEAD $args] r]
  39    } err]} {
  40        puts stderr "Error executing git-rev-list: $err"
  41        exit 1
  42    }
  43    set commfd($view) $fd
  44    set leftover($view) {}
  45    fconfigure $fd -blocking 0 -translation lf
  46    if {$tclencoding != {}} {
  47        fconfigure $fd -encoding $tclencoding
  48    }
  49    fileevent $fd readable [list getcommitlines $fd $view]
  50    nowbusy $view
  51}
  52
  53proc stop_rev_list {} {
  54    global commfd curview
  55
  56    if {![info exists commfd($curview)]} return
  57    set fd $commfd($curview)
  58    catch {
  59        set pid [pid $fd]
  60        exec kill $pid
  61    }
  62    catch {close $fd}
  63    unset commfd($curview)
  64}
  65
  66proc getcommits {} {
  67    global phase canv mainfont curview
  68
  69    set phase getcommits
  70    initlayout
  71    start_rev_list $curview
  72    show_status "Reading commits..."
  73}
  74
  75proc getcommitlines {fd view}  {
  76    global commitlisted nextupdate
  77    global leftover commfd
  78    global displayorder commitidx commitrow commitdata
  79    global parentlist childlist children curview hlview
  80    global vparentlist vchildlist vdisporder vcmitlisted
  81
  82    set stuff [read $fd]
  83    if {$stuff == {}} {
  84        if {![eof $fd]} return
  85        global viewname
  86        unset commfd($view)
  87        notbusy $view
  88        # set it blocking so we wait for the process to terminate
  89        fconfigure $fd -blocking 1
  90        if {[catch {close $fd} err]} {
  91            set fv {}
  92            if {$view != $curview} {
  93                set fv " for the \"$viewname($view)\" view"
  94            }
  95            if {[string range $err 0 4] == "usage"} {
  96                set err "Gitk: error reading commits$fv:\
  97                        bad arguments to git-rev-list."
  98                if {$viewname($view) eq "Command line"} {
  99                    append err \
 100                        "  (Note: arguments to gitk are passed to git-rev-list\
 101                         to allow selection of commits to be displayed.)"
 102                }
 103            } else {
 104                set err "Error reading commits$fv: $err"
 105            }
 106            error_popup $err
 107        }
 108        if {$view == $curview} {
 109            after idle finishcommits
 110        }
 111        return
 112    }
 113    set start 0
 114    set gotsome 0
 115    while 1 {
 116        set i [string first "\0" $stuff $start]
 117        if {$i < 0} {
 118            append leftover($view) [string range $stuff $start end]
 119            break
 120        }
 121        if {$start == 0} {
 122            set cmit $leftover($view)
 123            append cmit [string range $stuff 0 [expr {$i - 1}]]
 124            set leftover($view) {}
 125        } else {
 126            set cmit [string range $stuff $start [expr {$i - 1}]]
 127        }
 128        set start [expr {$i + 1}]
 129        set j [string first "\n" $cmit]
 130        set ok 0
 131        set listed 1
 132        if {$j >= 0} {
 133            set ids [string range $cmit 0 [expr {$j - 1}]]
 134            if {[string range $ids 0 0] == "-"} {
 135                set listed 0
 136                set ids [string range $ids 1 end]
 137            }
 138            set ok 1
 139            foreach id $ids {
 140                if {[string length $id] != 40} {
 141                    set ok 0
 142                    break
 143                }
 144            }
 145        }
 146        if {!$ok} {
 147            set shortcmit $cmit
 148            if {[string length $shortcmit] > 80} {
 149                set shortcmit "[string range $shortcmit 0 80]..."
 150            }
 151            error_popup "Can't parse git-rev-list output: {$shortcmit}"
 152            exit 1
 153        }
 154        set id [lindex $ids 0]
 155        if {$listed} {
 156            set olds [lrange $ids 1 end]
 157            set i 0
 158            foreach p $olds {
 159                if {$i == 0 || [lsearch -exact $olds $p] >= $i} {
 160                    lappend children($view,$p) $id
 161                }
 162                incr i
 163            }
 164        } else {
 165            set olds {}
 166        }
 167        if {![info exists children($view,$id)]} {
 168            set children($view,$id) {}
 169        }
 170        set commitdata($id) [string range $cmit [expr {$j + 1}] end]
 171        set commitrow($view,$id) $commitidx($view)
 172        incr commitidx($view)
 173        if {$view == $curview} {
 174            lappend parentlist $olds
 175            lappend childlist $children($view,$id)
 176            lappend displayorder $id
 177            lappend commitlisted $listed
 178        } else {
 179            lappend vparentlist($view) $olds
 180            lappend vchildlist($view) $children($view,$id)
 181            lappend vdisporder($view) $id
 182            lappend vcmitlisted($view) $listed
 183        }
 184        set gotsome 1
 185    }
 186    if {$gotsome} {
 187        if {$view == $curview} {
 188            layoutmore
 189        } elseif {[info exists hlview] && $view == $hlview} {
 190            highlightmore
 191        }
 192    }
 193    if {[clock clicks -milliseconds] >= $nextupdate} {
 194        doupdate
 195    }
 196}
 197
 198proc doupdate {} {
 199    global commfd nextupdate numcommits ncmupdate
 200
 201    foreach v [array names commfd] {
 202        fileevent $commfd($v) readable {}
 203    }
 204    update
 205    set nextupdate [expr {[clock clicks -milliseconds] + 100}]
 206    if {$numcommits < 100} {
 207        set ncmupdate [expr {$numcommits + 1}]
 208    } elseif {$numcommits < 10000} {
 209        set ncmupdate [expr {$numcommits + 10}]
 210    } else {
 211        set ncmupdate [expr {$numcommits + 100}]
 212    }
 213    foreach v [array names commfd] {
 214        set fd $commfd($v)
 215        fileevent $fd readable [list getcommitlines $fd $v]
 216    }
 217}
 218
 219proc readcommit {id} {
 220    if {[catch {set contents [exec git-cat-file commit $id]}]} return
 221    parsecommit $id $contents 0
 222}
 223
 224proc updatecommits {} {
 225    global viewdata curview phase displayorder
 226    global children commitrow
 227
 228    if {$phase ne {}} {
 229        stop_rev_list
 230        set phase {}
 231    }
 232    set n $curview
 233    foreach id $displayorder {
 234        catch {unset children($n,$id)}
 235        catch {unset commitrow($n,$id)}
 236    }
 237    set curview -1
 238    catch {unset viewdata($n)}
 239    readrefs
 240    showview $n
 241}
 242
 243proc parsecommit {id contents listed} {
 244    global commitinfo cdate
 245
 246    set inhdr 1
 247    set comment {}
 248    set headline {}
 249    set auname {}
 250    set audate {}
 251    set comname {}
 252    set comdate {}
 253    set hdrend [string first "\n\n" $contents]
 254    if {$hdrend < 0} {
 255        # should never happen...
 256        set hdrend [string length $contents]
 257    }
 258    set header [string range $contents 0 [expr {$hdrend - 1}]]
 259    set comment [string range $contents [expr {$hdrend + 2}] end]
 260    foreach line [split $header "\n"] {
 261        set tag [lindex $line 0]
 262        if {$tag == "author"} {
 263            set audate [lindex $line end-1]
 264            set auname [lrange $line 1 end-2]
 265        } elseif {$tag == "committer"} {
 266            set comdate [lindex $line end-1]
 267            set comname [lrange $line 1 end-2]
 268        }
 269    }
 270    set headline {}
 271    # take the first line of the comment as the headline
 272    set i [string first "\n" $comment]
 273    if {$i >= 0} {
 274        set headline [string trim [string range $comment 0 $i]]
 275    } else {
 276        set headline $comment
 277    }
 278    if {!$listed} {
 279        # git-rev-list indents the comment by 4 spaces;
 280        # if we got this via git-cat-file, add the indentation
 281        set newcomment {}
 282        foreach line [split $comment "\n"] {
 283            append newcomment "    "
 284            append newcomment $line
 285            append newcomment "\n"
 286        }
 287        set comment $newcomment
 288    }
 289    if {$comdate != {}} {
 290        set cdate($id) $comdate
 291    }
 292    set commitinfo($id) [list $headline $auname $audate \
 293                             $comname $comdate $comment]
 294}
 295
 296proc getcommit {id} {
 297    global commitdata commitinfo
 298
 299    if {[info exists commitdata($id)]} {
 300        parsecommit $id $commitdata($id) 1
 301    } else {
 302        readcommit $id
 303        if {![info exists commitinfo($id)]} {
 304            set commitinfo($id) {"No commit information available"}
 305        }
 306    }
 307    return 1
 308}
 309
 310proc readrefs {} {
 311    global tagids idtags headids idheads tagcontents
 312    global otherrefids idotherrefs
 313
 314    foreach v {tagids idtags headids idheads otherrefids idotherrefs} {
 315        catch {unset $v}
 316    }
 317    set refd [open [list | git ls-remote [gitdir]] r]
 318    while {0 <= [set n [gets $refd line]]} {
 319        if {![regexp {^([0-9a-f]{40})   refs/([^^]*)$} $line \
 320            match id path]} {
 321            continue
 322        }
 323        if {[regexp {^remotes/.*/HEAD$} $path match]} {
 324            continue
 325        }
 326        if {![regexp {^(tags|heads)/(.*)$} $path match type name]} {
 327            set type others
 328            set name $path
 329        }
 330        if {[regexp {^remotes/} $path match]} {
 331            set type heads
 332        }
 333        if {$type == "tags"} {
 334            set tagids($name) $id
 335            lappend idtags($id) $name
 336            set obj {}
 337            set type {}
 338            set tag {}
 339            catch {
 340                set commit [exec git-rev-parse "$id^0"]
 341                if {"$commit" != "$id"} {
 342                    set tagids($name) $commit
 343                    lappend idtags($commit) $name
 344                }
 345            }           
 346            catch {
 347                set tagcontents($name) [exec git-cat-file tag "$id"]
 348            }
 349        } elseif { $type == "heads" } {
 350            set headids($name) $id
 351            lappend idheads($id) $name
 352        } else {
 353            set otherrefids($name) $id
 354            lappend idotherrefs($id) $name
 355        }
 356    }
 357    close $refd
 358}
 359
 360proc show_error {w msg} {
 361    message $w.m -text $msg -justify center -aspect 400
 362    pack $w.m -side top -fill x -padx 20 -pady 20
 363    button $w.ok -text OK -command "destroy $w"
 364    pack $w.ok -side bottom -fill x
 365    bind $w <Visibility> "grab $w; focus $w"
 366    bind $w <Key-Return> "destroy $w"
 367    tkwait window $w
 368}
 369
 370proc error_popup msg {
 371    set w .error
 372    toplevel $w
 373    wm transient $w .
 374    show_error $w $msg
 375}
 376
 377proc makewindow {} {
 378    global canv canv2 canv3 linespc charspc ctext cflist
 379    global textfont mainfont uifont
 380    global findtype findtypemenu findloc findstring fstring geometry
 381    global entries sha1entry sha1string sha1but
 382    global maincursor textcursor curtextcursor
 383    global rowctxmenu mergemax
 384
 385    menu .bar
 386    .bar add cascade -label "File" -menu .bar.file
 387    .bar configure -font $uifont
 388    menu .bar.file
 389    .bar.file add command -label "Update" -command updatecommits
 390    .bar.file add command -label "Reread references" -command rereadrefs
 391    .bar.file add command -label "Quit" -command doquit
 392    .bar.file configure -font $uifont
 393    menu .bar.edit
 394    .bar add cascade -label "Edit" -menu .bar.edit
 395    .bar.edit add command -label "Preferences" -command doprefs
 396    .bar.edit configure -font $uifont
 397
 398    menu .bar.view -font $uifont
 399    menu .bar.view.hl -font $uifont -tearoff 0
 400    .bar add cascade -label "View" -menu .bar.view
 401    .bar.view add command -label "New view..." -command {newview 0}
 402    .bar.view add command -label "Edit view..." -command editview \
 403        -state disabled
 404    .bar.view add command -label "Delete view" -command delview -state disabled
 405    .bar.view add cascade -label "Highlight" -menu .bar.view.hl
 406    .bar.view add separator
 407    .bar.view add radiobutton -label "All files" -command {showview 0} \
 408        -variable selectedview -value 0
 409    .bar.view.hl add command -label "New view..." -command {newview 1}
 410    .bar.view.hl add command -label "Remove" -command delhighlight \
 411        -state disabled
 412    .bar.view.hl add separator
 413    
 414    menu .bar.help
 415    .bar add cascade -label "Help" -menu .bar.help
 416    .bar.help add command -label "About gitk" -command about
 417    .bar.help add command -label "Key bindings" -command keys
 418    .bar.help configure -font $uifont
 419    . configure -menu .bar
 420
 421    if {![info exists geometry(canv1)]} {
 422        set geometry(canv1) [expr {45 * $charspc}]
 423        set geometry(canv2) [expr {30 * $charspc}]
 424        set geometry(canv3) [expr {15 * $charspc}]
 425        set geometry(canvh) [expr {25 * $linespc + 4}]
 426        set geometry(ctextw) 80
 427        set geometry(ctexth) 30
 428        set geometry(cflistw) 30
 429    }
 430    panedwindow .ctop -orient vertical
 431    if {[info exists geometry(width)]} {
 432        .ctop conf -width $geometry(width) -height $geometry(height)
 433        set texth [expr {$geometry(height) - $geometry(canvh) - 56}]
 434        set geometry(ctexth) [expr {($texth - 8) /
 435                                    [font metrics $textfont -linespace]}]
 436    }
 437    frame .ctop.top
 438    frame .ctop.top.bar
 439    pack .ctop.top.bar -side bottom -fill x
 440    set cscroll .ctop.top.csb
 441    scrollbar $cscroll -command {allcanvs yview} -highlightthickness 0
 442    pack $cscroll -side right -fill y
 443    panedwindow .ctop.top.clist -orient horizontal -sashpad 0 -handlesize 4
 444    pack .ctop.top.clist -side top -fill both -expand 1
 445    .ctop add .ctop.top
 446    set canv .ctop.top.clist.canv
 447    canvas $canv -height $geometry(canvh) -width $geometry(canv1) \
 448        -bg white -bd 0 \
 449        -yscrollincr $linespc -yscrollcommand "scrollcanv $cscroll"
 450    .ctop.top.clist add $canv
 451    set canv2 .ctop.top.clist.canv2
 452    canvas $canv2 -height $geometry(canvh) -width $geometry(canv2) \
 453        -bg white -bd 0 -yscrollincr $linespc
 454    .ctop.top.clist add $canv2
 455    set canv3 .ctop.top.clist.canv3
 456    canvas $canv3 -height $geometry(canvh) -width $geometry(canv3) \
 457        -bg white -bd 0 -yscrollincr $linespc
 458    .ctop.top.clist add $canv3
 459    bind .ctop.top.clist <Configure> {resizeclistpanes %W %w}
 460
 461    set sha1entry .ctop.top.bar.sha1
 462    set entries $sha1entry
 463    set sha1but .ctop.top.bar.sha1label
 464    button $sha1but -text "SHA1 ID: " -state disabled -relief flat \
 465        -command gotocommit -width 8 -font $uifont
 466    $sha1but conf -disabledforeground [$sha1but cget -foreground]
 467    pack .ctop.top.bar.sha1label -side left
 468    entry $sha1entry -width 40 -font $textfont -textvariable sha1string
 469    trace add variable sha1string write sha1change
 470    pack $sha1entry -side left -pady 2
 471
 472    image create bitmap bm-left -data {
 473        #define left_width 16
 474        #define left_height 16
 475        static unsigned char left_bits[] = {
 476        0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,
 477        0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,
 478        0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};
 479    }
 480    image create bitmap bm-right -data {
 481        #define right_width 16
 482        #define right_height 16
 483        static unsigned char right_bits[] = {
 484        0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
 485        0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
 486        0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
 487    }
 488    button .ctop.top.bar.leftbut -image bm-left -command goback \
 489        -state disabled -width 26
 490    pack .ctop.top.bar.leftbut -side left -fill y
 491    button .ctop.top.bar.rightbut -image bm-right -command goforw \
 492        -state disabled -width 26
 493    pack .ctop.top.bar.rightbut -side left -fill y
 494
 495    button .ctop.top.bar.findbut -text "Find" -command dofind -font $uifont
 496    pack .ctop.top.bar.findbut -side left
 497    set findstring {}
 498    set fstring .ctop.top.bar.findstring
 499    lappend entries $fstring
 500    entry $fstring -width 30 -font $textfont -textvariable findstring -font $textfont
 501    pack $fstring -side left -expand 1 -fill x
 502    set findtype Exact
 503    set findtypemenu [tk_optionMenu .ctop.top.bar.findtype \
 504                          findtype Exact IgnCase Regexp]
 505    .ctop.top.bar.findtype configure -font $uifont
 506    .ctop.top.bar.findtype.menu configure -font $uifont
 507    set findloc "All fields"
 508    tk_optionMenu .ctop.top.bar.findloc findloc "All fields" Headline \
 509        Comments Author Committer Files Pickaxe
 510    .ctop.top.bar.findloc configure -font $uifont
 511    .ctop.top.bar.findloc.menu configure -font $uifont
 512
 513    pack .ctop.top.bar.findloc -side right
 514    pack .ctop.top.bar.findtype -side right
 515    # for making sure type==Exact whenever loc==Pickaxe
 516    trace add variable findloc write findlocchange
 517
 518    panedwindow .ctop.cdet -orient horizontal
 519    .ctop add .ctop.cdet
 520    frame .ctop.cdet.left
 521    set ctext .ctop.cdet.left.ctext
 522    text $ctext -bg white -state disabled -font $textfont \
 523        -width $geometry(ctextw) -height $geometry(ctexth) \
 524        -yscrollcommand {.ctop.cdet.left.sb set} -wrap none
 525    scrollbar .ctop.cdet.left.sb -command "$ctext yview"
 526    pack .ctop.cdet.left.sb -side right -fill y
 527    pack $ctext -side left -fill both -expand 1
 528    .ctop.cdet add .ctop.cdet.left
 529
 530    $ctext tag conf filesep -font [concat $textfont bold] -back "#aaaaaa"
 531    $ctext tag conf hunksep -fore blue
 532    $ctext tag conf d0 -fore red
 533    $ctext tag conf d1 -fore "#00a000"
 534    $ctext tag conf m0 -fore red
 535    $ctext tag conf m1 -fore blue
 536    $ctext tag conf m2 -fore green
 537    $ctext tag conf m3 -fore purple
 538    $ctext tag conf m4 -fore brown
 539    $ctext tag conf m5 -fore "#009090"
 540    $ctext tag conf m6 -fore magenta
 541    $ctext tag conf m7 -fore "#808000"
 542    $ctext tag conf m8 -fore "#009000"
 543    $ctext tag conf m9 -fore "#ff0080"
 544    $ctext tag conf m10 -fore cyan
 545    $ctext tag conf m11 -fore "#b07070"
 546    $ctext tag conf m12 -fore "#70b0f0"
 547    $ctext tag conf m13 -fore "#70f0b0"
 548    $ctext tag conf m14 -fore "#f0b070"
 549    $ctext tag conf m15 -fore "#ff70b0"
 550    $ctext tag conf mmax -fore darkgrey
 551    set mergemax 16
 552    $ctext tag conf mresult -font [concat $textfont bold]
 553    $ctext tag conf msep -font [concat $textfont bold]
 554    $ctext tag conf found -back yellow
 555
 556    frame .ctop.cdet.right
 557    frame .ctop.cdet.right.mode
 558    radiobutton .ctop.cdet.right.mode.patch -text "Patch" \
 559        -command reselectline -variable cmitmode -value "patch"
 560    radiobutton .ctop.cdet.right.mode.tree -text "Tree" \
 561        -command reselectline -variable cmitmode -value "tree"
 562    grid .ctop.cdet.right.mode.patch .ctop.cdet.right.mode.tree -sticky ew
 563    pack .ctop.cdet.right.mode -side top -fill x
 564    set cflist .ctop.cdet.right.cfiles
 565    set indent [font measure $mainfont "nn"]
 566    text $cflist -width $geometry(cflistw) -background white -font $mainfont \
 567        -tabs [list $indent [expr {2 * $indent}]] \
 568        -yscrollcommand ".ctop.cdet.right.sb set" \
 569        -cursor [. cget -cursor] \
 570        -spacing1 1 -spacing3 1
 571    scrollbar .ctop.cdet.right.sb -command "$cflist yview"
 572    pack .ctop.cdet.right.sb -side right -fill y
 573    pack $cflist -side left -fill both -expand 1
 574    $cflist tag configure highlight \
 575        -background [$cflist cget -selectbackground]
 576    .ctop.cdet add .ctop.cdet.right
 577    bind .ctop.cdet <Configure> {resizecdetpanes %W %w}
 578
 579    pack .ctop -side top -fill both -expand 1
 580
 581    bindall <1> {selcanvline %W %x %y}
 582    #bindall <B1-Motion> {selcanvline %W %x %y}
 583    bindall <ButtonRelease-4> "allcanvs yview scroll -5 units"
 584    bindall <ButtonRelease-5> "allcanvs yview scroll 5 units"
 585    bindall <2> "canvscan mark %W %x %y"
 586    bindall <B2-Motion> "canvscan dragto %W %x %y"
 587    bindkey <Home> selfirstline
 588    bindkey <End> sellastline
 589    bind . <Key-Up> "selnextline -1"
 590    bind . <Key-Down> "selnextline 1"
 591    bindkey <Key-Right> "goforw"
 592    bindkey <Key-Left> "goback"
 593    bind . <Key-Prior> "selnextpage -1"
 594    bind . <Key-Next> "selnextpage 1"
 595    bind . <Control-Home> "allcanvs yview moveto 0.0"
 596    bind . <Control-End> "allcanvs yview moveto 1.0"
 597    bind . <Control-Key-Up> "allcanvs yview scroll -1 units"
 598    bind . <Control-Key-Down> "allcanvs yview scroll 1 units"
 599    bind . <Control-Key-Prior> "allcanvs yview scroll -1 pages"
 600    bind . <Control-Key-Next> "allcanvs yview scroll 1 pages"
 601    bindkey <Key-Delete> "$ctext yview scroll -1 pages"
 602    bindkey <Key-BackSpace> "$ctext yview scroll -1 pages"
 603    bindkey <Key-space> "$ctext yview scroll 1 pages"
 604    bindkey p "selnextline -1"
 605    bindkey n "selnextline 1"
 606    bindkey z "goback"
 607    bindkey x "goforw"
 608    bindkey i "selnextline -1"
 609    bindkey k "selnextline 1"
 610    bindkey j "goback"
 611    bindkey l "goforw"
 612    bindkey b "$ctext yview scroll -1 pages"
 613    bindkey d "$ctext yview scroll 18 units"
 614    bindkey u "$ctext yview scroll -18 units"
 615    bindkey / {findnext 1}
 616    bindkey <Key-Return> {findnext 0}
 617    bindkey ? findprev
 618    bindkey f nextfile
 619    bind . <Control-q> doquit
 620    bind . <Control-f> dofind
 621    bind . <Control-g> {findnext 0}
 622    bind . <Control-r> findprev
 623    bind . <Control-equal> {incrfont 1}
 624    bind . <Control-KP_Add> {incrfont 1}
 625    bind . <Control-minus> {incrfont -1}
 626    bind . <Control-KP_Subtract> {incrfont -1}
 627    bind . <Destroy> {savestuff %W}
 628    bind . <Button-1> "click %W"
 629    bind $fstring <Key-Return> dofind
 630    bind $sha1entry <Key-Return> gotocommit
 631    bind $sha1entry <<PasteSelection>> clearsha1
 632    bind $cflist <1> {sel_flist %W %x %y; break}
 633    bind $cflist <B1-Motion> {sel_flist %W %x %y; break}
 634    bind $cflist <ButtonRelease-1> {treeclick %W %x %y}
 635
 636    set maincursor [. cget -cursor]
 637    set textcursor [$ctext cget -cursor]
 638    set curtextcursor $textcursor
 639
 640    set rowctxmenu .rowctxmenu
 641    menu $rowctxmenu -tearoff 0
 642    $rowctxmenu add command -label "Diff this -> selected" \
 643        -command {diffvssel 0}
 644    $rowctxmenu add command -label "Diff selected -> this" \
 645        -command {diffvssel 1}
 646    $rowctxmenu add command -label "Make patch" -command mkpatch
 647    $rowctxmenu add command -label "Create tag" -command mktag
 648    $rowctxmenu add command -label "Write commit to file" -command writecommit
 649}
 650
 651# mouse-2 makes all windows scan vertically, but only the one
 652# the cursor is in scans horizontally
 653proc canvscan {op w x y} {
 654    global canv canv2 canv3
 655    foreach c [list $canv $canv2 $canv3] {
 656        if {$c == $w} {
 657            $c scan $op $x $y
 658        } else {
 659            $c scan $op 0 $y
 660        }
 661    }
 662}
 663
 664proc scrollcanv {cscroll f0 f1} {
 665    $cscroll set $f0 $f1
 666    drawfrac $f0 $f1
 667}
 668
 669# when we make a key binding for the toplevel, make sure
 670# it doesn't get triggered when that key is pressed in the
 671# find string entry widget.
 672proc bindkey {ev script} {
 673    global entries
 674    bind . $ev $script
 675    set escript [bind Entry $ev]
 676    if {$escript == {}} {
 677        set escript [bind Entry <Key>]
 678    }
 679    foreach e $entries {
 680        bind $e $ev "$escript; break"
 681    }
 682}
 683
 684# set the focus back to the toplevel for any click outside
 685# the entry widgets
 686proc click {w} {
 687    global entries
 688    foreach e $entries {
 689        if {$w == $e} return
 690    }
 691    focus .
 692}
 693
 694proc savestuff {w} {
 695    global canv canv2 canv3 ctext cflist mainfont textfont uifont
 696    global stuffsaved findmergefiles maxgraphpct
 697    global maxwidth
 698    global viewname viewfiles viewargs viewperm nextviewnum
 699    global cmitmode
 700
 701    if {$stuffsaved} return
 702    if {![winfo viewable .]} return
 703    catch {
 704        set f [open "~/.gitk-new" w]
 705        puts $f [list set mainfont $mainfont]
 706        puts $f [list set textfont $textfont]
 707        puts $f [list set uifont $uifont]
 708        puts $f [list set findmergefiles $findmergefiles]
 709        puts $f [list set maxgraphpct $maxgraphpct]
 710        puts $f [list set maxwidth $maxwidth]
 711        puts $f [list set cmitmode $cmitmode]
 712        puts $f "set geometry(width) [winfo width .ctop]"
 713        puts $f "set geometry(height) [winfo height .ctop]"
 714        puts $f "set geometry(canv1) [expr {[winfo width $canv]-2}]"
 715        puts $f "set geometry(canv2) [expr {[winfo width $canv2]-2}]"
 716        puts $f "set geometry(canv3) [expr {[winfo width $canv3]-2}]"
 717        puts $f "set geometry(canvh) [expr {[winfo height $canv]-2}]"
 718        set wid [expr {([winfo width $ctext] - 8) \
 719                           / [font measure $textfont "0"]}]
 720        puts $f "set geometry(ctextw) $wid"
 721        set wid [expr {([winfo width $cflist] - 11) \
 722                           / [font measure [$cflist cget -font] "0"]}]
 723        puts $f "set geometry(cflistw) $wid"
 724        puts -nonewline $f "set permviews {"
 725        for {set v 0} {$v < $nextviewnum} {incr v} {
 726            if {$viewperm($v)} {
 727                puts $f "{[list $viewname($v) $viewfiles($v) $viewargs($v)]}"
 728            }
 729        }
 730        puts $f "}"
 731        close $f
 732        file rename -force "~/.gitk-new" "~/.gitk"
 733    }
 734    set stuffsaved 1
 735}
 736
 737proc resizeclistpanes {win w} {
 738    global oldwidth
 739    if {[info exists oldwidth($win)]} {
 740        set s0 [$win sash coord 0]
 741        set s1 [$win sash coord 1]
 742        if {$w < 60} {
 743            set sash0 [expr {int($w/2 - 2)}]
 744            set sash1 [expr {int($w*5/6 - 2)}]
 745        } else {
 746            set factor [expr {1.0 * $w / $oldwidth($win)}]
 747            set sash0 [expr {int($factor * [lindex $s0 0])}]
 748            set sash1 [expr {int($factor * [lindex $s1 0])}]
 749            if {$sash0 < 30} {
 750                set sash0 30
 751            }
 752            if {$sash1 < $sash0 + 20} {
 753                set sash1 [expr {$sash0 + 20}]
 754            }
 755            if {$sash1 > $w - 10} {
 756                set sash1 [expr {$w - 10}]
 757                if {$sash0 > $sash1 - 20} {
 758                    set sash0 [expr {$sash1 - 20}]
 759                }
 760            }
 761        }
 762        $win sash place 0 $sash0 [lindex $s0 1]
 763        $win sash place 1 $sash1 [lindex $s1 1]
 764    }
 765    set oldwidth($win) $w
 766}
 767
 768proc resizecdetpanes {win w} {
 769    global oldwidth
 770    if {[info exists oldwidth($win)]} {
 771        set s0 [$win sash coord 0]
 772        if {$w < 60} {
 773            set sash0 [expr {int($w*3/4 - 2)}]
 774        } else {
 775            set factor [expr {1.0 * $w / $oldwidth($win)}]
 776            set sash0 [expr {int($factor * [lindex $s0 0])}]
 777            if {$sash0 < 45} {
 778                set sash0 45
 779            }
 780            if {$sash0 > $w - 15} {
 781                set sash0 [expr {$w - 15}]
 782            }
 783        }
 784        $win sash place 0 $sash0 [lindex $s0 1]
 785    }
 786    set oldwidth($win) $w
 787}
 788
 789proc allcanvs args {
 790    global canv canv2 canv3
 791    eval $canv $args
 792    eval $canv2 $args
 793    eval $canv3 $args
 794}
 795
 796proc bindall {event action} {
 797    global canv canv2 canv3
 798    bind $canv $event $action
 799    bind $canv2 $event $action
 800    bind $canv3 $event $action
 801}
 802
 803proc about {} {
 804    set w .about
 805    if {[winfo exists $w]} {
 806        raise $w
 807        return
 808    }
 809    toplevel $w
 810    wm title $w "About gitk"
 811    message $w.m -text {
 812Gitk - a commit viewer for git
 813
 814Copyright © 2005-2006 Paul Mackerras
 815
 816Use and redistribute under the terms of the GNU General Public License} \
 817            -justify center -aspect 400
 818    pack $w.m -side top -fill x -padx 20 -pady 20
 819    button $w.ok -text Close -command "destroy $w"
 820    pack $w.ok -side bottom
 821}
 822
 823proc keys {} {
 824    set w .keys
 825    if {[winfo exists $w]} {
 826        raise $w
 827        return
 828    }
 829    toplevel $w
 830    wm title $w "Gitk key bindings"
 831    message $w.m -text {
 832Gitk key bindings:
 833
 834<Ctrl-Q>                Quit
 835<Home>          Move to first commit
 836<End>           Move to last commit
 837<Up>, p, i      Move up one commit
 838<Down>, n, k    Move down one commit
 839<Left>, z, j    Go back in history list
 840<Right>, x, l   Go forward in history list
 841<PageUp>        Move up one page in commit list
 842<PageDown>      Move down one page in commit list
 843<Ctrl-Home>     Scroll to top of commit list
 844<Ctrl-End>      Scroll to bottom of commit list
 845<Ctrl-Up>       Scroll commit list up one line
 846<Ctrl-Down>     Scroll commit list down one line
 847<Ctrl-PageUp>   Scroll commit list up one page
 848<Ctrl-PageDown> Scroll commit list down one page
 849<Delete>, b     Scroll diff view up one page
 850<Backspace>     Scroll diff view up one page
 851<Space>         Scroll diff view down one page
 852u               Scroll diff view up 18 lines
 853d               Scroll diff view down 18 lines
 854<Ctrl-F>                Find
 855<Ctrl-G>                Move to next find hit
 856<Ctrl-R>                Move to previous find hit
 857<Return>        Move to next find hit
 858/               Move to next find hit, or redo find
 859?               Move to previous find hit
 860f               Scroll diff view to next file
 861<Ctrl-KP+>      Increase font size
 862<Ctrl-plus>     Increase font size
 863<Ctrl-KP->      Decrease font size
 864<Ctrl-minus>    Decrease font size
 865} \
 866            -justify left -bg white -border 2 -relief sunken
 867    pack $w.m -side top -fill both
 868    button $w.ok -text Close -command "destroy $w"
 869    pack $w.ok -side bottom
 870}
 871
 872# Procedures for manipulating the file list window at the
 873# bottom right of the overall window.
 874
 875proc treeview {w l openlevs} {
 876    global treecontents treediropen treeheight treeparent treeindex
 877
 878    set ix 0
 879    set treeindex() 0
 880    set lev 0
 881    set prefix {}
 882    set prefixend -1
 883    set prefendstack {}
 884    set htstack {}
 885    set ht 0
 886    set treecontents() {}
 887    $w conf -state normal
 888    foreach f $l {
 889        while {[string range $f 0 $prefixend] ne $prefix} {
 890            if {$lev <= $openlevs} {
 891                $w mark set e:$treeindex($prefix) "end -1c"
 892                $w mark gravity e:$treeindex($prefix) left
 893            }
 894            set treeheight($prefix) $ht
 895            incr ht [lindex $htstack end]
 896            set htstack [lreplace $htstack end end]
 897            set prefixend [lindex $prefendstack end]
 898            set prefendstack [lreplace $prefendstack end end]
 899            set prefix [string range $prefix 0 $prefixend]
 900            incr lev -1
 901        }
 902        set tail [string range $f [expr {$prefixend+1}] end]
 903        while {[set slash [string first "/" $tail]] >= 0} {
 904            lappend htstack $ht
 905            set ht 0
 906            lappend prefendstack $prefixend
 907            incr prefixend [expr {$slash + 1}]
 908            set d [string range $tail 0 $slash]
 909            lappend treecontents($prefix) $d
 910            set oldprefix $prefix
 911            append prefix $d
 912            set treecontents($prefix) {}
 913            set treeindex($prefix) [incr ix]
 914            set treeparent($prefix) $oldprefix
 915            set tail [string range $tail [expr {$slash+1}] end]
 916            if {$lev <= $openlevs} {
 917                set ht 1
 918                set treediropen($prefix) [expr {$lev < $openlevs}]
 919                set bm [expr {$lev == $openlevs? "tri-rt": "tri-dn"}]
 920                $w mark set d:$ix "end -1c"
 921                $w mark gravity d:$ix left
 922                set str "\n"
 923                for {set i 0} {$i < $lev} {incr i} {append str "\t"}
 924                $w insert end $str
 925                $w image create end -align center -image $bm -padx 1 \
 926                    -name a:$ix
 927                $w insert end $d
 928                $w mark set s:$ix "end -1c"
 929                $w mark gravity s:$ix left
 930            }
 931            incr lev
 932        }
 933        if {$tail ne {}} {
 934            if {$lev <= $openlevs} {
 935                incr ht
 936                set str "\n"
 937                for {set i 0} {$i < $lev} {incr i} {append str "\t"}
 938                $w insert end $str
 939                $w insert end $tail
 940            }
 941            lappend treecontents($prefix) $tail
 942        }
 943    }
 944    while {$htstack ne {}} {
 945        set treeheight($prefix) $ht
 946        incr ht [lindex $htstack end]
 947        set htstack [lreplace $htstack end end]
 948    }
 949    $w conf -state disabled
 950}
 951
 952proc linetoelt {l} {
 953    global treeheight treecontents
 954
 955    set y 2
 956    set prefix {}
 957    while {1} {
 958        foreach e $treecontents($prefix) {
 959            if {$y == $l} {
 960                return "$prefix$e"
 961            }
 962            set n 1
 963            if {[string index $e end] eq "/"} {
 964                set n $treeheight($prefix$e)
 965                if {$y + $n > $l} {
 966                    append prefix $e
 967                    incr y
 968                    break
 969                }
 970            }
 971            incr y $n
 972        }
 973    }
 974}
 975
 976proc treeclosedir {w dir} {
 977    global treediropen treeheight treeparent treeindex
 978
 979    set ix $treeindex($dir)
 980    $w conf -state normal
 981    $w delete s:$ix e:$ix
 982    set treediropen($dir) 0
 983    $w image configure a:$ix -image tri-rt
 984    $w conf -state disabled
 985    set n [expr {1 - $treeheight($dir)}]
 986    while {$dir ne {}} {
 987        incr treeheight($dir) $n
 988        set dir $treeparent($dir)
 989    }
 990}
 991
 992proc treeopendir {w dir} {
 993    global treediropen treeheight treeparent treecontents treeindex
 994
 995    set ix $treeindex($dir)
 996    $w conf -state normal
 997    $w image configure a:$ix -image tri-dn
 998    $w mark set e:$ix s:$ix
 999    $w mark gravity e:$ix right
1000    set lev 0
1001    set str "\n"
1002    set n [llength $treecontents($dir)]
1003    for {set x $dir} {$x ne {}} {set x $treeparent($x)} {
1004        incr lev
1005        append str "\t"
1006        incr treeheight($x) $n
1007    }
1008    foreach e $treecontents($dir) {
1009        if {[string index $e end] eq "/"} {
1010            set de $dir$e
1011            set iy $treeindex($de)
1012            $w mark set d:$iy e:$ix
1013            $w mark gravity d:$iy left
1014            $w insert e:$ix $str
1015            set treediropen($de) 0
1016            $w image create e:$ix -align center -image tri-rt -padx 1 \
1017                -name a:$iy
1018            $w insert e:$ix $e
1019            $w mark set s:$iy e:$ix
1020            $w mark gravity s:$iy left
1021            set treeheight($de) 1
1022        } else {
1023            $w insert e:$ix $str
1024            $w insert e:$ix $e
1025        }
1026    }
1027    $w mark gravity e:$ix left
1028    $w conf -state disabled
1029    set treediropen($dir) 1
1030    set top [lindex [split [$w index @0,0] .] 0]
1031    set ht [$w cget -height]
1032    set l [lindex [split [$w index s:$ix] .] 0]
1033    if {$l < $top} {
1034        $w yview $l.0
1035    } elseif {$l + $n + 1 > $top + $ht} {
1036        set top [expr {$l + $n + 2 - $ht}]
1037        if {$l < $top} {
1038            set top $l
1039        }
1040        $w yview $top.0
1041    }
1042}
1043
1044proc treeclick {w x y} {
1045    global treediropen cmitmode ctext cflist cflist_top
1046
1047    if {$cmitmode ne "tree"} return
1048    if {![info exists cflist_top]} return
1049    set l [lindex [split [$w index "@$x,$y"] "."] 0]
1050    $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
1051    $cflist tag add highlight $l.0 "$l.0 lineend"
1052    set cflist_top $l
1053    if {$l == 1} {
1054        $ctext yview 1.0
1055        return
1056    }
1057    set e [linetoelt $l]
1058    if {[string index $e end] ne "/"} {
1059        showfile $e
1060    } elseif {$treediropen($e)} {
1061        treeclosedir $w $e
1062    } else {
1063        treeopendir $w $e
1064    }
1065}
1066
1067proc setfilelist {id} {
1068    global treefilelist cflist
1069
1070    treeview $cflist $treefilelist($id) 0
1071}
1072
1073image create bitmap tri-rt -background black -foreground blue -data {
1074    #define tri-rt_width 13
1075    #define tri-rt_height 13
1076    static unsigned char tri-rt_bits[] = {
1077       0x00, 0x00, 0x00, 0x00, 0x10, 0x00, 0x30, 0x00, 0x70, 0x00, 0xf0, 0x00,
1078       0xf0, 0x01, 0xf0, 0x00, 0x70, 0x00, 0x30, 0x00, 0x10, 0x00, 0x00, 0x00,
1079       0x00, 0x00};
1080} -maskdata {
1081    #define tri-rt-mask_width 13
1082    #define tri-rt-mask_height 13
1083    static unsigned char tri-rt-mask_bits[] = {
1084       0x08, 0x00, 0x18, 0x00, 0x38, 0x00, 0x78, 0x00, 0xf8, 0x00, 0xf8, 0x01,
1085       0xf8, 0x03, 0xf8, 0x01, 0xf8, 0x00, 0x78, 0x00, 0x38, 0x00, 0x18, 0x00,
1086       0x08, 0x00};
1087}
1088image create bitmap tri-dn -background black -foreground blue -data {
1089    #define tri-dn_width 13
1090    #define tri-dn_height 13
1091    static unsigned char tri-dn_bits[] = {
1092       0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x07, 0xf8, 0x03,
1093       0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
1094       0x00, 0x00};
1095} -maskdata {
1096    #define tri-dn-mask_width 13
1097    #define tri-dn-mask_height 13
1098    static unsigned char tri-dn-mask_bits[] = {
1099       0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0x1f, 0xfe, 0x0f, 0xfc, 0x07,
1100       0xf8, 0x03, 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00,
1101       0x00, 0x00};
1102}
1103
1104proc init_flist {first} {
1105    global cflist cflist_top selectedline difffilestart
1106
1107    $cflist conf -state normal
1108    $cflist delete 0.0 end
1109    if {$first ne {}} {
1110        $cflist insert end $first
1111        set cflist_top 1
1112        $cflist tag add highlight 1.0 "1.0 lineend"
1113    } else {
1114        catch {unset cflist_top}
1115    }
1116    $cflist conf -state disabled
1117    set difffilestart {}
1118}
1119
1120proc add_flist {fl} {
1121    global flistmode cflist
1122
1123    $cflist conf -state normal
1124    if {$flistmode eq "flat"} {
1125        foreach f $fl {
1126            $cflist insert end "\n$f"
1127        }
1128    }
1129    $cflist conf -state disabled
1130}
1131
1132proc sel_flist {w x y} {
1133    global flistmode ctext difffilestart cflist cflist_top cmitmode
1134
1135    if {$cmitmode eq "tree"} return
1136    if {![info exists cflist_top]} return
1137    set l [lindex [split [$w index "@$x,$y"] "."] 0]
1138    $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
1139    $cflist tag add highlight $l.0 "$l.0 lineend"
1140    set cflist_top $l
1141    if {$l == 1} {
1142        $ctext yview 1.0
1143    } else {
1144        catch {$ctext yview [lindex $difffilestart [expr {$l - 2}]]}
1145    }
1146}
1147
1148# Functions for adding and removing shell-type quoting
1149
1150proc shellquote {str} {
1151    if {![string match "*\['\"\\ \t]*" $str]} {
1152        return $str
1153    }
1154    if {![string match "*\['\"\\]*" $str]} {
1155        return "\"$str\""
1156    }
1157    if {![string match "*'*" $str]} {
1158        return "'$str'"
1159    }
1160    return "\"[string map {\" \\\" \\ \\\\} $str]\""
1161}
1162
1163proc shellarglist {l} {
1164    set str {}
1165    foreach a $l {
1166        if {$str ne {}} {
1167            append str " "
1168        }
1169        append str [shellquote $a]
1170    }
1171    return $str
1172}
1173
1174proc shelldequote {str} {
1175    set ret {}
1176    set used -1
1177    while {1} {
1178        incr used
1179        if {![regexp -start $used -indices "\['\"\\\\ \t]" $str first]} {
1180            append ret [string range $str $used end]
1181            set used [string length $str]
1182            break
1183        }
1184        set first [lindex $first 0]
1185        set ch [string index $str $first]
1186        if {$first > $used} {
1187            append ret [string range $str $used [expr {$first - 1}]]
1188            set used $first
1189        }
1190        if {$ch eq " " || $ch eq "\t"} break
1191        incr used
1192        if {$ch eq "'"} {
1193            set first [string first "'" $str $used]
1194            if {$first < 0} {
1195                error "unmatched single-quote"
1196            }
1197            append ret [string range $str $used [expr {$first - 1}]]
1198            set used $first
1199            continue
1200        }
1201        if {$ch eq "\\"} {
1202            if {$used >= [string length $str]} {
1203                error "trailing backslash"
1204            }
1205            append ret [string index $str $used]
1206            continue
1207        }
1208        # here ch == "\""
1209        while {1} {
1210            if {![regexp -start $used -indices "\[\"\\\\]" $str first]} {
1211                error "unmatched double-quote"
1212            }
1213            set first [lindex $first 0]
1214            set ch [string index $str $first]
1215            if {$first > $used} {
1216                append ret [string range $str $used [expr {$first - 1}]]
1217                set used $first
1218            }
1219            if {$ch eq "\""} break
1220            incr used
1221            append ret [string index $str $used]
1222            incr used
1223        }
1224    }
1225    return [list $used $ret]
1226}
1227
1228proc shellsplit {str} {
1229    set l {}
1230    while {1} {
1231        set str [string trimleft $str]
1232        if {$str eq {}} break
1233        set dq [shelldequote $str]
1234        set n [lindex $dq 0]
1235        set word [lindex $dq 1]
1236        set str [string range $str $n end]
1237        lappend l $word
1238    }
1239    return $l
1240}
1241
1242# Code to implement multiple views
1243
1244proc newview {ishighlight} {
1245    global nextviewnum newviewname newviewperm uifont newishighlight
1246    global newviewargs revtreeargs
1247
1248    set newishighlight $ishighlight
1249    set top .gitkview
1250    if {[winfo exists $top]} {
1251        raise $top
1252        return
1253    }
1254    set newviewname($nextviewnum) "View $nextviewnum"
1255    set newviewperm($nextviewnum) 0
1256    set newviewargs($nextviewnum) [shellarglist $revtreeargs]
1257    vieweditor $top $nextviewnum "Gitk view definition" 
1258}
1259
1260proc editview {} {
1261    global curview
1262    global viewname viewperm newviewname newviewperm
1263    global viewargs newviewargs
1264
1265    set top .gitkvedit-$curview
1266    if {[winfo exists $top]} {
1267        raise $top
1268        return
1269    }
1270    set newviewname($curview) $viewname($curview)
1271    set newviewperm($curview) $viewperm($curview)
1272    set newviewargs($curview) [shellarglist $viewargs($curview)]
1273    vieweditor $top $curview "Gitk: edit view $viewname($curview)"
1274}
1275
1276proc vieweditor {top n title} {
1277    global newviewname newviewperm viewfiles
1278    global uifont
1279
1280    toplevel $top
1281    wm title $top $title
1282    label $top.nl -text "Name" -font $uifont
1283    entry $top.name -width 20 -textvariable newviewname($n)
1284    grid $top.nl $top.name -sticky w -pady 5
1285    checkbutton $top.perm -text "Remember this view" -variable newviewperm($n)
1286    grid $top.perm - -pady 5 -sticky w
1287    message $top.al -aspect 1000 -font $uifont \
1288        -text "Commits to include (arguments to git-rev-list):"
1289    grid $top.al - -sticky w -pady 5
1290    entry $top.args -width 50 -textvariable newviewargs($n) \
1291        -background white
1292    grid $top.args - -sticky ew -padx 5
1293    message $top.l -aspect 1000 -font $uifont \
1294        -text "Enter files and directories to include, one per line:"
1295    grid $top.l - -sticky w
1296    text $top.t -width 40 -height 10 -background white
1297    if {[info exists viewfiles($n)]} {
1298        foreach f $viewfiles($n) {
1299            $top.t insert end $f
1300            $top.t insert end "\n"
1301        }
1302        $top.t delete {end - 1c} end
1303        $top.t mark set insert 0.0
1304    }
1305    grid $top.t - -sticky ew -padx 5
1306    frame $top.buts
1307    button $top.buts.ok -text "OK" -command [list newviewok $top $n]
1308    button $top.buts.can -text "Cancel" -command [list destroy $top]
1309    grid $top.buts.ok $top.buts.can
1310    grid columnconfigure $top.buts 0 -weight 1 -uniform a
1311    grid columnconfigure $top.buts 1 -weight 1 -uniform a
1312    grid $top.buts - -pady 10 -sticky ew
1313    focus $top.t
1314}
1315
1316proc doviewmenu {m first cmd op args} {
1317    set nmenu [$m index end]
1318    for {set i $first} {$i <= $nmenu} {incr i} {
1319        if {[$m entrycget $i -command] eq $cmd} {
1320            eval $m $op $i $args
1321            break
1322        }
1323    }
1324}
1325
1326proc allviewmenus {n op args} {
1327    doviewmenu .bar.view 7 [list showview $n] $op $args
1328    doviewmenu .bar.view.hl 3 [list addhighlight $n] $op $args
1329}
1330
1331proc newviewok {top n} {
1332    global nextviewnum newviewperm newviewname newishighlight
1333    global viewname viewfiles viewperm selectedview curview
1334    global viewargs newviewargs
1335
1336    if {[catch {
1337        set newargs [shellsplit $newviewargs($n)]
1338    } err]} {
1339        error_popup "Error in commit selection arguments: $err"
1340        wm raise $top
1341        focus $top
1342        return
1343    }
1344    set files {}
1345    foreach f [split [$top.t get 0.0 end] "\n"] {
1346        set ft [string trim $f]
1347        if {$ft ne {}} {
1348            lappend files $ft
1349        }
1350    }
1351    if {![info exists viewfiles($n)]} {
1352        # creating a new view
1353        incr nextviewnum
1354        set viewname($n) $newviewname($n)
1355        set viewperm($n) $newviewperm($n)
1356        set viewfiles($n) $files
1357        set viewargs($n) $newargs
1358        addviewmenu $n
1359        if {!$newishighlight} {
1360            after idle showview $n
1361        } else {
1362            after idle addhighlight $n
1363        }
1364    } else {
1365        # editing an existing view
1366        set viewperm($n) $newviewperm($n)
1367        if {$newviewname($n) ne $viewname($n)} {
1368            set viewname($n) $newviewname($n)
1369            allviewmenus $n entryconf -label $viewname($n)
1370        }
1371        if {$files ne $viewfiles($n) || $newargs ne $viewargs($n)} {
1372            set viewfiles($n) $files
1373            set viewargs($n) $newargs
1374            if {$curview == $n} {
1375                after idle updatecommits
1376            }
1377        }
1378    }
1379    catch {destroy $top}
1380}
1381
1382proc delview {} {
1383    global curview viewdata viewperm
1384
1385    if {$curview == 0} return
1386    allviewmenus $curview delete
1387    set viewdata($curview) {}
1388    set viewperm($curview) 0
1389    showview 0
1390}
1391
1392proc addviewmenu {n} {
1393    global viewname
1394
1395    .bar.view add radiobutton -label $viewname($n) \
1396        -command [list showview $n] -variable selectedview -value $n
1397    .bar.view.hl add radiobutton -label $viewname($n) \
1398        -command [list addhighlight $n] -variable selectedhlview -value $n
1399}
1400
1401proc flatten {var} {
1402    global $var
1403
1404    set ret {}
1405    foreach i [array names $var] {
1406        lappend ret $i [set $var\($i\)]
1407    }
1408    return $ret
1409}
1410
1411proc unflatten {var l} {
1412    global $var
1413
1414    catch {unset $var}
1415    foreach {i v} $l {
1416        set $var\($i\) $v
1417    }
1418}
1419
1420proc showview {n} {
1421    global curview viewdata viewfiles
1422    global displayorder parentlist childlist rowidlist rowoffsets
1423    global colormap rowtextx commitrow nextcolor canvxmax
1424    global numcommits rowrangelist commitlisted idrowranges
1425    global selectedline currentid canv canvy0
1426    global matchinglines treediffs
1427    global pending_select phase
1428    global commitidx rowlaidout rowoptim linesegends
1429    global commfd nextupdate
1430    global selectedview hlview selectedhlview
1431    global vparentlist vchildlist vdisporder vcmitlisted
1432
1433    if {$n == $curview} return
1434    set selid {}
1435    if {[info exists selectedline]} {
1436        set selid $currentid
1437        set y [yc $selectedline]
1438        set ymax [lindex [$canv cget -scrollregion] 3]
1439        set span [$canv yview]
1440        set ytop [expr {[lindex $span 0] * $ymax}]
1441        set ybot [expr {[lindex $span 1] * $ymax}]
1442        if {$ytop < $y && $y < $ybot} {
1443            set yscreen [expr {$y - $ytop}]
1444        } else {
1445            set yscreen [expr {($ybot - $ytop) / 2}]
1446        }
1447    }
1448    unselectline
1449    normalline
1450    stopfindproc
1451    if {$curview >= 0} {
1452        set vparentlist($curview) $parentlist
1453        set vchildlist($curview) $childlist
1454        set vdisporder($curview) $displayorder
1455        set vcmitlisted($curview) $commitlisted
1456        if {$phase ne {}} {
1457            set viewdata($curview) \
1458                [list $phase $rowidlist $rowoffsets $rowrangelist \
1459                     [flatten idrowranges] [flatten idinlist] \
1460                     $rowlaidout $rowoptim $numcommits $linesegends]
1461        } elseif {![info exists viewdata($curview)]
1462                  || [lindex $viewdata($curview) 0] ne {}} {
1463            set viewdata($curview) \
1464                [list {} $rowidlist $rowoffsets $rowrangelist]
1465        }
1466    }
1467    catch {unset matchinglines}
1468    catch {unset treediffs}
1469    clear_display
1470
1471    set curview $n
1472    set selectedview $n
1473    set selectedhlview -1
1474    .bar.view entryconf 2 -state [expr {$n == 0? "disabled": "normal"}]
1475    .bar.view entryconf 3 -state [expr {$n == 0? "disabled": "normal"}]
1476    catch {unset hlview}
1477    .bar.view.hl entryconf 1 -state disabled
1478
1479    if {![info exists viewdata($n)]} {
1480        set pending_select $selid
1481        getcommits
1482        return
1483    }
1484
1485    set v $viewdata($n)
1486    set phase [lindex $v 0]
1487    set displayorder $vdisporder($n)
1488    set parentlist $vparentlist($n)
1489    set childlist $vchildlist($n)
1490    set commitlisted $vcmitlisted($n)
1491    set rowidlist [lindex $v 1]
1492    set rowoffsets [lindex $v 2]
1493    set rowrangelist [lindex $v 3]
1494    if {$phase eq {}} {
1495        set numcommits [llength $displayorder]
1496        catch {unset idrowranges}
1497    } else {
1498        unflatten idrowranges [lindex $v 4]
1499        unflatten idinlist [lindex $v 5]
1500        set rowlaidout [lindex $v 6]
1501        set rowoptim [lindex $v 7]
1502        set numcommits [lindex $v 8]
1503        set linesegends [lindex $v 9]
1504    }
1505
1506    catch {unset colormap}
1507    catch {unset rowtextx}
1508    set nextcolor 0
1509    set canvxmax [$canv cget -width]
1510    set curview $n
1511    set row 0
1512    setcanvscroll
1513    set yf 0
1514    set row 0
1515    if {$selid ne {} && [info exists commitrow($n,$selid)]} {
1516        set row $commitrow($n,$selid)
1517        # try to get the selected row in the same position on the screen
1518        set ymax [lindex [$canv cget -scrollregion] 3]
1519        set ytop [expr {[yc $row] - $yscreen}]
1520        if {$ytop < 0} {
1521            set ytop 0
1522        }
1523        set yf [expr {$ytop * 1.0 / $ymax}]
1524    }
1525    allcanvs yview moveto $yf
1526    drawvisible
1527    selectline $row 0
1528    if {$phase ne {}} {
1529        if {$phase eq "getcommits"} {
1530            show_status "Reading commits..."
1531        }
1532        if {[info exists commfd($n)]} {
1533            layoutmore
1534        } else {
1535            finishcommits
1536        }
1537    } elseif {$numcommits == 0} {
1538        show_status "No commits selected"
1539    }
1540}
1541
1542proc addhighlight {n} {
1543    global hlview curview viewdata highlighted highlightedrows
1544    global selectedhlview
1545
1546    if {[info exists hlview]} {
1547        delhighlight
1548    }
1549    set hlview $n
1550    set selectedhlview $n
1551    .bar.view.hl entryconf 1 -state normal
1552    set highlighted($n) 0
1553    set highlightedrows {}
1554    if {$n != $curview && ![info exists viewdata($n)]} {
1555        set viewdata($n) [list getcommits {{}} {{}} {} {} {} 0 0 0 {}]
1556        set vparentlist($n) {}
1557        set vchildlist($n) {}
1558        set vdisporder($n) {}
1559        set vcmitlisted($n) {}
1560        start_rev_list $n
1561    } else {
1562        highlightmore
1563    }
1564}
1565
1566proc delhighlight {} {
1567    global hlview highlightedrows canv linehtag mainfont
1568    global selectedhlview selectedline
1569
1570    if {![info exists hlview]} return
1571    unset hlview
1572    set selectedhlview {}
1573    .bar.view.hl entryconf 1 -state disabled
1574    foreach l $highlightedrows {
1575        $canv itemconf $linehtag($l) -font $mainfont
1576        if {$l == $selectedline} {
1577            $canv delete secsel
1578            set t [eval $canv create rect [$canv bbox $linehtag($l)] \
1579                       -outline {{}} -tags secsel \
1580                       -fill [$canv cget -selectbackground]]
1581            $canv lower $t
1582        }
1583    }
1584}
1585
1586proc highlightmore {} {
1587    global hlview highlighted commitidx highlightedrows linehtag mainfont
1588    global displayorder vdisporder curview canv commitrow selectedline
1589
1590    set font [concat $mainfont bold]
1591    set max $commitidx($hlview)
1592    if {$hlview == $curview} {
1593        set disp $displayorder
1594    } else {
1595        set disp $vdisporder($hlview)
1596    }
1597    for {set i $highlighted($hlview)} {$i < $max} {incr i} {
1598        set id [lindex $disp $i]
1599        if {[info exists commitrow($curview,$id)]} {
1600            set row $commitrow($curview,$id)
1601            if {[info exists linehtag($row)]} {
1602                $canv itemconf $linehtag($row) -font $font
1603                lappend highlightedrows $row
1604                if {$row == $selectedline} {
1605                    $canv delete secsel
1606                    set t [eval $canv create rect \
1607                               [$canv bbox $linehtag($row)] \
1608                               -outline {{}} -tags secsel \
1609                               -fill [$canv cget -selectbackground]]
1610                    $canv lower $t
1611                }
1612            }
1613        }
1614    }
1615    set highlighted($hlview) $max
1616}
1617
1618# Graph layout functions
1619
1620proc shortids {ids} {
1621    set res {}
1622    foreach id $ids {
1623        if {[llength $id] > 1} {
1624            lappend res [shortids $id]
1625        } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
1626            lappend res [string range $id 0 7]
1627        } else {
1628            lappend res $id
1629        }
1630    }
1631    return $res
1632}
1633
1634proc incrange {l x o} {
1635    set n [llength $l]
1636    while {$x < $n} {
1637        set e [lindex $l $x]
1638        if {$e ne {}} {
1639            lset l $x [expr {$e + $o}]
1640        }
1641        incr x
1642    }
1643    return $l
1644}
1645
1646proc ntimes {n o} {
1647    set ret {}
1648    for {} {$n > 0} {incr n -1} {
1649        lappend ret $o
1650    }
1651    return $ret
1652}
1653
1654proc usedinrange {id l1 l2} {
1655    global children commitrow childlist curview
1656
1657    if {[info exists commitrow($curview,$id)]} {
1658        set r $commitrow($curview,$id)
1659        if {$l1 <= $r && $r <= $l2} {
1660            return [expr {$r - $l1 + 1}]
1661        }
1662        set kids [lindex $childlist $r]
1663    } else {
1664        set kids $children($curview,$id)
1665    }
1666    foreach c $kids {
1667        set r $commitrow($curview,$c)
1668        if {$l1 <= $r && $r <= $l2} {
1669            return [expr {$r - $l1 + 1}]
1670        }
1671    }
1672    return 0
1673}
1674
1675proc sanity {row {full 0}} {
1676    global rowidlist rowoffsets
1677
1678    set col -1
1679    set ids [lindex $rowidlist $row]
1680    foreach id $ids {
1681        incr col
1682        if {$id eq {}} continue
1683        if {$col < [llength $ids] - 1 &&
1684            [lsearch -exact -start [expr {$col+1}] $ids $id] >= 0} {
1685            puts "oops: [shortids $id] repeated in row $row col $col: {[shortids [lindex $rowidlist $row]]}"
1686        }
1687        set o [lindex $rowoffsets $row $col]
1688        set y $row
1689        set x $col
1690        while {$o ne {}} {
1691            incr y -1
1692            incr x $o
1693            if {[lindex $rowidlist $y $x] != $id} {
1694                puts "oops: rowoffsets wrong at row [expr {$y+1}] col [expr {$x-$o}]"
1695                puts "  id=[shortids $id] check started at row $row"
1696                for {set i $row} {$i >= $y} {incr i -1} {
1697                    puts "  row $i ids={[shortids [lindex $rowidlist $i]]} offs={[lindex $rowoffsets $i]}"
1698                }
1699                break
1700            }
1701            if {!$full} break
1702            set o [lindex $rowoffsets $y $x]
1703        }
1704    }
1705}
1706
1707proc makeuparrow {oid x y z} {
1708    global rowidlist rowoffsets uparrowlen idrowranges
1709
1710    for {set i 1} {$i < $uparrowlen && $y > 1} {incr i} {
1711        incr y -1
1712        incr x $z
1713        set off0 [lindex $rowoffsets $y]
1714        for {set x0 $x} {1} {incr x0} {
1715            if {$x0 >= [llength $off0]} {
1716                set x0 [llength [lindex $rowoffsets [expr {$y-1}]]]
1717                break
1718            }
1719            set z [lindex $off0 $x0]
1720            if {$z ne {}} {
1721                incr x0 $z
1722                break
1723            }
1724        }
1725        set z [expr {$x0 - $x}]
1726        lset rowidlist $y [linsert [lindex $rowidlist $y] $x $oid]
1727        lset rowoffsets $y [linsert [lindex $rowoffsets $y] $x $z]
1728    }
1729    set tmp [lreplace [lindex $rowoffsets $y] $x $x {}]
1730    lset rowoffsets $y [incrange $tmp [expr {$x+1}] -1]
1731    lappend idrowranges($oid) $y
1732}
1733
1734proc initlayout {} {
1735    global rowidlist rowoffsets displayorder commitlisted
1736    global rowlaidout rowoptim
1737    global idinlist rowchk rowrangelist idrowranges
1738    global numcommits canvxmax canv
1739    global nextcolor
1740    global parentlist childlist children
1741    global colormap rowtextx
1742    global linesegends
1743
1744    set numcommits 0
1745    set displayorder {}
1746    set commitlisted {}
1747    set parentlist {}
1748    set childlist {}
1749    set rowrangelist {}
1750    set nextcolor 0
1751    set rowidlist {{}}
1752    set rowoffsets {{}}
1753    catch {unset idinlist}
1754    catch {unset rowchk}
1755    set rowlaidout 0
1756    set rowoptim 0
1757    set canvxmax [$canv cget -width]
1758    catch {unset colormap}
1759    catch {unset rowtextx}
1760    catch {unset idrowranges}
1761    set linesegends {}
1762}
1763
1764proc setcanvscroll {} {
1765    global canv canv2 canv3 numcommits linespc canvxmax canvy0
1766
1767    set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
1768    $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
1769    $canv2 conf -scrollregion [list 0 0 0 $ymax]
1770    $canv3 conf -scrollregion [list 0 0 0 $ymax]
1771}
1772
1773proc visiblerows {} {
1774    global canv numcommits linespc
1775
1776    set ymax [lindex [$canv cget -scrollregion] 3]
1777    if {$ymax eq {} || $ymax == 0} return
1778    set f [$canv yview]
1779    set y0 [expr {int([lindex $f 0] * $ymax)}]
1780    set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
1781    if {$r0 < 0} {
1782        set r0 0
1783    }
1784    set y1 [expr {int([lindex $f 1] * $ymax)}]
1785    set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
1786    if {$r1 >= $numcommits} {
1787        set r1 [expr {$numcommits - 1}]
1788    }
1789    return [list $r0 $r1]
1790}
1791
1792proc layoutmore {} {
1793    global rowlaidout rowoptim commitidx numcommits optim_delay
1794    global uparrowlen curview
1795
1796    set row $rowlaidout
1797    set rowlaidout [layoutrows $row $commitidx($curview) 0]
1798    set orow [expr {$rowlaidout - $uparrowlen - 1}]
1799    if {$orow > $rowoptim} {
1800        optimize_rows $rowoptim 0 $orow
1801        set rowoptim $orow
1802    }
1803    set canshow [expr {$rowoptim - $optim_delay}]
1804    if {$canshow > $numcommits} {
1805        showstuff $canshow
1806    }
1807}
1808
1809proc showstuff {canshow} {
1810    global numcommits commitrow pending_select selectedline
1811    global linesegends idrowranges idrangedrawn curview
1812
1813    if {$numcommits == 0} {
1814        global phase
1815        set phase "incrdraw"
1816        allcanvs delete all
1817    }
1818    set row $numcommits
1819    set numcommits $canshow
1820    setcanvscroll
1821    set rows [visiblerows]
1822    set r0 [lindex $rows 0]
1823    set r1 [lindex $rows 1]
1824    set selrow -1
1825    for {set r $row} {$r < $canshow} {incr r} {
1826        foreach id [lindex $linesegends [expr {$r+1}]] {
1827            set i -1
1828            foreach {s e} [rowranges $id] {
1829                incr i
1830                if {$e ne {} && $e < $numcommits && $s <= $r1 && $e >= $r0
1831                    && ![info exists idrangedrawn($id,$i)]} {
1832                    drawlineseg $id $i
1833                    set idrangedrawn($id,$i) 1
1834                }
1835            }
1836        }
1837    }
1838    if {$canshow > $r1} {
1839        set canshow $r1
1840    }
1841    while {$row < $canshow} {
1842        drawcmitrow $row
1843        incr row
1844    }
1845    if {[info exists pending_select] &&
1846        [info exists commitrow($curview,$pending_select)] &&
1847        $commitrow($curview,$pending_select) < $numcommits} {
1848        selectline $commitrow($curview,$pending_select) 1
1849    }
1850    if {![info exists selectedline] && ![info exists pending_select]} {
1851        selectline 0 1
1852    }
1853}
1854
1855proc layoutrows {row endrow last} {
1856    global rowidlist rowoffsets displayorder
1857    global uparrowlen downarrowlen maxwidth mingaplen
1858    global childlist parentlist
1859    global idrowranges linesegends
1860    global commitidx curview
1861    global idinlist rowchk rowrangelist
1862
1863    set idlist [lindex $rowidlist $row]
1864    set offs [lindex $rowoffsets $row]
1865    while {$row < $endrow} {
1866        set id [lindex $displayorder $row]
1867        set oldolds {}
1868        set newolds {}
1869        foreach p [lindex $parentlist $row] {
1870            if {![info exists idinlist($p)]} {
1871                lappend newolds $p
1872            } elseif {!$idinlist($p)} {
1873                lappend oldolds $p
1874            }
1875        }
1876        set lse {}
1877        set nev [expr {[llength $idlist] + [llength $newolds]
1878                       + [llength $oldolds] - $maxwidth + 1}]
1879        if {$nev > 0} {
1880            if {!$last &&
1881                $row + $uparrowlen + $mingaplen >= $commitidx($curview)} break
1882            for {set x [llength $idlist]} {[incr x -1] >= 0} {} {
1883                set i [lindex $idlist $x]
1884                if {![info exists rowchk($i)] || $row >= $rowchk($i)} {
1885                    set r [usedinrange $i [expr {$row - $downarrowlen}] \
1886                               [expr {$row + $uparrowlen + $mingaplen}]]
1887                    if {$r == 0} {
1888                        set idlist [lreplace $idlist $x $x]
1889                        set offs [lreplace $offs $x $x]
1890                        set offs [incrange $offs $x 1]
1891                        set idinlist($i) 0
1892                        set rm1 [expr {$row - 1}]
1893                        lappend lse $i
1894                        lappend idrowranges($i) $rm1
1895                        if {[incr nev -1] <= 0} break
1896                        continue
1897                    }
1898                    set rowchk($id) [expr {$row + $r}]
1899                }
1900            }
1901            lset rowidlist $row $idlist
1902            lset rowoffsets $row $offs
1903        }
1904        lappend linesegends $lse
1905        set col [lsearch -exact $idlist $id]
1906        if {$col < 0} {
1907            set col [llength $idlist]
1908            lappend idlist $id
1909            lset rowidlist $row $idlist
1910            set z {}
1911            if {[lindex $childlist $row] ne {}} {
1912                set z [expr {[llength [lindex $rowidlist [expr {$row-1}]]] - $col}]
1913                unset idinlist($id)
1914            }
1915            lappend offs $z
1916            lset rowoffsets $row $offs
1917            if {$z ne {}} {
1918                makeuparrow $id $col $row $z
1919            }
1920        } else {
1921            unset idinlist($id)
1922        }
1923        set ranges {}
1924        if {[info exists idrowranges($id)]} {
1925            set ranges $idrowranges($id)
1926            lappend ranges $row
1927            unset idrowranges($id)
1928        }
1929        lappend rowrangelist $ranges
1930        incr row
1931        set offs [ntimes [llength $idlist] 0]
1932        set l [llength $newolds]
1933        set idlist [eval lreplace \$idlist $col $col $newolds]
1934        set o 0
1935        if {$l != 1} {
1936            set offs [lrange $offs 0 [expr {$col - 1}]]
1937            foreach x $newolds {
1938                lappend offs {}
1939                incr o -1
1940            }
1941            incr o
1942            set tmp [expr {[llength $idlist] - [llength $offs]}]
1943            if {$tmp > 0} {
1944                set offs [concat $offs [ntimes $tmp $o]]
1945            }
1946        } else {
1947            lset offs $col {}
1948        }
1949        foreach i $newolds {
1950            set idinlist($i) 1
1951            set idrowranges($i) $row
1952        }
1953        incr col $l
1954        foreach oid $oldolds {
1955            set idinlist($oid) 1
1956            set idlist [linsert $idlist $col $oid]
1957            set offs [linsert $offs $col $o]
1958            makeuparrow $oid $col $row $o
1959            incr col
1960        }
1961        lappend rowidlist $idlist
1962        lappend rowoffsets $offs
1963    }
1964    return $row
1965}
1966
1967proc addextraid {id row} {
1968    global displayorder commitrow commitinfo
1969    global commitidx commitlisted
1970    global parentlist childlist children curview
1971
1972    incr commitidx($curview)
1973    lappend displayorder $id
1974    lappend commitlisted 0
1975    lappend parentlist {}
1976    set commitrow($curview,$id) $row
1977    readcommit $id
1978    if {![info exists commitinfo($id)]} {
1979        set commitinfo($id) {"No commit information available"}
1980    }
1981    if {![info exists children($curview,$id)]} {
1982        set children($curview,$id) {}
1983    }
1984    lappend childlist $children($curview,$id)
1985}
1986
1987proc layouttail {} {
1988    global rowidlist rowoffsets idinlist commitidx curview
1989    global idrowranges rowrangelist
1990
1991    set row $commitidx($curview)
1992    set idlist [lindex $rowidlist $row]
1993    while {$idlist ne {}} {
1994        set col [expr {[llength $idlist] - 1}]
1995        set id [lindex $idlist $col]
1996        addextraid $id $row
1997        unset idinlist($id)
1998        lappend idrowranges($id) $row
1999        lappend rowrangelist $idrowranges($id)
2000        unset idrowranges($id)
2001        incr row
2002        set offs [ntimes $col 0]
2003        set idlist [lreplace $idlist $col $col]
2004        lappend rowidlist $idlist
2005        lappend rowoffsets $offs
2006    }
2007
2008    foreach id [array names idinlist] {
2009        addextraid $id $row
2010        lset rowidlist $row [list $id]
2011        lset rowoffsets $row 0
2012        makeuparrow $id 0 $row 0
2013        lappend idrowranges($id) $row
2014        lappend rowrangelist $idrowranges($id)
2015        unset idrowranges($id)
2016        incr row
2017        lappend rowidlist {}
2018        lappend rowoffsets {}
2019    }
2020}
2021
2022proc insert_pad {row col npad} {
2023    global rowidlist rowoffsets
2024
2025    set pad [ntimes $npad {}]
2026    lset rowidlist $row [eval linsert [list [lindex $rowidlist $row]] $col $pad]
2027    set tmp [eval linsert [list [lindex $rowoffsets $row]] $col $pad]
2028    lset rowoffsets $row [incrange $tmp [expr {$col + $npad}] [expr {-$npad}]]
2029}
2030
2031proc optimize_rows {row col endrow} {
2032    global rowidlist rowoffsets idrowranges displayorder
2033
2034    for {} {$row < $endrow} {incr row} {
2035        set idlist [lindex $rowidlist $row]
2036        set offs [lindex $rowoffsets $row]
2037        set haspad 0
2038        for {} {$col < [llength $offs]} {incr col} {
2039            if {[lindex $idlist $col] eq {}} {
2040                set haspad 1
2041                continue
2042            }
2043            set z [lindex $offs $col]
2044            if {$z eq {}} continue
2045            set isarrow 0
2046            set x0 [expr {$col + $z}]
2047            set y0 [expr {$row - 1}]
2048            set z0 [lindex $rowoffsets $y0 $x0]
2049            if {$z0 eq {}} {
2050                set id [lindex $idlist $col]
2051                set ranges [rowranges $id]
2052                if {$ranges ne {} && $y0 > [lindex $ranges 0]} {
2053                    set isarrow 1
2054                }
2055            }
2056            if {$z < -1 || ($z < 0 && $isarrow)} {
2057                set npad [expr {-1 - $z + $isarrow}]
2058                set offs [incrange $offs $col $npad]
2059                insert_pad $y0 $x0 $npad
2060                if {$y0 > 0} {
2061                    optimize_rows $y0 $x0 $row
2062                }
2063                set z [lindex $offs $col]
2064                set x0 [expr {$col + $z}]
2065                set z0 [lindex $rowoffsets $y0 $x0]
2066            } elseif {$z > 1 || ($z > 0 && $isarrow)} {
2067                set npad [expr {$z - 1 + $isarrow}]
2068                set y1 [expr {$row + 1}]
2069                set offs2 [lindex $rowoffsets $y1]
2070                set x1 -1
2071                foreach z $offs2 {
2072                    incr x1
2073                    if {$z eq {} || $x1 + $z < $col} continue
2074                    if {$x1 + $z > $col} {
2075                        incr npad
2076                    }
2077                    lset rowoffsets $y1 [incrange $offs2 $x1 $npad]
2078                    break
2079                }
2080                set pad [ntimes $npad {}]
2081                set idlist [eval linsert \$idlist $col $pad]
2082                set tmp [eval linsert \$offs $col $pad]
2083                incr col $npad
2084                set offs [incrange $tmp $col [expr {-$npad}]]
2085                set z [lindex $offs $col]
2086                set haspad 1
2087            }
2088            if {$z0 eq {} && !$isarrow} {
2089                # this line links to its first child on row $row-2
2090                set rm2 [expr {$row - 2}]
2091                set id [lindex $displayorder $rm2]
2092                set xc [lsearch -exact [lindex $rowidlist $rm2] $id]
2093                if {$xc >= 0} {
2094                    set z0 [expr {$xc - $x0}]
2095                }
2096            }
2097            if {$z0 ne {} && $z < 0 && $z0 > 0} {
2098                insert_pad $y0 $x0 1
2099                set offs [incrange $offs $col 1]
2100                optimize_rows $y0 [expr {$x0 + 1}] $row
2101            }
2102        }
2103        if {!$haspad} {
2104            set o {}
2105            for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
2106                set o [lindex $offs $col]
2107                if {$o eq {}} {
2108                    # check if this is the link to the first child
2109                    set id [lindex $idlist $col]
2110                    set ranges [rowranges $id]
2111                    if {$ranges ne {} && $row == [lindex $ranges 0]} {
2112                        # it is, work out offset to child
2113                        set y0 [expr {$row - 1}]
2114                        set id [lindex $displayorder $y0]
2115                        set x0 [lsearch -exact [lindex $rowidlist $y0] $id]
2116                        if {$x0 >= 0} {
2117                            set o [expr {$x0 - $col}]
2118                        }
2119                    }
2120                }
2121                if {$o eq {} || $o <= 0} break
2122            }
2123            if {$o ne {} && [incr col] < [llength $idlist]} {
2124                set y1 [expr {$row + 1}]
2125                set offs2 [lindex $rowoffsets $y1]
2126                set x1 -1
2127                foreach z $offs2 {
2128                    incr x1
2129                    if {$z eq {} || $x1 + $z < $col} continue
2130                    lset rowoffsets $y1 [incrange $offs2 $x1 1]
2131                    break
2132                }
2133                set idlist [linsert $idlist $col {}]
2134                set tmp [linsert $offs $col {}]
2135                incr col
2136                set offs [incrange $tmp $col -1]
2137            }
2138        }
2139        lset rowidlist $row $idlist
2140        lset rowoffsets $row $offs
2141        set col 0
2142    }
2143}
2144
2145proc xc {row col} {
2146    global canvx0 linespc
2147    return [expr {$canvx0 + $col * $linespc}]
2148}
2149
2150proc yc {row} {
2151    global canvy0 linespc
2152    return [expr {$canvy0 + $row * $linespc}]
2153}
2154
2155proc linewidth {id} {
2156    global thickerline lthickness
2157
2158    set wid $lthickness
2159    if {[info exists thickerline] && $id eq $thickerline} {
2160        set wid [expr {2 * $lthickness}]
2161    }
2162    return $wid
2163}
2164
2165proc rowranges {id} {
2166    global phase idrowranges commitrow rowlaidout rowrangelist curview
2167
2168    set ranges {}
2169    if {$phase eq {} ||
2170        ([info exists commitrow($curview,$id)]
2171         && $commitrow($curview,$id) < $rowlaidout)} {
2172        set ranges [lindex $rowrangelist $commitrow($curview,$id)]
2173    } elseif {[info exists idrowranges($id)]} {
2174        set ranges $idrowranges($id)
2175    }
2176    return $ranges
2177}
2178
2179proc drawlineseg {id i} {
2180    global rowoffsets rowidlist
2181    global displayorder
2182    global canv colormap linespc
2183    global numcommits commitrow curview
2184
2185    set ranges [rowranges $id]
2186    set downarrow 1
2187    if {[info exists commitrow($curview,$id)]
2188        && $commitrow($curview,$id) < $numcommits} {
2189        set downarrow [expr {$i < [llength $ranges] / 2 - 1}]
2190    } else {
2191        set downarrow 1
2192    }
2193    set startrow [lindex $ranges [expr {2 * $i}]]
2194    set row [lindex $ranges [expr {2 * $i + 1}]]
2195    if {$startrow == $row} return
2196    assigncolor $id
2197    set coords {}
2198    set col [lsearch -exact [lindex $rowidlist $row] $id]
2199    if {$col < 0} {
2200        puts "oops: drawline: id $id not on row $row"
2201        return
2202    }
2203    set lasto {}
2204    set ns 0
2205    while {1} {
2206        set o [lindex $rowoffsets $row $col]
2207        if {$o eq {}} break
2208        if {$o ne $lasto} {
2209            # changing direction
2210            set x [xc $row $col]
2211            set y [yc $row]
2212            lappend coords $x $y
2213            set lasto $o
2214        }
2215        incr col $o
2216        incr row -1
2217    }
2218    set x [xc $row $col]
2219    set y [yc $row]
2220    lappend coords $x $y
2221    if {$i == 0} {
2222        # draw the link to the first child as part of this line
2223        incr row -1
2224        set child [lindex $displayorder $row]
2225        set ccol [lsearch -exact [lindex $rowidlist $row] $child]
2226        if {$ccol >= 0} {
2227            set x [xc $row $ccol]
2228            set y [yc $row]
2229            if {$ccol < $col - 1} {
2230                lappend coords [xc $row [expr {$col - 1}]] [yc $row]
2231            } elseif {$ccol > $col + 1} {
2232                lappend coords [xc $row [expr {$col + 1}]] [yc $row]
2233            }
2234            lappend coords $x $y
2235        }
2236    }
2237    if {[llength $coords] < 4} return
2238    if {$downarrow} {
2239        # This line has an arrow at the lower end: check if the arrow is
2240        # on a diagonal segment, and if so, work around the Tk 8.4
2241        # refusal to draw arrows on diagonal lines.
2242        set x0 [lindex $coords 0]
2243        set x1 [lindex $coords 2]
2244        if {$x0 != $x1} {
2245            set y0 [lindex $coords 1]
2246            set y1 [lindex $coords 3]
2247            if {$y0 - $y1 <= 2 * $linespc && $x1 == [lindex $coords 4]} {
2248                # we have a nearby vertical segment, just trim off the diag bit
2249                set coords [lrange $coords 2 end]
2250            } else {
2251                set slope [expr {($x0 - $x1) / ($y0 - $y1)}]
2252                set xi [expr {$x0 - $slope * $linespc / 2}]
2253                set yi [expr {$y0 - $linespc / 2}]
2254                set coords [lreplace $coords 0 1 $xi $y0 $xi $yi]
2255            }
2256        }
2257    }
2258    set arrow [expr {2 * ($i > 0) + $downarrow}]
2259    set arrow [lindex {none first last both} $arrow]
2260    set t [$canv create line $coords -width [linewidth $id] \
2261               -fill $colormap($id) -tags lines.$id -arrow $arrow]
2262    $canv lower $t
2263    bindline $t $id
2264}
2265
2266proc drawparentlinks {id row col olds} {
2267    global rowidlist canv colormap
2268
2269    set row2 [expr {$row + 1}]
2270    set x [xc $row $col]
2271    set y [yc $row]
2272    set y2 [yc $row2]
2273    set ids [lindex $rowidlist $row2]
2274    # rmx = right-most X coord used
2275    set rmx 0
2276    foreach p $olds {
2277        set i [lsearch -exact $ids $p]
2278        if {$i < 0} {
2279            puts "oops, parent $p of $id not in list"
2280            continue
2281        }
2282        set x2 [xc $row2 $i]
2283        if {$x2 > $rmx} {
2284            set rmx $x2
2285        }
2286        set ranges [rowranges $p]
2287        if {$ranges ne {} && $row2 == [lindex $ranges 0]
2288            && $row2 < [lindex $ranges 1]} {
2289            # drawlineseg will do this one for us
2290            continue
2291        }
2292        assigncolor $p
2293        # should handle duplicated parents here...
2294        set coords [list $x $y]
2295        if {$i < $col - 1} {
2296            lappend coords [xc $row [expr {$i + 1}]] $y
2297        } elseif {$i > $col + 1} {
2298            lappend coords [xc $row [expr {$i - 1}]] $y
2299        }
2300        lappend coords $x2 $y2
2301        set t [$canv create line $coords -width [linewidth $p] \
2302                   -fill $colormap($p) -tags lines.$p]
2303        $canv lower $t
2304        bindline $t $p
2305    }
2306    return $rmx
2307}
2308
2309proc drawlines {id} {
2310    global colormap canv
2311    global idrangedrawn
2312    global children iddrawn commitrow rowidlist curview
2313
2314    $canv delete lines.$id
2315    set nr [expr {[llength [rowranges $id]] / 2}]
2316    for {set i 0} {$i < $nr} {incr i} {
2317        if {[info exists idrangedrawn($id,$i)]} {
2318            drawlineseg $id $i
2319        }
2320    }
2321    foreach child $children($curview,$id) {
2322        if {[info exists iddrawn($child)]} {
2323            set row $commitrow($curview,$child)
2324            set col [lsearch -exact [lindex $rowidlist $row] $child]
2325            if {$col >= 0} {
2326                drawparentlinks $child $row $col [list $id]
2327            }
2328        }
2329    }
2330}
2331
2332proc drawcmittext {id row col rmx} {
2333    global linespc canv canv2 canv3 canvy0
2334    global commitlisted commitinfo rowidlist
2335    global rowtextx idpos idtags idheads idotherrefs
2336    global linehtag linentag linedtag
2337    global mainfont canvxmax
2338    global hlview commitrow highlightedrows
2339
2340    set ofill [expr {[lindex $commitlisted $row]? "blue": "white"}]
2341    set x [xc $row $col]
2342    set y [yc $row]
2343    set orad [expr {$linespc / 3}]
2344    set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
2345               [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
2346               -fill $ofill -outline black -width 1]
2347    $canv raise $t
2348    $canv bind $t <1> {selcanvline {} %x %y}
2349    set xt [xc $row [llength [lindex $rowidlist $row]]]
2350    if {$xt < $rmx} {
2351        set xt $rmx
2352    }
2353    set rowtextx($row) $xt
2354    set idpos($id) [list $x $xt $y]
2355    if {[info exists idtags($id)] || [info exists idheads($id)]
2356        || [info exists idotherrefs($id)]} {
2357        set xt [drawtags $id $x $xt $y]
2358    }
2359    set headline [lindex $commitinfo($id) 0]
2360    set name [lindex $commitinfo($id) 1]
2361    set date [lindex $commitinfo($id) 2]
2362    set date [formatdate $date]
2363    set font $mainfont
2364    if {[info exists hlview] && [info exists commitrow($hlview,$id)]} {
2365        lappend font bold
2366        lappend highlightedrows $row
2367    }
2368    set linehtag($row) [$canv create text $xt $y -anchor w \
2369                            -text $headline -font $font]
2370    $canv bind $linehtag($row) <Button-3> "rowmenu %X %Y $id"
2371    set linentag($row) [$canv2 create text 3 $y -anchor w \
2372                            -text $name -font $mainfont]
2373    set linedtag($row) [$canv3 create text 3 $y -anchor w \
2374                            -text $date -font $mainfont]
2375    set xr [expr {$xt + [font measure $mainfont $headline]}]
2376    if {$xr > $canvxmax} {
2377        set canvxmax $xr
2378        setcanvscroll
2379    }
2380}
2381
2382proc drawcmitrow {row} {
2383    global displayorder rowidlist
2384    global idrangedrawn iddrawn
2385    global commitinfo parentlist numcommits
2386
2387    if {$row >= $numcommits} return
2388    foreach id [lindex $rowidlist $row] {
2389        if {$id eq {}} continue
2390        set i -1
2391        foreach {s e} [rowranges $id] {
2392            incr i
2393            if {$row < $s} continue
2394            if {$e eq {}} break
2395            if {$row <= $e} {
2396                if {$e < $numcommits && ![info exists idrangedrawn($id,$i)]} {
2397                    drawlineseg $id $i
2398                    set idrangedrawn($id,$i) 1
2399                }
2400                break
2401            }
2402        }
2403    }
2404
2405    set id [lindex $displayorder $row]
2406    if {[info exists iddrawn($id)]} return
2407    set col [lsearch -exact [lindex $rowidlist $row] $id]
2408    if {$col < 0} {
2409        puts "oops, row $row id $id not in list"
2410        return
2411    }
2412    if {![info exists commitinfo($id)]} {
2413        getcommit $id
2414    }
2415    assigncolor $id
2416    set olds [lindex $parentlist $row]
2417    if {$olds ne {}} {
2418        set rmx [drawparentlinks $id $row $col $olds]
2419    } else {
2420        set rmx 0
2421    }
2422    drawcmittext $id $row $col $rmx
2423    set iddrawn($id) 1
2424}
2425
2426proc drawfrac {f0 f1} {
2427    global numcommits canv
2428    global linespc
2429
2430    set ymax [lindex [$canv cget -scrollregion] 3]
2431    if {$ymax eq {} || $ymax == 0} return
2432    set y0 [expr {int($f0 * $ymax)}]
2433    set row [expr {int(($y0 - 3) / $linespc) - 1}]
2434    if {$row < 0} {
2435        set row 0
2436    }
2437    set y1 [expr {int($f1 * $ymax)}]
2438    set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
2439    if {$endrow >= $numcommits} {
2440        set endrow [expr {$numcommits - 1}]
2441    }
2442    for {} {$row <= $endrow} {incr row} {
2443        drawcmitrow $row
2444    }
2445}
2446
2447proc drawvisible {} {
2448    global canv
2449    eval drawfrac [$canv yview]
2450}
2451
2452proc clear_display {} {
2453    global iddrawn idrangedrawn
2454
2455    allcanvs delete all
2456    catch {unset iddrawn}
2457    catch {unset idrangedrawn}
2458}
2459
2460proc findcrossings {id} {
2461    global rowidlist parentlist numcommits rowoffsets displayorder
2462
2463    set cross {}
2464    set ccross {}
2465    foreach {s e} [rowranges $id] {
2466        if {$e >= $numcommits} {
2467            set e [expr {$numcommits - 1}]
2468        }
2469        if {$e <= $s} continue
2470        set x [lsearch -exact [lindex $rowidlist $e] $id]
2471        if {$x < 0} {
2472            puts "findcrossings: oops, no [shortids $id] in row $e"
2473            continue
2474        }
2475        for {set row $e} {[incr row -1] >= $s} {} {
2476            set olds [lindex $parentlist $row]
2477            set kid [lindex $displayorder $row]
2478            set kidx [lsearch -exact [lindex $rowidlist $row] $kid]
2479            if {$kidx < 0} continue
2480            set nextrow [lindex $rowidlist [expr {$row + 1}]]
2481            foreach p $olds {
2482                set px [lsearch -exact $nextrow $p]
2483                if {$px < 0} continue
2484                if {($kidx < $x && $x < $px) || ($px < $x && $x < $kidx)} {
2485                    if {[lsearch -exact $ccross $p] >= 0} continue
2486                    if {$x == $px + ($kidx < $px? -1: 1)} {
2487                        lappend ccross $p
2488                    } elseif {[lsearch -exact $cross $p] < 0} {
2489                        lappend cross $p
2490                    }
2491                }
2492            }
2493            set inc [lindex $rowoffsets $row $x]
2494            if {$inc eq {}} break
2495            incr x $inc
2496        }
2497    }
2498    return [concat $ccross {{}} $cross]
2499}
2500
2501proc assigncolor {id} {
2502    global colormap colors nextcolor
2503    global commitrow parentlist children children curview
2504
2505    if {[info exists colormap($id)]} return
2506    set ncolors [llength $colors]
2507    if {[info exists children($curview,$id)]} {
2508        set kids $children($curview,$id)
2509    } else {
2510        set kids {}
2511    }
2512    if {[llength $kids] == 1} {
2513        set child [lindex $kids 0]
2514        if {[info exists colormap($child)]
2515            && [llength [lindex $parentlist $commitrow($curview,$child)]] == 1} {
2516            set colormap($id) $colormap($child)
2517            return
2518        }
2519    }
2520    set badcolors {}
2521    set origbad {}
2522    foreach x [findcrossings $id] {
2523        if {$x eq {}} {
2524            # delimiter between corner crossings and other crossings
2525            if {[llength $badcolors] >= $ncolors - 1} break
2526            set origbad $badcolors
2527        }
2528        if {[info exists colormap($x)]
2529            && [lsearch -exact $badcolors $colormap($x)] < 0} {
2530            lappend badcolors $colormap($x)
2531        }
2532    }
2533    if {[llength $badcolors] >= $ncolors} {
2534        set badcolors $origbad
2535    }
2536    set origbad $badcolors
2537    if {[llength $badcolors] < $ncolors - 1} {
2538        foreach child $kids {
2539            if {[info exists colormap($child)]
2540                && [lsearch -exact $badcolors $colormap($child)] < 0} {
2541                lappend badcolors $colormap($child)
2542            }
2543            foreach p [lindex $parentlist $commitrow($curview,$child)] {
2544                if {[info exists colormap($p)]
2545                    && [lsearch -exact $badcolors $colormap($p)] < 0} {
2546                    lappend badcolors $colormap($p)
2547                }
2548            }
2549        }
2550        if {[llength $badcolors] >= $ncolors} {
2551            set badcolors $origbad
2552        }
2553    }
2554    for {set i 0} {$i <= $ncolors} {incr i} {
2555        set c [lindex $colors $nextcolor]
2556        if {[incr nextcolor] >= $ncolors} {
2557            set nextcolor 0
2558        }
2559        if {[lsearch -exact $badcolors $c]} break
2560    }
2561    set colormap($id) $c
2562}
2563
2564proc bindline {t id} {
2565    global canv
2566
2567    $canv bind $t <Enter> "lineenter %x %y $id"
2568    $canv bind $t <Motion> "linemotion %x %y $id"
2569    $canv bind $t <Leave> "lineleave $id"
2570    $canv bind $t <Button-1> "lineclick %x %y $id 1"
2571}
2572
2573proc drawtags {id x xt y1} {
2574    global idtags idheads idotherrefs
2575    global linespc lthickness
2576    global canv mainfont commitrow rowtextx curview
2577
2578    set marks {}
2579    set ntags 0
2580    set nheads 0
2581    if {[info exists idtags($id)]} {
2582        set marks $idtags($id)
2583        set ntags [llength $marks]
2584    }
2585    if {[info exists idheads($id)]} {
2586        set marks [concat $marks $idheads($id)]
2587        set nheads [llength $idheads($id)]
2588    }
2589    if {[info exists idotherrefs($id)]} {
2590        set marks [concat $marks $idotherrefs($id)]
2591    }
2592    if {$marks eq {}} {
2593        return $xt
2594    }
2595
2596    set delta [expr {int(0.5 * ($linespc - $lthickness))}]
2597    set yt [expr {$y1 - 0.5 * $linespc}]
2598    set yb [expr {$yt + $linespc - 1}]
2599    set xvals {}
2600    set wvals {}
2601    foreach tag $marks {
2602        set wid [font measure $mainfont $tag]
2603        lappend xvals $xt
2604        lappend wvals $wid
2605        set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
2606    }
2607    set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
2608               -width $lthickness -fill black -tags tag.$id]
2609    $canv lower $t
2610    foreach tag $marks x $xvals wid $wvals {
2611        set xl [expr {$x + $delta}]
2612        set xr [expr {$x + $delta + $wid + $lthickness}]
2613        if {[incr ntags -1] >= 0} {
2614            # draw a tag
2615            set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
2616                       $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
2617                       -width 1 -outline black -fill yellow -tags tag.$id]
2618            $canv bind $t <1> [list showtag $tag 1]
2619            set rowtextx($commitrow($curview,$id)) [expr {$xr + $linespc}]
2620        } else {
2621            # draw a head or other ref
2622            if {[incr nheads -1] >= 0} {
2623                set col green
2624            } else {
2625                set col "#ddddff"
2626            }
2627            set xl [expr {$xl - $delta/2}]
2628            $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
2629                -width 1 -outline black -fill $col -tags tag.$id
2630            if {[regexp {^(remotes/.*/|remotes/)} $tag match remoteprefix]} {
2631                set rwid [font measure $mainfont $remoteprefix]
2632                set xi [expr {$x + 1}]
2633                set yti [expr {$yt + 1}]
2634                set xri [expr {$x + $rwid}]
2635                $canv create polygon $xi $yti $xri $yti $xri $yb $xi $yb \
2636                        -width 0 -fill "#ffddaa" -tags tag.$id
2637            }
2638        }
2639        set t [$canv create text $xl $y1 -anchor w -text $tag \
2640                   -font $mainfont -tags tag.$id]
2641        if {$ntags >= 0} {
2642            $canv bind $t <1> [list showtag $tag 1]
2643        }
2644    }
2645    return $xt
2646}
2647
2648proc xcoord {i level ln} {
2649    global canvx0 xspc1 xspc2
2650
2651    set x [expr {$canvx0 + $i * $xspc1($ln)}]
2652    if {$i > 0 && $i == $level} {
2653        set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
2654    } elseif {$i > $level} {
2655        set x [expr {$x + $xspc2 - $xspc1($ln)}]
2656    }
2657    return $x
2658}
2659
2660proc show_status {msg} {
2661    global canv mainfont
2662
2663    clear_display
2664    $canv create text 3 3 -anchor nw -text $msg -font $mainfont -tags textitems
2665}
2666
2667proc finishcommits {} {
2668    global commitidx phase curview
2669    global canv mainfont ctext maincursor textcursor
2670    global findinprogress pending_select
2671
2672    if {$commitidx($curview) > 0} {
2673        drawrest
2674    } else {
2675        show_status "No commits selected"
2676    }
2677    set phase {}
2678    catch {unset pending_select}
2679}
2680
2681# Don't change the text pane cursor if it is currently the hand cursor,
2682# showing that we are over a sha1 ID link.
2683proc settextcursor {c} {
2684    global ctext curtextcursor
2685
2686    if {[$ctext cget -cursor] == $curtextcursor} {
2687        $ctext config -cursor $c
2688    }
2689    set curtextcursor $c
2690}
2691
2692proc nowbusy {what} {
2693    global isbusy
2694
2695    if {[array names isbusy] eq {}} {
2696        . config -cursor watch
2697        settextcursor watch
2698    }
2699    set isbusy($what) 1
2700}
2701
2702proc notbusy {what} {
2703    global isbusy maincursor textcursor
2704
2705    catch {unset isbusy($what)}
2706    if {[array names isbusy] eq {}} {
2707        . config -cursor $maincursor
2708        settextcursor $textcursor
2709    }
2710}
2711
2712proc drawrest {} {
2713    global numcommits
2714    global startmsecs
2715    global canvy0 numcommits linespc
2716    global rowlaidout commitidx curview
2717    global pending_select
2718
2719    set row $rowlaidout
2720    layoutrows $rowlaidout $commitidx($curview) 1
2721    layouttail
2722    optimize_rows $row 0 $commitidx($curview)
2723    showstuff $commitidx($curview)
2724    if {[info exists pending_select]} {
2725        selectline 0 1
2726    }
2727
2728    set drawmsecs [expr {[clock clicks -milliseconds] - $startmsecs}]
2729    #puts "overall $drawmsecs ms for $numcommits commits"
2730}
2731
2732proc findmatches {f} {
2733    global findtype foundstring foundstrlen
2734    if {$findtype == "Regexp"} {
2735        set matches [regexp -indices -all -inline $foundstring $f]
2736    } else {
2737        if {$findtype == "IgnCase"} {
2738            set str [string tolower $f]
2739        } else {
2740            set str $f
2741        }
2742        set matches {}
2743        set i 0
2744        while {[set j [string first $foundstring $str $i]] >= 0} {
2745            lappend matches [list $j [expr {$j+$foundstrlen-1}]]
2746            set i [expr {$j + $foundstrlen}]
2747        }
2748    }
2749    return $matches
2750}
2751
2752proc dofind {} {
2753    global findtype findloc findstring markedmatches commitinfo
2754    global numcommits displayorder linehtag linentag linedtag
2755    global mainfont canv canv2 canv3 selectedline
2756    global matchinglines foundstring foundstrlen matchstring
2757    global commitdata
2758
2759    stopfindproc
2760    unmarkmatches
2761    focus .
2762    set matchinglines {}
2763    if {$findloc == "Pickaxe"} {
2764        findpatches
2765        return
2766    }
2767    if {$findtype == "IgnCase"} {
2768        set foundstring [string tolower $findstring]
2769    } else {
2770        set foundstring $findstring
2771    }
2772    set foundstrlen [string length $findstring]
2773    if {$foundstrlen == 0} return
2774    regsub -all {[*?\[\\]} $foundstring {\\&} matchstring
2775    set matchstring "*$matchstring*"
2776    if {$findloc == "Files"} {
2777        findfiles
2778        return
2779    }
2780    if {![info exists selectedline]} {
2781        set oldsel -1
2782    } else {
2783        set oldsel $selectedline
2784    }
2785    set didsel 0
2786    set fldtypes {Headline Author Date Committer CDate Comment}
2787    set l -1
2788    foreach id $displayorder {
2789        set d $commitdata($id)
2790        incr l
2791        if {$findtype == "Regexp"} {
2792            set doesmatch [regexp $foundstring $d]
2793        } elseif {$findtype == "IgnCase"} {
2794            set doesmatch [string match -nocase $matchstring $d]
2795        } else {
2796            set doesmatch [string match $matchstring $d]
2797        }
2798        if {!$doesmatch} continue
2799        if {![info exists commitinfo($id)]} {
2800            getcommit $id
2801        }
2802        set info $commitinfo($id)
2803        set doesmatch 0
2804        foreach f $info ty $fldtypes {
2805            if {$findloc != "All fields" && $findloc != $ty} {
2806                continue
2807            }
2808            set matches [findmatches $f]
2809            if {$matches == {}} continue
2810            set doesmatch 1
2811            if {$ty == "Headline"} {
2812                drawcmitrow $l
2813                markmatches $canv $l $f $linehtag($l) $matches $mainfont
2814            } elseif {$ty == "Author"} {
2815                drawcmitrow $l
2816                markmatches $canv2 $l $f $linentag($l) $matches $mainfont
2817            } elseif {$ty == "Date"} {
2818                drawcmitrow $l
2819                markmatches $canv3 $l $f $linedtag($l) $matches $mainfont
2820            }
2821        }
2822        if {$doesmatch} {
2823            lappend matchinglines $l
2824            if {!$didsel && $l > $oldsel} {
2825                findselectline $l
2826                set didsel 1
2827            }
2828        }
2829    }
2830    if {$matchinglines == {}} {
2831        bell
2832    } elseif {!$didsel} {
2833        findselectline [lindex $matchinglines 0]
2834    }
2835}
2836
2837proc findselectline {l} {
2838    global findloc commentend ctext
2839    selectline $l 1
2840    if {$findloc == "All fields" || $findloc == "Comments"} {
2841        # highlight the matches in the comments
2842        set f [$ctext get 1.0 $commentend]
2843        set matches [findmatches $f]
2844        foreach match $matches {
2845            set start [lindex $match 0]
2846            set end [expr {[lindex $match 1] + 1}]
2847            $ctext tag add found "1.0 + $start c" "1.0 + $end c"
2848        }
2849    }
2850}
2851
2852proc findnext {restart} {
2853    global matchinglines selectedline
2854    if {![info exists matchinglines]} {
2855        if {$restart} {
2856            dofind
2857        }
2858        return
2859    }
2860    if {![info exists selectedline]} return
2861    foreach l $matchinglines {
2862        if {$l > $selectedline} {
2863            findselectline $l
2864            return
2865        }
2866    }
2867    bell
2868}
2869
2870proc findprev {} {
2871    global matchinglines selectedline
2872    if {![info exists matchinglines]} {
2873        dofind
2874        return
2875    }
2876    if {![info exists selectedline]} return
2877    set prev {}
2878    foreach l $matchinglines {
2879        if {$l >= $selectedline} break
2880        set prev $l
2881    }
2882    if {$prev != {}} {
2883        findselectline $prev
2884    } else {
2885        bell
2886    }
2887}
2888
2889proc findlocchange {name ix op} {
2890    global findloc findtype findtypemenu
2891    if {$findloc == "Pickaxe"} {
2892        set findtype Exact
2893        set state disabled
2894    } else {
2895        set state normal
2896    }
2897    $findtypemenu entryconf 1 -state $state
2898    $findtypemenu entryconf 2 -state $state
2899}
2900
2901proc stopfindproc {{done 0}} {
2902    global findprocpid findprocfile findids
2903    global ctext findoldcursor phase maincursor textcursor
2904    global findinprogress
2905
2906    catch {unset findids}
2907    if {[info exists findprocpid]} {
2908        if {!$done} {
2909            catch {exec kill $findprocpid}
2910        }
2911        catch {close $findprocfile}
2912        unset findprocpid
2913    }
2914    catch {unset findinprogress}
2915    notbusy find
2916}
2917
2918proc findpatches {} {
2919    global findstring selectedline numcommits
2920    global findprocpid findprocfile
2921    global finddidsel ctext displayorder findinprogress
2922    global findinsertpos
2923
2924    if {$numcommits == 0} return
2925
2926    # make a list of all the ids to search, starting at the one
2927    # after the selected line (if any)
2928    if {[info exists selectedline]} {
2929        set l $selectedline
2930    } else {
2931        set l -1
2932    }
2933    set inputids {}
2934    for {set i 0} {$i < $numcommits} {incr i} {
2935        if {[incr l] >= $numcommits} {
2936            set l 0
2937        }
2938        append inputids [lindex $displayorder $l] "\n"
2939    }
2940
2941    if {[catch {
2942        set f [open [list | git-diff-tree --stdin -s -r -S$findstring \
2943                         << $inputids] r]
2944    } err]} {
2945        error_popup "Error starting search process: $err"
2946        return
2947    }
2948
2949    set findinsertpos end
2950    set findprocfile $f
2951    set findprocpid [pid $f]
2952    fconfigure $f -blocking 0
2953    fileevent $f readable readfindproc
2954    set finddidsel 0
2955    nowbusy find
2956    set findinprogress 1
2957}
2958
2959proc readfindproc {} {
2960    global findprocfile finddidsel
2961    global commitrow matchinglines findinsertpos curview
2962
2963    set n [gets $findprocfile line]
2964    if {$n < 0} {
2965        if {[eof $findprocfile]} {
2966            stopfindproc 1
2967            if {!$finddidsel} {
2968                bell
2969            }
2970        }
2971        return
2972    }
2973    if {![regexp {^[0-9a-f]{40}} $line id]} {
2974        error_popup "Can't parse git-diff-tree output: $line"
2975        stopfindproc
2976        return
2977    }
2978    if {![info exists commitrow($curview,$id)]} {
2979        puts stderr "spurious id: $id"
2980        return
2981    }
2982    set l $commitrow($curview,$id)
2983    insertmatch $l $id
2984}
2985
2986proc insertmatch {l id} {
2987    global matchinglines findinsertpos finddidsel
2988
2989    if {$findinsertpos == "end"} {
2990        if {$matchinglines != {} && $l < [lindex $matchinglines 0]} {
2991            set matchinglines [linsert $matchinglines 0 $l]
2992            set findinsertpos 1
2993        } else {
2994            lappend matchinglines $l
2995        }
2996    } else {
2997        set matchinglines [linsert $matchinglines $findinsertpos $l]
2998        incr findinsertpos
2999    }
3000    markheadline $l $id
3001    if {!$finddidsel} {
3002        findselectline $l
3003        set finddidsel 1
3004    }
3005}
3006
3007proc findfiles {} {
3008    global selectedline numcommits displayorder ctext
3009    global ffileline finddidsel parentlist
3010    global findinprogress findstartline findinsertpos
3011    global treediffs fdiffid fdiffsneeded fdiffpos
3012    global findmergefiles
3013
3014    if {$numcommits == 0} return
3015
3016    if {[info exists selectedline]} {
3017        set l [expr {$selectedline + 1}]
3018    } else {
3019        set l 0
3020    }
3021    set ffileline $l
3022    set findstartline $l
3023    set diffsneeded {}
3024    set fdiffsneeded {}
3025    while 1 {
3026        set id [lindex $displayorder $l]
3027        if {$findmergefiles || [llength [lindex $parentlist $l]] == 1} {
3028            if {![info exists treediffs($id)]} {
3029                append diffsneeded "$id\n"
3030                lappend fdiffsneeded $id
3031            }
3032        }
3033        if {[incr l] >= $numcommits} {
3034            set l 0
3035        }
3036        if {$l == $findstartline} break
3037    }
3038
3039    # start off a git-diff-tree process if needed
3040    if {$diffsneeded ne {}} {
3041        if {[catch {
3042            set df [open [list | git-diff-tree -r --stdin << $diffsneeded] r]
3043        } err ]} {
3044            error_popup "Error starting search process: $err"
3045            return
3046        }
3047        catch {unset fdiffid}
3048        set fdiffpos 0
3049        fconfigure $df -blocking 0
3050        fileevent $df readable [list readfilediffs $df]
3051    }
3052
3053    set finddidsel 0
3054    set findinsertpos end
3055    set id [lindex $displayorder $l]
3056    nowbusy find
3057    set findinprogress 1
3058    findcont
3059    update
3060}
3061
3062proc readfilediffs {df} {
3063    global findid fdiffid fdiffs
3064
3065    set n [gets $df line]
3066    if {$n < 0} {
3067        if {[eof $df]} {
3068            donefilediff
3069            if {[catch {close $df} err]} {
3070                stopfindproc
3071                bell
3072                error_popup "Error in git-diff-tree: $err"
3073            } elseif {[info exists findid]} {
3074                set id $findid
3075                stopfindproc
3076                bell
3077                error_popup "Couldn't find diffs for $id"
3078            }
3079        }
3080        return
3081    }
3082    if {[regexp {^([0-9a-f]{40})$} $line match id]} {
3083        # start of a new string of diffs
3084        donefilediff
3085        set fdiffid $id
3086        set fdiffs {}
3087    } elseif {[string match ":*" $line]} {
3088        lappend fdiffs [lindex $line 5]
3089    }
3090}
3091
3092proc donefilediff {} {
3093    global fdiffid fdiffs treediffs findid
3094    global fdiffsneeded fdiffpos
3095
3096    if {[info exists fdiffid]} {
3097        while {[lindex $fdiffsneeded $fdiffpos] ne $fdiffid
3098               && $fdiffpos < [llength $fdiffsneeded]} {
3099            # git-diff-tree doesn't output anything for a commit
3100            # which doesn't change anything
3101            set nullid [lindex $fdiffsneeded $fdiffpos]
3102            set treediffs($nullid) {}
3103            if {[info exists findid] && $nullid eq $findid} {
3104                unset findid
3105                findcont
3106            }
3107            incr fdiffpos
3108        }
3109        incr fdiffpos
3110
3111        if {![info exists treediffs($fdiffid)]} {
3112            set treediffs($fdiffid) $fdiffs
3113        }
3114        if {[info exists findid] && $fdiffid eq $findid} {
3115            unset findid
3116            findcont
3117        }
3118    }
3119}
3120
3121proc findcont {} {
3122    global findid treediffs parentlist
3123    global ffileline findstartline finddidsel
3124    global displayorder numcommits matchinglines findinprogress
3125    global findmergefiles
3126
3127    set l $ffileline
3128    while {1} {
3129        set id [lindex $displayorder $l]
3130        if {$findmergefiles || [llength [lindex $parentlist $l]] == 1} {
3131            if {![info exists treediffs($id)]} {
3132                set findid $id
3133                set ffileline $l
3134                return
3135            }
3136            set doesmatch 0
3137            foreach f $treediffs($id) {
3138                set x [findmatches $f]
3139                if {$x != {}} {
3140                    set doesmatch 1
3141                    break
3142                }
3143            }
3144            if {$doesmatch} {
3145                insertmatch $l $id
3146            }
3147        }
3148        if {[incr l] >= $numcommits} {
3149            set l 0
3150        }
3151        if {$l == $findstartline} break
3152    }
3153    stopfindproc
3154    if {!$finddidsel} {
3155        bell
3156    }
3157}
3158
3159# mark a commit as matching by putting a yellow background
3160# behind the headline
3161proc markheadline {l id} {
3162    global canv mainfont linehtag
3163
3164    drawcmitrow $l
3165    set bbox [$canv bbox $linehtag($l)]
3166    set t [$canv create rect $bbox -outline {} -tags matches -fill yellow]
3167    $canv lower $t
3168}
3169
3170# mark the bits of a headline, author or date that match a find string
3171proc markmatches {canv l str tag matches font} {
3172    set bbox [$canv bbox $tag]
3173    set x0 [lindex $bbox 0]
3174    set y0 [lindex $bbox 1]
3175    set y1 [lindex $bbox 3]
3176    foreach match $matches {
3177        set start [lindex $match 0]
3178        set end [lindex $match 1]
3179        if {$start > $end} continue
3180        set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
3181        set xlen [font measure $font [string range $str 0 [expr {$end}]]]
3182        set t [$canv create rect [expr {$x0+$xoff}] $y0 \
3183                   [expr {$x0+$xlen+2}] $y1 \
3184                   -outline {} -tags matches -fill yellow]
3185        $canv lower $t
3186    }
3187}
3188
3189proc unmarkmatches {} {
3190    global matchinglines findids
3191    allcanvs delete matches
3192    catch {unset matchinglines}
3193    catch {unset findids}
3194}
3195
3196proc selcanvline {w x y} {
3197    global canv canvy0 ctext linespc
3198    global rowtextx
3199    set ymax [lindex [$canv cget -scrollregion] 3]
3200    if {$ymax == {}} return
3201    set yfrac [lindex [$canv yview] 0]
3202    set y [expr {$y + $yfrac * $ymax}]
3203    set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
3204    if {$l < 0} {
3205        set l 0
3206    }
3207    if {$w eq $canv} {
3208        if {![info exists rowtextx($l)] || $x < $rowtextx($l)} return
3209    }
3210    unmarkmatches
3211    selectline $l 1
3212}
3213
3214proc commit_descriptor {p} {
3215    global commitinfo
3216    if {![info exists commitinfo($p)]} {
3217        getcommit $p
3218    }
3219    set l "..."
3220    if {[llength $commitinfo($p)] > 1} {
3221        set l [lindex $commitinfo($p) 0]
3222    }
3223    return "$p ($l)"
3224}
3225
3226# append some text to the ctext widget, and make any SHA1 ID
3227# that we know about be a clickable link.
3228proc appendwithlinks {text} {
3229    global ctext commitrow linknum curview
3230
3231    set start [$ctext index "end - 1c"]
3232    $ctext insert end $text
3233    $ctext insert end "\n"
3234    set links [regexp -indices -all -inline {[0-9a-f]{40}} $text]
3235    foreach l $links {
3236        set s [lindex $l 0]
3237        set e [lindex $l 1]
3238        set linkid [string range $text $s $e]
3239        if {![info exists commitrow($curview,$linkid)]} continue
3240        incr e
3241        $ctext tag add link "$start + $s c" "$start + $e c"
3242        $ctext tag add link$linknum "$start + $s c" "$start + $e c"
3243        $ctext tag bind link$linknum <1> \
3244            [list selectline $commitrow($curview,$linkid) 1]
3245        incr linknum
3246    }
3247    $ctext tag conf link -foreground blue -underline 1
3248    $ctext tag bind link <Enter> { %W configure -cursor hand2 }
3249    $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
3250}
3251
3252proc viewnextline {dir} {
3253    global canv linespc
3254
3255    $canv delete hover
3256    set ymax [lindex [$canv cget -scrollregion] 3]
3257    set wnow [$canv yview]
3258    set wtop [expr {[lindex $wnow 0] * $ymax}]
3259    set newtop [expr {$wtop + $dir * $linespc}]
3260    if {$newtop < 0} {
3261        set newtop 0
3262    } elseif {$newtop > $ymax} {
3263        set newtop $ymax
3264    }
3265    allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
3266}
3267
3268proc selectline {l isnew} {
3269    global canv canv2 canv3 ctext commitinfo selectedline
3270    global displayorder linehtag linentag linedtag
3271    global canvy0 linespc parentlist childlist
3272    global currentid sha1entry
3273    global commentend idtags linknum
3274    global mergemax numcommits pending_select
3275    global cmitmode
3276
3277    catch {unset pending_select}
3278    $canv delete hover
3279    normalline
3280    if {$l < 0 || $l >= $numcommits} return
3281    set y [expr {$canvy0 + $l * $linespc}]
3282    set ymax [lindex [$canv cget -scrollregion] 3]
3283    set ytop [expr {$y - $linespc - 1}]
3284    set ybot [expr {$y + $linespc + 1}]
3285    set wnow [$canv yview]
3286    set wtop [expr {[lindex $wnow 0] * $ymax}]
3287    set wbot [expr {[lindex $wnow 1] * $ymax}]
3288    set wh [expr {$wbot - $wtop}]
3289    set newtop $wtop
3290    if {$ytop < $wtop} {
3291        if {$ybot < $wtop} {
3292            set newtop [expr {$y - $wh / 2.0}]
3293        } else {
3294            set newtop $ytop
3295            if {$newtop > $wtop - $linespc} {
3296                set newtop [expr {$wtop - $linespc}]
3297            }
3298        }
3299    } elseif {$ybot > $wbot} {
3300        if {$ytop > $wbot} {
3301            set newtop [expr {$y - $wh / 2.0}]
3302        } else {
3303            set newtop [expr {$ybot - $wh}]
3304            if {$newtop < $wtop + $linespc} {
3305                set newtop [expr {$wtop + $linespc}]
3306            }
3307        }
3308    }
3309    if {$newtop != $wtop} {
3310        if {$newtop < 0} {
3311            set newtop 0
3312        }
3313        allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
3314        drawvisible
3315    }
3316
3317    if {![info exists linehtag($l)]} return
3318    $canv delete secsel
3319    set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
3320               -tags secsel -fill [$canv cget -selectbackground]]
3321    $canv lower $t
3322    $canv2 delete secsel
3323    set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
3324               -tags secsel -fill [$canv2 cget -selectbackground]]
3325    $canv2 lower $t
3326    $canv3 delete secsel
3327    set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
3328               -tags secsel -fill [$canv3 cget -selectbackground]]
3329    $canv3 lower $t
3330
3331    if {$isnew} {
3332        addtohistory [list selectline $l 0]
3333    }
3334
3335    set selectedline $l
3336
3337    set id [lindex $displayorder $l]
3338    set currentid $id
3339    $sha1entry delete 0 end
3340    $sha1entry insert 0 $id
3341    $sha1entry selection from 0
3342    $sha1entry selection to end
3343
3344    $ctext conf -state normal
3345    $ctext delete 0.0 end
3346    set linknum 0
3347    set info $commitinfo($id)
3348    set date [formatdate [lindex $info 2]]
3349    $ctext insert end "Author: [lindex $info 1]  $date\n"
3350    set date [formatdate [lindex $info 4]]
3351    $ctext insert end "Committer: [lindex $info 3]  $date\n"
3352    if {[info exists idtags($id)]} {
3353        $ctext insert end "Tags:"
3354        foreach tag $idtags($id) {
3355            $ctext insert end " $tag"
3356        }
3357        $ctext insert end "\n"
3358    }
3359 
3360    set comment {}
3361    set olds [lindex $parentlist $l]
3362    if {[llength $olds] > 1} {
3363        set np 0
3364        foreach p $olds {
3365            if {$np >= $mergemax} {
3366                set tag mmax
3367            } else {
3368                set tag m$np
3369            }
3370            $ctext insert end "Parent: " $tag
3371            appendwithlinks [commit_descriptor $p]
3372            incr np
3373        }
3374    } else {
3375        foreach p $olds {
3376            append comment "Parent: [commit_descriptor $p]\n"
3377        }
3378    }
3379
3380    foreach c [lindex $childlist $l] {
3381        append comment "Child:  [commit_descriptor $c]\n"
3382    }
3383    append comment "\n"
3384    append comment [lindex $info 5]
3385
3386    # make anything that looks like a SHA1 ID be a clickable link
3387    appendwithlinks $comment
3388
3389    $ctext tag delete Comments
3390    $ctext tag remove found 1.0 end
3391    $ctext conf -state disabled
3392    set commentend [$ctext index "end - 1c"]
3393
3394    init_flist "Comments"
3395    if {$cmitmode eq "tree"} {
3396        gettree $id
3397    } elseif {[llength $olds] <= 1} {
3398        startdiff $id
3399    } else {
3400        mergediff $id $l
3401    }
3402}
3403
3404proc selfirstline {} {
3405    unmarkmatches
3406    selectline 0 1
3407}
3408
3409proc sellastline {} {
3410    global numcommits
3411    unmarkmatches
3412    set l [expr {$numcommits - 1}]
3413    selectline $l 1
3414}
3415
3416proc selnextline {dir} {
3417    global selectedline
3418    if {![info exists selectedline]} return
3419    set l [expr {$selectedline + $dir}]
3420    unmarkmatches
3421    selectline $l 1
3422}
3423
3424proc selnextpage {dir} {
3425    global canv linespc selectedline numcommits
3426
3427    set lpp [expr {([winfo height $canv] - 2) / $linespc}]
3428    if {$lpp < 1} {
3429        set lpp 1
3430    }
3431    allcanvs yview scroll [expr {$dir * $lpp}] units
3432    if {![info exists selectedline]} return
3433    set l [expr {$selectedline + $dir * $lpp}]
3434    if {$l < 0} {
3435        set l 0
3436    } elseif {$l >= $numcommits} {
3437        set l [expr $numcommits - 1]
3438    }
3439    unmarkmatches
3440    selectline $l 1    
3441}
3442
3443proc unselectline {} {
3444    global selectedline currentid
3445
3446    catch {unset selectedline}
3447    catch {unset currentid}
3448    allcanvs delete secsel
3449}
3450
3451proc reselectline {} {
3452    global selectedline
3453
3454    if {[info exists selectedline]} {
3455        selectline $selectedline 0
3456    }
3457}
3458
3459proc addtohistory {cmd} {
3460    global history historyindex curview
3461
3462    set elt [list $curview $cmd]
3463    if {$historyindex > 0
3464        && [lindex $history [expr {$historyindex - 1}]] == $elt} {
3465        return
3466    }
3467
3468    if {$historyindex < [llength $history]} {
3469        set history [lreplace $history $historyindex end $elt]
3470    } else {
3471        lappend history $elt
3472    }
3473    incr historyindex
3474    if {$historyindex > 1} {
3475        .ctop.top.bar.leftbut conf -state normal
3476    } else {
3477        .ctop.top.bar.leftbut conf -state disabled
3478    }
3479    .ctop.top.bar.rightbut conf -state disabled
3480}
3481
3482proc godo {elt} {
3483    global curview
3484
3485    set view [lindex $elt 0]
3486    set cmd [lindex $elt 1]
3487    if {$curview != $view} {
3488        showview $view
3489    }
3490    eval $cmd
3491}
3492
3493proc goback {} {
3494    global history historyindex
3495
3496    if {$historyindex > 1} {
3497        incr historyindex -1
3498        godo [lindex $history [expr {$historyindex - 1}]]
3499        .ctop.top.bar.rightbut conf -state normal
3500    }
3501    if {$historyindex <= 1} {
3502        .ctop.top.bar.leftbut conf -state disabled
3503    }
3504}
3505
3506proc goforw {} {
3507    global history historyindex
3508
3509    if {$historyindex < [llength $history]} {
3510        set cmd [lindex $history $historyindex]
3511        incr historyindex
3512        godo $cmd
3513        .ctop.top.bar.leftbut conf -state normal
3514    }
3515    if {$historyindex >= [llength $history]} {
3516        .ctop.top.bar.rightbut conf -state disabled
3517    }
3518}
3519
3520proc gettree {id} {
3521    global treefilelist treeidlist diffids diffmergeid treepending
3522
3523    set diffids $id
3524    catch {unset diffmergeid}
3525    if {![info exists treefilelist($id)]} {
3526        if {![info exists treepending]} {
3527            if {[catch {set gtf [open [concat | git-ls-tree -r $id] r]}]} {
3528                return
3529            }
3530            set treepending $id
3531            set treefilelist($id) {}
3532            set treeidlist($id) {}
3533            fconfigure $gtf -blocking 0
3534            fileevent $gtf readable [list gettreeline $gtf $id]
3535        }
3536    } else {
3537        setfilelist $id
3538    }
3539}
3540
3541proc gettreeline {gtf id} {
3542    global treefilelist treeidlist treepending cmitmode diffids
3543
3544    while {[gets $gtf line] >= 0} {
3545        if {[lindex $line 1] ne "blob"} continue
3546        set sha1 [lindex $line 2]
3547        set fname [lindex $line 3]
3548        lappend treefilelist($id) $fname
3549        lappend treeidlist($id) $sha1
3550    }
3551    if {![eof $gtf]} return
3552    close $gtf
3553    unset treepending
3554    if {$cmitmode ne "tree"} {
3555        if {![info exists diffmergeid]} {
3556            gettreediffs $diffids
3557        }
3558    } elseif {$id ne $diffids} {
3559        gettree $diffids
3560    } else {
3561        setfilelist $id
3562    }
3563}
3564
3565proc showfile {f} {
3566    global treefilelist treeidlist diffids
3567    global ctext commentend
3568
3569    set i [lsearch -exact $treefilelist($diffids) $f]
3570    if {$i < 0} {
3571        puts "oops, $f not in list for id $diffids"
3572        return
3573    }
3574    set blob [lindex $treeidlist($diffids) $i]
3575    if {[catch {set bf [open [concat | git-cat-file blob $blob] r]} err]} {
3576        puts "oops, error reading blob $blob: $err"
3577        return
3578    }
3579    fconfigure $bf -blocking 0
3580    fileevent $bf readable [list getblobline $bf $diffids]
3581    $ctext config -state normal
3582    $ctext delete $commentend end
3583    $ctext insert end "\n"
3584    $ctext insert end "$f\n" filesep
3585    $ctext config -state disabled
3586    $ctext yview $commentend
3587}
3588
3589proc getblobline {bf id} {
3590    global diffids cmitmode ctext
3591
3592    if {$id ne $diffids || $cmitmode ne "tree"} {
3593        catch {close $bf}
3594        return
3595    }
3596    $ctext config -state normal
3597    while {[gets $bf line] >= 0} {
3598        $ctext insert end "$line\n"
3599    }
3600    if {[eof $bf]} {
3601        # delete last newline
3602        $ctext delete "end - 2c" "end - 1c"
3603        close $bf
3604    }
3605    $ctext config -state disabled
3606}
3607
3608proc mergediff {id l} {
3609    global diffmergeid diffopts mdifffd
3610    global diffids
3611    global parentlist
3612
3613    set diffmergeid $id
3614    set diffids $id
3615    # this doesn't seem to actually affect anything...
3616    set env(GIT_DIFF_OPTS) $diffopts
3617    set cmd [concat | git-diff-tree --no-commit-id --cc $id]
3618    if {[catch {set mdf [open $cmd r]} err]} {
3619        error_popup "Error getting merge diffs: $err"
3620        return
3621    }
3622    fconfigure $mdf -blocking 0
3623    set mdifffd($id) $mdf
3624    set np [llength [lindex $parentlist $l]]
3625    fileevent $mdf readable [list getmergediffline $mdf $id $np]
3626    set nextupdate [expr {[clock clicks -milliseconds] + 100}]
3627}
3628
3629proc getmergediffline {mdf id np} {
3630    global diffmergeid ctext cflist nextupdate mergemax
3631    global difffilestart mdifffd
3632
3633    set n [gets $mdf line]
3634    if {$n < 0} {
3635        if {[eof $mdf]} {
3636            close $mdf
3637        }
3638        return
3639    }
3640    if {![info exists diffmergeid] || $id != $diffmergeid
3641        || $mdf != $mdifffd($id)} {
3642        return
3643    }
3644    $ctext conf -state normal
3645    if {[regexp {^diff --cc (.*)} $line match fname]} {
3646        # start of a new file
3647        $ctext insert end "\n"
3648        set here [$ctext index "end - 1c"]
3649        lappend difffilestart $here
3650        add_flist [list $fname]
3651        set l [expr {(78 - [string length $fname]) / 2}]
3652        set pad [string range "----------------------------------------" 1 $l]
3653        $ctext insert end "$pad $fname $pad\n" filesep
3654    } elseif {[regexp {^@@} $line]} {
3655        $ctext insert end "$line\n" hunksep
3656    } elseif {[regexp {^[0-9a-f]{40}$} $line] || [regexp {^index} $line]} {
3657        # do nothing
3658    } else {
3659        # parse the prefix - one ' ', '-' or '+' for each parent
3660        set spaces {}
3661        set minuses {}
3662        set pluses {}
3663        set isbad 0
3664        for {set j 0} {$j < $np} {incr j} {
3665            set c [string range $line $j $j]
3666            if {$c == " "} {
3667                lappend spaces $j
3668            } elseif {$c == "-"} {
3669                lappend minuses $j
3670            } elseif {$c == "+"} {
3671                lappend pluses $j
3672            } else {
3673                set isbad 1
3674                break
3675            }
3676        }
3677        set tags {}
3678        set num {}
3679        if {!$isbad && $minuses ne {} && $pluses eq {}} {
3680            # line doesn't appear in result, parents in $minuses have the line
3681            set num [lindex $minuses 0]
3682        } elseif {!$isbad && $pluses ne {} && $minuses eq {}} {
3683            # line appears in result, parents in $pluses don't have the line
3684            lappend tags mresult
3685            set num [lindex $spaces 0]
3686        }
3687        if {$num ne {}} {
3688            if {$num >= $mergemax} {
3689                set num "max"
3690            }
3691            lappend tags m$num
3692        }
3693        $ctext insert end "$line\n" $tags
3694    }
3695    $ctext conf -state disabled
3696    if {[clock clicks -milliseconds] >= $nextupdate} {
3697        incr nextupdate 100
3698        fileevent $mdf readable {}
3699        update
3700        fileevent $mdf readable [list getmergediffline $mdf $id $np]
3701    }
3702}
3703
3704proc startdiff {ids} {
3705    global treediffs diffids treepending diffmergeid
3706
3707    set diffids $ids
3708    catch {unset diffmergeid}
3709    if {![info exists treediffs($ids)]} {
3710        if {![info exists treepending]} {
3711            gettreediffs $ids
3712        }
3713    } else {
3714        addtocflist $ids
3715    }
3716}
3717
3718proc addtocflist {ids} {
3719    global treediffs cflist
3720    add_flist $treediffs($ids)
3721    getblobdiffs $ids
3722}
3723
3724proc gettreediffs {ids} {
3725    global treediff treepending
3726    set treepending $ids
3727    set treediff {}
3728    if {[catch \
3729         {set gdtf [open [concat | git-diff-tree --no-commit-id -r $ids] r]} \
3730        ]} return
3731    fconfigure $gdtf -blocking 0
3732    fileevent $gdtf readable [list gettreediffline $gdtf $ids]
3733}
3734
3735proc gettreediffline {gdtf ids} {
3736    global treediff treediffs treepending diffids diffmergeid
3737    global cmitmode
3738
3739    set n [gets $gdtf line]
3740    if {$n < 0} {
3741        if {![eof $gdtf]} return
3742        close $gdtf
3743        set treediffs($ids) $treediff
3744        unset treepending
3745        if {$cmitmode eq "tree"} {
3746            gettree $diffids
3747        } elseif {$ids != $diffids} {
3748            if {![info exists diffmergeid]} {
3749                gettreediffs $diffids
3750            }
3751        } else {
3752            addtocflist $ids
3753        }
3754        return
3755    }
3756    set file [lindex $line 5]
3757    lappend treediff $file
3758}
3759
3760proc getblobdiffs {ids} {
3761    global diffopts blobdifffd diffids env curdifftag curtagstart
3762    global nextupdate diffinhdr treediffs
3763
3764    set env(GIT_DIFF_OPTS) $diffopts
3765    set cmd [concat | git-diff-tree --no-commit-id -r -p -C $ids]
3766    if {[catch {set bdf [open $cmd r]} err]} {
3767        puts "error getting diffs: $err"
3768        return
3769    }
3770    set diffinhdr 0
3771    fconfigure $bdf -blocking 0
3772    set blobdifffd($ids) $bdf
3773    set curdifftag Comments
3774    set curtagstart 0.0
3775    fileevent $bdf readable [list getblobdiffline $bdf $diffids]
3776    set nextupdate [expr {[clock clicks -milliseconds] + 100}]
3777}
3778
3779proc setinlist {var i val} {
3780    global $var
3781
3782    while {[llength [set $var]] < $i} {
3783        lappend $var {}
3784    }
3785    if {[llength [set $var]] == $i} {
3786        lappend $var $val
3787    } else {
3788        lset $var $i $val
3789    }
3790}
3791
3792proc getblobdiffline {bdf ids} {
3793    global diffids blobdifffd ctext curdifftag curtagstart
3794    global diffnexthead diffnextnote difffilestart
3795    global nextupdate diffinhdr treediffs
3796
3797    set n [gets $bdf line]
3798    if {$n < 0} {
3799        if {[eof $bdf]} {
3800            close $bdf
3801            if {$ids == $diffids && $bdf == $blobdifffd($ids)} {
3802                $ctext tag add $curdifftag $curtagstart end
3803            }
3804        }
3805        return
3806    }
3807    if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
3808        return
3809    }
3810    $ctext conf -state normal
3811    if {[regexp {^diff --git a/(.*) b/(.*)} $line match fname newname]} {
3812        # start of a new file
3813        $ctext insert end "\n"
3814        $ctext tag add $curdifftag $curtagstart end
3815        set here [$ctext index "end - 1c"]
3816        set curtagstart $here
3817        set header $newname
3818        set i [lsearch -exact $treediffs($ids) $fname]
3819        if {$i >= 0} {
3820            setinlist difffilestart $i $here
3821        }
3822        if {$newname ne $fname} {
3823            set i [lsearch -exact $treediffs($ids) $newname]
3824            if {$i >= 0} {
3825                setinlist difffilestart $i $here
3826            }
3827        }
3828        set curdifftag "f:$fname"
3829        $ctext tag delete $curdifftag
3830        set l [expr {(78 - [string length $header]) / 2}]
3831        set pad [string range "----------------------------------------" 1 $l]
3832        $ctext insert end "$pad $header $pad\n" filesep
3833        set diffinhdr 1
3834    } elseif {$diffinhdr && [string compare -length 3 $line "---"] == 0} {
3835        # do nothing
3836    } elseif {$diffinhdr && [string compare -length 3 $line "+++"] == 0} {
3837        set diffinhdr 0
3838    } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \
3839                   $line match f1l f1c f2l f2c rest]} {
3840        $ctext insert end "$line\n" hunksep
3841        set diffinhdr 0
3842    } else {
3843        set x [string range $line 0 0]
3844        if {$x == "-" || $x == "+"} {
3845            set tag [expr {$x == "+"}]
3846            $ctext insert end "$line\n" d$tag
3847        } elseif {$x == " "} {
3848            $ctext insert end "$line\n"
3849        } elseif {$diffinhdr || $x == "\\"} {
3850            # e.g. "\ No newline at end of file"
3851            $ctext insert end "$line\n" filesep
3852        } else {
3853            # Something else we don't recognize
3854            if {$curdifftag != "Comments"} {
3855                $ctext insert end "\n"
3856                $ctext tag add $curdifftag $curtagstart end
3857                set curtagstart [$ctext index "end - 1c"]
3858                set curdifftag Comments
3859            }
3860            $ctext insert end "$line\n" filesep
3861        }
3862    }
3863    $ctext conf -state disabled
3864    if {[clock clicks -milliseconds] >= $nextupdate} {
3865        incr nextupdate 100
3866        fileevent $bdf readable {}
3867        update
3868        fileevent $bdf readable "getblobdiffline $bdf {$ids}"
3869    }
3870}
3871
3872proc nextfile {} {
3873    global difffilestart ctext
3874    set here [$ctext index @0,0]
3875    foreach loc $difffilestart {
3876        if {[$ctext compare $loc > $here]} {
3877            $ctext yview $loc
3878        }
3879    }
3880}
3881
3882proc setcoords {} {
3883    global linespc charspc canvx0 canvy0 mainfont
3884    global xspc1 xspc2 lthickness
3885
3886    set linespc [font metrics $mainfont -linespace]
3887    set charspc [font measure $mainfont "m"]
3888    set canvy0 [expr {int(3 + 0.5 * $linespc)}]
3889    set canvx0 [expr {int(3 + 0.5 * $linespc)}]
3890    set lthickness [expr {int($linespc / 9) + 1}]
3891    set xspc1(0) $linespc
3892    set xspc2 $linespc
3893}
3894
3895proc redisplay {} {
3896    global canv
3897    global selectedline
3898
3899    set ymax [lindex [$canv cget -scrollregion] 3]
3900    if {$ymax eq {} || $ymax == 0} return
3901    set span [$canv yview]
3902    clear_display
3903    setcanvscroll
3904    allcanvs yview moveto [lindex $span 0]
3905    drawvisible
3906    if {[info exists selectedline]} {
3907        selectline $selectedline 0
3908    }
3909}
3910
3911proc incrfont {inc} {
3912    global mainfont textfont ctext canv phase
3913    global stopped entries
3914    unmarkmatches
3915    set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
3916    set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
3917    setcoords
3918    $ctext conf -font $textfont
3919    $ctext tag conf filesep -font [concat $textfont bold]
3920    foreach e $entries {
3921        $e conf -font $mainfont
3922    }
3923    if {$phase eq "getcommits"} {
3924        $canv itemconf textitems -font $mainfont
3925    }
3926    redisplay
3927}
3928
3929proc clearsha1 {} {
3930    global sha1entry sha1string
3931    if {[string length $sha1string] == 40} {
3932        $sha1entry delete 0 end
3933    }
3934}
3935
3936proc sha1change {n1 n2 op} {
3937    global sha1string currentid sha1but
3938    if {$sha1string == {}
3939        || ([info exists currentid] && $sha1string == $currentid)} {
3940        set state disabled
3941    } else {
3942        set state normal
3943    }
3944    if {[$sha1but cget -state] == $state} return
3945    if {$state == "normal"} {
3946        $sha1but conf -state normal -relief raised -text "Goto: "
3947    } else {
3948        $sha1but conf -state disabled -relief flat -text "SHA1 ID: "
3949    }
3950}
3951
3952proc gotocommit {} {
3953    global sha1string currentid commitrow tagids headids
3954    global displayorder numcommits curview
3955
3956    if {$sha1string == {}
3957        || ([info exists currentid] && $sha1string == $currentid)} return
3958    if {[info exists tagids($sha1string)]} {
3959        set id $tagids($sha1string)
3960    } elseif {[info exists headids($sha1string)]} {
3961        set id $headids($sha1string)
3962    } else {
3963        set id [string tolower $sha1string]
3964        if {[regexp {^[0-9a-f]{4,39}$} $id]} {
3965            set matches {}
3966            foreach i $displayorder {
3967                if {[string match $id* $i]} {
3968                    lappend matches $i
3969                }
3970            }
3971            if {$matches ne {}} {
3972                if {[llength $matches] > 1} {
3973                    error_popup "Short SHA1 id $id is ambiguous"
3974                    return
3975                }
3976                set id [lindex $matches 0]
3977            }
3978        }
3979    }
3980    if {[info exists commitrow($curview,$id)]} {
3981        selectline $commitrow($curview,$id) 1
3982        return
3983    }
3984    if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
3985        set type "SHA1 id"
3986    } else {
3987        set type "Tag/Head"
3988    }
3989    error_popup "$type $sha1string is not known"
3990}
3991
3992proc lineenter {x y id} {
3993    global hoverx hovery hoverid hovertimer
3994    global commitinfo canv
3995
3996    if {![info exists commitinfo($id)] && ![getcommit $id]} return
3997    set hoverx $x
3998    set hovery $y
3999    set hoverid $id
4000    if {[info exists hovertimer]} {
4001        after cancel $hovertimer
4002    }
4003    set hovertimer [after 500 linehover]
4004    $canv delete hover
4005}
4006
4007proc linemotion {x y id} {
4008    global hoverx hovery hoverid hovertimer
4009
4010    if {[info exists hoverid] && $id == $hoverid} {
4011        set hoverx $x
4012        set hovery $y
4013        if {[info exists hovertimer]} {
4014            after cancel $hovertimer
4015        }
4016        set hovertimer [after 500 linehover]
4017    }
4018}
4019
4020proc lineleave {id} {
4021    global hoverid hovertimer canv
4022
4023    if {[info exists hoverid] && $id == $hoverid} {
4024        $canv delete hover
4025        if {[info exists hovertimer]} {
4026            after cancel $hovertimer
4027            unset hovertimer
4028        }
4029        unset hoverid
4030    }
4031}
4032
4033proc linehover {} {
4034    global hoverx hovery hoverid hovertimer
4035    global canv linespc lthickness
4036    global commitinfo mainfont
4037
4038    set text [lindex $commitinfo($hoverid) 0]
4039    set ymax [lindex [$canv cget -scrollregion] 3]
4040    if {$ymax == {}} return
4041    set yfrac [lindex [$canv yview] 0]
4042    set x [expr {$hoverx + 2 * $linespc}]
4043    set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
4044    set x0 [expr {$x - 2 * $lthickness}]
4045    set y0 [expr {$y - 2 * $lthickness}]
4046    set x1 [expr {$x + [font measure $mainfont $text] + 2 * $lthickness}]
4047    set y1 [expr {$y + $linespc + 2 * $lthickness}]
4048    set t [$canv create rectangle $x0 $y0 $x1 $y1 \
4049               -fill \#ffff80 -outline black -width 1 -tags hover]
4050    $canv raise $t
4051    set t [$canv create text $x $y -anchor nw -text $text -tags hover -font $mainfont]
4052    $canv raise $t
4053}
4054
4055proc clickisonarrow {id y} {
4056    global lthickness
4057
4058    set ranges [rowranges $id]
4059    set thresh [expr {2 * $lthickness + 6}]
4060    set n [expr {[llength $ranges] - 1}]
4061    for {set i 1} {$i < $n} {incr i} {
4062        set row [lindex $ranges $i]
4063        if {abs([yc $row] - $y) < $thresh} {
4064            return $i
4065        }
4066    }
4067    return {}
4068}
4069
4070proc arrowjump {id n y} {
4071    global canv
4072
4073    # 1 <-> 2, 3 <-> 4, etc...
4074    set n [expr {(($n - 1) ^ 1) + 1}]
4075    set row [lindex [rowranges $id] $n]
4076    set yt [yc $row]
4077    set ymax [lindex [$canv cget -scrollregion] 3]
4078    if {$ymax eq {} || $ymax <= 0} return
4079    set view [$canv yview]
4080    set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
4081    set yfrac [expr {$yt / $ymax - $yspan / 2}]
4082    if {$yfrac < 0} {
4083        set yfrac 0
4084    }
4085    allcanvs yview moveto $yfrac
4086}
4087
4088proc lineclick {x y id isnew} {
4089    global ctext commitinfo children canv thickerline curview
4090
4091    if {![info exists commitinfo($id)] && ![getcommit $id]} return
4092    unmarkmatches
4093    unselectline
4094    normalline
4095    $canv delete hover
4096    # draw this line thicker than normal
4097    set thickerline $id
4098    drawlines $id
4099    if {$isnew} {
4100        set ymax [lindex [$canv cget -scrollregion] 3]
4101        if {$ymax eq {}} return
4102        set yfrac [lindex [$canv yview] 0]
4103        set y [expr {$y + $yfrac * $ymax}]
4104    }
4105    set dirn [clickisonarrow $id $y]
4106    if {$dirn ne {}} {
4107        arrowjump $id $dirn $y
4108        return
4109    }
4110
4111    if {$isnew} {
4112        addtohistory [list lineclick $x $y $id 0]
4113    }
4114    # fill the details pane with info about this line
4115    $ctext conf -state normal
4116    $ctext delete 0.0 end
4117    $ctext tag conf link -foreground blue -underline 1
4118    $ctext tag bind link <Enter> { %W configure -cursor hand2 }
4119    $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
4120    $ctext insert end "Parent:\t"
4121    $ctext insert end $id [list link link0]
4122    $ctext tag bind link0 <1> [list selbyid $id]
4123    set info $commitinfo($id)
4124    $ctext insert end "\n\t[lindex $info 0]\n"
4125    $ctext insert end "\tAuthor:\t[lindex $info 1]\n"
4126    set date [formatdate [lindex $info 2]]
4127    $ctext insert end "\tDate:\t$date\n"
4128    set kids $children($curview,$id)
4129    if {$kids ne {}} {
4130        $ctext insert end "\nChildren:"
4131        set i 0
4132        foreach child $kids {
4133            incr i
4134            if {![info exists commitinfo($child)] && ![getcommit $child]} continue
4135            set info $commitinfo($child)
4136            $ctext insert end "\n\t"
4137            $ctext insert end $child [list link link$i]
4138            $ctext tag bind link$i <1> [list selbyid $child]
4139            $ctext insert end "\n\t[lindex $info 0]"
4140            $ctext insert end "\n\tAuthor:\t[lindex $info 1]"
4141            set date [formatdate [lindex $info 2]]
4142            $ctext insert end "\n\tDate:\t$date\n"
4143        }
4144    }
4145    $ctext conf -state disabled
4146    init_flist {}
4147}
4148
4149proc normalline {} {
4150    global thickerline
4151    if {[info exists thickerline]} {
4152        set id $thickerline
4153        unset thickerline
4154        drawlines $id
4155    }
4156}
4157
4158proc selbyid {id} {
4159    global commitrow curview
4160    if {[info exists commitrow($curview,$id)]} {
4161        selectline $commitrow($curview,$id) 1
4162    }
4163}
4164
4165proc mstime {} {
4166    global startmstime
4167    if {![info exists startmstime]} {
4168        set startmstime [clock clicks -milliseconds]
4169    }
4170    return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
4171}
4172
4173proc rowmenu {x y id} {
4174    global rowctxmenu commitrow selectedline rowmenuid curview
4175
4176    if {![info exists selectedline]
4177        || $commitrow($curview,$id) eq $selectedline} {
4178        set state disabled
4179    } else {
4180        set state normal
4181    }
4182    $rowctxmenu entryconfigure 0 -state $state
4183    $rowctxmenu entryconfigure 1 -state $state
4184    $rowctxmenu entryconfigure 2 -state $state
4185    set rowmenuid $id
4186    tk_popup $rowctxmenu $x $y
4187}
4188
4189proc diffvssel {dirn} {
4190    global rowmenuid selectedline displayorder
4191
4192    if {![info exists selectedline]} return
4193    if {$dirn} {
4194        set oldid [lindex $displayorder $selectedline]
4195        set newid $rowmenuid
4196    } else {
4197        set oldid $rowmenuid
4198        set newid [lindex $displayorder $selectedline]
4199    }
4200    addtohistory [list doseldiff $oldid $newid]
4201    doseldiff $oldid $newid
4202}
4203
4204proc doseldiff {oldid newid} {
4205    global ctext
4206    global commitinfo
4207
4208    $ctext conf -state normal
4209    $ctext delete 0.0 end
4210    init_flist "Top"
4211    $ctext insert end "From "
4212    $ctext tag conf link -foreground blue -underline 1
4213    $ctext tag bind link <Enter> { %W configure -cursor hand2 }
4214    $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
4215    $ctext tag bind link0 <1> [list selbyid $oldid]
4216    $ctext insert end $oldid [list link link0]
4217    $ctext insert end "\n     "
4218    $ctext insert end [lindex $commitinfo($oldid) 0]
4219    $ctext insert end "\n\nTo   "
4220    $ctext tag bind link1 <1> [list selbyid $newid]
4221    $ctext insert end $newid [list link link1]
4222    $ctext insert end "\n     "
4223    $ctext insert end [lindex $commitinfo($newid) 0]
4224    $ctext insert end "\n"
4225    $ctext conf -state disabled
4226    $ctext tag delete Comments
4227    $ctext tag remove found 1.0 end
4228    startdiff [list $oldid $newid]
4229}
4230
4231proc mkpatch {} {
4232    global rowmenuid currentid commitinfo patchtop patchnum
4233
4234    if {![info exists currentid]} return
4235    set oldid $currentid
4236    set oldhead [lindex $commitinfo($oldid) 0]
4237    set newid $rowmenuid
4238    set newhead [lindex $commitinfo($newid) 0]
4239    set top .patch
4240    set patchtop $top
4241    catch {destroy $top}
4242    toplevel $top
4243    label $top.title -text "Generate patch"
4244    grid $top.title - -pady 10
4245    label $top.from -text "From:"
4246    entry $top.fromsha1 -width 40 -relief flat
4247    $top.fromsha1 insert 0 $oldid
4248    $top.fromsha1 conf -state readonly
4249    grid $top.from $top.fromsha1 -sticky w
4250    entry $top.fromhead -width 60 -relief flat
4251    $top.fromhead insert 0 $oldhead
4252    $top.fromhead conf -state readonly
4253    grid x $top.fromhead -sticky w
4254    label $top.to -text "To:"
4255    entry $top.tosha1 -width 40 -relief flat
4256    $top.tosha1 insert 0 $newid
4257    $top.tosha1 conf -state readonly
4258    grid $top.to $top.tosha1 -sticky w
4259    entry $top.tohead -width 60 -relief flat
4260    $top.tohead insert 0 $newhead
4261    $top.tohead conf -state readonly
4262    grid x $top.tohead -sticky w
4263    button $top.rev -text "Reverse" -command mkpatchrev -padx 5
4264    grid $top.rev x -pady 10
4265    label $top.flab -text "Output file:"
4266    entry $top.fname -width 60
4267    $top.fname insert 0 [file normalize "patch$patchnum.patch"]
4268    incr patchnum
4269    grid $top.flab $top.fname -sticky w
4270    frame $top.buts
4271    button $top.buts.gen -text "Generate" -command mkpatchgo
4272    button $top.buts.can -text "Cancel" -command mkpatchcan
4273    grid $top.buts.gen $top.buts.can
4274    grid columnconfigure $top.buts 0 -weight 1 -uniform a
4275    grid columnconfigure $top.buts 1 -weight 1 -uniform a
4276    grid $top.buts - -pady 10 -sticky ew
4277    focus $top.fname
4278}
4279
4280proc mkpatchrev {} {
4281    global patchtop
4282
4283    set oldid [$patchtop.fromsha1 get]
4284    set oldhead [$patchtop.fromhead get]
4285    set newid [$patchtop.tosha1 get]
4286    set newhead [$patchtop.tohead get]
4287    foreach e [list fromsha1 fromhead tosha1 tohead] \
4288            v [list $newid $newhead $oldid $oldhead] {
4289        $patchtop.$e conf -state normal
4290        $patchtop.$e delete 0 end
4291        $patchtop.$e insert 0 $v
4292        $patchtop.$e conf -state readonly
4293    }
4294}
4295
4296proc mkpatchgo {} {
4297    global patchtop
4298
4299    set oldid [$patchtop.fromsha1 get]
4300    set newid [$patchtop.tosha1 get]
4301    set fname [$patchtop.fname get]
4302    if {[catch {exec git-diff-tree -p $oldid $newid >$fname &} err]} {
4303        error_popup "Error creating patch: $err"
4304    }
4305    catch {destroy $patchtop}
4306    unset patchtop
4307}
4308
4309proc mkpatchcan {} {
4310    global patchtop
4311
4312    catch {destroy $patchtop}
4313    unset patchtop
4314}
4315
4316proc mktag {} {
4317    global rowmenuid mktagtop commitinfo
4318
4319    set top .maketag
4320    set mktagtop $top
4321    catch {destroy $top}
4322    toplevel $top
4323    label $top.title -text "Create tag"
4324    grid $top.title - -pady 10
4325    label $top.id -text "ID:"
4326    entry $top.sha1 -width 40 -relief flat
4327    $top.sha1 insert 0 $rowmenuid
4328    $top.sha1 conf -state readonly
4329    grid $top.id $top.sha1 -sticky w
4330    entry $top.head -width 60 -relief flat
4331    $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
4332    $top.head conf -state readonly
4333    grid x $top.head -sticky w
4334    label $top.tlab -text "Tag name:"
4335    entry $top.tag -width 60
4336    grid $top.tlab $top.tag -sticky w
4337    frame $top.buts
4338    button $top.buts.gen -text "Create" -command mktaggo
4339    button $top.buts.can -text "Cancel" -command mktagcan
4340    grid $top.buts.gen $top.buts.can
4341    grid columnconfigure $top.buts 0 -weight 1 -uniform a
4342    grid columnconfigure $top.buts 1 -weight 1 -uniform a
4343    grid $top.buts - -pady 10 -sticky ew
4344    focus $top.tag
4345}
4346
4347proc domktag {} {
4348    global mktagtop env tagids idtags
4349
4350    set id [$mktagtop.sha1 get]
4351    set tag [$mktagtop.tag get]
4352    if {$tag == {}} {
4353        error_popup "No tag name specified"
4354        return
4355    }
4356    if {[info exists tagids($tag)]} {
4357        error_popup "Tag \"$tag\" already exists"
4358        return
4359    }
4360    if {[catch {
4361        set dir [gitdir]
4362        set fname [file join $dir "refs/tags" $tag]
4363        set f [open $fname w]
4364        puts $f $id
4365        close $f
4366    } err]} {
4367        error_popup "Error creating tag: $err"
4368        return
4369    }
4370
4371    set tagids($tag) $id
4372    lappend idtags($id) $tag
4373    redrawtags $id
4374}
4375
4376proc redrawtags {id} {
4377    global canv linehtag commitrow idpos selectedline curview
4378
4379    if {![info exists commitrow($curview,$id)]} return
4380    drawcmitrow $commitrow($curview,$id)
4381    $canv delete tag.$id
4382    set xt [eval drawtags $id $idpos($id)]
4383    $canv coords $linehtag($commitrow($curview,$id)) $xt [lindex $idpos($id) 2]
4384    if {[info exists selectedline]
4385        && $selectedline == $commitrow($curview,$id)} {
4386        selectline $selectedline 0
4387    }
4388}
4389
4390proc mktagcan {} {
4391    global mktagtop
4392
4393    catch {destroy $mktagtop}
4394    unset mktagtop
4395}
4396
4397proc mktaggo {} {
4398    domktag
4399    mktagcan
4400}
4401
4402proc writecommit {} {
4403    global rowmenuid wrcomtop commitinfo wrcomcmd
4404
4405    set top .writecommit
4406    set wrcomtop $top
4407    catch {destroy $top}
4408    toplevel $top
4409    label $top.title -text "Write commit to file"
4410    grid $top.title - -pady 10
4411    label $top.id -text "ID:"
4412    entry $top.sha1 -width 40 -relief flat
4413    $top.sha1 insert 0 $rowmenuid
4414    $top.sha1 conf -state readonly
4415    grid $top.id $top.sha1 -sticky w
4416    entry $top.head -width 60 -relief flat
4417    $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
4418    $top.head conf -state readonly
4419    grid x $top.head -sticky w
4420    label $top.clab -text "Command:"
4421    entry $top.cmd -width 60 -textvariable wrcomcmd
4422    grid $top.clab $top.cmd -sticky w -pady 10
4423    label $top.flab -text "Output file:"
4424    entry $top.fname -width 60
4425    $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
4426    grid $top.flab $top.fname -sticky w
4427    frame $top.buts
4428    button $top.buts.gen -text "Write" -command wrcomgo
4429    button $top.buts.can -text "Cancel" -command wrcomcan
4430    grid $top.buts.gen $top.buts.can
4431    grid columnconfigure $top.buts 0 -weight 1 -uniform a
4432    grid columnconfigure $top.buts 1 -weight 1 -uniform a
4433    grid $top.buts - -pady 10 -sticky ew
4434    focus $top.fname
4435}
4436
4437proc wrcomgo {} {
4438    global wrcomtop
4439
4440    set id [$wrcomtop.sha1 get]
4441    set cmd "echo $id | [$wrcomtop.cmd get]"
4442    set fname [$wrcomtop.fname get]
4443    if {[catch {exec sh -c $cmd >$fname &} err]} {
4444        error_popup "Error writing commit: $err"
4445    }
4446    catch {destroy $wrcomtop}
4447    unset wrcomtop
4448}
4449
4450proc wrcomcan {} {
4451    global wrcomtop
4452
4453    catch {destroy $wrcomtop}
4454    unset wrcomtop
4455}
4456
4457proc listrefs {id} {
4458    global idtags idheads idotherrefs
4459
4460    set x {}
4461    if {[info exists idtags($id)]} {
4462        set x $idtags($id)
4463    }
4464    set y {}
4465    if {[info exists idheads($id)]} {
4466        set y $idheads($id)
4467    }
4468    set z {}
4469    if {[info exists idotherrefs($id)]} {
4470        set z $idotherrefs($id)
4471    }
4472    return [list $x $y $z]
4473}
4474
4475proc rereadrefs {} {
4476    global idtags idheads idotherrefs
4477
4478    set refids [concat [array names idtags] \
4479                    [array names idheads] [array names idotherrefs]]
4480    foreach id $refids {
4481        if {![info exists ref($id)]} {
4482            set ref($id) [listrefs $id]
4483        }
4484    }
4485    readrefs
4486    set refids [lsort -unique [concat $refids [array names idtags] \
4487                        [array names idheads] [array names idotherrefs]]]
4488    foreach id $refids {
4489        set v [listrefs $id]
4490        if {![info exists ref($id)] || $ref($id) != $v} {
4491            redrawtags $id
4492        }
4493    }
4494}
4495
4496proc showtag {tag isnew} {
4497    global ctext tagcontents tagids linknum
4498
4499    if {$isnew} {
4500        addtohistory [list showtag $tag 0]
4501    }
4502    $ctext conf -state normal
4503    $ctext delete 0.0 end
4504    set linknum 0
4505    if {[info exists tagcontents($tag)]} {
4506        set text $tagcontents($tag)
4507    } else {
4508        set text "Tag: $tag\nId:  $tagids($tag)"
4509    }
4510    appendwithlinks $text
4511    $ctext conf -state disabled
4512    init_flist {}
4513}
4514
4515proc doquit {} {
4516    global stopped
4517    set stopped 100
4518    destroy .
4519}
4520
4521proc doprefs {} {
4522    global maxwidth maxgraphpct diffopts findmergefiles
4523    global oldprefs prefstop
4524
4525    set top .gitkprefs
4526    set prefstop $top
4527    if {[winfo exists $top]} {
4528        raise $top
4529        return
4530    }
4531    foreach v {maxwidth maxgraphpct diffopts findmergefiles} {
4532        set oldprefs($v) [set $v]
4533    }
4534    toplevel $top
4535    wm title $top "Gitk preferences"
4536    label $top.ldisp -text "Commit list display options"
4537    grid $top.ldisp - -sticky w -pady 10
4538    label $top.spacer -text " "
4539    label $top.maxwidthl -text "Maximum graph width (lines)" \
4540        -font optionfont
4541    spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
4542    grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
4543    label $top.maxpctl -text "Maximum graph width (% of pane)" \
4544        -font optionfont
4545    spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
4546    grid x $top.maxpctl $top.maxpct -sticky w
4547    checkbutton $top.findm -variable findmergefiles
4548    label $top.findml -text "Include merges for \"Find\" in \"Files\"" \
4549        -font optionfont
4550    grid $top.findm $top.findml - -sticky w
4551    label $top.ddisp -text "Diff display options"
4552    grid $top.ddisp - -sticky w -pady 10
4553    label $top.diffoptl -text "Options for diff program" \
4554        -font optionfont
4555    entry $top.diffopt -width 20 -textvariable diffopts
4556    grid x $top.diffoptl $top.diffopt -sticky w
4557    frame $top.buts
4558    button $top.buts.ok -text "OK" -command prefsok
4559    button $top.buts.can -text "Cancel" -command prefscan
4560    grid $top.buts.ok $top.buts.can
4561    grid columnconfigure $top.buts 0 -weight 1 -uniform a
4562    grid columnconfigure $top.buts 1 -weight 1 -uniform a
4563    grid $top.buts - - -pady 10 -sticky ew
4564}
4565
4566proc prefscan {} {
4567    global maxwidth maxgraphpct diffopts findmergefiles
4568    global oldprefs prefstop
4569
4570    foreach v {maxwidth maxgraphpct diffopts findmergefiles} {
4571        set $v $oldprefs($v)
4572    }
4573    catch {destroy $prefstop}
4574    unset prefstop
4575}
4576
4577proc prefsok {} {
4578    global maxwidth maxgraphpct
4579    global oldprefs prefstop
4580
4581    catch {destroy $prefstop}
4582    unset prefstop
4583    if {$maxwidth != $oldprefs(maxwidth)
4584        || $maxgraphpct != $oldprefs(maxgraphpct)} {
4585        redisplay
4586    }
4587}
4588
4589proc formatdate {d} {
4590    return [clock format $d -format "%Y-%m-%d %H:%M:%S"]
4591}
4592
4593# This list of encoding names and aliases is distilled from
4594# http://www.iana.org/assignments/character-sets.
4595# Not all of them are supported by Tcl.
4596set encoding_aliases {
4597    { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
4598      ISO646-US US-ASCII us IBM367 cp367 csASCII }
4599    { ISO-10646-UTF-1 csISO10646UTF1 }
4600    { ISO_646.basic:1983 ref csISO646basic1983 }
4601    { INVARIANT csINVARIANT }
4602    { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
4603    { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
4604    { NATS-SEFI iso-ir-8-1 csNATSSEFI }
4605    { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
4606    { NATS-DANO iso-ir-9-1 csNATSDANO }
4607    { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
4608    { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
4609    { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
4610    { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
4611    { ISO-2022-KR csISO2022KR }
4612    { EUC-KR csEUCKR }
4613    { ISO-2022-JP csISO2022JP }
4614    { ISO-2022-JP-2 csISO2022JP2 }
4615    { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
4616      csISO13JISC6220jp }
4617    { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
4618    { IT iso-ir-15 ISO646-IT csISO15Italian }
4619    { PT iso-ir-16 ISO646-PT csISO16Portuguese }
4620    { ES iso-ir-17 ISO646-ES csISO17Spanish }
4621    { greek7-old iso-ir-18 csISO18Greek7Old }
4622    { latin-greek iso-ir-19 csISO19LatinGreek }
4623    { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
4624    { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
4625    { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
4626    { ISO_5427 iso-ir-37 csISO5427Cyrillic }
4627    { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
4628    { BS_viewdata iso-ir-47 csISO47BSViewdata }
4629    { INIS iso-ir-49 csISO49INIS }
4630    { INIS-8 iso-ir-50 csISO50INIS8 }
4631    { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
4632    { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
4633    { ISO_5428:1980 iso-ir-55 csISO5428Greek }
4634    { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
4635    { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
4636    { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
4637      csISO60Norwegian1 }
4638    { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
4639    { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
4640    { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
4641    { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
4642    { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
4643    { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
4644    { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
4645    { greek7 iso-ir-88 csISO88Greek7 }
4646    { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
4647    { iso-ir-90 csISO90 }
4648    { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
4649    { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
4650      csISO92JISC62991984b }
4651    { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
4652    { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
4653    { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
4654      csISO95JIS62291984handadd }
4655    { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
4656    { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
4657    { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
4658    { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
4659      CP819 csISOLatin1 }
4660    { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
4661    { T.61-7bit iso-ir-102 csISO102T617bit }
4662    { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
4663    { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
4664    { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
4665    { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
4666    { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
4667    { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
4668    { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
4669    { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
4670      arabic csISOLatinArabic }
4671    { ISO_8859-6-E csISO88596E ISO-8859-6-E }
4672    { ISO_8859-6-I csISO88596I ISO-8859-6-I }
4673    { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
4674      greek greek8 csISOLatinGreek }
4675    { T.101-G2 iso-ir-128 csISO128T101G2 }
4676    { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
4677      csISOLatinHebrew }
4678    { ISO_8859-8-E csISO88598E ISO-8859-8-E }
4679    { ISO_8859-8-I csISO88598I ISO-8859-8-I }
4680    { CSN_369103 iso-ir-139 csISO139CSN369103 }
4681    { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
4682    { ISO_6937-2-add iso-ir-142 csISOTextComm }
4683    { IEC_P27-1 iso-ir-143 csISO143IECP271 }
4684    { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
4685      csISOLatinCyrillic }
4686    { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
4687    { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
4688    { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
4689    { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
4690    { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
4691    { ISO_6937-2-25 iso-ir-152 csISO6937Add }
4692    { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
4693    { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
4694    { ISO_10367-box iso-ir-155 csISO10367Box }
4695    { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
4696    { latin-lap lap iso-ir-158 csISO158Lap }
4697    { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
4698    { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
4699    { us-dk csUSDK }
4700    { dk-us csDKUS }
4701    { JIS_X0201 X0201 csHalfWidthKatakana }
4702    { KSC5636 ISO646-KR csKSC5636 }
4703    { ISO-10646-UCS-2 csUnicode }
4704    { ISO-10646-UCS-4 csUCS4 }
4705    { DEC-MCS dec csDECMCS }
4706    { hp-roman8 roman8 r8 csHPRoman8 }
4707    { macintosh mac csMacintosh }
4708    { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
4709      csIBM037 }
4710    { IBM038 EBCDIC-INT cp038 csIBM038 }
4711    { IBM273 CP273 csIBM273 }
4712    { IBM274 EBCDIC-BE CP274 csIBM274 }
4713    { IBM275 EBCDIC-BR cp275 csIBM275 }
4714    { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
4715    { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
4716    { IBM280 CP280 ebcdic-cp-it csIBM280 }
4717    { IBM281 EBCDIC-JP-E cp281 csIBM281 }
4718    { IBM284 CP284 ebcdic-cp-es csIBM284 }
4719    { IBM285 CP285 ebcdic-cp-gb csIBM285 }
4720    { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
4721    { IBM297 cp297 ebcdic-cp-fr csIBM297 }
4722    { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
4723    { IBM423 cp423 ebcdic-cp-gr csIBM423 }
4724    { IBM424 cp424 ebcdic-cp-he csIBM424 }
4725    { IBM437 cp437 437 csPC8CodePage437 }
4726    { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
4727    { IBM775 cp775 csPC775Baltic }
4728    { IBM850 cp850 850 csPC850Multilingual }
4729    { IBM851 cp851 851 csIBM851 }
4730    { IBM852 cp852 852 csPCp852 }
4731    { IBM855 cp855 855 csIBM855 }
4732    { IBM857 cp857 857 csIBM857 }
4733    { IBM860 cp860 860 csIBM860 }
4734    { IBM861 cp861 861 cp-is csIBM861 }
4735    { IBM862 cp862 862 csPC862LatinHebrew }
4736    { IBM863 cp863 863 csIBM863 }
4737    { IBM864 cp864 csIBM864 }
4738    { IBM865 cp865 865 csIBM865 }
4739    { IBM866 cp866 866 csIBM866 }
4740    { IBM868 CP868 cp-ar csIBM868 }
4741    { IBM869 cp869 869 cp-gr csIBM869 }
4742    { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
4743    { IBM871 CP871 ebcdic-cp-is csIBM871 }
4744    { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
4745    { IBM891 cp891 csIBM891 }
4746    { IBM903 cp903 csIBM903 }
4747    { IBM904 cp904 904 csIBBM904 }
4748    { IBM905 CP905 ebcdic-cp-tr csIBM905 }
4749    { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
4750    { IBM1026 CP1026 csIBM1026 }
4751    { EBCDIC-AT-DE csIBMEBCDICATDE }
4752    { EBCDIC-AT-DE-A csEBCDICATDEA }
4753    { EBCDIC-CA-FR csEBCDICCAFR }
4754    { EBCDIC-DK-NO csEBCDICDKNO }
4755    { EBCDIC-DK-NO-A csEBCDICDKNOA }
4756    { EBCDIC-FI-SE csEBCDICFISE }
4757    { EBCDIC-FI-SE-A csEBCDICFISEA }
4758    { EBCDIC-FR csEBCDICFR }
4759    { EBCDIC-IT csEBCDICIT }
4760    { EBCDIC-PT csEBCDICPT }
4761    { EBCDIC-ES csEBCDICES }
4762    { EBCDIC-ES-A csEBCDICESA }
4763    { EBCDIC-ES-S csEBCDICESS }
4764    { EBCDIC-UK csEBCDICUK }
4765    { EBCDIC-US csEBCDICUS }
4766    { UNKNOWN-8BIT csUnknown8BiT }
4767    { MNEMONIC csMnemonic }
4768    { MNEM csMnem }
4769    { VISCII csVISCII }
4770    { VIQR csVIQR }
4771    { KOI8-R csKOI8R }
4772    { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
4773    { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
4774    { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
4775    { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
4776    { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
4777    { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
4778    { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
4779    { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
4780    { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
4781    { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
4782    { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
4783    { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
4784    { IBM1047 IBM-1047 }
4785    { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
4786    { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
4787    { UNICODE-1-1 csUnicode11 }
4788    { CESU-8 csCESU-8 }
4789    { BOCU-1 csBOCU-1 }
4790    { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
4791    { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
4792      l8 }
4793    { ISO-8859-15 ISO_8859-15 Latin-9 }
4794    { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
4795    { GBK CP936 MS936 windows-936 }
4796    { JIS_Encoding csJISEncoding }
4797    { Shift_JIS MS_Kanji csShiftJIS }
4798    { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
4799      EUC-JP }
4800    { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
4801    { ISO-10646-UCS-Basic csUnicodeASCII }
4802    { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
4803    { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
4804    { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
4805    { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
4806    { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
4807    { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
4808    { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
4809    { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
4810    { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
4811    { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
4812    { Adobe-Standard-Encoding csAdobeStandardEncoding }
4813    { Ventura-US csVenturaUS }
4814    { Ventura-International csVenturaInternational }
4815    { PC8-Danish-Norwegian csPC8DanishNorwegian }
4816    { PC8-Turkish csPC8Turkish }
4817    { IBM-Symbols csIBMSymbols }
4818    { IBM-Thai csIBMThai }
4819    { HP-Legal csHPLegal }
4820    { HP-Pi-font csHPPiFont }
4821    { HP-Math8 csHPMath8 }
4822    { Adobe-Symbol-Encoding csHPPSMath }
4823    { HP-DeskTop csHPDesktop }
4824    { Ventura-Math csVenturaMath }
4825    { Microsoft-Publishing csMicrosoftPublishing }
4826    { Windows-31J csWindows31J }
4827    { GB2312 csGB2312 }
4828    { Big5 csBig5 }
4829}
4830
4831proc tcl_encoding {enc} {
4832    global encoding_aliases
4833    set names [encoding names]
4834    set lcnames [string tolower $names]
4835    set enc [string tolower $enc]
4836    set i [lsearch -exact $lcnames $enc]
4837    if {$i < 0} {
4838        # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
4839        if {[regsub {^iso[-_]} $enc iso encx]} {
4840            set i [lsearch -exact $lcnames $encx]
4841        }
4842    }
4843    if {$i < 0} {
4844        foreach l $encoding_aliases {
4845            set ll [string tolower $l]
4846            if {[lsearch -exact $ll $enc] < 0} continue
4847            # look through the aliases for one that tcl knows about
4848            foreach e $ll {
4849                set i [lsearch -exact $lcnames $e]
4850                if {$i < 0} {
4851                    if {[regsub {^iso[-_]} $e iso ex]} {
4852                        set i [lsearch -exact $lcnames $ex]
4853                    }
4854                }
4855                if {$i >= 0} break
4856            }
4857            break
4858        }
4859    }
4860    if {$i >= 0} {
4861        return [lindex $names $i]
4862    }
4863    return {}
4864}
4865
4866# defaults...
4867set datemode 0
4868set diffopts "-U 5 -p"
4869set wrcomcmd "git-diff-tree --stdin -p --pretty"
4870
4871set gitencoding {}
4872catch {
4873    set gitencoding [exec git-repo-config --get i18n.commitencoding]
4874}
4875if {$gitencoding == ""} {
4876    set gitencoding "utf-8"
4877}
4878set tclencoding [tcl_encoding $gitencoding]
4879if {$tclencoding == {}} {
4880    puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
4881}
4882
4883set mainfont {Helvetica 9}
4884set textfont {Courier 9}
4885set uifont {Helvetica 9 bold}
4886set findmergefiles 0
4887set maxgraphpct 50
4888set maxwidth 16
4889set revlistorder 0
4890set fastdate 0
4891set uparrowlen 7
4892set downarrowlen 7
4893set mingaplen 30
4894set flistmode "flat"
4895set cmitmode "patch"
4896
4897set colors {green red blue magenta darkgrey brown orange}
4898
4899catch {source ~/.gitk}
4900
4901font create optionfont -family sans-serif -size -12
4902
4903set revtreeargs {}
4904foreach arg $argv {
4905    switch -regexp -- $arg {
4906        "^$" { }
4907        "^-d" { set datemode 1 }
4908        default {
4909            lappend revtreeargs $arg
4910        }
4911    }
4912}
4913
4914# check that we can find a .git directory somewhere...
4915set gitdir [gitdir]
4916if {![file isdirectory $gitdir]} {
4917    show_error . "Cannot find the git directory \"$gitdir\"."
4918    exit 1
4919}
4920
4921set cmdline_files {}
4922set i [lsearch -exact $revtreeargs "--"]
4923if {$i >= 0} {
4924    set cmdline_files [lrange $revtreeargs [expr {$i + 1}] end]
4925    set revtreeargs [lrange $revtreeargs 0 [expr {$i - 1}]]
4926} elseif {$revtreeargs ne {}} {
4927    if {[catch {
4928        set f [eval exec git-rev-parse --no-revs --no-flags $revtreeargs]
4929        set cmdline_files [split $f "\n"]
4930        set n [llength $cmdline_files]
4931        set revtreeargs [lrange $revtreeargs 0 end-$n]
4932    } err]} {
4933        # unfortunately we get both stdout and stderr in $err,
4934        # so look for "fatal:".
4935        set i [string first "fatal:" $err]
4936        if {$i > 0} {
4937            set err [string range [expr {$i + 6}] end]
4938        }
4939        show_error . "Bad arguments to gitk:\n$err"
4940        exit 1
4941    }
4942}
4943
4944set history {}
4945set historyindex 0
4946
4947set optim_delay 16
4948
4949set nextviewnum 1
4950set curview 0
4951set selectedview 0
4952set selectedhlview {}
4953set viewfiles(0) {}
4954set viewperm(0) 0
4955set viewargs(0) {}
4956
4957set cmdlineok 0
4958set stopped 0
4959set stuffsaved 0
4960set patchnum 0
4961setcoords
4962makewindow
4963readrefs
4964
4965if {$cmdline_files ne {} || $revtreeargs ne {}} {
4966    # create a view for the files/dirs specified on the command line
4967    set curview 1
4968    set selectedview 1
4969    set nextviewnum 2
4970    set viewname(1) "Command line"
4971    set viewfiles(1) $cmdline_files
4972    set viewargs(1) $revtreeargs
4973    set viewperm(1) 0
4974    addviewmenu 1
4975    .bar.view entryconf 2 -state normal
4976    .bar.view entryconf 3 -state normal
4977}
4978
4979if {[info exists permviews]} {
4980    foreach v $permviews {
4981        set n $nextviewnum
4982        incr nextviewnum
4983        set viewname($n) [lindex $v 0]
4984        set viewfiles($n) [lindex $v 1]
4985        set viewargs($n) [lindex $v 2]
4986        set viewperm($n) 1
4987        addviewmenu $n
4988    }
4989}
4990getcommits