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