git.oblomov.eu Git - git/blob - 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 # CVS $Revision: 1.24 $
  11
  12 proc getcommits {rargs} {
  13     global commits commfd phase canv mainfont
  14     global startmsecs nextupdate
  15     global ctext maincursor textcursor nlines
  16
  17     if {$rargs == {}} {
  18         set rargs HEAD
  19     }
  20     set commits {}
  21     set phase getcommits
  22     set startmsecs [clock clicks -milliseconds]
  23     set nextupdate [expr $startmsecs + 100]
  24     if [catch {set commfd [open "|git-rev-list --merge-order $rargs" r]} err] {
  25         puts stderr "Error executing git-rev-list: $err"
  26         exit 1
  27     }
  28     set nlines 0
  29     fconfigure $commfd -blocking 0
  30     fileevent $commfd readable "getcommitline $commfd"
  31     $canv delete all
  32     $canv create text 3 3 -anchor nw -text "Reading commits..." \
  33         -font $mainfont -tags textitems
  34     . config -cursor watch
  35     $ctext config -cursor watch
  36 }
  37
  38 proc getcommitline {commfd}  {
  39     global commits parents cdate children nchildren ncleft
  40     global commitlisted phase commitinfo nextupdate
  41     global stopped redisplaying nlines
  42
  43     set n [gets $commfd line]
  44     if {$n < 0} {
  45         if {![eof $commfd]} return
  46         # this works around what is apparently a bug in Tcl...
  47         fconfigure $commfd -blocking 1
  48         if {![catch {close $commfd} err]} {
  49             after idle finishcommits
  50             return
  51         }
  52         if {[string range $err 0 4] == "usage"} {
  53             set err \
  54 {Gitk: error reading commits: bad arguments to git-rev-list.
  55 (Note: arguments to gitk are passed to git-rev-list
  56 to allow selection of commits to be displayed.)}
  57         } else {
  58             set err "Error reading commits: $err"
  59         }
  60         error_popup $err
  61         exit 1
  62     }
  63     incr nlines
  64     if {![regexp {^[0-9a-f]{40}$} $line id]} {
  65         error_popup "Can't parse git-rev-list output: {$line}"
  66         exit 1
  67     }
  68     lappend commits $id
  69     set commitlisted($id) 1
  70     if {![info exists commitinfo($id)]} {
  71         readcommit $id
  72     }
  73     foreach p $parents($id) {
  74         if {[info exists commitlisted($p)]} {
  75             puts "oops, parent $p before child $id"
  76         }
  77     }
  78     drawcommit $id
  79     if {[clock clicks -milliseconds] >= $nextupdate} {
  80         doupdate
  81     }
  82     while {$redisplaying} {
  83         set redisplaying 0
  84         if {$stopped == 1} {
  85             set stopped 0
  86             set phase "getcommits"
  87             foreach id $commits {
  88                 drawcommit $id
  89                 if {$stopped} break
  90                 if {[clock clicks -milliseconds] >= $nextupdate} {
  91                     doupdate
  92                 }
  93             }
  94         }
  95     }
  96 }
  97
  98 proc doupdate {} {
  99     global commfd nextupdate
 100
 101     incr nextupdate 100
 102     fileevent $commfd readable {}
 103     update
 104     fileevent $commfd readable "getcommitline $commfd"
 105 }
 106
 107 proc readcommit {id} {
 108     global commitinfo children nchildren parents nparents cdate ncleft
 109     global noreadobj
 110
 111     set inhdr 1
 112     set comment {}
 113     set headline {}
 114     set auname {}
 115     set audate {}
 116     set comname {}
 117     set comdate {}
 118     if {![info exists nchildren($id)]} {
 119         set children($id) {}
 120         set nchildren($id) 0
 121         set ncleft($id) 0
 122     }
 123     set parents($id) {}
 124     set nparents($id) 0
 125     if {$noreadobj} {
 126         if [catch {set contents [exec git-cat-file commit $id]}] return
 127     } else {
 128         if [catch {set x [readobj $id]}] return
 129         if {[lindex $x 0] != "commit"} return
 130         set contents [lindex $x 1]
 131     }
 132     foreach line [split $contents "\n"] {
 133         if {$inhdr} {
 134             if {$line == {}} {
 135                 set inhdr 0
 136             } else {
 137                 set tag [lindex $line 0]
 138                 if {$tag == "parent"} {
 139                     set p [lindex $line 1]
 140                     if {![info exists nchildren($p)]} {
 141                         set children($p) {}
 142                         set nchildren($p) 0
 143                         set ncleft($p) 0
 144                     }
 145                     lappend parents($id) $p
 146                     incr nparents($id)
 147                     if {[lsearch -exact $children($p) $id] < 0} {
 148                         lappend children($p) $id
 149                         incr nchildren($p)
 150                         incr ncleft($p)
 151                     } else {
 152                         puts "child $id already in $p's list??"
 153                     }
 154                 } elseif {$tag == "author"} {
 155                     set x [expr {[llength $line] - 2}]
 156                     set audate [lindex $line $x]
 157                     set auname [lrange $line 1 [expr {$x - 1}]]
 158                 } elseif {$tag == "committer"} {
 159                     set x [expr {[llength $line] - 2}]
 160                     set comdate [lindex $line $x]
 161                     set comname [lrange $line 1 [expr {$x - 1}]]
 162                 }
 163             }
 164         } else {
 165             if {$comment == {}} {
 166                 set headline $line
 167             } else {
 168                 append comment "\n"
 169             }
 170             append comment $line
 171         }
 172     }
 173     if {$audate != {}} {
 174         set audate [clock format $audate -format "%Y-%m-%d %H:%M:%S"]
 175     }
 176     if {$comdate != {}} {
 177         set cdate($id) $comdate
 178         set comdate [clock format $comdate -format "%Y-%m-%d %H:%M:%S"]
 179     }
 180     set commitinfo($id) [list $headline $auname $audate \
 181                              $comname $comdate $comment]
 182 }
 183
 184 proc readrefs {} {
 185     global tagids idtags headids idheads
 186     set tags [glob -nocomplain -types f .git/refs/tags/*]
 187     foreach f $tags {
 188         catch {
 189             set fd [open $f r]
 190             set line [read $fd]
 191             if {[regexp {^[0-9a-f]{40}} $line id]} {
 192                 set direct [file tail $f]
 193                 set tagids($direct) $id
 194                 lappend idtags($id) $direct
 195                 set contents [split [exec git-cat-file tag $id] "\n"]
 196                 set obj {}
 197                 set type {}
 198                 set tag {}
 199                 foreach l $contents {
 200                     if {$l == {}} break
 201                     switch -- [lindex $l 0] {
 202                         "object" {set obj [lindex $l 1]}
 203                         "type" {set type [lindex $l 1]}
 204                         "tag" {set tag [string range $l 4 end]}
 205                     }
 206                 }
 207                 if {$obj != {} && $type == "commit" && $tag != {}} {
 208                     set tagids($tag) $obj
 209                     lappend idtags($obj) $tag
 210                 }
 211             }
 212             close $fd
 213         }
 214     }
 215     set heads [glob -nocomplain -types f .git/refs/heads/*]
 216     foreach f $heads {
 217         catch {
 218             set fd [open $f r]
 219             set line [read $fd 40]
 220             if {[regexp {^[0-9a-f]{40}} $line id]} {
 221                 set head [file tail $f]
 222                 set headids($head) $line
 223                 lappend idheads($line) $head
 224             }
 225             close $fd
 226         }
 227     }
 228 }
 229
 230 proc error_popup msg {
 231     set w .error
 232     toplevel $w
 233     wm transient $w .
 234     message $w.m -text $msg -justify center -aspect 400
 235     pack $w.m -side top -fill x -padx 20 -pady 20
 236     button $w.ok -text OK -command "destroy $w"
 237     pack $w.ok -side bottom -fill x
 238     bind $w <Visibility> "grab $w; focus $w"
 239     tkwait window $w
 240 }
 241
 242 proc makewindow {} {
 243     global canv canv2 canv3 linespc charspc ctext cflist textfont
 244     global findtype findloc findstring fstring geometry
 245     global entries sha1entry sha1string sha1but
 246     global maincursor textcursor
 247     global linectxmenu
 248
 249     menu .bar
 250     .bar add cascade -label "File" -menu .bar.file
 251     menu .bar.file
 252     .bar.file add command -label "Quit" -command doquit
 253     menu .bar.help
 254     .bar add cascade -label "Help" -menu .bar.help
 255     .bar.help add command -label "About gitk" -command about
 256     . configure -menu .bar
 257
 258     if {![info exists geometry(canv1)]} {
 259         set geometry(canv1) [expr 45 * $charspc]
 260         set geometry(canv2) [expr 30 * $charspc]
 261         set geometry(canv3) [expr 15 * $charspc]
 262         set geometry(canvh) [expr 25 * $linespc + 4]
 263         set geometry(ctextw) 80
 264         set geometry(ctexth) 30
 265         set geometry(cflistw) 30
 266     }
 267     panedwindow .ctop -orient vertical
 268     if {[info exists geometry(width)]} {
 269         .ctop conf -width $geometry(width) -height $geometry(height)
 270         set texth [expr {$geometry(height) - $geometry(canvh) - 56}]
 271         set geometry(ctexth) [expr {($texth - 8) /
 272                                     [font metrics $textfont -linespace]}]
 273     }
 274     frame .ctop.top
 275     frame .ctop.top.bar
 276     pack .ctop.top.bar -side bottom -fill x
 277     set cscroll .ctop.top.csb
 278     scrollbar $cscroll -command {allcanvs yview} -highlightthickness 0
 279     pack $cscroll -side right -fill y
 280     panedwindow .ctop.top.clist -orient horizontal -sashpad 0 -handlesize 4
 281     pack .ctop.top.clist -side top -fill both -expand 1
 282     .ctop add .ctop.top
 283     set canv .ctop.top.clist.canv
 284     canvas $canv -height $geometry(canvh) -width $geometry(canv1) \
 285         -bg white -bd 0 \
 286         -yscrollincr $linespc -yscrollcommand "$cscroll set"
 287     .ctop.top.clist add $canv
 288     set canv2 .ctop.top.clist.canv2
 289     canvas $canv2 -height $geometry(canvh) -width $geometry(canv2) \
 290         -bg white -bd 0 -yscrollincr $linespc
 291     .ctop.top.clist add $canv2
 292     set canv3 .ctop.top.clist.canv3
 293     canvas $canv3 -height $geometry(canvh) -width $geometry(canv3) \
 294         -bg white -bd 0 -yscrollincr $linespc
 295     .ctop.top.clist add $canv3
 296     bind .ctop.top.clist <Configure> {resizeclistpanes %W %w}
 297
 298     set sha1entry .ctop.top.bar.sha1
 299     set entries $sha1entry
 300     set sha1but .ctop.top.bar.sha1label
 301     button $sha1but -text "SHA1 ID: " -state disabled -relief flat \
 302         -command gotocommit -width 8
 303     $sha1but conf -disabledforeground [$sha1but cget -foreground]
 304     pack .ctop.top.bar.sha1label -side left
 305     entry $sha1entry -width 40 -font $textfont -textvariable sha1string
 306     trace add variable sha1string write sha1change
 307     pack $sha1entry -side left -pady 2
 308     button .ctop.top.bar.findbut -text "Find" -command dofind
 309     pack .ctop.top.bar.findbut -side left
 310     set findstring {}
 311     set fstring .ctop.top.bar.findstring
 312     lappend entries $fstring
 313     entry $fstring -width 30 -font $textfont -textvariable findstring
 314     pack $fstring -side left -expand 1 -fill x
 315     set findtype Exact
 316     tk_optionMenu .ctop.top.bar.findtype findtype Exact IgnCase Regexp
 317     set findloc "All fields"
 318     tk_optionMenu .ctop.top.bar.findloc findloc "All fields" Headline \
 319         Comments Author Committer
 320     pack .ctop.top.bar.findloc -side right
 321     pack .ctop.top.bar.findtype -side right
 322
 323     panedwindow .ctop.cdet -orient horizontal
 324     .ctop add .ctop.cdet
 325     frame .ctop.cdet.left
 326     set ctext .ctop.cdet.left.ctext
 327     text $ctext -bg white -state disabled -font $textfont \
 328         -width $geometry(ctextw) -height $geometry(ctexth) \
 329         -yscrollcommand ".ctop.cdet.left.sb set"
 330     scrollbar .ctop.cdet.left.sb -command "$ctext yview"
 331     pack .ctop.cdet.left.sb -side right -fill y
 332     pack $ctext -side left -fill both -expand 1
 333     .ctop.cdet add .ctop.cdet.left
 334
 335     $ctext tag conf filesep -font [concat $textfont bold]
 336     $ctext tag conf hunksep -back blue -fore white
 337     $ctext tag conf d0 -back "#ff8080"
 338     $ctext tag conf d1 -back green
 339     $ctext tag conf found -back yellow
 340
 341     frame .ctop.cdet.right
 342     set cflist .ctop.cdet.right.cfiles
 343     listbox $cflist -bg white -selectmode extended -width $geometry(cflistw) \
 344         -yscrollcommand ".ctop.cdet.right.sb set"
 345     scrollbar .ctop.cdet.right.sb -command "$cflist yview"
 346     pack .ctop.cdet.right.sb -side right -fill y
 347     pack $cflist -side left -fill both -expand 1
 348     .ctop.cdet add .ctop.cdet.right
 349     bind .ctop.cdet <Configure> {resizecdetpanes %W %w}
 350
 351     pack .ctop -side top -fill both -expand 1
 352
 353     bindall <1> {selcanvline %x %y}
 354     bindall <B1-Motion> {selcanvline %x %y}
 355     bindall <ButtonRelease-4> "allcanvs yview scroll -5 units"
 356     bindall <ButtonRelease-5> "allcanvs yview scroll 5 units"
 357     bindall <2> "allcanvs scan mark 0 %y"
 358     bindall <B2-Motion> "allcanvs scan dragto 0 %y"
 359     bind . <Key-Up> "selnextline -1"
 360     bind . <Key-Down> "selnextline 1"
 361     bind . <Key-Prior> "allcanvs yview scroll -1 pages"
 362     bind . <Key-Next> "allcanvs yview scroll 1 pages"
 363     bindkey <Key-Delete> "$ctext yview scroll -1 pages"
 364     bindkey <Key-BackSpace> "$ctext yview scroll -1 pages"
 365     bindkey <Key-space> "$ctext yview scroll 1 pages"
 366     bindkey p "selnextline -1"
 367     bindkey n "selnextline 1"
 368     bindkey b "$ctext yview scroll -1 pages"
 369     bindkey d "$ctext yview scroll 18 units"
 370     bindkey u "$ctext yview scroll -18 units"
 371     bindkey / findnext
 372     bindkey ? findprev
 373     bindkey f nextfile
 374     bind . <Control-q> doquit
 375     bind . <Control-f> dofind
 376     bind . <Control-g> findnext
 377     bind . <Control-r> findprev
 378     bind . <Control-equal> {incrfont 1}
 379     bind . <Control-KP_Add> {incrfont 1}
 380     bind . <Control-minus> {incrfont -1}
 381     bind . <Control-KP_Subtract> {incrfont -1}
 382     bind $cflist <<ListboxSelect>> listboxsel
 383     bind . <Destroy> {savestuff %W}
 384     bind . <Button-1> "click %W"
 385     bind $fstring <Key-Return> dofind
 386     bind $sha1entry <Key-Return> gotocommit
 387
 388     set maincursor [. cget -cursor]
 389     set textcursor [$ctext cget -cursor]
 390
 391     set linectxmenu .linectxmenu
 392     menu $linectxmenu -tearoff 0
 393     $linectxmenu add command -label "Select" -command lineselect
 394 }
 395
 396 # when we make a key binding for the toplevel, make sure
 397 # it doesn't get triggered when that key is pressed in the
 398 # find string entry widget.
 399 proc bindkey {ev script} {
 400     global entries
 401     bind . $ev $script
 402     set escript [bind Entry $ev]
 403     if {$escript == {}} {
 404         set escript [bind Entry <Key>]
 405     }
 406     foreach e $entries {
 407         bind $e $ev "$escript; break"
 408     }
 409 }
 410
 411 # set the focus back to the toplevel for any click outside
 412 # the entry widgets
 413 proc click {w} {
 414     global entries
 415     foreach e $entries {
 416         if {$w == $e} return
 417     }
 418     focus .
 419 }
 420
 421 proc savestuff {w} {
 422     global canv canv2 canv3 ctext cflist mainfont textfont
 423     global stuffsaved
 424     if {$stuffsaved} return
 425     if {![winfo viewable .]} return
 426     catch {
 427         set f [open "~/.gitk-new" w]
 428         puts $f "set mainfont {$mainfont}"
 429         puts $f "set textfont {$textfont}"
 430         puts $f "set geometry(width) [winfo width .ctop]"
 431         puts $f "set geometry(height) [winfo height .ctop]"
 432         puts $f "set geometry(canv1) [expr [winfo width $canv]-2]"
 433         puts $f "set geometry(canv2) [expr [winfo width $canv2]-2]"
 434         puts $f "set geometry(canv3) [expr [winfo width $canv3]-2]"
 435         puts $f "set geometry(canvh) [expr [winfo height $canv]-2]"
 436         set wid [expr {([winfo width $ctext] - 8) \
 437                            / [font measure $textfont "0"]}]
 438         puts $f "set geometry(ctextw) $wid"
 439         set wid [expr {([winfo width $cflist] - 11) \
 440                            / [font measure [$cflist cget -font] "0"]}]
 441         puts $f "set geometry(cflistw) $wid"
 442         close $f
 443         file rename -force "~/.gitk-new" "~/.gitk"
 444     }
 445     set stuffsaved 1
 446 }
 447
 448 proc resizeclistpanes {win w} {
 449     global oldwidth
 450     if [info exists oldwidth($win)] {
 451         set s0 [$win sash coord 0]
 452         set s1 [$win sash coord 1]
 453         if {$w < 60} {
 454             set sash0 [expr {int($w/2 - 2)}]
 455             set sash1 [expr {int($w*5/6 - 2)}]
 456         } else {
 457             set factor [expr {1.0 * $w / $oldwidth($win)}]
 458             set sash0 [expr {int($factor * [lindex $s0 0])}]
 459             set sash1 [expr {int($factor * [lindex $s1 0])}]
 460             if {$sash0 < 30} {
 461                 set sash0 30
 462             }
 463             if {$sash1 < $sash0 + 20} {
 464                 set sash1 [expr $sash0 + 20]
 465             }
 466             if {$sash1 > $w - 10} {
 467                 set sash1 [expr $w - 10]
 468                 if {$sash0 > $sash1 - 20} {
 469                     set sash0 [expr $sash1 - 20]
 470                 }
 471             }
 472         }
 473         $win sash place 0 $sash0 [lindex $s0 1]
 474         $win sash place 1 $sash1 [lindex $s1 1]
 475     }
 476     set oldwidth($win) $w
 477 }
 478
 479 proc resizecdetpanes {win w} {
 480     global oldwidth
 481     if [info exists oldwidth($win)] {
 482         set s0 [$win sash coord 0]
 483         if {$w < 60} {
 484             set sash0 [expr {int($w*3/4 - 2)}]
 485         } else {
 486             set factor [expr {1.0 * $w / $oldwidth($win)}]
 487             set sash0 [expr {int($factor * [lindex $s0 0])}]
 488             if {$sash0 < 45} {
 489                 set sash0 45
 490             }
 491             if {$sash0 > $w - 15} {
 492                 set sash0 [expr $w - 15]
 493             }
 494         }
 495         $win sash place 0 $sash0 [lindex $s0 1]
 496     }
 497     set oldwidth($win) $w
 498 }
 499
 500 proc allcanvs args {
 501     global canv canv2 canv3
 502     eval $canv $args
 503     eval $canv2 $args
 504     eval $canv3 $args
 505 }
 506
 507 proc bindall {event action} {
 508     global canv canv2 canv3
 509     bind $canv $event $action
 510     bind $canv2 $event $action
 511     bind $canv3 $event $action
 512 }
 513
 514 proc about {} {
 515     set w .about
 516     if {[winfo exists $w]} {
 517         raise $w
 518         return
 519     }
 520     toplevel $w
 521     wm title $w "About gitk"
 522     message $w.m -text {
 523 Gitk version 1.1
 524
 525 Copyright © 2005 Paul Mackerras
 526
 527 Use and redistribute under the terms of the GNU General Public License
 528
 529 (CVS $Revision: 1.24 $)} \
 530             -justify center -aspect 400
 531     pack $w.m -side top -fill x -padx 20 -pady 20
 532     button $w.ok -text Close -command "destroy $w"
 533     pack $w.ok -side bottom
 534 }
 535
 536 proc assigncolor {id} {
 537     global commitinfo colormap commcolors colors nextcolor
 538     global parents nparents children nchildren
 539     if [info exists colormap($id)] return
 540     set ncolors [llength $colors]
 541     if {$nparents($id) == 1 && $nchildren($id) == 1} {
 542         set child [lindex $children($id) 0]
 543         if {[info exists colormap($child)]
 544             && $nparents($child) == 1} {
 545             set colormap($id) $colormap($child)
 546             return
 547         }
 548     }
 549     set badcolors {}
 550     foreach child $children($id) {
 551         if {[info exists colormap($child)]
 552             && [lsearch -exact $badcolors $colormap($child)] < 0} {
 553             lappend badcolors $colormap($child)
 554         }
 555         if {[info exists parents($child)]} {
 556             foreach p $parents($child) {
 557                 if {[info exists colormap($p)]
 558                     && [lsearch -exact $badcolors $colormap($p)] < 0} {
 559                     lappend badcolors $colormap($p)
 560                 }
 561             }
 562         }
 563     }
 564     if {[llength $badcolors] >= $ncolors} {
 565         set badcolors {}
 566     }
 567     for {set i 0} {$i <= $ncolors} {incr i} {
 568         set c [lindex $colors $nextcolor]
 569         if {[incr nextcolor] >= $ncolors} {
 570             set nextcolor 0
 571         }
 572         if {[lsearch -exact $badcolors $c]} break
 573     }
 574     set colormap($id) $c
 575 }
 576
 577 proc initgraph {} {
 578     global canvy canvy0 lineno numcommits lthickness nextcolor linespc
 579     global glines
 580     global nchildren ncleft
 581
 582     allcanvs delete all
 583     set nextcolor 0
 584     set canvy $canvy0
 585     set lineno -1
 586     set numcommits 0
 587     set lthickness [expr {int($linespc / 9) + 1}]
 588     catch {unset glines}
 589     foreach id [array names nchildren] {
 590         set ncleft($id) $nchildren($id)
 591     }
 592 }
 593
 594 proc drawcommitline {level} {
 595     global parents children nparents nchildren ncleft todo
 596     global canv canv2 canv3 mainfont namefont canvx0 canvy linespc
 597     global datemode cdate
 598     global lineid linehtag linentag linedtag commitinfo
 599     global colormap numcommits currentparents
 600     global oldlevel oldnlines oldtodo
 601     global idtags idline idheads
 602     global lineno lthickness glines
 603     global commitlisted
 604
 605     incr numcommits
 606     incr lineno
 607     set id [lindex $todo $level]
 608     set lineid($lineno) $id
 609     set idline($id) $lineno
 610     set ofill [expr {[info exists commitlisted($id)]? "blue": "white"}]
 611     if {![info exists commitinfo($id)]} {
 612         readcommit $id
 613         if {![info exists commitinfo($id)]} {
 614             set commitinfo($id) {"No commit information available"}
 615             set nparents($id) 0
 616         }
 617     }
 618     set currentparents {}
 619     if {[info exists commitlisted($id)] && [info exists parents($id)]} {
 620         set currentparents $parents($id)
 621     }
 622     set x [expr $canvx0 + $level * $linespc]
 623     set y1 $canvy
 624     set canvy [expr $canvy + $linespc]
 625     allcanvs conf -scrollregion \
 626         [list 0 0 0 [expr $y1 + 0.5 * $linespc + 2]]
 627     if {[info exists glines($id)]} {
 628         lappend glines($id) $x $y1
 629         set t [$canv create line $glines($id) \
 630                    -width $lthickness -fill $colormap($id)]
 631         $canv lower $t
 632         $canv bind $t <Button-3> "linemenu %X %Y $id"
 633         $canv bind $t <Enter> "lineenter %x %y $id"
 634         $canv bind $t <Motion> "linemotion %x %y $id"
 635         $canv bind $t <Leave> "lineleave $id"
 636     }
 637     set orad [expr {$linespc / 3}]
 638     set t [$canv create oval [expr $x - $orad] [expr $y1 - $orad] \
 639                [expr $x + $orad - 1] [expr $y1 + $orad - 1] \
 640                -fill $ofill -outline black -width 1]
 641     $canv raise $t
 642     set xt [expr $canvx0 + [llength $todo] * $linespc]
 643     if {$nparents($id) > 2} {
 644         set xt [expr {$xt + ($nparents($id) - 2) * $linespc}]
 645     }
 646     set marks {}
 647     set ntags 0
 648     if {[info exists idtags($id)]} {
 649         set marks $idtags($id)
 650         set ntags [llength $marks]
 651     }
 652     if {[info exists idheads($id)]} {
 653         set marks [concat $marks $idheads($id)]
 654     }
 655     if {$marks != {}} {
 656         set delta [expr {int(0.5 * ($linespc - $lthickness))}]
 657         set yt [expr $y1 - 0.5 * $linespc]
 658         set yb [expr $yt + $linespc - 1]
 659         set xvals {}
 660         set wvals {}
 661         foreach tag $marks {
 662             set wid [font measure $mainfont $tag]
 663             lappend xvals $xt
 664             lappend wvals $wid
 665             set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
 666         }
 667         set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
 668                    -width $lthickness -fill black]
 669         $canv lower $t
 670         $canv bind $t <Button-3> "linemenu %X %Y $id"
 671         $canv bind $t <Enter> "lineenter %x %y $id"
 672         $canv bind $t <Motion> "linemotion %x %y $id"
 673         $canv bind $t <Leave> "lineleave $id"
 674         foreach tag $marks x $xvals wid $wvals {
 675             set xl [expr $x + $delta]
 676             set xr [expr $x + $delta + $wid + $lthickness]
 677             if {[incr ntags -1] >= 0} {
 678                 # draw a tag
 679                 $canv create polygon $x [expr $yt + $delta] $xl $yt\
 680                     $xr $yt $xr $yb $xl $yb $x [expr $yb - $delta] \
 681                     -width 1 -outline black -fill yellow
 682             } else {
 683                 # draw a head
 684                 set xl [expr $xl - $delta/2]
 685                 $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
 686                     -width 1 -outline black -fill green
 687             }
 688             $canv create text $xl $y1 -anchor w -text $tag \
 689                 -font $mainfont
 690         }
 691     }
 692     set headline [lindex $commitinfo($id) 0]
 693     set name [lindex $commitinfo($id) 1]
 694     set date [lindex $commitinfo($id) 2]
 695     set linehtag($lineno) [$canv create text $xt $y1 -anchor w \
 696                                -text $headline -font $mainfont ]
 697     set linentag($lineno) [$canv2 create text 3 $y1 -anchor w \
 698                                -text $name -font $namefont]
 699     set linedtag($lineno) [$canv3 create text 3 $y1 -anchor w \
 700                                -text $date -font $mainfont]
 701 }
 702
 703 proc updatetodo {level noshortcut} {
 704     global datemode currentparents ncleft todo
 705     global glines oldlevel oldtodo oldnlines
 706     global canvx0 canvy linespc glines
 707     global commitinfo
 708
 709     foreach p $currentparents {
 710         if {![info exists commitinfo($p)]} {
 711             readcommit $p
 712         }
 713     }
 714     set x [expr $canvx0 + $level * $linespc]
 715     set y [expr $canvy - $linespc]
 716     if {!$noshortcut && [llength $currentparents] == 1} {
 717         set p [lindex $currentparents 0]
 718         if {$ncleft($p) == 0 && [lsearch -exact $todo $p] < 0} {
 719             assigncolor $p
 720             set glines($p) [list $x $y]
 721             set todo [lreplace $todo $level $level $p]
 722             return 0
 723         }
 724     }
 725
 726     set oldlevel $level
 727     set oldtodo $todo
 728     set oldnlines [llength $todo]
 729     set todo [lreplace $todo $level $level]
 730     set i $level
 731     foreach p $currentparents {
 732         incr ncleft($p) -1
 733         set k [lsearch -exact $todo $p]
 734         if {$k < 0} {
 735             assigncolor $p
 736             set todo [linsert $todo $i $p]
 737             incr i
 738         }
 739     }
 740     return 1
 741 }
 742
 743 proc drawslants {} {
 744     global canv glines canvx0 canvy linespc
 745     global oldlevel oldtodo todo currentparents
 746     global lthickness linespc canvy colormap
 747
 748     set y1 [expr $canvy - $linespc]
 749     set y2 $canvy
 750     set i -1
 751     foreach id $oldtodo {
 752         incr i
 753         if {$id == {}} continue
 754         set xi [expr {$canvx0 + $i * $linespc}]
 755         if {$i == $oldlevel} {
 756             foreach p $currentparents {
 757                 set j [lsearch -exact $todo $p]
 758                 if {$i == $j && ![info exists glines($p)]} {
 759                     set glines($p) [list $xi $y1]
 760                 } else {
 761                     set xj [expr {$canvx0 + $j * $linespc}]
 762                     set coords [list $xi $y1]
 763                     if {$j < $i - 1} {
 764                         lappend coords [expr $xj + $linespc] $y1
 765                     } elseif {$j > $i + 1} {
 766                         lappend coords [expr $xj - $linespc] $y1
 767                     }
 768                     lappend coords $xj $y2
 769                     if {![info exists glines($p)]} {
 770                         set glines($p) $coords
 771                     } else {
 772                         set t [$canv create line $coords -width $lthickness \
 773                                    -fill $colormap($p)]
 774                         $canv lower $t
 775                         $canv bind $t <Button-3> "linemenu %X %Y $p"
 776                         $canv bind $t <Enter> "lineenter %x %y $p"
 777                         $canv bind $t <Motion> "linemotion %x %y $p"
 778                         $canv bind $t <Leave> "lineleave $p"
 779                     }
 780                 }
 781             }
 782         } elseif {[lindex $todo $i] != $id} {
 783             set j [lsearch -exact $todo $id]
 784             set xj [expr {$canvx0 + $j * $linespc}]
 785             lappend glines($id) $xi $y1 $xj $y2
 786         }
 787     }
 788 }
 789
 790 proc decidenext {} {
 791     global parents children nchildren ncleft todo
 792     global canv canv2 canv3 mainfont namefont canvx0 canvy linespc
 793     global datemode cdate
 794     global lineid linehtag linentag linedtag commitinfo
 795     global currentparents oldlevel oldnlines oldtodo
 796     global lineno lthickness
 797
 798     # remove the null entry if present
 799     set nullentry [lsearch -exact $todo {}]
 800     if {$nullentry >= 0} {
 801         set todo [lreplace $todo $nullentry $nullentry]
 802     }
 803
 804     # choose which one to do next time around
 805     set todol [llength $todo]
 806     set level -1
 807     set latest {}
 808     for {set k $todol} {[incr k -1] >= 0} {} {
 809         set p [lindex $todo $k]
 810         if {$ncleft($p) == 0} {
 811             if {$datemode} {
 812                 if {$latest == {} || $cdate($p) > $latest} {
 813                     set level $k
 814                     set latest $cdate($p)
 815                 }
 816             } else {
 817                 set level $k
 818                 break
 819             }
 820         }
 821     }
 822     if {$level < 0} {
 823         if {$todo != {}} {
 824             puts "ERROR: none of the pending commits can be done yet:"
 825             foreach p $todo {
 826                 puts "  $p"
 827             }
 828         }
 829         return -1
 830     }
 831
 832     # If we are reducing, put in a null entry
 833     if {$todol < $oldnlines} {
 834         if {$nullentry >= 0} {
 835             set i $nullentry
 836             while {$i < $todol
 837                    && [lindex $oldtodo $i] == [lindex $todo $i]} {
 838                 incr i
 839             }
 840         } else {
 841             set i $oldlevel
 842             if {$level >= $i} {
 843                 incr i
 844             }
 845         }
 846         if {$i < $todol} {
 847             set todo [linsert $todo $i {}]
 848             if {$level >= $i} {
 849                 incr level
 850             }
 851         }
 852     }
 853     return $level
 854 }
 855
 856 proc drawcommit {id} {
 857     global phase todo nchildren datemode nextupdate
 858     global startcommits
 859
 860     if {$phase != "incrdraw"} {
 861         set phase incrdraw
 862         set todo $id
 863         set startcommits $id
 864         initgraph
 865         assigncolor $id
 866         drawcommitline 0
 867         updatetodo 0 $datemode
 868     } else {
 869         if {$nchildren($id) == 0} {
 870             lappend todo $id
 871             lappend startcommits $id
 872             assigncolor $id
 873         }
 874         set level [decidenext]
 875         if {$id != [lindex $todo $level]} {
 876             return
 877         }
 878         while 1 {
 879             drawslants
 880             drawcommitline $level
 881             if {[updatetodo $level $datemode]} {
 882                 set level [decidenext]
 883             }
 884             set id [lindex $todo $level]
 885             if {![info exists commitlisted($id)]} {
 886                 break
 887             }
 888             if {[clock clicks -milliseconds] >= $nextupdate} {
 889                 doupdate
 890                 if {$stopped} break
 891             }
 892         }
 893     }
 894 }
 895
 896 proc finishcommits {} {
 897     global phase
 898     global startcommits
 899     global ctext maincursor textcursor
 900
 901     if {$phase != "incrdraw"} {
 902         $canv delete all
 903         $canv create text 3 3 -anchor nw -text "No commits selected" \
 904             -font $mainfont -tags textitems
 905         set phase {}
 906         return
 907     }
 908     drawslants
 909     set level [decidenext]
 910     drawrest $level [llength $startcommits]
 911     . config -cursor $maincursor
 912     $ctext config -cursor $textcursor
 913 }
 914
 915 proc drawgraph {} {
 916     global nextupdate startmsecs startcommits todo
 917
 918     if {$startcommits == {}} return
 919     set startmsecs [clock clicks -milliseconds]
 920     set nextupdate [expr $startmsecs + 100]
 921     initgraph
 922     set todo [lindex $startcommits 0]
 923     drawrest 0 1
 924 }
 925
 926 proc drawrest {level startix} {
 927     global phase stopped redisplaying selectedline
 928     global datemode currentparents todo
 929     global numcommits
 930     global nextupdate startmsecs startcommits idline
 931
 932     set phase drawgraph
 933     set startid [lindex $startcommits $startix]
 934     set startline -1
 935     if {$startid != {}} {
 936         set startline $idline($startid)
 937     }
 938     while 1 {
 939         if {$stopped} break
 940         drawcommitline $level
 941         set hard [updatetodo $level $datemode]
 942         if {$numcommits == $startline} {
 943             lappend todo $startid
 944             set hard 1
 945             incr startix
 946             set startid [lindex $startcommits $startix]
 947             set startline -1
 948             if {$startid != {}} {
 949                 set startline $idline($startid)
 950             }
 951         }
 952         if {$hard} {
 953             set level [decidenext]
 954             if {$level < 0} break
 955             drawslants
 956         }
 957         if {[clock clicks -milliseconds] >= $nextupdate} {
 958             update
 959             incr nextupdate 100
 960         }
 961     }
 962     set phase {}
 963     set drawmsecs [expr [clock clicks -milliseconds] - $startmsecs]
 964     #puts "overall $drawmsecs ms for $numcommits commits"
 965     if {$redisplaying} {
 966         if {$stopped == 0 && [info exists selectedline]} {
 967             selectline $selectedline
 968         }
 969         if {$stopped == 1} {
 970             set stopped 0
 971             after idle drawgraph
 972         } else {
 973             set redisplaying 0
 974         }
 975     }
 976 }
 977
 978 proc findmatches {f} {
 979     global findtype foundstring foundstrlen
 980     if {$findtype == "Regexp"} {
 981         set matches [regexp -indices -all -inline $foundstring $f]
 982     } else {
 983         if {$findtype == "IgnCase"} {
 984             set str [string tolower $f]
 985         } else {
 986             set str $f
 987         }
 988         set matches {}
 989         set i 0
 990         while {[set j [string first $foundstring $str $i]] >= 0} {
 991             lappend matches [list $j [expr $j+$foundstrlen-1]]
 992             set i [expr $j + $foundstrlen]
 993         }
 994     }
 995     return $matches
 996 }
 997
 998 proc dofind {} {
 999     global findtype findloc findstring markedmatches commitinfo
1000     global numcommits lineid linehtag linentag linedtag
1001     global mainfont namefont canv canv2 canv3 selectedline
1002     global matchinglines foundstring foundstrlen
1003     unmarkmatches
1004     focus .
1005     set matchinglines {}
1006     set fldtypes {Headline Author Date Committer CDate Comment}
1007     if {$findtype == "IgnCase"} {
1008         set foundstring [string tolower $findstring]
1009     } else {
1010         set foundstring $findstring
1011     }
1012     set foundstrlen [string length $findstring]
1013     if {$foundstrlen == 0} return
1014     if {![info exists selectedline]} {
1015         set oldsel -1
1016     } else {
1017         set oldsel $selectedline
1018     }
1019     set didsel 0
1020     for {set l 0} {$l < $numcommits} {incr l} {
1021         set id $lineid($l)
1022         set info $commitinfo($id)
1023         set doesmatch 0
1024         foreach f $info ty $fldtypes {
1025             if {$findloc != "All fields" && $findloc != $ty} {
1026                 continue
1027             }
1028             set matches [findmatches $f]
1029             if {$matches == {}} continue
1030             set doesmatch 1
1031             if {$ty == "Headline"} {
1032                 markmatches $canv $l $f $linehtag($l) $matches $mainfont
1033             } elseif {$ty == "Author"} {
1034                 markmatches $canv2 $l $f $linentag($l) $matches $namefont
1035             } elseif {$ty == "Date"} {
1036                 markmatches $canv3 $l $f $linedtag($l) $matches $mainfont
1037             }
1038         }
1039         if {$doesmatch} {
1040             lappend matchinglines $l
1041             if {!$didsel && $l > $oldsel} {
1042                 findselectline $l
1043                 set didsel 1
1044             }
1045         }
1046     }
1047     if {$matchinglines == {}} {
1048         bell
1049     } elseif {!$didsel} {
1050         findselectline [lindex $matchinglines 0]
1051     }
1052 }
1053
1054 proc findselectline {l} {
1055     global findloc commentend ctext
1056     selectline $l
1057     if {$findloc == "All fields" || $findloc == "Comments"} {
1058         # highlight the matches in the comments
1059         set f [$ctext get 1.0 $commentend]
1060         set matches [findmatches $f]
1061         foreach match $matches {
1062             set start [lindex $match 0]
1063             set end [expr [lindex $match 1] + 1]
1064             $ctext tag add found "1.0 + $start c" "1.0 + $end c"
1065         }
1066     }
1067 }
1068
1069 proc findnext {} {
1070     global matchinglines selectedline
1071     if {![info exists matchinglines]} {
1072         dofind
1073         return
1074     }
1075     if {![info exists selectedline]} return
1076     foreach l $matchinglines {
1077         if {$l > $selectedline} {
1078             findselectline $l
1079             return
1080         }
1081     }
1082     bell
1083 }
1084
1085 proc findprev {} {
1086     global matchinglines selectedline
1087     if {![info exists matchinglines]} {
1088         dofind
1089         return
1090     }
1091     if {![info exists selectedline]} return
1092     set prev {}
1093     foreach l $matchinglines {
1094         if {$l >= $selectedline} break
1095         set prev $l
1096     }
1097     if {$prev != {}} {
1098         findselectline $prev
1099     } else {
1100         bell
1101     }
1102 }
1103
1104 proc markmatches {canv l str tag matches font} {
1105     set bbox [$canv bbox $tag]
1106     set x0 [lindex $bbox 0]
1107     set y0 [lindex $bbox 1]
1108     set y1 [lindex $bbox 3]
1109     foreach match $matches {
1110         set start [lindex $match 0]
1111         set end [lindex $match 1]
1112         if {$start > $end} continue
1113         set xoff [font measure $font [string range $str 0 [expr $start-1]]]
1114         set xlen [font measure $font [string range $str 0 [expr $end]]]
1115         set t [$canv create rect [expr $x0+$xoff] $y0 [expr $x0+$xlen+2] $y1 \
1116                    -outline {} -tags matches -fill yellow]
1117         $canv lower $t
1118     }
1119 }
1120
1121 proc unmarkmatches {} {
1122     global matchinglines
1123     allcanvs delete matches
1124     catch {unset matchinglines}
1125 }
1126
1127 proc selcanvline {x y} {
1128     global canv canvy0 ctext linespc selectedline
1129     global lineid linehtag linentag linedtag
1130     set ymax [lindex [$canv cget -scrollregion] 3]
1131     if {$ymax == {}} return
1132     set yfrac [lindex [$canv yview] 0]
1133     set y [expr {$y + $yfrac * $ymax}]
1134     set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
1135     if {$l < 0} {
1136         set l 0
1137     }
1138     if {[info exists selectedline] && $selectedline == $l} return
1139     unmarkmatches
1140     selectline $l
1141 }
1142
1143 proc selectline {l} {
1144     global canv canv2 canv3 ctext commitinfo selectedline
1145     global lineid linehtag linentag linedtag
1146     global canvy0 linespc nparents treepending
1147     global cflist treediffs currentid sha1entry
1148     global commentend seenfile idtags
1149     $canv delete hover
1150     if {![info exists lineid($l)] || ![info exists linehtag($l)]} return
1151     $canv delete secsel
1152     set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
1153                -tags secsel -fill [$canv cget -selectbackground]]
1154     $canv lower $t
1155     $canv2 delete secsel
1156     set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
1157                -tags secsel -fill [$canv2 cget -selectbackground]]
1158     $canv2 lower $t
1159     $canv3 delete secsel
1160     set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
1161                -tags secsel -fill [$canv3 cget -selectbackground]]
1162     $canv3 lower $t
1163     set y [expr {$canvy0 + $l * $linespc}]
1164     set ymax [lindex [$canv cget -scrollregion] 3]
1165     set ytop [expr {$y - $linespc - 1}]
1166     set ybot [expr {$y + $linespc + 1}]
1167     set wnow [$canv yview]
1168     set wtop [expr [lindex $wnow 0] * $ymax]
1169     set wbot [expr [lindex $wnow 1] * $ymax]
1170     set wh [expr {$wbot - $wtop}]
1171     set newtop $wtop
1172     if {$ytop < $wtop} {
1173         if {$ybot < $wtop} {
1174             set newtop [expr {$y - $wh / 2.0}]
1175         } else {
1176             set newtop $ytop
1177             if {$newtop > $wtop - $linespc} {
1178                 set newtop [expr {$wtop - $linespc}]
1179             }
1180         }
1181     } elseif {$ybot > $wbot} {
1182         if {$ytop > $wbot} {
1183             set newtop [expr {$y - $wh / 2.0}]
1184         } else {
1185             set newtop [expr {$ybot - $wh}]
1186             if {$newtop < $wtop + $linespc} {
1187                 set newtop [expr {$wtop + $linespc}]
1188             }
1189         }
1190     }
1191     if {$newtop != $wtop} {
1192         if {$newtop < 0} {
1193             set newtop 0
1194         }
1195         allcanvs yview moveto [expr $newtop * 1.0 / $ymax]
1196     }
1197     set selectedline $l
1198
1199     set id $lineid($l)
1200     set currentid $id
1201     $sha1entry delete 0 end
1202     $sha1entry insert 0 $id
1203     $sha1entry selection from 0
1204     $sha1entry selection to end
1205
1206     $ctext conf -state normal
1207     $ctext delete 0.0 end
1208     set info $commitinfo($id)
1209     $ctext insert end "Author: [lindex $info 1]  [lindex $info 2]\n"
1210     $ctext insert end "Committer: [lindex $info 3]  [lindex $info 4]\n"
1211     if {[info exists idtags($id)]} {
1212         $ctext insert end "Tags:"
1213         foreach tag $idtags($id) {
1214             $ctext insert end " $tag"
1215         }
1216         $ctext insert end "\n"
1217     }
1218     $ctext insert end "\n"
1219     $ctext insert end [lindex $info 5]
1220     $ctext insert end "\n"
1221     $ctext tag delete Comments
1222     $ctext tag remove found 1.0 end
1223     $ctext conf -state disabled
1224     set commentend [$ctext index "end - 1c"]
1225
1226     $cflist delete 0 end
1227     if {$nparents($id) == 1} {
1228         if {![info exists treediffs($id)]} {
1229             if {![info exists treepending]} {
1230                 gettreediffs $id
1231             }
1232         } else {
1233             addtocflist $id
1234         }
1235     }
1236     catch {unset seenfile}
1237 }
1238
1239 proc selnextline {dir} {
1240     global selectedline
1241     if {![info exists selectedline]} return
1242     set l [expr $selectedline + $dir]
1243     unmarkmatches
1244     selectline $l
1245 }
1246
1247 proc addtocflist {id} {
1248     global currentid treediffs cflist treepending
1249     if {$id != $currentid} {
1250         gettreediffs $currentid
1251         return
1252     }
1253     $cflist insert end "All files"
1254     foreach f $treediffs($currentid) {
1255         $cflist insert end $f
1256     }
1257     getblobdiffs $id
1258 }
1259
1260 proc gettreediffs {id} {
1261     global treediffs parents treepending
1262     set treepending $id
1263     set treediffs($id) {}
1264     set p [lindex $parents($id) 0]
1265     if [catch {set gdtf [open "|git-diff-tree -r $p $id" r]}] return
1266     fconfigure $gdtf -blocking 0
1267     fileevent $gdtf readable "gettreediffline $gdtf $id"
1268 }
1269
1270 proc gettreediffline {gdtf id} {
1271     global treediffs treepending
1272     set n [gets $gdtf line]
1273     if {$n < 0} {
1274         if {![eof $gdtf]} return
1275         close $gdtf
1276         unset treepending
1277         addtocflist $id
1278         return
1279     }
1280     set file [lindex $line 5]
1281     lappend treediffs($id) $file
1282 }
1283
1284 proc getblobdiffs {id} {
1285     global parents diffopts blobdifffd env curdifftag curtagstart
1286     global diffindex difffilestart
1287     set p [lindex $parents($id) 0]
1288     set env(GIT_DIFF_OPTS) $diffopts
1289     if [catch {set bdf [open "|git-diff-tree -r -p $p $id" r]} err] {
1290         puts "error getting diffs: $err"
1291         return
1292     }
1293     fconfigure $bdf -blocking 0
1294     set blobdifffd($id) $bdf
1295     set curdifftag Comments
1296     set curtagstart 0.0
1297     set diffindex 0
1298     catch {unset difffilestart}
1299     fileevent $bdf readable "getblobdiffline $bdf $id"
1300 }
1301
1302 proc getblobdiffline {bdf id} {
1303     global currentid blobdifffd ctext curdifftag curtagstart seenfile
1304     global diffnexthead diffnextnote diffindex difffilestart
1305     set n [gets $bdf line]
1306     if {$n < 0} {
1307         if {[eof $bdf]} {
1308             close $bdf
1309             if {$id == $currentid && $bdf == $blobdifffd($id)} {
1310                 $ctext tag add $curdifftag $curtagstart end
1311                 set seenfile($curdifftag) 1
1312             }
1313         }
1314         return
1315     }
1316     if {$id != $currentid || $bdf != $blobdifffd($id)} {
1317         return
1318     }
1319     $ctext conf -state normal
1320     if {[regexp {^---[ \t]+([^/])*/(.*)} $line match s1 fname]} {
1321         # start of a new file
1322         $ctext insert end "\n"
1323         $ctext tag add $curdifftag $curtagstart end
1324         set seenfile($curdifftag) 1
1325         set curtagstart [$ctext index "end - 1c"]
1326         set header $fname
1327         if {[info exists diffnexthead]} {
1328             set fname $diffnexthead
1329             set header "$diffnexthead ($diffnextnote)"
1330             unset diffnexthead
1331         }
1332         set difffilestart($diffindex) [$ctext index "end - 1c"]
1333         incr diffindex
1334         set curdifftag "f:$fname"
1335         $ctext tag delete $curdifftag
1336         set l [expr {(78 - [string length $header]) / 2}]
1337         set pad [string range "----------------------------------------" 1 $l]
1338         $ctext insert end "$pad $header $pad\n" filesep
1339     } elseif {[string range $line 0 2] == "+++"} {
1340         # no need to do anything with this
1341     } elseif {[regexp {^Created: (.*) \((mode: *[0-7]*)\)} $line match fn m]} {
1342         set diffnexthead $fn
1343         set diffnextnote "created, mode $m"
1344     } elseif {[string range $line 0 8] == "Deleted: "} {
1345         set diffnexthead [string range $line 9 end]
1346         set diffnextnote "deleted"
1347     } elseif {[regexp {^diff --git a/(.*) b/} $line match fn]} {
1348         # save the filename in case the next thing is "new file mode ..."
1349         set diffnexthead $fn
1350         set diffnextnote "modified"
1351     } elseif {[regexp {^new file mode ([0-7]+)} $line match m]} {
1352         set diffnextnote "new file, mode $m"
1353     } elseif {[string range $line 0 11] == "deleted file"} {
1354         set diffnextnote "deleted"
1355     } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \
1356                    $line match f1l f1c f2l f2c rest]} {
1357         $ctext insert end "\t" hunksep
1358         $ctext insert end "    $f1l    " d0 "    $f2l    " d1
1359         $ctext insert end "    $rest \n" hunksep
1360     } else {
1361         set x [string range $line 0 0]
1362         if {$x == "-" || $x == "+"} {
1363             set tag [expr {$x == "+"}]
1364             set line [string range $line 1 end]
1365             $ctext insert end "$line\n" d$tag
1366         } elseif {$x == " "} {
1367             set line [string range $line 1 end]
1368             $ctext insert end "$line\n"
1369         } elseif {$x == "\\"} {
1370             # e.g. "\ No newline at end of file"
1371             $ctext insert end "$line\n" filesep
1372         } else {
1373             # Something else we don't recognize
1374             if {$curdifftag != "Comments"} {
1375                 $ctext insert end "\n"
1376                 $ctext tag add $curdifftag $curtagstart end
1377                 set seenfile($curdifftag) 1
1378                 set curtagstart [$ctext index "end - 1c"]
1379                 set curdifftag Comments
1380             }
1381             $ctext insert end "$line\n" filesep
1382         }
1383     }
1384     $ctext conf -state disabled
1385 }
1386
1387 proc nextfile {} {
1388     global difffilestart ctext
1389     set here [$ctext index @0,0]
1390     for {set i 0} {[info exists difffilestart($i)]} {incr i} {
1391         if {[$ctext compare $difffilestart($i) > $here]} {
1392             $ctext yview $difffilestart($i)
1393             break
1394         }
1395     }
1396 }
1397
1398 proc listboxsel {} {
1399     global ctext cflist currentid treediffs seenfile
1400     if {![info exists currentid]} return
1401     set sel [$cflist curselection]
1402     if {$sel == {} || [lsearch -exact $sel 0] >= 0} {
1403         # show everything
1404         $ctext tag conf Comments -elide 0
1405         foreach f $treediffs($currentid) {
1406             if [info exists seenfile(f:$f)] {
1407                 $ctext tag conf "f:$f" -elide 0
1408             }
1409         }
1410     } else {
1411         # just show selected files
1412         $ctext tag conf Comments -elide 1
1413         set i 1
1414         foreach f $treediffs($currentid) {
1415             set elide [expr {[lsearch -exact $sel $i] < 0}]
1416             if [info exists seenfile(f:$f)] {
1417                 $ctext tag conf "f:$f" -elide $elide
1418             }
1419             incr i
1420         }
1421     }
1422 }
1423
1424 proc setcoords {} {
1425     global linespc charspc canvx0 canvy0 mainfont
1426     set linespc [font metrics $mainfont -linespace]
1427     set charspc [font measure $mainfont "m"]
1428     set canvy0 [expr 3 + 0.5 * $linespc]
1429     set canvx0 [expr 3 + 0.5 * $linespc]
1430 }
1431
1432 proc redisplay {} {
1433     global selectedline stopped redisplaying phase
1434     if {$stopped > 1} return
1435     if {$phase == "getcommits"} return
1436     set redisplaying 1
1437     if {$phase == "drawgraph" || $phase == "incrdraw"} {
1438         set stopped 1
1439     } else {
1440         drawgraph
1441     }
1442 }
1443
1444 proc incrfont {inc} {
1445     global mainfont namefont textfont selectedline ctext canv phase
1446     global stopped entries
1447     unmarkmatches
1448     set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
1449     set namefont [lreplace $namefont 1 1 [expr {[lindex $namefont 1] + $inc}]]
1450     set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
1451     setcoords
1452     $ctext conf -font $textfont
1453     $ctext tag conf filesep -font [concat $textfont bold]
1454     foreach e $entries {
1455         $e conf -font $mainfont
1456     }
1457     if {$phase == "getcommits"} {
1458         $canv itemconf textitems -font $mainfont
1459     }
1460     redisplay
1461 }
1462
1463 proc sha1change {n1 n2 op} {
1464     global sha1string currentid sha1but
1465     if {$sha1string == {}
1466         || ([info exists currentid] && $sha1string == $currentid)} {
1467         set state disabled
1468     } else {
1469         set state normal
1470     }
1471     if {[$sha1but cget -state] == $state} return
1472     if {$state == "normal"} {
1473         $sha1but conf -state normal -relief raised -text "Goto: "
1474     } else {
1475         $sha1but conf -state disabled -relief flat -text "SHA1 ID: "
1476     }
1477 }
1478
1479 proc gotocommit {} {
1480     global sha1string currentid idline tagids
1481     if {$sha1string == {}
1482         || ([info exists currentid] && $sha1string == $currentid)} return
1483     if {[info exists tagids($sha1string)]} {
1484         set id $tagids($sha1string)
1485     } else {
1486         set id [string tolower $sha1string]
1487     }
1488     if {[info exists idline($id)]} {
1489         selectline $idline($id)
1490         return
1491     }
1492     if {[regexp {^[0-9a-fA-F]{40}$} $sha1string]} {
1493         set type "SHA1 id"
1494     } else {
1495         set type "Tag"
1496     }
1497     error_popup "$type $sha1string is not known"
1498 }
1499
1500 proc linemenu {x y id} {
1501     global linectxmenu linemenuid
1502     set linemenuid $id
1503     $linectxmenu post $x $y
1504 }
1505
1506 proc lineselect {} {
1507     global linemenuid idline
1508     if {[info exists linemenuid] && [info exists idline($linemenuid)]} {
1509         selectline $idline($linemenuid)
1510     }
1511 }
1512
1513 proc lineenter {x y id} {
1514     global hoverx hovery hoverid hovertimer
1515     global commitinfo canv
1516
1517     if {![info exists commitinfo($id)]} return
1518     set hoverx $x
1519     set hovery $y
1520     set hoverid $id
1521     if {[info exists hovertimer]} {
1522         after cancel $hovertimer
1523     }
1524     set hovertimer [after 500 linehover]
1525     $canv delete hover
1526 }
1527
1528 proc linemotion {x y id} {
1529     global hoverx hovery hoverid hovertimer
1530
1531     if {[info exists hoverid] && $id == $hoverid} {
1532         set hoverx $x
1533         set hovery $y
1534         if {[info exists hovertimer]} {
1535             after cancel $hovertimer
1536         }
1537         set hovertimer [after 500 linehover]
1538     }
1539 }
1540
1541 proc lineleave {id} {
1542     global hoverid hovertimer canv
1543
1544     if {[info exists hoverid] && $id == $hoverid} {
1545         $canv delete hover
1546         if {[info exists hovertimer]} {
1547             after cancel $hovertimer
1548             unset hovertimer
1549         }
1550         unset hoverid
1551     }
1552 }
1553
1554 proc linehover {} {
1555     global hoverx hovery hoverid hovertimer
1556     global canv linespc lthickness
1557     global commitinfo mainfont
1558
1559     set text [lindex $commitinfo($hoverid) 0]
1560     set ymax [lindex [$canv cget -scrollregion] 3]
1561     if {$ymax == {}} return
1562     set yfrac [lindex [$canv yview] 0]
1563     set x [expr {$hoverx + 2 * $linespc}]
1564     set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
1565     set x0 [expr {$x - 2 * $lthickness}]
1566     set y0 [expr {$y - 2 * $lthickness}]
1567     set x1 [expr {$x + [font measure $mainfont $text] + 2 * $lthickness}]
1568     set y1 [expr {$y + $linespc + 2 * $lthickness}]
1569     set t [$canv create rectangle $x0 $y0 $x1 $y1 \
1570                -fill \#ffff80 -outline black -width 1 -tags hover]
1571     $canv raise $t
1572     set t [$canv create text $x $y -anchor nw -text $text -tags hover]
1573     $canv raise $t
1574 }
1575
1576 proc doquit {} {
1577     global stopped
1578     set stopped 100
1579     destroy .
1580 }
1581
1582 # defaults...
1583 set datemode 0
1584 set boldnames 0
1585 set diffopts "-U 5 -p"
1586
1587 set mainfont {Helvetica 9}
1588 set textfont {Courier 9}
1589
1590 set colors {green red blue magenta darkgrey brown orange}
1591
1592 catch {source ~/.gitk}
1593
1594 set namefont $mainfont
1595 if {$boldnames} {
1596     lappend namefont bold
1597 }
1598
1599 set revtreeargs {}
1600 foreach arg $argv {
1601     switch -regexp -- $arg {
1602         "^$" { }
1603         "^-b" { set boldnames 1 }
1604         "^-d" { set datemode 1 }
1605         default {
1606             lappend revtreeargs $arg
1607         }
1608     }
1609 }
1610
1611 set noreadobj [catch {load libreadobj.so.0.0}]
1612 set stopped 0
1613 set redisplaying 0
1614 set stuffsaved 0
1615 setcoords
1616 makewindow
1617 readrefs
1618 getcommits $revtreeargs