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