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