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