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