+ global canv canv2 canv3 linespc charspc ctext cflist textfont
+ global sha1entry findtype findloc findstring fstring geometry
+
+ menu .bar
+ .bar add cascade -label "File" -menu .bar.file
+ menu .bar.file
+ .bar.file add command -label "Quit" -command doquit
+ menu .bar.help
+ .bar add cascade -label "Help" -menu .bar.help
+ .bar.help add command -label "About gitk" -command about
+ . configure -menu .bar
+
+ if {![info exists geometry(canv1)]} {
+ set geometry(canv1) [expr 45 * $charspc]
+ set geometry(canv2) [expr 30 * $charspc]
+ set geometry(canv3) [expr 15 * $charspc]
+ set geometry(canvh) [expr 25 * $linespc + 4]
+ set geometry(ctextw) 80
+ set geometry(ctexth) 30
+ set geometry(cflistw) 30
+ }
+ panedwindow .ctop -orient vertical
+ if {[info exists geometry(width)]} {
+ .ctop conf -width $geometry(width) -height $geometry(height)
+ set texth [expr {$geometry(height) - $geometry(canvh) - 56}]
+ set geometry(ctexth) [expr {($texth - 8) /
+ [font metrics $textfont -linespace]}]
+ }
+ frame .ctop.top
+ frame .ctop.top.bar
+ pack .ctop.top.bar -side bottom -fill x
+ set cscroll .ctop.top.csb
+ scrollbar $cscroll -command {allcanvs yview} -highlightthickness 0
+ pack $cscroll -side right -fill y
+ panedwindow .ctop.top.clist -orient horizontal -sashpad 0 -handlesize 4
+ pack .ctop.top.clist -side top -fill both -expand 1
+ .ctop add .ctop.top
+ set canv .ctop.top.clist.canv
+ canvas $canv -height $geometry(canvh) -width $geometry(canv1) \
+ -bg white -bd 0 \
+ -yscrollincr $linespc -yscrollcommand "$cscroll set"
+ .ctop.top.clist add $canv
+ set canv2 .ctop.top.clist.canv2
+ canvas $canv2 -height $geometry(canvh) -width $geometry(canv2) \
+ -bg white -bd 0 -yscrollincr $linespc
+ .ctop.top.clist add $canv2
+ set canv3 .ctop.top.clist.canv3
+ canvas $canv3 -height $geometry(canvh) -width $geometry(canv3) \
+ -bg white -bd 0 -yscrollincr $linespc
+ .ctop.top.clist add $canv3
+ bind .ctop.top.clist <Configure> {resizeclistpanes %W %w}
+
+ set sha1entry .ctop.top.bar.sha1
+ label .ctop.top.bar.sha1label -text "SHA1 ID: "
+ pack .ctop.top.bar.sha1label -side left
+ entry $sha1entry -width 40 -font $textfont -state readonly
+ pack $sha1entry -side left -pady 2
+ button .ctop.top.bar.findbut -text "Find" -command dofind
+ pack .ctop.top.bar.findbut -side left
+ set findstring {}
+ set fstring .ctop.top.bar.findstring
+ entry $fstring -width 30 -font $textfont -textvariable findstring
+ pack $fstring -side left -expand 1 -fill x
+ set findtype Exact
+ tk_optionMenu .ctop.top.bar.findtype findtype Exact IgnCase Regexp
+ set findloc "All fields"
+ tk_optionMenu .ctop.top.bar.findloc findloc "All fields" Headline \
+ Comments Author Committer
+ pack .ctop.top.bar.findloc -side right
+ pack .ctop.top.bar.findtype -side right
+
+ panedwindow .ctop.cdet -orient horizontal
+ .ctop add .ctop.cdet
+ frame .ctop.cdet.left
+ set ctext .ctop.cdet.left.ctext
+ text $ctext -bg white -state disabled -font $textfont \
+ -width $geometry(ctextw) -height $geometry(ctexth) \
+ -yscrollcommand ".ctop.cdet.left.sb set"
+ scrollbar .ctop.cdet.left.sb -command "$ctext yview"
+ pack .ctop.cdet.left.sb -side right -fill y
+ pack $ctext -side left -fill both -expand 1
+ .ctop.cdet add .ctop.cdet.left
+
+ $ctext tag conf filesep -font [concat $textfont bold]
+ $ctext tag conf hunksep -back blue -fore white
+ $ctext tag conf d0 -back "#ff8080"
+ $ctext tag conf d1 -back green
+ $ctext tag conf found -back yellow
+
+ frame .ctop.cdet.right
+ set cflist .ctop.cdet.right.cfiles
+ listbox $cflist -bg white -selectmode extended -width $geometry(cflistw) \
+ -yscrollcommand ".ctop.cdet.right.sb set"
+ scrollbar .ctop.cdet.right.sb -command "$cflist yview"
+ pack .ctop.cdet.right.sb -side right -fill y
+ pack $cflist -side left -fill both -expand 1
+ .ctop.cdet add .ctop.cdet.right
+ bind .ctop.cdet <Configure> {resizecdetpanes %W %w}
+
+ pack .ctop -side top -fill both -expand 1
+
+ bindall <1> {selcanvline %x %y}
+ bindall <B1-Motion> {selcanvline %x %y}
+ bindall <ButtonRelease-4> "allcanvs yview scroll -5 u"
+ bindall <ButtonRelease-5> "allcanvs yview scroll 5 u"
+ bindall <2> "allcanvs scan mark 0 %y"
+ bindall <B2-Motion> "allcanvs scan dragto 0 %y"
+ bind . <Key-Up> "selnextline -1"
+ bind . <Key-Down> "selnextline 1"
+ bind . <Key-Prior> "allcanvs yview scroll -1 p"
+ bind . <Key-Next> "allcanvs yview scroll 1 p"
+ bindkey <Key-Delete> "$ctext yview scroll -1 p"
+ bindkey <Key-BackSpace> "$ctext yview scroll -1 p"
+ bindkey <Key-space> "$ctext yview scroll 1 p"
+ bindkey p "selnextline -1"
+ bindkey n "selnextline 1"
+ bindkey b "$ctext yview scroll -1 p"
+ bindkey d "$ctext yview scroll 18 u"
+ bindkey u "$ctext yview scroll -18 u"
+ bindkey / findnext
+ bindkey ? findprev
+ bindkey f nextfile
+ bind . <Control-q> doquit
+ bind . <Control-f> dofind
+ bind . <Control-g> findnext
+ bind . <Control-r> findprev
+ bind . <Control-equal> {incrfont 1}
+ bind . <Control-KP_Add> {incrfont 1}
+ bind . <Control-minus> {incrfont -1}
+ bind . <Control-KP_Subtract> {incrfont -1}
+ bind $cflist <<ListboxSelect>> listboxsel
+ bind . <Destroy> {savestuff %W}
+ bind . <Button-1> "click %W"
+ bind $fstring <Key-Return> dofind
+}
+
+# when we make a key binding for the toplevel, make sure
+# it doesn't get triggered when that key is pressed in the
+# find string entry widget.
+proc bindkey {ev script} {
+ global fstring
+ bind . $ev $script
+ set escript [bind Entry $ev]
+ if {$escript == {}} {
+ set escript [bind Entry <Key>]
+ }
+ bind $fstring $ev "$escript; break"
+}
+
+# set the focus back to the toplevel for any click outside
+# the find string entry widget
+proc click {w} {
+ global fstring
+ if {$w != $fstring} {
+ focus .
+ }
+}
+
+proc savestuff {w} {
+ global canv canv2 canv3 ctext cflist mainfont textfont
+ global stuffsaved
+ if {$stuffsaved} return
+ if {![winfo viewable .]} return
+ catch {
+ set f [open "~/.gitk-new" w]
+ puts $f "set mainfont {$mainfont}"
+ puts $f "set textfont {$textfont}"
+ puts $f "set geometry(width) [winfo width .ctop]"
+ puts $f "set geometry(height) [winfo height .ctop]"
+ puts $f "set geometry(canv1) [expr [winfo width $canv]-2]"
+ puts $f "set geometry(canv2) [expr [winfo width $canv2]-2]"
+ puts $f "set geometry(canv3) [expr [winfo width $canv3]-2]"
+ puts $f "set geometry(canvh) [expr [winfo height $canv]-2]"
+ set wid [expr {([winfo width $ctext] - 8) \
+ / [font measure $textfont "0"]}]
+ puts $f "set geometry(ctextw) $wid"
+ set wid [expr {([winfo width $cflist] - 11) \
+ / [font measure [$cflist cget -font] "0"]}]
+ puts $f "set geometry(cflistw) $wid"
+ close $f
+ file rename -force "~/.gitk-new" "~/.gitk"
+ }
+ set stuffsaved 1
+}
+
+proc resizeclistpanes {win w} {
+ global oldwidth
+ if [info exists oldwidth($win)] {
+ set s0 [$win sash coord 0]
+ set s1 [$win sash coord 1]
+ if {$w < 60} {
+ set sash0 [expr {int($w/2 - 2)}]
+ set sash1 [expr {int($w*5/6 - 2)}]
+ } else {
+ set factor [expr {1.0 * $w / $oldwidth($win)}]
+ set sash0 [expr {int($factor * [lindex $s0 0])}]
+ set sash1 [expr {int($factor * [lindex $s1 0])}]
+ if {$sash0 < 30} {
+ set sash0 30
+ }
+ if {$sash1 < $sash0 + 20} {
+ set sash1 [expr $sash0 + 20]
+ }
+ if {$sash1 > $w - 10} {
+ set sash1 [expr $w - 10]
+ if {$sash0 > $sash1 - 20} {
+ set sash0 [expr $sash1 - 20]
+ }
+ }
+ }
+ $win sash place 0 $sash0 [lindex $s0 1]
+ $win sash place 1 $sash1 [lindex $s1 1]
+ }
+ set oldwidth($win) $w
+}
+
+proc resizecdetpanes {win w} {
+ global oldwidth
+ if [info exists oldwidth($win)] {
+ set s0 [$win sash coord 0]
+ if {$w < 60} {
+ set sash0 [expr {int($w*3/4 - 2)}]
+ } else {
+ set factor [expr {1.0 * $w / $oldwidth($win)}]
+ set sash0 [expr {int($factor * [lindex $s0 0])}]
+ if {$sash0 < 45} {
+ set sash0 45
+ }
+ if {$sash0 > $w - 15} {
+ set sash0 [expr $w - 15]
+ }
+ }
+ $win sash place 0 $sash0 [lindex $s0 1]
+ }
+ set oldwidth($win) $w
+}
+
+proc allcanvs args {
+ global canv canv2 canv3
+ eval $canv $args
+ eval $canv2 $args
+ eval $canv3 $args
+}
+
+proc bindall {event action} {
+ global canv canv2 canv3
+ bind $canv $event $action
+ bind $canv2 $event $action
+ bind $canv3 $event $action
+}
+
+proc about {} {
+ set w .about
+ if {[winfo exists $w]} {
+ raise $w
+ return
+ }
+ toplevel $w
+ wm title $w "About gitk"
+ message $w.m -text {
+Gitk version 1.0
+
+Copyright © 2005 Paul Mackerras
+
+Use and redistribute under the terms of the GNU General Public License
+
+(CVS $Revision: 1.17 $)} \
+ -justify center -aspect 400
+ pack $w.m -side top -fill x -padx 20 -pady 20
+ button $w.ok -text Close -command "destroy $w"
+ pack $w.ok -side bottom