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