gitk

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