gitkon commit Merge branch 'master' into next (5957f04)
   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
1120    global parentlist childlist children
1121
1122    incr commitidx
1123    lappend displayorder $id
1124    lappend parentlist {}
1125    set commitrow($id) $row
1126    readcommit $id
1127    if {![info exists commitinfo($id)]} {
1128        set commitinfo($id) {"No commit information available"}
1129    }
1130    if {[info exists children($id)]} {
1131        lappend childlist $children($id)
1132    } else {
1133        lappend childlist {}
1134    }
1135}
1136
1137proc layouttail {} {
1138    global rowidlist rowoffsets idinlist commitidx
1139    global idrowranges
1140
1141    set row $commitidx
1142    set idlist [lindex $rowidlist $row]
1143    while {$idlist ne {}} {
1144        set col [expr {[llength $idlist] - 1}]
1145        set id [lindex $idlist $col]
1146        addextraid $id $row
1147        unset idinlist($id)
1148        lappend idrowranges($id) $row
1149        incr row
1150        set offs [ntimes $col 0]
1151        set idlist [lreplace $idlist $col $col]
1152        lappend rowidlist $idlist
1153        lappend rowoffsets $offs
1154    }
1155
1156    foreach id [array names idinlist] {
1157        addextraid $id $row
1158        lset rowidlist $row [list $id]
1159        lset rowoffsets $row 0
1160        makeuparrow $id 0 $row 0
1161        lappend idrowranges($id) $row
1162        incr row
1163        lappend rowidlist {}
1164        lappend rowoffsets {}
1165    }
1166}
1167
1168proc insert_pad {row col npad} {
1169    global rowidlist rowoffsets
1170
1171    set pad [ntimes $npad {}]
1172    lset rowidlist $row [eval linsert [list [lindex $rowidlist $row]] $col $pad]
1173    set tmp [eval linsert [list [lindex $rowoffsets $row]] $col $pad]
1174    lset rowoffsets $row [incrange $tmp [expr {$col + $npad}] [expr {-$npad}]]
1175}
1176
1177proc optimize_rows {row col endrow} {
1178    global rowidlist rowoffsets idrowranges linesegends displayorder
1179
1180    for {} {$row < $endrow} {incr row} {
1181        set idlist [lindex $rowidlist $row]
1182        set offs [lindex $rowoffsets $row]
1183        set haspad 0
1184        for {} {$col < [llength $offs]} {incr col} {
1185            if {[lindex $idlist $col] eq {}} {
1186                set haspad 1
1187                continue
1188            }
1189            set z [lindex $offs $col]
1190            if {$z eq {}} continue
1191            set isarrow 0
1192            set x0 [expr {$col + $z}]
1193            set y0 [expr {$row - 1}]
1194            set z0 [lindex $rowoffsets $y0 $x0]
1195            if {$z0 eq {}} {
1196                set id [lindex $idlist $col]
1197                if {[info exists idrowranges($id)] &&
1198                    $y0 > [lindex $idrowranges($id) 0]} {
1199                    set isarrow 1
1200                }
1201            }
1202            if {$z < -1 || ($z < 0 && $isarrow)} {
1203                set npad [expr {-1 - $z + $isarrow}]
1204                set offs [incrange $offs $col $npad]
1205                insert_pad $y0 $x0 $npad
1206                if {$y0 > 0} {
1207                    optimize_rows $y0 $x0 $row
1208                }
1209                set z [lindex $offs $col]
1210                set x0 [expr {$col + $z}]
1211                set z0 [lindex $rowoffsets $y0 $x0]
1212            } elseif {$z > 1 || ($z > 0 && $isarrow)} {
1213                set npad [expr {$z - 1 + $isarrow}]
1214                set y1 [expr {$row + 1}]
1215                set offs2 [lindex $rowoffsets $y1]
1216                set x1 -1
1217                foreach z $offs2 {
1218                    incr x1
1219                    if {$z eq {} || $x1 + $z < $col} continue
1220                    if {$x1 + $z > $col} {
1221                        incr npad
1222                    }
1223                    lset rowoffsets $y1 [incrange $offs2 $x1 $npad]
1224                    break
1225                }
1226                set pad [ntimes $npad {}]
1227                set idlist [eval linsert \$idlist $col $pad]
1228                set tmp [eval linsert \$offs $col $pad]
1229                incr col $npad
1230                set offs [incrange $tmp $col [expr {-$npad}]]
1231                set z [lindex $offs $col]
1232                set haspad 1
1233            }
1234            if {$z0 eq {} && !$isarrow} {
1235                # this line links to its first child on row $row-2
1236                set rm2 [expr {$row - 2}]
1237                set id [lindex $displayorder $rm2]
1238                set xc [lsearch -exact [lindex $rowidlist $rm2] $id]
1239                if {$xc >= 0} {
1240                    set z0 [expr {$xc - $x0}]
1241                }
1242            }
1243            if {$z0 ne {} && $z < 0 && $z0 > 0} {
1244                insert_pad $y0 $x0 1
1245                set offs [incrange $offs $col 1]
1246                optimize_rows $y0 [expr {$x0 + 1}] $row
1247            }
1248        }
1249        if {!$haspad} {
1250            set o {}
1251            for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
1252                set o [lindex $offs $col]
1253                if {$o eq {}} {
1254                    # check if this is the link to the first child
1255                    set id [lindex $idlist $col]
1256                    if {[info exists idrowranges($id)] &&
1257                        $row == [lindex $idrowranges($id) 0]} {
1258                        # it is, work out offset to child
1259                        set y0 [expr {$row - 1}]
1260                        set id [lindex $displayorder $y0]
1261                        set x0 [lsearch -exact [lindex $rowidlist $y0] $id]
1262                        if {$x0 >= 0} {
1263                            set o [expr {$x0 - $col}]
1264                        }
1265                    }
1266                }
1267                if {$o eq {} || $o <= 0} break
1268            }
1269            if {$o ne {} && [incr col] < [llength $idlist]} {
1270                set y1 [expr {$row + 1}]
1271                set offs2 [lindex $rowoffsets $y1]
1272                set x1 -1
1273                foreach z $offs2 {
1274                    incr x1
1275                    if {$z eq {} || $x1 + $z < $col} continue
1276                    lset rowoffsets $y1 [incrange $offs2 $x1 1]
1277                    break
1278                }
1279                set idlist [linsert $idlist $col {}]
1280                set tmp [linsert $offs $col {}]
1281                incr col
1282                set offs [incrange $tmp $col -1]
1283            }
1284        }
1285        lset rowidlist $row $idlist
1286        lset rowoffsets $row $offs
1287        set col 0
1288    }
1289}
1290
1291proc xc {row col} {
1292    global canvx0 linespc
1293    return [expr {$canvx0 + $col * $linespc}]
1294}
1295
1296proc yc {row} {
1297    global canvy0 linespc
1298    return [expr {$canvy0 + $row * $linespc}]
1299}
1300
1301proc linewidth {id} {
1302    global thickerline lthickness
1303
1304    set wid $lthickness
1305    if {[info exists thickerline] && $id eq $thickerline} {
1306        set wid [expr {2 * $lthickness}]
1307    }
1308    return $wid
1309}
1310
1311proc drawlineseg {id i} {
1312    global rowoffsets rowidlist idrowranges
1313    global displayorder
1314    global canv colormap linespc
1315
1316    set startrow [lindex $idrowranges($id) [expr {2 * $i}]]
1317    set row [lindex $idrowranges($id) [expr {2 * $i + 1}]]
1318    if {$startrow == $row} return
1319    assigncolor $id
1320    set coords {}
1321    set col [lsearch -exact [lindex $rowidlist $row] $id]
1322    if {$col < 0} {
1323        puts "oops: drawline: id $id not on row $row"
1324        return
1325    }
1326    set lasto {}
1327    set ns 0
1328    while {1} {
1329        set o [lindex $rowoffsets $row $col]
1330        if {$o eq {}} break
1331        if {$o ne $lasto} {
1332            # changing direction
1333            set x [xc $row $col]
1334            set y [yc $row]
1335            lappend coords $x $y
1336            set lasto $o
1337        }
1338        incr col $o
1339        incr row -1
1340    }
1341    set x [xc $row $col]
1342    set y [yc $row]
1343    lappend coords $x $y
1344    if {$i == 0} {
1345        # draw the link to the first child as part of this line
1346        incr row -1
1347        set child [lindex $displayorder $row]
1348        set ccol [lsearch -exact [lindex $rowidlist $row] $child]
1349        if {$ccol >= 0} {
1350            set x [xc $row $ccol]
1351            set y [yc $row]
1352            if {$ccol < $col - 1} {
1353                lappend coords [xc $row [expr {$col - 1}]] [yc $row]
1354            } elseif {$ccol > $col + 1} {
1355                lappend coords [xc $row [expr {$col + 1}]] [yc $row]
1356            }
1357            lappend coords $x $y
1358        }
1359    }
1360    if {[llength $coords] < 4} return
1361    set last [expr {[llength $idrowranges($id)] / 2 - 1}]
1362    if {$i < $last} {
1363        # This line has an arrow at the lower end: check if the arrow is
1364        # on a diagonal segment, and if so, work around the Tk 8.4
1365        # refusal to draw arrows on diagonal lines.
1366        set x0 [lindex $coords 0]
1367        set x1 [lindex $coords 2]
1368        if {$x0 != $x1} {
1369            set y0 [lindex $coords 1]
1370            set y1 [lindex $coords 3]
1371            if {$y0 - $y1 <= 2 * $linespc && $x1 == [lindex $coords 4]} {
1372                # we have a nearby vertical segment, just trim off the diag bit
1373                set coords [lrange $coords 2 end]
1374            } else {
1375                set slope [expr {($x0 - $x1) / ($y0 - $y1)}]
1376                set xi [expr {$x0 - $slope * $linespc / 2}]
1377                set yi [expr {$y0 - $linespc / 2}]
1378                set coords [lreplace $coords 0 1 $xi $y0 $xi $yi]
1379            }
1380        }
1381    }
1382    set arrow [expr {2 * ($i > 0) + ($i < $last)}]
1383    set arrow [lindex {none first last both} $arrow]
1384    set t [$canv create line $coords -width [linewidth $id] \
1385               -fill $colormap($id) -tags lines.$id -arrow $arrow]
1386    $canv lower $t
1387    bindline $t $id
1388}
1389
1390proc drawparentlinks {id row col olds} {
1391    global rowidlist canv colormap idrowranges
1392
1393    set row2 [expr {$row + 1}]
1394    set x [xc $row $col]
1395    set y [yc $row]
1396    set y2 [yc $row2]
1397    set ids [lindex $rowidlist $row2]
1398    # rmx = right-most X coord used
1399    set rmx 0
1400    foreach p $olds {
1401        set i [lsearch -exact $ids $p]
1402        if {$i < 0} {
1403            puts "oops, parent $p of $id not in list"
1404            continue
1405        }
1406        set x2 [xc $row2 $i]
1407        if {$x2 > $rmx} {
1408            set rmx $x2
1409        }
1410        if {[info exists idrowranges($p)] &&
1411            $row2 == [lindex $idrowranges($p) 0] &&
1412            $row2 < [lindex $idrowranges($p) 1]} {
1413            # drawlineseg will do this one for us
1414            continue
1415        }
1416        assigncolor $p
1417        # should handle duplicated parents here...
1418        set coords [list $x $y]
1419        if {$i < $col - 1} {
1420            lappend coords [xc $row [expr {$i + 1}]] $y
1421        } elseif {$i > $col + 1} {
1422            lappend coords [xc $row [expr {$i - 1}]] $y
1423        }
1424        lappend coords $x2 $y2
1425        set t [$canv create line $coords -width [linewidth $p] \
1426                   -fill $colormap($p) -tags lines.$p]
1427        $canv lower $t
1428        bindline $t $p
1429    }
1430    return $rmx
1431}
1432
1433proc drawlines {id} {
1434    global colormap canv
1435    global idrowranges idrangedrawn
1436    global childlist iddrawn commitrow rowidlist
1437
1438    $canv delete lines.$id
1439    set nr [expr {[llength $idrowranges($id)] / 2}]
1440    for {set i 0} {$i < $nr} {incr i} {
1441        if {[info exists idrangedrawn($id,$i)]} {
1442            drawlineseg $id $i
1443        }
1444    }
1445    foreach child [lindex $childlist $commitrow($id)] {
1446        if {[info exists iddrawn($child)]} {
1447            set row $commitrow($child)
1448            set col [lsearch -exact [lindex $rowidlist $row] $child]
1449            if {$col >= 0} {
1450                drawparentlinks $child $row $col [list $id]
1451            }
1452        }
1453    }
1454}
1455
1456proc drawcmittext {id row col rmx} {
1457    global linespc canv canv2 canv3 canvy0
1458    global commitlisted commitinfo rowidlist
1459    global rowtextx idpos idtags idheads idotherrefs
1460    global linehtag linentag linedtag
1461    global mainfont namefont canvxmax
1462
1463    set ofill [expr {[lindex $commitlisted $row]? "blue": "white"}]
1464    set x [xc $row $col]
1465    set y [yc $row]
1466    set orad [expr {$linespc / 3}]
1467    set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
1468               [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
1469               -fill $ofill -outline black -width 1]
1470    $canv raise $t
1471    $canv bind $t <1> {selcanvline {} %x %y}
1472    set xt [xc $row [llength [lindex $rowidlist $row]]]
1473    if {$xt < $rmx} {
1474        set xt $rmx
1475    }
1476    set rowtextx($row) $xt
1477    set idpos($id) [list $x $xt $y]
1478    if {[info exists idtags($id)] || [info exists idheads($id)]
1479        || [info exists idotherrefs($id)]} {
1480        set xt [drawtags $id $x $xt $y]
1481    }
1482    set headline [lindex $commitinfo($id) 0]
1483    set name [lindex $commitinfo($id) 1]
1484    set date [lindex $commitinfo($id) 2]
1485    set date [formatdate $date]
1486    set linehtag($row) [$canv create text $xt $y -anchor w \
1487                            -text $headline -font $mainfont ]
1488    $canv bind $linehtag($row) <Button-3> "rowmenu %X %Y $id"
1489    set linentag($row) [$canv2 create text 3 $y -anchor w \
1490                            -text $name -font $namefont]
1491    set linedtag($row) [$canv3 create text 3 $y -anchor w \
1492                            -text $date -font $mainfont]
1493    set xr [expr {$xt + [font measure $mainfont $headline]}]
1494    if {$xr > $canvxmax} {
1495        set canvxmax $xr
1496        setcanvscroll
1497    }
1498}
1499
1500proc drawcmitrow {row} {
1501    global displayorder rowidlist
1502    global idrowranges idrangedrawn iddrawn
1503    global commitinfo commitlisted parentlist numcommits
1504
1505    if {$row >= $numcommits} return
1506    foreach id [lindex $rowidlist $row] {
1507        if {![info exists idrowranges($id)]} continue
1508        set i -1
1509        foreach {s e} $idrowranges($id) {
1510            incr i
1511            if {$row < $s} continue
1512            if {$e eq {}} break
1513            if {$row <= $e} {
1514                if {$e < $numcommits && ![info exists idrangedrawn($id,$i)]} {
1515                    drawlineseg $id $i
1516                    set idrangedrawn($id,$i) 1
1517                }
1518                break
1519            }
1520        }
1521    }
1522
1523    set id [lindex $displayorder $row]
1524    if {[info exists iddrawn($id)]} return
1525    set col [lsearch -exact [lindex $rowidlist $row] $id]
1526    if {$col < 0} {
1527        puts "oops, row $row id $id not in list"
1528        return
1529    }
1530    if {![info exists commitinfo($id)]} {
1531        getcommit $id
1532    }
1533    assigncolor $id
1534    set olds [lindex $parentlist $row]
1535    if {$olds ne {}} {
1536        set rmx [drawparentlinks $id $row $col $olds]
1537    } else {
1538        set rmx 0
1539    }
1540    drawcmittext $id $row $col $rmx
1541    set iddrawn($id) 1
1542}
1543
1544proc drawfrac {f0 f1} {
1545    global numcommits canv
1546    global linespc
1547
1548    set ymax [lindex [$canv cget -scrollregion] 3]
1549    if {$ymax eq {} || $ymax == 0} return
1550    set y0 [expr {int($f0 * $ymax)}]
1551    set row [expr {int(($y0 - 3) / $linespc) - 1}]
1552    if {$row < 0} {
1553        set row 0
1554    }
1555    set y1 [expr {int($f1 * $ymax)}]
1556    set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
1557    if {$endrow >= $numcommits} {
1558        set endrow [expr {$numcommits - 1}]
1559    }
1560    for {} {$row <= $endrow} {incr row} {
1561        drawcmitrow $row
1562    }
1563}
1564
1565proc drawvisible {} {
1566    global canv
1567    eval drawfrac [$canv yview]
1568}
1569
1570proc clear_display {} {
1571    global iddrawn idrangedrawn
1572
1573    allcanvs delete all
1574    catch {unset iddrawn}
1575    catch {unset idrangedrawn}
1576}
1577
1578proc assigncolor {id} {
1579    global colormap colors nextcolor
1580    global commitrow parentlist children childlist
1581    global cornercrossings crossings
1582
1583    if {[info exists colormap($id)]} return
1584    set ncolors [llength $colors]
1585    if {[info exists commitrow($id)]} {
1586        set kids [lindex $childlist $commitrow($id)]
1587    } elseif {[info exists children($id)]} {
1588        set kids $children($id)
1589    } else {
1590        set kids {}
1591    }
1592    if {[llength $kids] == 1} {
1593        set child [lindex $kids 0]
1594        if {[info exists colormap($child)]
1595            && [llength [lindex $parentlist $commitrow($child)]] == 1} {
1596            set colormap($id) $colormap($child)
1597            return
1598        }
1599    }
1600    set badcolors {}
1601    if {[info exists cornercrossings($id)]} {
1602        foreach x $cornercrossings($id) {
1603            if {[info exists colormap($x)]
1604                && [lsearch -exact $badcolors $colormap($x)] < 0} {
1605                lappend badcolors $colormap($x)
1606            }
1607        }
1608        if {[llength $badcolors] >= $ncolors} {
1609            set badcolors {}
1610        }
1611    }
1612    set origbad $badcolors
1613    if {[llength $badcolors] < $ncolors - 1} {
1614        if {[info exists crossings($id)]} {
1615            foreach x $crossings($id) {
1616                if {[info exists colormap($x)]
1617                    && [lsearch -exact $badcolors $colormap($x)] < 0} {
1618                    lappend badcolors $colormap($x)
1619                }
1620            }
1621            if {[llength $badcolors] >= $ncolors} {
1622                set badcolors $origbad
1623            }
1624        }
1625        set origbad $badcolors
1626    }
1627    if {[llength $badcolors] < $ncolors - 1} {
1628        foreach child $kids {
1629            if {[info exists colormap($child)]
1630                && [lsearch -exact $badcolors $colormap($child)] < 0} {
1631                lappend badcolors $colormap($child)
1632            }
1633            foreach p [lindex $parentlist $commitrow($child)] {
1634                if {[info exists colormap($p)]
1635                    && [lsearch -exact $badcolors $colormap($p)] < 0} {
1636                    lappend badcolors $colormap($p)
1637                }
1638            }
1639        }
1640        if {[llength $badcolors] >= $ncolors} {
1641            set badcolors $origbad
1642        }
1643    }
1644    for {set i 0} {$i <= $ncolors} {incr i} {
1645        set c [lindex $colors $nextcolor]
1646        if {[incr nextcolor] >= $ncolors} {
1647            set nextcolor 0
1648        }
1649        if {[lsearch -exact $badcolors $c]} break
1650    }
1651    set colormap($id) $c
1652}
1653
1654proc bindline {t id} {
1655    global canv
1656
1657    $canv bind $t <Enter> "lineenter %x %y $id"
1658    $canv bind $t <Motion> "linemotion %x %y $id"
1659    $canv bind $t <Leave> "lineleave $id"
1660    $canv bind $t <Button-1> "lineclick %x %y $id 1"
1661}
1662
1663proc drawtags {id x xt y1} {
1664    global idtags idheads idotherrefs
1665    global linespc lthickness
1666    global canv mainfont commitrow rowtextx
1667
1668    set marks {}
1669    set ntags 0
1670    set nheads 0
1671    if {[info exists idtags($id)]} {
1672        set marks $idtags($id)
1673        set ntags [llength $marks]
1674    }
1675    if {[info exists idheads($id)]} {
1676        set marks [concat $marks $idheads($id)]
1677        set nheads [llength $idheads($id)]
1678    }
1679    if {[info exists idotherrefs($id)]} {
1680        set marks [concat $marks $idotherrefs($id)]
1681    }
1682    if {$marks eq {}} {
1683        return $xt
1684    }
1685
1686    set delta [expr {int(0.5 * ($linespc - $lthickness))}]
1687    set yt [expr {$y1 - 0.5 * $linespc}]
1688    set yb [expr {$yt + $linespc - 1}]
1689    set xvals {}
1690    set wvals {}
1691    foreach tag $marks {
1692        set wid [font measure $mainfont $tag]
1693        lappend xvals $xt
1694        lappend wvals $wid
1695        set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
1696    }
1697    set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
1698               -width $lthickness -fill black -tags tag.$id]
1699    $canv lower $t
1700    foreach tag $marks x $xvals wid $wvals {
1701        set xl [expr {$x + $delta}]
1702        set xr [expr {$x + $delta + $wid + $lthickness}]
1703        if {[incr ntags -1] >= 0} {
1704            # draw a tag
1705            set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
1706                       $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
1707                       -width 1 -outline black -fill yellow -tags tag.$id]
1708            $canv bind $t <1> [list showtag $tag 1]
1709            set rowtextx($commitrow($id)) [expr {$xr + $linespc}]
1710        } else {
1711            # draw a head or other ref
1712            if {[incr nheads -1] >= 0} {
1713                set col green
1714            } else {
1715                set col "#ddddff"
1716            }
1717            set xl [expr {$xl - $delta/2}]
1718            $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
1719                -width 1 -outline black -fill $col -tags tag.$id
1720        }
1721        set t [$canv create text $xl $y1 -anchor w -text $tag \
1722                   -font $mainfont -tags tag.$id]
1723        if {$ntags >= 0} {
1724            $canv bind $t <1> [list showtag $tag 1]
1725        }
1726    }
1727    return $xt
1728}
1729
1730proc checkcrossings {row endrow} {
1731    global displayorder parentlist rowidlist
1732
1733    for {} {$row < $endrow} {incr row} {
1734        set id [lindex $displayorder $row]
1735        set i [lsearch -exact [lindex $rowidlist $row] $id]
1736        if {$i < 0} continue
1737        set idlist [lindex $rowidlist [expr {$row+1}]]
1738        foreach p [lindex $parentlist $row] {
1739            set j [lsearch -exact $idlist $p]
1740            if {$j > 0} {
1741                if {$j < $i - 1} {
1742                    notecrossings $row $p $j $i [expr {$j+1}]
1743                } elseif {$j > $i + 1} {
1744                    notecrossings $row $p $i $j [expr {$j-1}]
1745                }
1746            }
1747        }
1748    }
1749}
1750
1751proc notecrossings {row id lo hi corner} {
1752    global rowidlist crossings cornercrossings
1753
1754    for {set i $lo} {[incr i] < $hi} {} {
1755        set p [lindex [lindex $rowidlist $row] $i]
1756        if {$p == {}} continue
1757        if {$i == $corner} {
1758            if {![info exists cornercrossings($id)]
1759                || [lsearch -exact $cornercrossings($id) $p] < 0} {
1760                lappend cornercrossings($id) $p
1761            }
1762            if {![info exists cornercrossings($p)]
1763                || [lsearch -exact $cornercrossings($p) $id] < 0} {
1764                lappend cornercrossings($p) $id
1765            }
1766        } else {
1767            if {![info exists crossings($id)]
1768                || [lsearch -exact $crossings($id) $p] < 0} {
1769                lappend crossings($id) $p
1770            }
1771            if {![info exists crossings($p)]
1772                || [lsearch -exact $crossings($p) $id] < 0} {
1773                lappend crossings($p) $id
1774            }
1775        }
1776    }
1777}
1778
1779proc xcoord {i level ln} {
1780    global canvx0 xspc1 xspc2
1781
1782    set x [expr {$canvx0 + $i * $xspc1($ln)}]
1783    if {$i > 0 && $i == $level} {
1784        set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
1785    } elseif {$i > $level} {
1786        set x [expr {$x + $xspc2 - $xspc1($ln)}]
1787    }
1788    return $x
1789}
1790
1791proc finishcommits {} {
1792    global commitidx phase
1793    global canv mainfont ctext maincursor textcursor
1794    global findinprogress
1795
1796    if {$commitidx > 0} {
1797        drawrest
1798    } else {
1799        $canv delete all
1800        $canv create text 3 3 -anchor nw -text "No commits selected" \
1801            -font $mainfont -tags textitems
1802    }
1803    if {![info exists findinprogress]} {
1804        . config -cursor $maincursor
1805        settextcursor $textcursor
1806    }
1807    set phase {}
1808}
1809
1810# Don't change the text pane cursor if it is currently the hand cursor,
1811# showing that we are over a sha1 ID link.
1812proc settextcursor {c} {
1813    global ctext curtextcursor
1814
1815    if {[$ctext cget -cursor] == $curtextcursor} {
1816        $ctext config -cursor $c
1817    }
1818    set curtextcursor $c
1819}
1820
1821proc drawrest {} {
1822    global numcommits
1823    global startmsecs
1824    global canvy0 numcommits linespc
1825    global rowlaidout commitidx
1826
1827    set row $rowlaidout
1828    layoutrows $rowlaidout $commitidx 1
1829    layouttail
1830    optimize_rows $row 0 $commitidx
1831    showstuff $commitidx
1832
1833    set drawmsecs [expr {[clock clicks -milliseconds] - $startmsecs}]
1834    #puts "overall $drawmsecs ms for $numcommits commits"
1835}
1836
1837proc findmatches {f} {
1838    global findtype foundstring foundstrlen
1839    if {$findtype == "Regexp"} {
1840        set matches [regexp -indices -all -inline $foundstring $f]
1841    } else {
1842        if {$findtype == "IgnCase"} {
1843            set str [string tolower $f]
1844        } else {
1845            set str $f
1846        }
1847        set matches {}
1848        set i 0
1849        while {[set j [string first $foundstring $str $i]] >= 0} {
1850            lappend matches [list $j [expr {$j+$foundstrlen-1}]]
1851            set i [expr {$j + $foundstrlen}]
1852        }
1853    }
1854    return $matches
1855}
1856
1857proc dofind {} {
1858    global findtype findloc findstring markedmatches commitinfo
1859    global numcommits displayorder linehtag linentag linedtag
1860    global mainfont namefont canv canv2 canv3 selectedline
1861    global matchinglines foundstring foundstrlen matchstring
1862    global commitdata
1863
1864    stopfindproc
1865    unmarkmatches
1866    focus .
1867    set matchinglines {}
1868    if {$findloc == "Pickaxe"} {
1869        findpatches
1870        return
1871    }
1872    if {$findtype == "IgnCase"} {
1873        set foundstring [string tolower $findstring]
1874    } else {
1875        set foundstring $findstring
1876    }
1877    set foundstrlen [string length $findstring]
1878    if {$foundstrlen == 0} return
1879    regsub -all {[*?\[\\]} $foundstring {\\&} matchstring
1880    set matchstring "*$matchstring*"
1881    if {$findloc == "Files"} {
1882        findfiles
1883        return
1884    }
1885    if {![info exists selectedline]} {
1886        set oldsel -1
1887    } else {
1888        set oldsel $selectedline
1889    }
1890    set didsel 0
1891    set fldtypes {Headline Author Date Committer CDate Comment}
1892    set l -1
1893    foreach id $displayorder {
1894        set d $commitdata($id)
1895        incr l
1896        if {$findtype == "Regexp"} {
1897            set doesmatch [regexp $foundstring $d]
1898        } elseif {$findtype == "IgnCase"} {
1899            set doesmatch [string match -nocase $matchstring $d]
1900        } else {
1901            set doesmatch [string match $matchstring $d]
1902        }
1903        if {!$doesmatch} continue
1904        if {![info exists commitinfo($id)]} {
1905            getcommit $id
1906        }
1907        set info $commitinfo($id)
1908        set doesmatch 0
1909        foreach f $info ty $fldtypes {
1910            if {$findloc != "All fields" && $findloc != $ty} {
1911                continue
1912            }
1913            set matches [findmatches $f]
1914            if {$matches == {}} continue
1915            set doesmatch 1
1916            if {$ty == "Headline"} {
1917                drawcmitrow $l
1918                markmatches $canv $l $f $linehtag($l) $matches $mainfont
1919            } elseif {$ty == "Author"} {
1920                drawcmitrow $l
1921                markmatches $canv2 $l $f $linentag($l) $matches $namefont
1922            } elseif {$ty == "Date"} {
1923                drawcmitrow $l
1924                markmatches $canv3 $l $f $linedtag($l) $matches $mainfont
1925            }
1926        }
1927        if {$doesmatch} {
1928            lappend matchinglines $l
1929            if {!$didsel && $l > $oldsel} {
1930                findselectline $l
1931                set didsel 1
1932            }
1933        }
1934    }
1935    if {$matchinglines == {}} {
1936        bell
1937    } elseif {!$didsel} {
1938        findselectline [lindex $matchinglines 0]
1939    }
1940}
1941
1942proc findselectline {l} {
1943    global findloc commentend ctext
1944    selectline $l 1
1945    if {$findloc == "All fields" || $findloc == "Comments"} {
1946        # highlight the matches in the comments
1947        set f [$ctext get 1.0 $commentend]
1948        set matches [findmatches $f]
1949        foreach match $matches {
1950            set start [lindex $match 0]
1951            set end [expr {[lindex $match 1] + 1}]
1952            $ctext tag add found "1.0 + $start c" "1.0 + $end c"
1953        }
1954    }
1955}
1956
1957proc findnext {restart} {
1958    global matchinglines selectedline
1959    if {![info exists matchinglines]} {
1960        if {$restart} {
1961            dofind
1962        }
1963        return
1964    }
1965    if {![info exists selectedline]} return
1966    foreach l $matchinglines {
1967        if {$l > $selectedline} {
1968            findselectline $l
1969            return
1970        }
1971    }
1972    bell
1973}
1974
1975proc findprev {} {
1976    global matchinglines selectedline
1977    if {![info exists matchinglines]} {
1978        dofind
1979        return
1980    }
1981    if {![info exists selectedline]} return
1982    set prev {}
1983    foreach l $matchinglines {
1984        if {$l >= $selectedline} break
1985        set prev $l
1986    }
1987    if {$prev != {}} {
1988        findselectline $prev
1989    } else {
1990        bell
1991    }
1992}
1993
1994proc findlocchange {name ix op} {
1995    global findloc findtype findtypemenu
1996    if {$findloc == "Pickaxe"} {
1997        set findtype Exact
1998        set state disabled
1999    } else {
2000        set state normal
2001    }
2002    $findtypemenu entryconf 1 -state $state
2003    $findtypemenu entryconf 2 -state $state
2004}
2005
2006proc stopfindproc {{done 0}} {
2007    global findprocpid findprocfile findids
2008    global ctext findoldcursor phase maincursor textcursor
2009    global findinprogress
2010
2011    catch {unset findids}
2012    if {[info exists findprocpid]} {
2013        if {!$done} {
2014            catch {exec kill $findprocpid}
2015        }
2016        catch {close $findprocfile}
2017        unset findprocpid
2018    }
2019    if {[info exists findinprogress]} {
2020        unset findinprogress
2021        if {$phase != "incrdraw"} {
2022            . config -cursor $maincursor
2023            settextcursor $textcursor
2024        }
2025    }
2026}
2027
2028proc findpatches {} {
2029    global findstring selectedline numcommits
2030    global findprocpid findprocfile
2031    global finddidsel ctext displayorder findinprogress
2032    global findinsertpos
2033
2034    if {$numcommits == 0} return
2035
2036    # make a list of all the ids to search, starting at the one
2037    # after the selected line (if any)
2038    if {[info exists selectedline]} {
2039        set l $selectedline
2040    } else {
2041        set l -1
2042    }
2043    set inputids {}
2044    for {set i 0} {$i < $numcommits} {incr i} {
2045        if {[incr l] >= $numcommits} {
2046            set l 0
2047        }
2048        append inputids [lindex $displayorder $l] "\n"
2049    }
2050
2051    if {[catch {
2052        set f [open [list | git-diff-tree --stdin -s -r -S$findstring \
2053                         << $inputids] r]
2054    } err]} {
2055        error_popup "Error starting search process: $err"
2056        return
2057    }
2058
2059    set findinsertpos end
2060    set findprocfile $f
2061    set findprocpid [pid $f]
2062    fconfigure $f -blocking 0
2063    fileevent $f readable readfindproc
2064    set finddidsel 0
2065    . config -cursor watch
2066    settextcursor watch
2067    set findinprogress 1
2068}
2069
2070proc readfindproc {} {
2071    global findprocfile finddidsel
2072    global commitrow matchinglines findinsertpos
2073
2074    set n [gets $findprocfile line]
2075    if {$n < 0} {
2076        if {[eof $findprocfile]} {
2077            stopfindproc 1
2078            if {!$finddidsel} {
2079                bell
2080            }
2081        }
2082        return
2083    }
2084    if {![regexp {^[0-9a-f]{40}} $line id]} {
2085        error_popup "Can't parse git-diff-tree output: $line"
2086        stopfindproc
2087        return
2088    }
2089    if {![info exists commitrow($id)]} {
2090        puts stderr "spurious id: $id"
2091        return
2092    }
2093    set l $commitrow($id)
2094    insertmatch $l $id
2095}
2096
2097proc insertmatch {l id} {
2098    global matchinglines findinsertpos finddidsel
2099
2100    if {$findinsertpos == "end"} {
2101        if {$matchinglines != {} && $l < [lindex $matchinglines 0]} {
2102            set matchinglines [linsert $matchinglines 0 $l]
2103            set findinsertpos 1
2104        } else {
2105            lappend matchinglines $l
2106        }
2107    } else {
2108        set matchinglines [linsert $matchinglines $findinsertpos $l]
2109        incr findinsertpos
2110    }
2111    markheadline $l $id
2112    if {!$finddidsel} {
2113        findselectline $l
2114        set finddidsel 1
2115    }
2116}
2117
2118proc findfiles {} {
2119    global selectedline numcommits displayorder ctext
2120    global ffileline finddidsel parentlist
2121    global findinprogress findstartline findinsertpos
2122    global treediffs fdiffid fdiffsneeded fdiffpos
2123    global findmergefiles
2124
2125    if {$numcommits == 0} return
2126
2127    if {[info exists selectedline]} {
2128        set l [expr {$selectedline + 1}]
2129    } else {
2130        set l 0
2131    }
2132    set ffileline $l
2133    set findstartline $l
2134    set diffsneeded {}
2135    set fdiffsneeded {}
2136    while 1 {
2137        set id [lindex $displayorder $l]
2138        if {$findmergefiles || [llength [lindex $parentlist $l]] == 1} {
2139            if {![info exists treediffs($id)]} {
2140                append diffsneeded "$id\n"
2141                lappend fdiffsneeded $id
2142            }
2143        }
2144        if {[incr l] >= $numcommits} {
2145            set l 0
2146        }
2147        if {$l == $findstartline} break
2148    }
2149
2150    # start off a git-diff-tree process if needed
2151    if {$diffsneeded ne {}} {
2152        if {[catch {
2153            set df [open [list | git-diff-tree -r --stdin << $diffsneeded] r]
2154        } err ]} {
2155            error_popup "Error starting search process: $err"
2156            return
2157        }
2158        catch {unset fdiffid}
2159        set fdiffpos 0
2160        fconfigure $df -blocking 0
2161        fileevent $df readable [list readfilediffs $df]
2162    }
2163
2164    set finddidsel 0
2165    set findinsertpos end
2166    set id [lindex $displayorder $l]
2167    . config -cursor watch
2168    settextcursor watch
2169    set findinprogress 1
2170    findcont
2171    update
2172}
2173
2174proc readfilediffs {df} {
2175    global findid fdiffid fdiffs
2176
2177    set n [gets $df line]
2178    if {$n < 0} {
2179        if {[eof $df]} {
2180            donefilediff
2181            if {[catch {close $df} err]} {
2182                stopfindproc
2183                bell
2184                error_popup "Error in git-diff-tree: $err"
2185            } elseif {[info exists findid]} {
2186                set id $findid
2187                stopfindproc
2188                bell
2189                error_popup "Couldn't find diffs for $id"
2190            }
2191        }
2192        return
2193    }
2194    if {[regexp {^([0-9a-f]{40})$} $line match id]} {
2195        # start of a new string of diffs
2196        donefilediff
2197        set fdiffid $id
2198        set fdiffs {}
2199    } elseif {[string match ":*" $line]} {
2200        lappend fdiffs [lindex $line 5]
2201    }
2202}
2203
2204proc donefilediff {} {
2205    global fdiffid fdiffs treediffs findid
2206    global fdiffsneeded fdiffpos
2207
2208    if {[info exists fdiffid]} {
2209        while {[lindex $fdiffsneeded $fdiffpos] ne $fdiffid
2210               && $fdiffpos < [llength $fdiffsneeded]} {
2211            # git-diff-tree doesn't output anything for a commit
2212            # which doesn't change anything
2213            set nullid [lindex $fdiffsneeded $fdiffpos]
2214            set treediffs($nullid) {}
2215            if {[info exists findid] && $nullid eq $findid} {
2216                unset findid
2217                findcont
2218            }
2219            incr fdiffpos
2220        }
2221        incr fdiffpos
2222
2223        if {![info exists treediffs($fdiffid)]} {
2224            set treediffs($fdiffid) $fdiffs
2225        }
2226        if {[info exists findid] && $fdiffid eq $findid} {
2227            unset findid
2228            findcont
2229        }
2230    }
2231}
2232
2233proc findcont {} {
2234    global findid treediffs parentlist
2235    global ffileline findstartline finddidsel
2236    global displayorder numcommits matchinglines findinprogress
2237    global findmergefiles
2238
2239    set l $ffileline
2240    while {1} {
2241        set id [lindex $displayorder $l]
2242        if {$findmergefiles || [llength [lindex $parentlist $l]] == 1} {
2243            if {![info exists treediffs($id)]} {
2244                set findid $id
2245                set ffileline $l
2246                return
2247            }
2248            set doesmatch 0
2249            foreach f $treediffs($id) {
2250                set x [findmatches $f]
2251                if {$x != {}} {
2252                    set doesmatch 1
2253                    break
2254                }
2255            }
2256            if {$doesmatch} {
2257                insertmatch $l $id
2258            }
2259        }
2260        if {[incr l] >= $numcommits} {
2261            set l 0
2262        }
2263        if {$l == $findstartline} break
2264    }
2265    stopfindproc
2266    if {!$finddidsel} {
2267        bell
2268    }
2269}
2270
2271# mark a commit as matching by putting a yellow background
2272# behind the headline
2273proc markheadline {l id} {
2274    global canv mainfont linehtag
2275
2276    drawcmitrow $l
2277    set bbox [$canv bbox $linehtag($l)]
2278    set t [$canv create rect $bbox -outline {} -tags matches -fill yellow]
2279    $canv lower $t
2280}
2281
2282# mark the bits of a headline, author or date that match a find string
2283proc markmatches {canv l str tag matches font} {
2284    set bbox [$canv bbox $tag]
2285    set x0 [lindex $bbox 0]
2286    set y0 [lindex $bbox 1]
2287    set y1 [lindex $bbox 3]
2288    foreach match $matches {
2289        set start [lindex $match 0]
2290        set end [lindex $match 1]
2291        if {$start > $end} continue
2292        set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
2293        set xlen [font measure $font [string range $str 0 [expr {$end}]]]
2294        set t [$canv create rect [expr {$x0+$xoff}] $y0 \
2295                   [expr {$x0+$xlen+2}] $y1 \
2296                   -outline {} -tags matches -fill yellow]
2297        $canv lower $t
2298    }
2299}
2300
2301proc unmarkmatches {} {
2302    global matchinglines findids
2303    allcanvs delete matches
2304    catch {unset matchinglines}
2305    catch {unset findids}
2306}
2307
2308proc selcanvline {w x y} {
2309    global canv canvy0 ctext linespc
2310    global rowtextx
2311    set ymax [lindex [$canv cget -scrollregion] 3]
2312    if {$ymax == {}} return
2313    set yfrac [lindex [$canv yview] 0]
2314    set y [expr {$y + $yfrac * $ymax}]
2315    set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
2316    if {$l < 0} {
2317        set l 0
2318    }
2319    if {$w eq $canv} {
2320        if {![info exists rowtextx($l)] || $x < $rowtextx($l)} return
2321    }
2322    unmarkmatches
2323    selectline $l 1
2324}
2325
2326proc commit_descriptor {p} {
2327    global commitinfo
2328    set l "..."
2329    if {[info exists commitinfo($p)]} {
2330        set l [lindex $commitinfo($p) 0]
2331    }
2332    return "$p ($l)"
2333}
2334
2335# append some text to the ctext widget, and make any SHA1 ID
2336# that we know about be a clickable link.
2337proc appendwithlinks {text} {
2338    global ctext commitrow linknum
2339
2340    set start [$ctext index "end - 1c"]
2341    $ctext insert end $text
2342    $ctext insert end "\n"
2343    set links [regexp -indices -all -inline {[0-9a-f]{40}} $text]
2344    foreach l $links {
2345        set s [lindex $l 0]
2346        set e [lindex $l 1]
2347        set linkid [string range $text $s $e]
2348        if {![info exists commitrow($linkid)]} continue
2349        incr e
2350        $ctext tag add link "$start + $s c" "$start + $e c"
2351        $ctext tag add link$linknum "$start + $s c" "$start + $e c"
2352        $ctext tag bind link$linknum <1> [list selectline $commitrow($linkid) 1]
2353        incr linknum
2354    }
2355    $ctext tag conf link -foreground blue -underline 1
2356    $ctext tag bind link <Enter> { %W configure -cursor hand2 }
2357    $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
2358}
2359
2360proc viewnextline {dir} {
2361    global canv linespc
2362
2363    $canv delete hover
2364    set ymax [lindex [$canv cget -scrollregion] 3]
2365    set wnow [$canv yview]
2366    set wtop [expr {[lindex $wnow 0] * $ymax}]
2367    set newtop [expr {$wtop + $dir * $linespc}]
2368    if {$newtop < 0} {
2369        set newtop 0
2370    } elseif {$newtop > $ymax} {
2371        set newtop $ymax
2372    }
2373    allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
2374}
2375
2376proc selectline {l isnew} {
2377    global canv canv2 canv3 ctext commitinfo selectedline
2378    global displayorder linehtag linentag linedtag
2379    global canvy0 linespc parentlist childlist
2380    global cflist currentid sha1entry
2381    global commentend idtags linknum
2382    global mergemax numcommits
2383
2384    $canv delete hover
2385    normalline
2386    if {$l < 0 || $l >= $numcommits} return
2387    set y [expr {$canvy0 + $l * $linespc}]
2388    set ymax [lindex [$canv cget -scrollregion] 3]
2389    set ytop [expr {$y - $linespc - 1}]
2390    set ybot [expr {$y + $linespc + 1}]
2391    set wnow [$canv yview]
2392    set wtop [expr {[lindex $wnow 0] * $ymax}]
2393    set wbot [expr {[lindex $wnow 1] * $ymax}]
2394    set wh [expr {$wbot - $wtop}]
2395    set newtop $wtop
2396    if {$ytop < $wtop} {
2397        if {$ybot < $wtop} {
2398            set newtop [expr {$y - $wh / 2.0}]
2399        } else {
2400            set newtop $ytop
2401            if {$newtop > $wtop - $linespc} {
2402                set newtop [expr {$wtop - $linespc}]
2403            }
2404        }
2405    } elseif {$ybot > $wbot} {
2406        if {$ytop > $wbot} {
2407            set newtop [expr {$y - $wh / 2.0}]
2408        } else {
2409            set newtop [expr {$ybot - $wh}]
2410            if {$newtop < $wtop + $linespc} {
2411                set newtop [expr {$wtop + $linespc}]
2412            }
2413        }
2414    }
2415    if {$newtop != $wtop} {
2416        if {$newtop < 0} {
2417            set newtop 0
2418        }
2419        allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
2420        drawvisible
2421    }
2422
2423    if {![info exists linehtag($l)]} return
2424    $canv delete secsel
2425    set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
2426               -tags secsel -fill [$canv cget -selectbackground]]
2427    $canv lower $t
2428    $canv2 delete secsel
2429    set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
2430               -tags secsel -fill [$canv2 cget -selectbackground]]
2431    $canv2 lower $t
2432    $canv3 delete secsel
2433    set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
2434               -tags secsel -fill [$canv3 cget -selectbackground]]
2435    $canv3 lower $t
2436
2437    if {$isnew} {
2438        addtohistory [list selectline $l 0]
2439    }
2440
2441    set selectedline $l
2442
2443    set id [lindex $displayorder $l]
2444    set currentid $id
2445    $sha1entry delete 0 end
2446    $sha1entry insert 0 $id
2447    $sha1entry selection from 0
2448    $sha1entry selection to end
2449
2450    $ctext conf -state normal
2451    $ctext delete 0.0 end
2452    set linknum 0
2453    $ctext mark set fmark.0 0.0
2454    $ctext mark gravity fmark.0 left
2455    set info $commitinfo($id)
2456    set date [formatdate [lindex $info 2]]
2457    $ctext insert end "Author: [lindex $info 1]  $date\n"
2458    set date [formatdate [lindex $info 4]]
2459    $ctext insert end "Committer: [lindex $info 3]  $date\n"
2460    if {[info exists idtags($id)]} {
2461        $ctext insert end "Tags:"
2462        foreach tag $idtags($id) {
2463            $ctext insert end " $tag"
2464        }
2465        $ctext insert end "\n"
2466    }
2467 
2468    set comment {}
2469    set olds [lindex $parentlist $l]
2470    if {[llength $olds] > 1} {
2471        set np 0
2472        foreach p $olds {
2473            if {$np >= $mergemax} {
2474                set tag mmax
2475            } else {
2476                set tag m$np
2477            }
2478            $ctext insert end "Parent: " $tag
2479            appendwithlinks [commit_descriptor $p]
2480            incr np
2481        }
2482    } else {
2483        foreach p $olds {
2484            append comment "Parent: [commit_descriptor $p]\n"
2485        }
2486    }
2487
2488    foreach c [lindex $childlist $l] {
2489        append comment "Child:  [commit_descriptor $c]\n"
2490    }
2491    append comment "\n"
2492    append comment [lindex $info 5]
2493
2494    # make anything that looks like a SHA1 ID be a clickable link
2495    appendwithlinks $comment
2496
2497    $ctext tag delete Comments
2498    $ctext tag remove found 1.0 end
2499    $ctext conf -state disabled
2500    set commentend [$ctext index "end - 1c"]
2501
2502    $cflist delete 0 end
2503    $cflist insert end "Comments"
2504    if {[llength $olds] <= 1} {
2505        startdiff $id
2506    } else {
2507        mergediff $id $l
2508    }
2509}
2510
2511proc selfirstline {} {
2512    unmarkmatches
2513    selectline 0 1
2514}
2515
2516proc sellastline {} {
2517    global numcommits
2518    unmarkmatches
2519    set l [expr {$numcommits - 1}]
2520    selectline $l 1
2521}
2522
2523proc selnextline {dir} {
2524    global selectedline
2525    if {![info exists selectedline]} return
2526    set l [expr {$selectedline + $dir}]
2527    unmarkmatches
2528    selectline $l 1
2529}
2530
2531proc selnextpage {dir} {
2532    global canv linespc selectedline numcommits
2533
2534    set lpp [expr {([winfo height $canv] - 2) / $linespc}]
2535    if {$lpp < 1} {
2536        set lpp 1
2537    }
2538    allcanvs yview scroll [expr {$dir * $lpp}] units
2539    if {![info exists selectedline]} return
2540    set l [expr {$selectedline + $dir * $lpp}]
2541    if {$l < 0} {
2542        set l 0
2543    } elseif {$l >= $numcommits} {
2544        set l [expr $numcommits - 1]
2545    }
2546    unmarkmatches
2547    selectline $l 1    
2548}
2549
2550proc unselectline {} {
2551    global selectedline
2552
2553    catch {unset selectedline}
2554    allcanvs delete secsel
2555}
2556
2557proc addtohistory {cmd} {
2558    global history historyindex
2559
2560    if {$historyindex > 0
2561        && [lindex $history [expr {$historyindex - 1}]] == $cmd} {
2562        return
2563    }
2564
2565    if {$historyindex < [llength $history]} {
2566        set history [lreplace $history $historyindex end $cmd]
2567    } else {
2568        lappend history $cmd
2569    }
2570    incr historyindex
2571    if {$historyindex > 1} {
2572        .ctop.top.bar.leftbut conf -state normal
2573    } else {
2574        .ctop.top.bar.leftbut conf -state disabled
2575    }
2576    .ctop.top.bar.rightbut conf -state disabled
2577}
2578
2579proc goback {} {
2580    global history historyindex
2581
2582    if {$historyindex > 1} {
2583        incr historyindex -1
2584        set cmd [lindex $history [expr {$historyindex - 1}]]
2585        eval $cmd
2586        .ctop.top.bar.rightbut conf -state normal
2587    }
2588    if {$historyindex <= 1} {
2589        .ctop.top.bar.leftbut conf -state disabled
2590    }
2591}
2592
2593proc goforw {} {
2594    global history historyindex
2595
2596    if {$historyindex < [llength $history]} {
2597        set cmd [lindex $history $historyindex]
2598        incr historyindex
2599        eval $cmd
2600        .ctop.top.bar.leftbut conf -state normal
2601    }
2602    if {$historyindex >= [llength $history]} {
2603        .ctop.top.bar.rightbut conf -state disabled
2604    }
2605}
2606
2607proc mergediff {id l} {
2608    global diffmergeid diffopts mdifffd
2609    global difffilestart diffids
2610    global parentlist
2611
2612    set diffmergeid $id
2613    set diffids $id
2614    catch {unset difffilestart}
2615    # this doesn't seem to actually affect anything...
2616    set env(GIT_DIFF_OPTS) $diffopts
2617    set cmd [concat | git-diff-tree --no-commit-id --cc $id]
2618    if {[catch {set mdf [open $cmd r]} err]} {
2619        error_popup "Error getting merge diffs: $err"
2620        return
2621    }
2622    fconfigure $mdf -blocking 0
2623    set mdifffd($id) $mdf
2624    set np [llength [lindex $parentlist $l]]
2625    fileevent $mdf readable [list getmergediffline $mdf $id $np]
2626    set nextupdate [expr {[clock clicks -milliseconds] + 100}]
2627}
2628
2629proc getmergediffline {mdf id np} {
2630    global diffmergeid ctext cflist nextupdate mergemax
2631    global difffilestart mdifffd
2632
2633    set n [gets $mdf line]
2634    if {$n < 0} {
2635        if {[eof $mdf]} {
2636            close $mdf
2637        }
2638        return
2639    }
2640    if {![info exists diffmergeid] || $id != $diffmergeid
2641        || $mdf != $mdifffd($id)} {
2642        return
2643    }
2644    $ctext conf -state normal
2645    if {[regexp {^diff --cc (.*)} $line match fname]} {
2646        # start of a new file
2647        $ctext insert end "\n"
2648        set here [$ctext index "end - 1c"]
2649        set i [$cflist index end]
2650        $ctext mark set fmark.$i $here
2651        $ctext mark gravity fmark.$i left
2652        set difffilestart([expr {$i-1}]) $here
2653        $cflist insert end $fname
2654        set l [expr {(78 - [string length $fname]) / 2}]
2655        set pad [string range "----------------------------------------" 1 $l]
2656        $ctext insert end "$pad $fname $pad\n" filesep
2657    } elseif {[regexp {^@@} $line]} {
2658        $ctext insert end "$line\n" hunksep
2659    } elseif {[regexp {^[0-9a-f]{40}$} $line] || [regexp {^index} $line]} {
2660        # do nothing
2661    } else {
2662        # parse the prefix - one ' ', '-' or '+' for each parent
2663        set spaces {}
2664        set minuses {}
2665        set pluses {}
2666        set isbad 0
2667        for {set j 0} {$j < $np} {incr j} {
2668            set c [string range $line $j $j]
2669            if {$c == " "} {
2670                lappend spaces $j
2671            } elseif {$c == "-"} {
2672                lappend minuses $j
2673            } elseif {$c == "+"} {
2674                lappend pluses $j
2675            } else {
2676                set isbad 1
2677                break
2678            }
2679        }
2680        set tags {}
2681        set num {}
2682        if {!$isbad && $minuses ne {} && $pluses eq {}} {
2683            # line doesn't appear in result, parents in $minuses have the line
2684            set num [lindex $minuses 0]
2685        } elseif {!$isbad && $pluses ne {} && $minuses eq {}} {
2686            # line appears in result, parents in $pluses don't have the line
2687            lappend tags mresult
2688            set num [lindex $spaces 0]
2689        }
2690        if {$num ne {}} {
2691            if {$num >= $mergemax} {
2692                set num "max"
2693            }
2694            lappend tags m$num
2695        }
2696        $ctext insert end "$line\n" $tags
2697    }
2698    $ctext conf -state disabled
2699    if {[clock clicks -milliseconds] >= $nextupdate} {
2700        incr nextupdate 100
2701        fileevent $mdf readable {}
2702        update
2703        fileevent $mdf readable [list getmergediffline $mdf $id $np]
2704    }
2705}
2706
2707proc startdiff {ids} {
2708    global treediffs diffids treepending diffmergeid
2709
2710    set diffids $ids
2711    catch {unset diffmergeid}
2712    if {![info exists treediffs($ids)]} {
2713        if {![info exists treepending]} {
2714            gettreediffs $ids
2715        }
2716    } else {
2717        addtocflist $ids
2718    }
2719}
2720
2721proc addtocflist {ids} {
2722    global treediffs cflist
2723    foreach f $treediffs($ids) {
2724        $cflist insert end $f
2725    }
2726    getblobdiffs $ids
2727}
2728
2729proc gettreediffs {ids} {
2730    global treediff treepending
2731    set treepending $ids
2732    set treediff {}
2733    if {[catch \
2734         {set gdtf [open [concat | git-diff-tree --no-commit-id -r $ids] r]} \
2735        ]} return
2736    fconfigure $gdtf -blocking 0
2737    fileevent $gdtf readable [list gettreediffline $gdtf $ids]
2738}
2739
2740proc gettreediffline {gdtf ids} {
2741    global treediff treediffs treepending diffids diffmergeid
2742
2743    set n [gets $gdtf line]
2744    if {$n < 0} {
2745        if {![eof $gdtf]} return
2746        close $gdtf
2747        set treediffs($ids) $treediff
2748        unset treepending
2749        if {$ids != $diffids} {
2750            if {![info exists diffmergeid]} {
2751                gettreediffs $diffids
2752            }
2753        } else {
2754            addtocflist $ids
2755        }
2756        return
2757    }
2758    set file [lindex $line 5]
2759    lappend treediff $file
2760}
2761
2762proc getblobdiffs {ids} {
2763    global diffopts blobdifffd diffids env curdifftag curtagstart
2764    global difffilestart nextupdate diffinhdr treediffs
2765
2766    set env(GIT_DIFF_OPTS) $diffopts
2767    set cmd [concat | git-diff-tree --no-commit-id -r -p -C $ids]
2768    if {[catch {set bdf [open $cmd r]} err]} {
2769        puts "error getting diffs: $err"
2770        return
2771    }
2772    set diffinhdr 0
2773    fconfigure $bdf -blocking 0
2774    set blobdifffd($ids) $bdf
2775    set curdifftag Comments
2776    set curtagstart 0.0
2777    catch {unset difffilestart}
2778    fileevent $bdf readable [list getblobdiffline $bdf $diffids]
2779    set nextupdate [expr {[clock clicks -milliseconds] + 100}]
2780}
2781
2782proc getblobdiffline {bdf ids} {
2783    global diffids blobdifffd ctext curdifftag curtagstart
2784    global diffnexthead diffnextnote difffilestart
2785    global nextupdate diffinhdr treediffs
2786
2787    set n [gets $bdf line]
2788    if {$n < 0} {
2789        if {[eof $bdf]} {
2790            close $bdf
2791            if {$ids == $diffids && $bdf == $blobdifffd($ids)} {
2792                $ctext tag add $curdifftag $curtagstart end
2793            }
2794        }
2795        return
2796    }
2797    if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
2798        return
2799    }
2800    $ctext conf -state normal
2801    if {[regexp {^diff --git a/(.*) b/(.*)} $line match fname newname]} {
2802        # start of a new file
2803        $ctext insert end "\n"
2804        $ctext tag add $curdifftag $curtagstart end
2805        set curtagstart [$ctext index "end - 1c"]
2806        set header $newname
2807        set here [$ctext index "end - 1c"]
2808        set i [lsearch -exact $treediffs($diffids) $fname]
2809        if {$i >= 0} {
2810            set difffilestart($i) $here
2811            incr i
2812            $ctext mark set fmark.$i $here
2813            $ctext mark gravity fmark.$i left
2814        }
2815        if {$newname != $fname} {
2816            set i [lsearch -exact $treediffs($diffids) $newname]
2817            if {$i >= 0} {
2818                set difffilestart($i) $here
2819                incr i
2820                $ctext mark set fmark.$i $here
2821                $ctext mark gravity fmark.$i left
2822            }
2823        }
2824        set curdifftag "f:$fname"
2825        $ctext tag delete $curdifftag
2826        set l [expr {(78 - [string length $header]) / 2}]
2827        set pad [string range "----------------------------------------" 1 $l]
2828        $ctext insert end "$pad $header $pad\n" filesep
2829        set diffinhdr 1
2830    } elseif {$diffinhdr && [string compare -length 3 $line "---"] == 0} {
2831        # do nothing
2832    } elseif {$diffinhdr && [string compare -length 3 $line "+++"] == 0} {
2833        set diffinhdr 0
2834    } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \
2835                   $line match f1l f1c f2l f2c rest]} {
2836        $ctext insert end "$line\n" hunksep
2837        set diffinhdr 0
2838    } else {
2839        set x [string range $line 0 0]
2840        if {$x == "-" || $x == "+"} {
2841            set tag [expr {$x == "+"}]
2842            $ctext insert end "$line\n" d$tag
2843        } elseif {$x == " "} {
2844            $ctext insert end "$line\n"
2845        } elseif {$diffinhdr || $x == "\\"} {
2846            # e.g. "\ No newline at end of file"
2847            $ctext insert end "$line\n" filesep
2848        } else {
2849            # Something else we don't recognize
2850            if {$curdifftag != "Comments"} {
2851                $ctext insert end "\n"
2852                $ctext tag add $curdifftag $curtagstart end
2853                set curtagstart [$ctext index "end - 1c"]
2854                set curdifftag Comments
2855            }
2856            $ctext insert end "$line\n" filesep
2857        }
2858    }
2859    $ctext conf -state disabled
2860    if {[clock clicks -milliseconds] >= $nextupdate} {
2861        incr nextupdate 100
2862        fileevent $bdf readable {}
2863        update
2864        fileevent $bdf readable "getblobdiffline $bdf {$ids}"
2865    }
2866}
2867
2868proc nextfile {} {
2869    global difffilestart ctext
2870    set here [$ctext index @0,0]
2871    for {set i 0} {[info exists difffilestart($i)]} {incr i} {
2872        if {[$ctext compare $difffilestart($i) > $here]} {
2873            if {![info exists pos]
2874                || [$ctext compare $difffilestart($i) < $pos]} {
2875                set pos $difffilestart($i)
2876            }
2877        }
2878    }
2879    if {[info exists pos]} {
2880        $ctext yview $pos
2881    }
2882}
2883
2884proc listboxsel {} {
2885    global ctext cflist currentid
2886    if {![info exists currentid]} return
2887    set sel [lsort [$cflist curselection]]
2888    if {$sel eq {}} return
2889    set first [lindex $sel 0]
2890    catch {$ctext yview fmark.$first}
2891}
2892
2893proc setcoords {} {
2894    global linespc charspc canvx0 canvy0 mainfont
2895    global xspc1 xspc2 lthickness
2896
2897    set linespc [font metrics $mainfont -linespace]
2898    set charspc [font measure $mainfont "m"]
2899    set canvy0 [expr {int(3 + 0.5 * $linespc)}]
2900    set canvx0 [expr {int(3 + 0.5 * $linespc)}]
2901    set lthickness [expr {int($linespc / 9) + 1}]
2902    set xspc1(0) $linespc
2903    set xspc2 $linespc
2904}
2905
2906proc redisplay {} {
2907    global canv
2908    global selectedline
2909
2910    set ymax [lindex [$canv cget -scrollregion] 3]
2911    if {$ymax eq {} || $ymax == 0} return
2912    set span [$canv yview]
2913    clear_display
2914    setcanvscroll
2915    allcanvs yview moveto [lindex $span 0]
2916    drawvisible
2917    if {[info exists selectedline]} {
2918        selectline $selectedline 0
2919    }
2920}
2921
2922proc incrfont {inc} {
2923    global mainfont namefont textfont ctext canv phase
2924    global stopped entries
2925    unmarkmatches
2926    set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
2927    set namefont [lreplace $namefont 1 1 [expr {[lindex $namefont 1] + $inc}]]
2928    set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
2929    setcoords
2930    $ctext conf -font $textfont
2931    $ctext tag conf filesep -font [concat $textfont bold]
2932    foreach e $entries {
2933        $e conf -font $mainfont
2934    }
2935    if {$phase == "getcommits"} {
2936        $canv itemconf textitems -font $mainfont
2937    }
2938    redisplay
2939}
2940
2941proc clearsha1 {} {
2942    global sha1entry sha1string
2943    if {[string length $sha1string] == 40} {
2944        $sha1entry delete 0 end
2945    }
2946}
2947
2948proc sha1change {n1 n2 op} {
2949    global sha1string currentid sha1but
2950    if {$sha1string == {}
2951        || ([info exists currentid] && $sha1string == $currentid)} {
2952        set state disabled
2953    } else {
2954        set state normal
2955    }
2956    if {[$sha1but cget -state] == $state} return
2957    if {$state == "normal"} {
2958        $sha1but conf -state normal -relief raised -text "Goto: "
2959    } else {
2960        $sha1but conf -state disabled -relief flat -text "SHA1 ID: "
2961    }
2962}
2963
2964proc gotocommit {} {
2965    global sha1string currentid commitrow tagids headids
2966    global displayorder numcommits
2967
2968    if {$sha1string == {}
2969        || ([info exists currentid] && $sha1string == $currentid)} return
2970    if {[info exists tagids($sha1string)]} {
2971        set id $tagids($sha1string)
2972    } elseif {[info exists headids($sha1string)]} {
2973        set id $headids($sha1string)
2974    } else {
2975        set id [string tolower $sha1string]
2976        if {[regexp {^[0-9a-f]{4,39}$} $id]} {
2977            set matches {}
2978            foreach i $displayorder {
2979                if {[string match $id* $i]} {
2980                    lappend matches $i
2981                }
2982            }
2983            if {$matches ne {}} {
2984                if {[llength $matches] > 1} {
2985                    error_popup "Short SHA1 id $id is ambiguous"
2986                    return
2987                }
2988                set id [lindex $matches 0]
2989            }
2990        }
2991    }
2992    if {[info exists commitrow($id)]} {
2993        selectline $commitrow($id) 1
2994        return
2995    }
2996    if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
2997        set type "SHA1 id"
2998    } else {
2999        set type "Tag/Head"
3000    }
3001    error_popup "$type $sha1string is not known"
3002}
3003
3004proc lineenter {x y id} {
3005    global hoverx hovery hoverid hovertimer
3006    global commitinfo canv
3007
3008    if {![info exists commitinfo($id)] && ![getcommit $id]} return
3009    set hoverx $x
3010    set hovery $y
3011    set hoverid $id
3012    if {[info exists hovertimer]} {
3013        after cancel $hovertimer
3014    }
3015    set hovertimer [after 500 linehover]
3016    $canv delete hover
3017}
3018
3019proc linemotion {x y id} {
3020    global hoverx hovery hoverid hovertimer
3021
3022    if {[info exists hoverid] && $id == $hoverid} {
3023        set hoverx $x
3024        set hovery $y
3025        if {[info exists hovertimer]} {
3026            after cancel $hovertimer
3027        }
3028        set hovertimer [after 500 linehover]
3029    }
3030}
3031
3032proc lineleave {id} {
3033    global hoverid hovertimer canv
3034
3035    if {[info exists hoverid] && $id == $hoverid} {
3036        $canv delete hover
3037        if {[info exists hovertimer]} {
3038            after cancel $hovertimer
3039            unset hovertimer
3040        }
3041        unset hoverid
3042    }
3043}
3044
3045proc linehover {} {
3046    global hoverx hovery hoverid hovertimer
3047    global canv linespc lthickness
3048    global commitinfo mainfont
3049
3050    set text [lindex $commitinfo($hoverid) 0]
3051    set ymax [lindex [$canv cget -scrollregion] 3]
3052    if {$ymax == {}} return
3053    set yfrac [lindex [$canv yview] 0]
3054    set x [expr {$hoverx + 2 * $linespc}]
3055    set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
3056    set x0 [expr {$x - 2 * $lthickness}]
3057    set y0 [expr {$y - 2 * $lthickness}]
3058    set x1 [expr {$x + [font measure $mainfont $text] + 2 * $lthickness}]
3059    set y1 [expr {$y + $linespc + 2 * $lthickness}]
3060    set t [$canv create rectangle $x0 $y0 $x1 $y1 \
3061               -fill \#ffff80 -outline black -width 1 -tags hover]
3062    $canv raise $t
3063    set t [$canv create text $x $y -anchor nw -text $text -tags hover -font $mainfont]
3064    $canv raise $t
3065}
3066
3067proc clickisonarrow {id y} {
3068    global lthickness idrowranges
3069
3070    set thresh [expr {2 * $lthickness + 6}]
3071    set n [expr {[llength $idrowranges($id)] - 1}]
3072    for {set i 1} {$i < $n} {incr i} {
3073        set row [lindex $idrowranges($id) $i]
3074        if {abs([yc $row] - $y) < $thresh} {
3075            return $i
3076        }
3077    }
3078    return {}
3079}
3080
3081proc arrowjump {id n y} {
3082    global idrowranges canv
3083
3084    # 1 <-> 2, 3 <-> 4, etc...
3085    set n [expr {(($n - 1) ^ 1) + 1}]
3086    set row [lindex $idrowranges($id) $n]
3087    set yt [yc $row]
3088    set ymax [lindex [$canv cget -scrollregion] 3]
3089    if {$ymax eq {} || $ymax <= 0} return
3090    set view [$canv yview]
3091    set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
3092    set yfrac [expr {$yt / $ymax - $yspan / 2}]
3093    if {$yfrac < 0} {
3094        set yfrac 0
3095    }
3096    allcanvs yview moveto $yfrac
3097}
3098
3099proc lineclick {x y id isnew} {
3100    global ctext commitinfo childlist commitrow cflist canv thickerline
3101
3102    if {![info exists commitinfo($id)] && ![getcommit $id]} return
3103    unmarkmatches
3104    unselectline
3105    normalline
3106    $canv delete hover
3107    # draw this line thicker than normal
3108    set thickerline $id
3109    drawlines $id
3110    if {$isnew} {
3111        set ymax [lindex [$canv cget -scrollregion] 3]
3112        if {$ymax eq {}} return
3113        set yfrac [lindex [$canv yview] 0]
3114        set y [expr {$y + $yfrac * $ymax}]
3115    }
3116    set dirn [clickisonarrow $id $y]
3117    if {$dirn ne {}} {
3118        arrowjump $id $dirn $y
3119        return
3120    }
3121
3122    if {$isnew} {
3123        addtohistory [list lineclick $x $y $id 0]
3124    }
3125    # fill the details pane with info about this line
3126    $ctext conf -state normal
3127    $ctext delete 0.0 end
3128    $ctext tag conf link -foreground blue -underline 1
3129    $ctext tag bind link <Enter> { %W configure -cursor hand2 }
3130    $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
3131    $ctext insert end "Parent:\t"
3132    $ctext insert end $id [list link link0]
3133    $ctext tag bind link0 <1> [list selbyid $id]
3134    set info $commitinfo($id)
3135    $ctext insert end "\n\t[lindex $info 0]\n"
3136    $ctext insert end "\tAuthor:\t[lindex $info 1]\n"
3137    set date [formatdate [lindex $info 2]]
3138    $ctext insert end "\tDate:\t$date\n"
3139    set kids [lindex $childlist $commitrow($id)]
3140    if {$kids ne {}} {
3141        $ctext insert end "\nChildren:"
3142        set i 0
3143        foreach child $kids {
3144            incr i
3145            if {![info exists commitinfo($child)] && ![getcommit $child]} continue
3146            set info $commitinfo($child)
3147            $ctext insert end "\n\t"
3148            $ctext insert end $child [list link link$i]
3149            $ctext tag bind link$i <1> [list selbyid $child]
3150            $ctext insert end "\n\t[lindex $info 0]"
3151            $ctext insert end "\n\tAuthor:\t[lindex $info 1]"
3152            set date [formatdate [lindex $info 2]]
3153            $ctext insert end "\n\tDate:\t$date\n"
3154        }
3155    }
3156    $ctext conf -state disabled
3157
3158    $cflist delete 0 end
3159}
3160
3161proc normalline {} {
3162    global thickerline
3163    if {[info exists thickerline]} {
3164        set id $thickerline
3165        unset thickerline
3166        drawlines $id
3167    }
3168}
3169
3170proc selbyid {id} {
3171    global commitrow
3172    if {[info exists commitrow($id)]} {
3173        selectline $commitrow($id) 1
3174    }
3175}
3176
3177proc mstime {} {
3178    global startmstime
3179    if {![info exists startmstime]} {
3180        set startmstime [clock clicks -milliseconds]
3181    }
3182    return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
3183}
3184
3185proc rowmenu {x y id} {
3186    global rowctxmenu commitrow selectedline rowmenuid
3187
3188    if {![info exists selectedline] || $commitrow($id) eq $selectedline} {
3189        set state disabled
3190    } else {
3191        set state normal
3192    }
3193    $rowctxmenu entryconfigure 0 -state $state
3194    $rowctxmenu entryconfigure 1 -state $state
3195    $rowctxmenu entryconfigure 2 -state $state
3196    set rowmenuid $id
3197    tk_popup $rowctxmenu $x $y
3198}
3199
3200proc diffvssel {dirn} {
3201    global rowmenuid selectedline displayorder
3202
3203    if {![info exists selectedline]} return
3204    if {$dirn} {
3205        set oldid [lindex $displayorder $selectedline]
3206        set newid $rowmenuid
3207    } else {
3208        set oldid $rowmenuid
3209        set newid [lindex $displayorder $selectedline]
3210    }
3211    addtohistory [list doseldiff $oldid $newid]
3212    doseldiff $oldid $newid
3213}
3214
3215proc doseldiff {oldid newid} {
3216    global ctext cflist
3217    global commitinfo
3218
3219    $ctext conf -state normal
3220    $ctext delete 0.0 end
3221    $ctext mark set fmark.0 0.0
3222    $ctext mark gravity fmark.0 left
3223    $cflist delete 0 end
3224    $cflist insert end "Top"
3225    $ctext insert end "From "
3226    $ctext tag conf link -foreground blue -underline 1
3227    $ctext tag bind link <Enter> { %W configure -cursor hand2 }
3228    $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
3229    $ctext tag bind link0 <1> [list selbyid $oldid]
3230    $ctext insert end $oldid [list link link0]
3231    $ctext insert end "\n     "
3232    $ctext insert end [lindex $commitinfo($oldid) 0]
3233    $ctext insert end "\n\nTo   "
3234    $ctext tag bind link1 <1> [list selbyid $newid]
3235    $ctext insert end $newid [list link link1]
3236    $ctext insert end "\n     "
3237    $ctext insert end [lindex $commitinfo($newid) 0]
3238    $ctext insert end "\n"
3239    $ctext conf -state disabled
3240    $ctext tag delete Comments
3241    $ctext tag remove found 1.0 end
3242    startdiff [list $oldid $newid]
3243}
3244
3245proc mkpatch {} {
3246    global rowmenuid currentid commitinfo patchtop patchnum
3247
3248    if {![info exists currentid]} return
3249    set oldid $currentid
3250    set oldhead [lindex $commitinfo($oldid) 0]
3251    set newid $rowmenuid
3252    set newhead [lindex $commitinfo($newid) 0]
3253    set top .patch
3254    set patchtop $top
3255    catch {destroy $top}
3256    toplevel $top
3257    label $top.title -text "Generate patch"
3258    grid $top.title - -pady 10
3259    label $top.from -text "From:"
3260    entry $top.fromsha1 -width 40 -relief flat
3261    $top.fromsha1 insert 0 $oldid
3262    $top.fromsha1 conf -state readonly
3263    grid $top.from $top.fromsha1 -sticky w
3264    entry $top.fromhead -width 60 -relief flat
3265    $top.fromhead insert 0 $oldhead
3266    $top.fromhead conf -state readonly
3267    grid x $top.fromhead -sticky w
3268    label $top.to -text "To:"
3269    entry $top.tosha1 -width 40 -relief flat
3270    $top.tosha1 insert 0 $newid
3271    $top.tosha1 conf -state readonly
3272    grid $top.to $top.tosha1 -sticky w
3273    entry $top.tohead -width 60 -relief flat
3274    $top.tohead insert 0 $newhead
3275    $top.tohead conf -state readonly
3276    grid x $top.tohead -sticky w
3277    button $top.rev -text "Reverse" -command mkpatchrev -padx 5
3278    grid $top.rev x -pady 10
3279    label $top.flab -text "Output file:"
3280    entry $top.fname -width 60
3281    $top.fname insert 0 [file normalize "patch$patchnum.patch"]
3282    incr patchnum
3283    grid $top.flab $top.fname -sticky w
3284    frame $top.buts
3285    button $top.buts.gen -text "Generate" -command mkpatchgo
3286    button $top.buts.can -text "Cancel" -command mkpatchcan
3287    grid $top.buts.gen $top.buts.can
3288    grid columnconfigure $top.buts 0 -weight 1 -uniform a
3289    grid columnconfigure $top.buts 1 -weight 1 -uniform a
3290    grid $top.buts - -pady 10 -sticky ew
3291    focus $top.fname
3292}
3293
3294proc mkpatchrev {} {
3295    global patchtop
3296
3297    set oldid [$patchtop.fromsha1 get]
3298    set oldhead [$patchtop.fromhead get]
3299    set newid [$patchtop.tosha1 get]
3300    set newhead [$patchtop.tohead get]
3301    foreach e [list fromsha1 fromhead tosha1 tohead] \
3302            v [list $newid $newhead $oldid $oldhead] {
3303        $patchtop.$e conf -state normal
3304        $patchtop.$e delete 0 end
3305        $patchtop.$e insert 0 $v
3306        $patchtop.$e conf -state readonly
3307    }
3308}
3309
3310proc mkpatchgo {} {
3311    global patchtop
3312
3313    set oldid [$patchtop.fromsha1 get]
3314    set newid [$patchtop.tosha1 get]
3315    set fname [$patchtop.fname get]
3316    if {[catch {exec git-diff-tree -p $oldid $newid >$fname &} err]} {
3317        error_popup "Error creating patch: $err"
3318    }
3319    catch {destroy $patchtop}
3320    unset patchtop
3321}
3322
3323proc mkpatchcan {} {
3324    global patchtop
3325
3326    catch {destroy $patchtop}
3327    unset patchtop
3328}
3329
3330proc mktag {} {
3331    global rowmenuid mktagtop commitinfo
3332
3333    set top .maketag
3334    set mktagtop $top
3335    catch {destroy $top}
3336    toplevel $top
3337    label $top.title -text "Create tag"
3338    grid $top.title - -pady 10
3339    label $top.id -text "ID:"
3340    entry $top.sha1 -width 40 -relief flat
3341    $top.sha1 insert 0 $rowmenuid
3342    $top.sha1 conf -state readonly
3343    grid $top.id $top.sha1 -sticky w
3344    entry $top.head -width 60 -relief flat
3345    $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
3346    $top.head conf -state readonly
3347    grid x $top.head -sticky w
3348    label $top.tlab -text "Tag name:"
3349    entry $top.tag -width 60
3350    grid $top.tlab $top.tag -sticky w
3351    frame $top.buts
3352    button $top.buts.gen -text "Create" -command mktaggo
3353    button $top.buts.can -text "Cancel" -command mktagcan
3354    grid $top.buts.gen $top.buts.can
3355    grid columnconfigure $top.buts 0 -weight 1 -uniform a
3356    grid columnconfigure $top.buts 1 -weight 1 -uniform a
3357    grid $top.buts - -pady 10 -sticky ew
3358    focus $top.tag
3359}
3360
3361proc domktag {} {
3362    global mktagtop env tagids idtags
3363
3364    set id [$mktagtop.sha1 get]
3365    set tag [$mktagtop.tag get]
3366    if {$tag == {}} {
3367        error_popup "No tag name specified"
3368        return
3369    }
3370    if {[info exists tagids($tag)]} {
3371        error_popup "Tag \"$tag\" already exists"
3372        return
3373    }
3374    if {[catch {
3375        set dir [gitdir]
3376        set fname [file join $dir "refs/tags" $tag]
3377        set f [open $fname w]
3378        puts $f $id
3379        close $f
3380    } err]} {
3381        error_popup "Error creating tag: $err"
3382        return
3383    }
3384
3385    set tagids($tag) $id
3386    lappend idtags($id) $tag
3387    redrawtags $id
3388}
3389
3390proc redrawtags {id} {
3391    global canv linehtag commitrow idpos selectedline
3392
3393    if {![info exists commitrow($id)]} return
3394    drawcmitrow $commitrow($id)
3395    $canv delete tag.$id
3396    set xt [eval drawtags $id $idpos($id)]
3397    $canv coords $linehtag($commitrow($id)) $xt [lindex $idpos($id) 2]
3398    if {[info exists selectedline] && $selectedline == $commitrow($id)} {
3399        selectline $selectedline 0
3400    }
3401}
3402
3403proc mktagcan {} {
3404    global mktagtop
3405
3406    catch {destroy $mktagtop}
3407    unset mktagtop
3408}
3409
3410proc mktaggo {} {
3411    domktag
3412    mktagcan
3413}
3414
3415proc writecommit {} {
3416    global rowmenuid wrcomtop commitinfo wrcomcmd
3417
3418    set top .writecommit
3419    set wrcomtop $top
3420    catch {destroy $top}
3421    toplevel $top
3422    label $top.title -text "Write commit to file"
3423    grid $top.title - -pady 10
3424    label $top.id -text "ID:"
3425    entry $top.sha1 -width 40 -relief flat
3426    $top.sha1 insert 0 $rowmenuid
3427    $top.sha1 conf -state readonly
3428    grid $top.id $top.sha1 -sticky w
3429    entry $top.head -width 60 -relief flat
3430    $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
3431    $top.head conf -state readonly
3432    grid x $top.head -sticky w
3433    label $top.clab -text "Command:"
3434    entry $top.cmd -width 60 -textvariable wrcomcmd
3435    grid $top.clab $top.cmd -sticky w -pady 10
3436    label $top.flab -text "Output file:"
3437    entry $top.fname -width 60
3438    $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
3439    grid $top.flab $top.fname -sticky w
3440    frame $top.buts
3441    button $top.buts.gen -text "Write" -command wrcomgo
3442    button $top.buts.can -text "Cancel" -command wrcomcan
3443    grid $top.buts.gen $top.buts.can
3444    grid columnconfigure $top.buts 0 -weight 1 -uniform a
3445    grid columnconfigure $top.buts 1 -weight 1 -uniform a
3446    grid $top.buts - -pady 10 -sticky ew
3447    focus $top.fname
3448}
3449
3450proc wrcomgo {} {
3451    global wrcomtop
3452
3453    set id [$wrcomtop.sha1 get]
3454    set cmd "echo $id | [$wrcomtop.cmd get]"
3455    set fname [$wrcomtop.fname get]
3456    if {[catch {exec sh -c $cmd >$fname &} err]} {
3457        error_popup "Error writing commit: $err"
3458    }
3459    catch {destroy $wrcomtop}
3460    unset wrcomtop
3461}
3462
3463proc wrcomcan {} {
3464    global wrcomtop
3465
3466    catch {destroy $wrcomtop}
3467    unset wrcomtop
3468}
3469
3470proc listrefs {id} {
3471    global idtags idheads idotherrefs
3472
3473    set x {}
3474    if {[info exists idtags($id)]} {
3475        set x $idtags($id)
3476    }
3477    set y {}
3478    if {[info exists idheads($id)]} {
3479        set y $idheads($id)
3480    }
3481    set z {}
3482    if {[info exists idotherrefs($id)]} {
3483        set z $idotherrefs($id)
3484    }
3485    return [list $x $y $z]
3486}
3487
3488proc rereadrefs {} {
3489    global idtags idheads idotherrefs
3490
3491    set refids [concat [array names idtags] \
3492                    [array names idheads] [array names idotherrefs]]
3493    foreach id $refids {
3494        if {![info exists ref($id)]} {
3495            set ref($id) [listrefs $id]
3496        }
3497    }
3498    readrefs
3499    set refids [lsort -unique [concat $refids [array names idtags] \
3500                        [array names idheads] [array names idotherrefs]]]
3501    foreach id $refids {
3502        set v [listrefs $id]
3503        if {![info exists ref($id)] || $ref($id) != $v} {
3504            redrawtags $id
3505        }
3506    }
3507}
3508
3509proc showtag {tag isnew} {
3510    global ctext cflist tagcontents tagids linknum
3511
3512    if {$isnew} {
3513        addtohistory [list showtag $tag 0]
3514    }
3515    $ctext conf -state normal
3516    $ctext delete 0.0 end
3517    set linknum 0
3518    if {[info exists tagcontents($tag)]} {
3519        set text $tagcontents($tag)
3520    } else {
3521        set text "Tag: $tag\nId:  $tagids($tag)"
3522    }
3523    appendwithlinks $text
3524    $ctext conf -state disabled
3525    $cflist delete 0 end
3526}
3527
3528proc doquit {} {
3529    global stopped
3530    set stopped 100
3531    destroy .
3532}
3533
3534proc doprefs {} {
3535    global maxwidth maxgraphpct diffopts findmergefiles
3536    global oldprefs prefstop
3537
3538    set top .gitkprefs
3539    set prefstop $top
3540    if {[winfo exists $top]} {
3541        raise $top
3542        return
3543    }
3544    foreach v {maxwidth maxgraphpct diffopts findmergefiles} {
3545        set oldprefs($v) [set $v]
3546    }
3547    toplevel $top
3548    wm title $top "Gitk preferences"
3549    label $top.ldisp -text "Commit list display options"
3550    grid $top.ldisp - -sticky w -pady 10
3551    label $top.spacer -text " "
3552    label $top.maxwidthl -text "Maximum graph width (lines)" \
3553        -font optionfont
3554    spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
3555    grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
3556    label $top.maxpctl -text "Maximum graph width (% of pane)" \
3557        -font optionfont
3558    spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
3559    grid x $top.maxpctl $top.maxpct -sticky w
3560    checkbutton $top.findm -variable findmergefiles
3561    label $top.findml -text "Include merges for \"Find\" in \"Files\"" \
3562        -font optionfont
3563    grid $top.findm $top.findml - -sticky w
3564    label $top.ddisp -text "Diff display options"
3565    grid $top.ddisp - -sticky w -pady 10
3566    label $top.diffoptl -text "Options for diff program" \
3567        -font optionfont
3568    entry $top.diffopt -width 20 -textvariable diffopts
3569    grid x $top.diffoptl $top.diffopt -sticky w
3570    frame $top.buts
3571    button $top.buts.ok -text "OK" -command prefsok
3572    button $top.buts.can -text "Cancel" -command prefscan
3573    grid $top.buts.ok $top.buts.can
3574    grid columnconfigure $top.buts 0 -weight 1 -uniform a
3575    grid columnconfigure $top.buts 1 -weight 1 -uniform a
3576    grid $top.buts - - -pady 10 -sticky ew
3577}
3578
3579proc prefscan {} {
3580    global maxwidth maxgraphpct diffopts findmergefiles
3581    global oldprefs prefstop
3582
3583    foreach v {maxwidth maxgraphpct diffopts findmergefiles} {
3584        set $v $oldprefs($v)
3585    }
3586    catch {destroy $prefstop}
3587    unset prefstop
3588}
3589
3590proc prefsok {} {
3591    global maxwidth maxgraphpct
3592    global oldprefs prefstop
3593
3594    catch {destroy $prefstop}
3595    unset prefstop
3596    if {$maxwidth != $oldprefs(maxwidth)
3597        || $maxgraphpct != $oldprefs(maxgraphpct)} {
3598        redisplay
3599    }
3600}
3601
3602proc formatdate {d} {
3603    return [clock format $d -format "%Y-%m-%d %H:%M:%S"]
3604}
3605
3606# This list of encoding names and aliases is distilled from
3607# http://www.iana.org/assignments/character-sets.
3608# Not all of them are supported by Tcl.
3609set encoding_aliases {
3610    { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
3611      ISO646-US US-ASCII us IBM367 cp367 csASCII }
3612    { ISO-10646-UTF-1 csISO10646UTF1 }
3613    { ISO_646.basic:1983 ref csISO646basic1983 }
3614    { INVARIANT csINVARIANT }
3615    { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
3616    { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
3617    { NATS-SEFI iso-ir-8-1 csNATSSEFI }
3618    { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
3619    { NATS-DANO iso-ir-9-1 csNATSDANO }
3620    { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
3621    { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
3622    { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
3623    { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
3624    { ISO-2022-KR csISO2022KR }
3625    { EUC-KR csEUCKR }
3626    { ISO-2022-JP csISO2022JP }
3627    { ISO-2022-JP-2 csISO2022JP2 }
3628    { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
3629      csISO13JISC6220jp }
3630    { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
3631    { IT iso-ir-15 ISO646-IT csISO15Italian }
3632    { PT iso-ir-16 ISO646-PT csISO16Portuguese }
3633    { ES iso-ir-17 ISO646-ES csISO17Spanish }
3634    { greek7-old iso-ir-18 csISO18Greek7Old }
3635    { latin-greek iso-ir-19 csISO19LatinGreek }
3636    { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
3637    { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
3638    { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
3639    { ISO_5427 iso-ir-37 csISO5427Cyrillic }
3640    { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
3641    { BS_viewdata iso-ir-47 csISO47BSViewdata }
3642    { INIS iso-ir-49 csISO49INIS }
3643    { INIS-8 iso-ir-50 csISO50INIS8 }
3644    { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
3645    { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
3646    { ISO_5428:1980 iso-ir-55 csISO5428Greek }
3647    { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
3648    { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
3649    { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
3650      csISO60Norwegian1 }
3651    { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
3652    { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
3653    { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
3654    { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
3655    { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
3656    { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
3657    { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
3658    { greek7 iso-ir-88 csISO88Greek7 }
3659    { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
3660    { iso-ir-90 csISO90 }
3661    { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
3662    { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
3663      csISO92JISC62991984b }
3664    { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
3665    { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
3666    { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
3667      csISO95JIS62291984handadd }
3668    { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
3669    { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
3670    { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
3671    { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
3672      CP819 csISOLatin1 }
3673    { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
3674    { T.61-7bit iso-ir-102 csISO102T617bit }
3675    { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
3676    { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
3677    { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
3678    { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
3679    { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
3680    { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
3681    { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
3682    { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
3683      arabic csISOLatinArabic }
3684    { ISO_8859-6-E csISO88596E ISO-8859-6-E }
3685    { ISO_8859-6-I csISO88596I ISO-8859-6-I }
3686    { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
3687      greek greek8 csISOLatinGreek }
3688    { T.101-G2 iso-ir-128 csISO128T101G2 }
3689    { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
3690      csISOLatinHebrew }
3691    { ISO_8859-8-E csISO88598E ISO-8859-8-E }
3692    { ISO_8859-8-I csISO88598I ISO-8859-8-I }
3693    { CSN_369103 iso-ir-139 csISO139CSN369103 }
3694    { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
3695    { ISO_6937-2-add iso-ir-142 csISOTextComm }
3696    { IEC_P27-1 iso-ir-143 csISO143IECP271 }
3697    { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
3698      csISOLatinCyrillic }
3699    { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
3700    { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
3701    { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
3702    { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
3703    { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
3704    { ISO_6937-2-25 iso-ir-152 csISO6937Add }
3705    { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
3706    { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
3707    { ISO_10367-box iso-ir-155 csISO10367Box }
3708    { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
3709    { latin-lap lap iso-ir-158 csISO158Lap }
3710    { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
3711    { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
3712    { us-dk csUSDK }
3713    { dk-us csDKUS }
3714    { JIS_X0201 X0201 csHalfWidthKatakana }
3715    { KSC5636 ISO646-KR csKSC5636 }
3716    { ISO-10646-UCS-2 csUnicode }
3717    { ISO-10646-UCS-4 csUCS4 }
3718    { DEC-MCS dec csDECMCS }
3719    { hp-roman8 roman8 r8 csHPRoman8 }
3720    { macintosh mac csMacintosh }
3721    { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
3722      csIBM037 }
3723    { IBM038 EBCDIC-INT cp038 csIBM038 }
3724    { IBM273 CP273 csIBM273 }
3725    { IBM274 EBCDIC-BE CP274 csIBM274 }
3726    { IBM275 EBCDIC-BR cp275 csIBM275 }
3727    { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
3728    { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
3729    { IBM280 CP280 ebcdic-cp-it csIBM280 }
3730    { IBM281 EBCDIC-JP-E cp281 csIBM281 }
3731    { IBM284 CP284 ebcdic-cp-es csIBM284 }
3732    { IBM285 CP285 ebcdic-cp-gb csIBM285 }
3733    { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
3734    { IBM297 cp297 ebcdic-cp-fr csIBM297 }
3735    { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
3736    { IBM423 cp423 ebcdic-cp-gr csIBM423 }
3737    { IBM424 cp424 ebcdic-cp-he csIBM424 }
3738    { IBM437 cp437 437 csPC8CodePage437 }
3739    { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
3740    { IBM775 cp775 csPC775Baltic }
3741    { IBM850 cp850 850 csPC850Multilingual }
3742    { IBM851 cp851 851 csIBM851 }
3743    { IBM852 cp852 852 csPCp852 }
3744    { IBM855 cp855 855 csIBM855 }
3745    { IBM857 cp857 857 csIBM857 }
3746    { IBM860 cp860 860 csIBM860 }
3747    { IBM861 cp861 861 cp-is csIBM861 }
3748    { IBM862 cp862 862 csPC862LatinHebrew }
3749    { IBM863 cp863 863 csIBM863 }
3750    { IBM864 cp864 csIBM864 }
3751    { IBM865 cp865 865 csIBM865 }
3752    { IBM866 cp866 866 csIBM866 }
3753    { IBM868 CP868 cp-ar csIBM868 }
3754    { IBM869 cp869 869 cp-gr csIBM869 }
3755    { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
3756    { IBM871 CP871 ebcdic-cp-is csIBM871 }
3757    { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
3758    { IBM891 cp891 csIBM891 }
3759    { IBM903 cp903 csIBM903 }
3760    { IBM904 cp904 904 csIBBM904 }
3761    { IBM905 CP905 ebcdic-cp-tr csIBM905 }
3762    { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
3763    { IBM1026 CP1026 csIBM1026 }
3764    { EBCDIC-AT-DE csIBMEBCDICATDE }
3765    { EBCDIC-AT-DE-A csEBCDICATDEA }
3766    { EBCDIC-CA-FR csEBCDICCAFR }
3767    { EBCDIC-DK-NO csEBCDICDKNO }
3768    { EBCDIC-DK-NO-A csEBCDICDKNOA }
3769    { EBCDIC-FI-SE csEBCDICFISE }
3770    { EBCDIC-FI-SE-A csEBCDICFISEA }
3771    { EBCDIC-FR csEBCDICFR }
3772    { EBCDIC-IT csEBCDICIT }
3773    { EBCDIC-PT csEBCDICPT }
3774    { EBCDIC-ES csEBCDICES }
3775    { EBCDIC-ES-A csEBCDICESA }
3776    { EBCDIC-ES-S csEBCDICESS }
3777    { EBCDIC-UK csEBCDICUK }
3778    { EBCDIC-US csEBCDICUS }
3779    { UNKNOWN-8BIT csUnknown8BiT }
3780    { MNEMONIC csMnemonic }
3781    { MNEM csMnem }
3782    { VISCII csVISCII }
3783    { VIQR csVIQR }
3784    { KOI8-R csKOI8R }
3785    { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
3786    { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
3787    { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
3788    { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
3789    { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
3790    { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
3791    { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
3792    { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
3793    { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
3794    { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
3795    { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
3796    { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
3797    { IBM1047 IBM-1047 }
3798    { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
3799    { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
3800    { UNICODE-1-1 csUnicode11 }
3801    { CESU-8 csCESU-8 }
3802    { BOCU-1 csBOCU-1 }
3803    { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
3804    { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
3805      l8 }
3806    { ISO-8859-15 ISO_8859-15 Latin-9 }
3807    { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
3808    { GBK CP936 MS936 windows-936 }
3809    { JIS_Encoding csJISEncoding }
3810    { Shift_JIS MS_Kanji csShiftJIS }
3811    { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
3812      EUC-JP }
3813    { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
3814    { ISO-10646-UCS-Basic csUnicodeASCII }
3815    { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
3816    { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
3817    { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
3818    { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
3819    { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
3820    { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
3821    { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
3822    { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
3823    { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
3824    { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
3825    { Adobe-Standard-Encoding csAdobeStandardEncoding }
3826    { Ventura-US csVenturaUS }
3827    { Ventura-International csVenturaInternational }
3828    { PC8-Danish-Norwegian csPC8DanishNorwegian }
3829    { PC8-Turkish csPC8Turkish }
3830    { IBM-Symbols csIBMSymbols }
3831    { IBM-Thai csIBMThai }
3832    { HP-Legal csHPLegal }
3833    { HP-Pi-font csHPPiFont }
3834    { HP-Math8 csHPMath8 }
3835    { Adobe-Symbol-Encoding csHPPSMath }
3836    { HP-DeskTop csHPDesktop }
3837    { Ventura-Math csVenturaMath }
3838    { Microsoft-Publishing csMicrosoftPublishing }
3839    { Windows-31J csWindows31J }
3840    { GB2312 csGB2312 }
3841    { Big5 csBig5 }
3842}
3843
3844proc tcl_encoding {enc} {
3845    global encoding_aliases
3846    set names [encoding names]
3847    set lcnames [string tolower $names]
3848    set enc [string tolower $enc]
3849    set i [lsearch -exact $lcnames $enc]
3850    if {$i < 0} {
3851        # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
3852        if {[regsub {^iso[-_]} $enc iso encx]} {
3853            set i [lsearch -exact $lcnames $encx]
3854        }
3855    }
3856    if {$i < 0} {
3857        foreach l $encoding_aliases {
3858            set ll [string tolower $l]
3859            if {[lsearch -exact $ll $enc] < 0} continue
3860            # look through the aliases for one that tcl knows about
3861            foreach e $ll {
3862                set i [lsearch -exact $lcnames $e]
3863                if {$i < 0} {
3864                    if {[regsub {^iso[-_]} $e iso ex]} {
3865                        set i [lsearch -exact $lcnames $ex]
3866                    }
3867                }
3868                if {$i >= 0} break
3869            }
3870            break
3871        }
3872    }
3873    if {$i >= 0} {
3874        return [lindex $names $i]
3875    }
3876    return {}
3877}
3878
3879# defaults...
3880set datemode 0
3881set diffopts "-U 5 -p"
3882set wrcomcmd "git-diff-tree --stdin -p --pretty"
3883
3884set gitencoding {}
3885catch {
3886    set gitencoding [exec git-repo-config --get i18n.commitencoding]
3887}
3888if {$gitencoding == ""} {
3889    set gitencoding "utf-8"
3890}
3891set tclencoding [tcl_encoding $gitencoding]
3892if {$tclencoding == {}} {
3893    puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
3894}
3895
3896set mainfont {Helvetica 9}
3897set textfont {Courier 9}
3898set uifont {Helvetica 9 bold}
3899set findmergefiles 0
3900set maxgraphpct 50
3901set maxwidth 16
3902set revlistorder 0
3903set fastdate 0
3904set uparrowlen 7
3905set downarrowlen 7
3906set mingaplen 30
3907
3908set colors {green red blue magenta darkgrey brown orange}
3909
3910catch {source ~/.gitk}
3911
3912set namefont $mainfont
3913
3914font create optionfont -family sans-serif -size -12
3915
3916set revtreeargs {}
3917foreach arg $argv {
3918    switch -regexp -- $arg {
3919        "^$" { }
3920        "^-d" { set datemode 1 }
3921        default {
3922            lappend revtreeargs $arg
3923        }
3924    }
3925}
3926
3927# check that we can find a .git directory somewhere...
3928set gitdir [gitdir]
3929if {![file isdirectory $gitdir]} {
3930    error_popup "Cannot find the git directory \"$gitdir\"."
3931    exit 1
3932}
3933
3934set history {}
3935set historyindex 0
3936
3937set optim_delay 16
3938
3939set stopped 0
3940set stuffsaved 0
3941set patchnum 0
3942setcoords
3943makewindow $revtreeargs
3944readrefs
3945getcommits $revtreeargs