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