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