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