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