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