[thirdparty/git.git] / gitk

#!/bin/sh
# Tcl ignores the next line -*- tcl -*- \
exec wish "$0" -- "${1+$@}"

# Copyright (C) 2005 Paul Mackerras.  All rights reserved.
# This program is free software; it may be used, copied, modified
# and distributed under the terms of the GNU General Public Licence,
# either version 2, or (at your option) any later version.

# CVS $Revision: 1.20 $

proc getcommits {rargs} {
    global commits commfd phase canv mainfont
    if {$rargs == {}} {
	set rargs HEAD
    }
    set commits {}
    set phase getcommits
    if [catch {set commfd [open "|git-rev-list $rargs" r]} err] {
	puts stderr "Error executing git-rev-list: $err"
	exit 1
    }
    fconfigure $commfd -blocking 0
    fileevent $commfd readable "getcommitline $commfd"
    $canv delete all
    $canv create text 3 3 -anchor nw -text "Reading commits..." \
	-font $mainfont -tags textitems
}

proc getcommitline {commfd}  {
    global commits parents cdate nparents children nchildren
    set n [gets $commfd line]
    if {$n < 0} {
	if {![eof $commfd]} return
	# this works around what is apparently a bug in Tcl...
	fconfigure $commfd -blocking 1
	if {![catch {close $commfd} err]} {
	    after idle readallcommits
	    return
	}
	if {[string range $err 0 4] == "usage"} {
	    set err "\
Gitk: error reading commits: bad arguments to git-rev-list.\n\
(Note: arguments to gitk are passed to git-rev-list\
to allow selection of commits to be displayed.)"
	} else {
	    set err "Error reading commits: $err"
	}
	error_popup $err
	exit 1
    }
    if {![regexp {^[0-9a-f]{40}$} $line]} {
	error_popup "Can't parse git-rev-tree output: {$line}"
	exit 1
    }
    lappend commits $line
}

proc readallcommits {} {
    global commits
    foreach id $commits {
	readcommit $id
	update
    }
    drawgraph
}

proc readcommit {id} {
    global commitinfo children nchildren parents nparents cdate
    set inhdr 1
    set comment {}
    set headline {}
    set auname {}
    set audate {}
    set comname {}
    set comdate {}
    if {![info exists nchildren($id)]} {
	set children($id) {}
	set nchildren($id) 0
    }
    set parents($id) {}
    set nparents($id) 0
    if [catch {set contents [exec git-cat-file commit $id]}] return
    foreach line [split $contents "\n"] {
	if {$inhdr} {
	    if {$line == {}} {
		set inhdr 0
	    } else {
		set tag [lindex $line 0]
		if {$tag == "parent"} {
		    set p [lindex $line 1]
		    if {![info exists nchildren($p)]} {
			set children($p) {}
			set nchildren($p) 0
		    }
		    lappend parents($id) $p
		    incr nparents($id)
		    if {[lsearch -exact $children($p) $id] < 0} {
			lappend children($p) $id
			incr nchildren($p)
		    }
		} elseif {$tag == "author"} {
		    set x [expr {[llength $line] - 2}]
		    set audate [lindex $line $x]
		    set auname [lrange $line 1 [expr {$x - 1}]]
		} elseif {$tag == "committer"} {
		    set x [expr {[llength $line] - 2}]
		    set comdate [lindex $line $x]
		    set comname [lrange $line 1 [expr {$x - 1}]]
		}
	    }
	} else {
	    if {$comment == {}} {
		set headline $line
	    } else {
		append comment "\n"
	    }
	    append comment $line
	}
    }
    if {$audate != {}} {
	set audate [clock format $audate -format "%Y-%m-%d %H:%M:%S"]
    }
    if {$comdate != {}} {
	set cdate($id) $comdate
	set comdate [clock format $comdate -format "%Y-%m-%d %H:%M:%S"]
    }
    set commitinfo($id) [list $headline $auname $audate \
			     $comname $comdate $comment]
}

proc readrefs {} {
    global tagids idtags
    set tags [glob -nocomplain -types f .git/refs/tags/*]
    foreach f $tags {
	catch {
	    set fd [open $f r]
	    set line [read $fd]
	    if {[regexp {^[0-9a-f]{40}} $line id]} {
		set contents [split [exec git-cat-file tag $id] "\n"]
		set obj {}
		set type {}
		set tag {}
		foreach l $contents {
		    if {$l == {}} break
		    switch -- [lindex $l 0] {
			"object" {set obj [lindex $l 1]}
			"type" {set type [lindex $l 1]}
			"tag" {set tag [string range $l 4 end]}
		    }
		}
		if {$obj != {} && $type == "commit" && $tag != {}} {
		    set tagids($tag) $obj
		    lappend idtags($obj) $tag
		}
	    }
	}
    }
}

proc error_popup msg {
    set w .error
    toplevel $w
    wm transient $w .
    message $w.m -text $msg -justify center -aspect 400
    pack $w.m -side top -fill x -padx 20 -pady 20
    button $w.ok -text OK -command "destroy $w"
    pack $w.ok -side bottom -fill x
    bind $w <Visibility> "grab $w; focus $w"
    tkwait window $w
}

proc makewindow {} {
    global canv canv2 canv3 linespc charspc ctext cflist textfont
    global findtype findloc findstring fstring geometry
    global entries sha1entry sha1string sha1but

    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
    set entries $sha1entry
    set sha1but .ctop.top.bar.sha1label
    button $sha1but -text "SHA1 ID: " -state disabled -relief flat \
	-command gotocommit -width 8
    $sha1but conf -disabledforeground [$sha1but cget -foreground]
    pack .ctop.top.bar.sha1label -side left
    entry $sha1entry -width 40 -font $textfont -textvariable sha1string
    trace add variable sha1string write sha1change
    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
    lappend entries $fstring
    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 units"
    bindall <ButtonRelease-5> "allcanvs yview scroll 5 units"
    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 pages"
    bind . <Key-Next> "allcanvs yview scroll 1 pages"
    bindkey <Key-Delete> "$ctext yview scroll -1 pages"
    bindkey <Key-BackSpace> "$ctext yview scroll -1 pages"
    bindkey <Key-space> "$ctext yview scroll 1 pages"
    bindkey p "selnextline -1"
    bindkey n "selnextline 1"
    bindkey b "$ctext yview scroll -1 pages"
    bindkey d "$ctext yview scroll 18 units"
    bindkey u "$ctext yview scroll -18 units"
    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
    bind $sha1entry <Key-Return> gotocommit
}

# 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 entries
    bind . $ev $script
    set escript [bind Entry $ev]
    if {$escript == {}} {
	set escript [bind Entry <Key>]
    }
    foreach e $entries {
	bind $e $ev "$escript; break"
    }
}

# set the focus back to the toplevel for any click outside
# the entry widgets
proc click {w} {
    global entries
    foreach e $entries {
	if {$w == $e} return
    }
    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.1
Commit	Line	Data
1db95b00 PM	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
d4e95cb6	10	# CVS $Revision: 1.20 $
1db95b00 PM	11
1db95b00 PM	12	proc getcommits {rargs} {
1d10f36d	13	global commits commfd phase canv mainfont
1db95b00 PM	14	if {$rargs == {}} {
	15	set rargs HEAD
	16	}
	17	set commits {}
1d10f36d	18	set phase getcommits
cfb4563c PM	19	if [catch {set commfd [open "\|git-rev-list $rargs" r]} err] {
cfb4563c PM	20	puts stderr "Error executing git-rev-list: $err"
1d10f36d PM	21	exit 1
	22	}
	23	fconfigure $commfd -blocking 0
	24	fileevent $commfd readable "getcommitline $commfd"
	25	$canv delete all
	26	$canv create text 3 3 -anchor nw -text "Reading commits..." \
	27	-font $mainfont -tags textitems
	28	}
	29
	30	proc getcommitline {commfd} {
	31	global commits parents cdate nparents children nchildren
	32	set n [gets $commfd line]
	33	if {$n < 0} {
	34	if {![eof $commfd]} return
df3d83b1 PM	35	# this works around what is apparently a bug in Tcl...
df3d83b1 PM	36	fconfigure $commfd -blocking 1
1d10f36d	37	if {![catch {close $commfd} err]} {
cfb4563c	38	after idle readallcommits
1d10f36d PM	39	return
1d10f36d PM	40	}
9a40c50c	41	if {[string range $err 0 4] == "usage"} {
df3d83b1	42	set err "\
cfb4563c PM	43	Gitk: error reading commits: bad arguments to git-rev-list.\n\
cfb4563c PM	44	(Note: arguments to gitk are passed to git-rev-list\
df3d83b1	45	to allow selection of commits to be displayed.)"
9a40c50c	46	} else {
df3d83b1	47	set err "Error reading commits: $err"
9a40c50c	48	}
df3d83b1	49	error_popup $err
1d10f36d	50	exit 1
9a40c50c	51	}
cfb4563c PM	52	if {![regexp {^[0-9a-f]{40}$} $line]} {
	53	error_popup "Can't parse git-rev-tree output: {$line}"
	54	exit 1
	55	}
	56	lappend commits $line
	57	}
1d10f36d	58
cfb4563c PM	59	proc readallcommits {} {
	60	global commits
	61	foreach id $commits {
	62	readcommit $id
	63	update
1db95b00	64	}
cfb4563c	65	drawgraph
1db95b00 PM	66	}
	67
	68	proc readcommit {id} {
cfb4563c	69	global commitinfo children nchildren parents nparents cdate
1db95b00 PM	70	set inhdr 1
	71	set comment {}
	72	set headline {}
	73	set auname {}
	74	set audate {}
	75	set comname {}
	76	set comdate {}
cfb4563c PM	77	if {![info exists nchildren($id)]} {
	78	set children($id) {}
	79	set nchildren($id) 0
	80	}
	81	set parents($id) {}
	82	set nparents($id) 0
df3d83b1 PM	83	if [catch {set contents [exec git-cat-file commit $id]}] return
df3d83b1 PM	84	foreach line [split $contents "\n"] {
1db95b00 PM	85	if {$inhdr} {
	86	if {$line == {}} {
	87	set inhdr 0
	88	} else {
	89	set tag [lindex $line 0]
cfb4563c PM	90	if {$tag == "parent"} {
	91	set p [lindex $line 1]
	92	if {![info exists nchildren($p)]} {
	93	set children($p) {}
	94	set nchildren($p) 0
	95	}
	96	lappend parents($id) $p
	97	incr nparents($id)
	98	if {[lsearch -exact $children($p) $id] < 0} {
	99	lappend children($p) $id
	100	incr nchildren($p)
	101	}
	102	} elseif {$tag == "author"} {
1db95b00 PM	103	set x [expr {[llength $line] - 2}]
	104	set audate [lindex $line $x]
	105	set auname [lrange $line 1 [expr {$x - 1}]]
	106	} elseif {$tag == "committer"} {
	107	set x [expr {[llength $line] - 2}]
	108	set comdate [lindex $line $x]
	109	set comname [lrange $line 1 [expr {$x - 1}]]
	110	}
	111	}
	112	} else {
	113	if {$comment == {}} {
	114	set headline $line
	115	} else {
	116	append comment "\n"
	117	}
	118	append comment $line
	119	}
	120	}
	121	if {$audate != {}} {
	122	set audate [clock format $audate -format "%Y-%m-%d %H:%M:%S"]
	123	}
	124	if {$comdate != {}} {
cfb4563c	125	set cdate($id) $comdate
1db95b00 PM	126	set comdate [clock format $comdate -format "%Y-%m-%d %H:%M:%S"]
1db95b00 PM	127	}
e5c2d856 PM	128	set commitinfo($id) [list $headline $auname $audate \
e5c2d856 PM	129	$comname $comdate $comment]
1db95b00 PM	130	}
1db95b00 PM	131
887fe3c4 PM	132	proc readrefs {} {
	133	global tagids idtags
	134	set tags [glob -nocomplain -types f .git/refs/tags/*]
	135	foreach f $tags {
	136	catch {
	137	set fd [open $f r]
	138	set line [read $fd]
	139	if {[regexp {^[0-9a-f]{40}} $line id]} {
	140	set contents [split [exec git-cat-file tag $id] "\n"]
	141	set obj {}
	142	set type {}
	143	set tag {}
	144	foreach l $contents {
	145	if {$l == {}} break
	146	switch -- [lindex $l 0] {
	147	"object" {set obj [lindex $l 1]}
	148	"type" {set type [lindex $l 1]}
	149	"tag" {set tag [string range $l 4 end]}
	150	}
	151	}
	152	if {$obj != {} && $type == "commit" && $tag != {}} {
	153	set tagids($tag) $obj
	154	lappend idtags($obj) $tag
	155	}
	156	}
	157	}
	158	}
	159	}
	160
df3d83b1 PM	161	proc error_popup msg {
	162	set w .error
	163	toplevel $w
	164	wm transient $w .
	165	message $w.m -text $msg -justify center -aspect 400
	166	pack $w.m -side top -fill x -padx 20 -pady 20
	167	button $w.ok -text OK -command "destroy $w"
	168	pack $w.ok -side bottom -fill x
	169	bind $w <Visibility> "grab $w; focus $w"
	170	tkwait window $w
	171	}
	172
1db95b00	173	proc makewindow {} {
e5c2d856	174	global canv canv2 canv3 linespc charspc ctext cflist textfont
887fe3c4 PM	175	global findtype findloc findstring fstring geometry
887fe3c4 PM	176	global entries sha1entry sha1string sha1but
9a40c50c PM	177
	178	menu .bar
	179	.bar add cascade -label "File" -menu .bar.file
	180	menu .bar.file
1d10f36d	181	.bar.file add command -label "Quit" -command doquit
9a40c50c PM	182	menu .bar.help
	183	.bar add cascade -label "Help" -menu .bar.help
	184	.bar.help add command -label "About gitk" -command about
	185	. configure -menu .bar
	186
0fba86b3 PM	187	if {![info exists geometry(canv1)]} {
	188	set geometry(canv1) [expr 45 * $charspc]
	189	set geometry(canv2) [expr 30 * $charspc]
	190	set geometry(canv3) [expr 15 * $charspc]
	191	set geometry(canvh) [expr 25 * $linespc + 4]
	192	set geometry(ctextw) 80
	193	set geometry(ctexth) 30
	194	set geometry(cflistw) 30
	195	}
0327d27a	196	panedwindow .ctop -orient vertical
0fba86b3 PM	197	if {[info exists geometry(width)]} {
0fba86b3 PM	198	.ctop conf -width $geometry(width) -height $geometry(height)
17386066 PM	199	set texth [expr {$geometry(height) - $geometry(canvh) - 56}]
	200	set geometry(ctexth) [expr {($texth - 8) /
	201	[font metrics $textfont -linespace]}]
0fba86b3	202	}
98f350e5 PM	203	frame .ctop.top
	204	frame .ctop.top.bar
	205	pack .ctop.top.bar -side bottom -fill x
	206	set cscroll .ctop.top.csb
	207	scrollbar $cscroll -command {allcanvs yview} -highlightthickness 0
	208	pack $cscroll -side right -fill y
	209	panedwindow .ctop.top.clist -orient horizontal -sashpad 0 -handlesize 4
	210	pack .ctop.top.clist -side top -fill both -expand 1
	211	.ctop add .ctop.top
	212	set canv .ctop.top.clist.canv
0fba86b3	213	canvas $canv -height $geometry(canvh) -width $geometry(canv1) \
b5721c72 PM	214	-bg white -bd 0 \
b5721c72 PM	215	-yscrollincr $linespc -yscrollcommand "$cscroll set"
98f350e5 PM	216	.ctop.top.clist add $canv
98f350e5 PM	217	set canv2 .ctop.top.clist.canv2
0fba86b3	218	canvas $canv2 -height $geometry(canvh) -width $geometry(canv2) \
b5721c72	219	-bg white -bd 0 -yscrollincr $linespc
98f350e5 PM	220	.ctop.top.clist add $canv2
98f350e5 PM	221	set canv3 .ctop.top.clist.canv3
0fba86b3	222	canvas $canv3 -height $geometry(canvh) -width $geometry(canv3) \
b5721c72	223	-bg white -bd 0 -yscrollincr $linespc
98f350e5	224	.ctop.top.clist add $canv3
43bddeb4	225	bind .ctop.top.clist <Configure> {resizeclistpanes %W %w}
98f350e5 PM	226
98f350e5 PM	227	set sha1entry .ctop.top.bar.sha1
887fe3c4 PM	228	set entries $sha1entry
	229	set sha1but .ctop.top.bar.sha1label
	230	button $sha1but -text "SHA1 ID: " -state disabled -relief flat \
	231	-command gotocommit -width 8
	232	$sha1but conf -disabledforeground [$sha1but cget -foreground]
98f350e5	233	pack .ctop.top.bar.sha1label -side left
887fe3c4 PM	234	entry $sha1entry -width 40 -font $textfont -textvariable sha1string
887fe3c4 PM	235	trace add variable sha1string write sha1change
98f350e5 PM	236	pack $sha1entry -side left -pady 2
	237	button .ctop.top.bar.findbut -text "Find" -command dofind
	238	pack .ctop.top.bar.findbut -side left
	239	set findstring {}
df3d83b1	240	set fstring .ctop.top.bar.findstring
887fe3c4	241	lappend entries $fstring
df3d83b1	242	entry $fstring -width 30 -font $textfont -textvariable findstring
df3d83b1	243	pack $fstring -side left -expand 1 -fill x
98f350e5 PM	244	set findtype Exact
	245	tk_optionMenu .ctop.top.bar.findtype findtype Exact IgnCase Regexp
	246	set findloc "All fields"
	247	tk_optionMenu .ctop.top.bar.findloc findloc "All fields" Headline \
	248	Comments Author Committer
	249	pack .ctop.top.bar.findloc -side right
	250	pack .ctop.top.bar.findtype -side right
b5721c72	251
5ad588de PM	252	panedwindow .ctop.cdet -orient horizontal
5ad588de PM	253	.ctop add .ctop.cdet
d2610d11 PM	254	frame .ctop.cdet.left
d2610d11 PM	255	set ctext .ctop.cdet.left.ctext
0fba86b3 PM	256	text $ctext -bg white -state disabled -font $textfont \
0fba86b3 PM	257	-width $geometry(ctextw) -height $geometry(ctexth) \
d2610d11 PM	258	-yscrollcommand ".ctop.cdet.left.sb set"
	259	scrollbar .ctop.cdet.left.sb -command "$ctext yview"
	260	pack .ctop.cdet.left.sb -side right -fill y
	261	pack $ctext -side left -fill both -expand 1
	262	.ctop.cdet add .ctop.cdet.left
	263
e5c2d856 PM	264	$ctext tag conf filesep -font [concat $textfont bold]
	265	$ctext tag conf hunksep -back blue -fore white
	266	$ctext tag conf d0 -back "#ff8080"
	267	$ctext tag conf d1 -back green
df3d83b1	268	$ctext tag conf found -back yellow
e5c2d856	269
d2610d11 PM	270	frame .ctop.cdet.right
d2610d11 PM	271	set cflist .ctop.cdet.right.cfiles
17386066	272	listbox $cflist -bg white -selectmode extended -width $geometry(cflistw) \
d2610d11 PM	273	-yscrollcommand ".ctop.cdet.right.sb set"
	274	scrollbar .ctop.cdet.right.sb -command "$cflist yview"
	275	pack .ctop.cdet.right.sb -side right -fill y
	276	pack $cflist -side left -fill both -expand 1
	277	.ctop.cdet add .ctop.cdet.right
0fba86b3	278	bind .ctop.cdet <Configure> {resizecdetpanes %W %w}
d2610d11	279
0327d27a	280	pack .ctop -side top -fill both -expand 1
1db95b00	281
b5721c72 PM	282	bindall <1> {selcanvline %x %y}
b5721c72 PM	283	bindall <B1-Motion> {selcanvline %x %y}
cfb4563c PM	284	bindall <ButtonRelease-4> "allcanvs yview scroll -5 units"
cfb4563c PM	285	bindall <ButtonRelease-5> "allcanvs yview scroll 5 units"
b5721c72 PM	286	bindall <2> "allcanvs scan mark 0 %y"
b5721c72 PM	287	bindall <B2-Motion> "allcanvs scan dragto 0 %y"
17386066 PM	288	bind . <Key-Up> "selnextline -1"
17386066 PM	289	bind . <Key-Down> "selnextline 1"
cfb4563c PM	290	bind . <Key-Prior> "allcanvs yview scroll -1 pages"
	291	bind . <Key-Next> "allcanvs yview scroll 1 pages"
	292	bindkey <Key-Delete> "$ctext yview scroll -1 pages"
	293	bindkey <Key-BackSpace> "$ctext yview scroll -1 pages"
	294	bindkey <Key-space> "$ctext yview scroll 1 pages"
df3d83b1 PM	295	bindkey p "selnextline -1"
df3d83b1 PM	296	bindkey n "selnextline 1"
cfb4563c PM	297	bindkey b "$ctext yview scroll -1 pages"
	298	bindkey d "$ctext yview scroll 18 units"
	299	bindkey u "$ctext yview scroll -18 units"
df3d83b1 PM	300	bindkey / findnext
df3d83b1 PM	301	bindkey ? findprev
39ad8570	302	bindkey f nextfile
1d10f36d	303	bind . <Control-q> doquit
98f350e5 PM	304	bind . <Control-f> dofind
	305	bind . <Control-g> findnext
	306	bind . <Control-r> findprev
1d10f36d PM	307	bind . <Control-equal> {incrfont 1}
	308	bind . <Control-KP_Add> {incrfont 1}
	309	bind . <Control-minus> {incrfont -1}
	310	bind . <Control-KP_Subtract> {incrfont -1}
e5c2d856	311	bind $cflist <<ListboxSelect>> listboxsel
0fba86b3	312	bind . <Destroy> {savestuff %W}
df3d83b1	313	bind . <Button-1> "click %W"
17386066	314	bind $fstring <Key-Return> dofind
887fe3c4	315	bind $sha1entry <Key-Return> gotocommit
df3d83b1 PM	316	}
	317
	318	# when we make a key binding for the toplevel, make sure
	319	# it doesn't get triggered when that key is pressed in the
	320	# find string entry widget.
	321	proc bindkey {ev script} {
887fe3c4	322	global entries
df3d83b1 PM	323	bind . $ev $script
	324	set escript [bind Entry $ev]
	325	if {$escript == {}} {
	326	set escript [bind Entry <Key>]
	327	}
887fe3c4 PM	328	foreach e $entries {
	329	bind $e $ev "$escript; break"
	330	}
df3d83b1 PM	331	}
	332
	333	# set the focus back to the toplevel for any click outside
887fe3c4	334	# the entry widgets
df3d83b1	335	proc click {w} {
887fe3c4 PM	336	global entries
	337	foreach e $entries {
	338	if {$w == $e} return
df3d83b1	339	}
887fe3c4	340	focus .
0fba86b3 PM	341	}
	342
	343	proc savestuff {w} {
	344	global canv canv2 canv3 ctext cflist mainfont textfont
	345	global stuffsaved
	346	if {$stuffsaved} return
df3d83b1	347	if {![winfo viewable .]} return
0fba86b3 PM	348	catch {
	349	set f [open "~/.gitk-new" w]
	350	puts $f "set mainfont {$mainfont}"
	351	puts $f "set textfont {$textfont}"
	352	puts $f "set geometry(width) [winfo width .ctop]"
	353	puts $f "set geometry(height) [winfo height .ctop]"
df3d83b1 PM	354	puts $f "set geometry(canv1) [expr [winfo width $canv]-2]"
	355	puts $f "set geometry(canv2) [expr [winfo width $canv2]-2]"
	356	puts $f "set geometry(canv3) [expr [winfo width $canv3]-2]"
	357	puts $f "set geometry(canvh) [expr [winfo height $canv]-2]"
0fba86b3 PM	358	set wid [expr {([winfo width $ctext] - 8) \
0fba86b3 PM	359	/ [font measure $textfont "0"]}]
0fba86b3	360	puts $f "set geometry(ctextw) $wid"
0fba86b3 PM	361	set wid [expr {([winfo width $cflist] - 11) \
	362	/ [font measure [$cflist cget -font] "0"]}]
	363	puts $f "set geometry(cflistw) $wid"
	364	close $f
	365	file rename -force "~/.gitk-new" "~/.gitk"
	366	}
	367	set stuffsaved 1
1db95b00 PM	368	}
1db95b00 PM	369
43bddeb4 PM	370	proc resizeclistpanes {win w} {
	371	global oldwidth
	372	if [info exists oldwidth($win)] {
	373	set s0 [$win sash coord 0]
	374	set s1 [$win sash coord 1]
	375	if {$w < 60} {
	376	set sash0 [expr {int($w/2 - 2)}]
	377	set sash1 [expr {int($w*5/6 - 2)}]
	378	} else {
	379	set factor [expr {1.0 * $w / $oldwidth($win)}]
	380	set sash0 [expr {int($factor * [lindex $s0 0])}]
	381	set sash1 [expr {int($factor * [lindex $s1 0])}]
	382	if {$sash0 < 30} {
	383	set sash0 30
	384	}
	385	if {$sash1 < $sash0 + 20} {
	386	set sash1 [expr $sash0 + 20]
	387	}
	388	if {$sash1 > $w - 10} {
	389	set sash1 [expr $w - 10]
	390	if {$sash0 > $sash1 - 20} {
	391	set sash0 [expr $sash1 - 20]
	392	}
	393	}
	394	}
	395	$win sash place 0 $sash0 [lindex $s0 1]
	396	$win sash place 1 $sash1 [lindex $s1 1]
	397	}
	398	set oldwidth($win) $w
	399	}
	400
	401	proc resizecdetpanes {win w} {
	402	global oldwidth
	403	if [info exists oldwidth($win)] {
	404	set s0 [$win sash coord 0]
	405	if {$w < 60} {
	406	set sash0 [expr {int($w*3/4 - 2)}]
	407	} else {
	408	set factor [expr {1.0 * $w / $oldwidth($win)}]
	409	set sash0 [expr {int($factor * [lindex $s0 0])}]
	410	if {$sash0 < 45} {
	411	set sash0 45
	412	}
	413	if {$sash0 > $w - 15} {
	414	set sash0 [expr $w - 15]
	415	}
	416	}
	417	$win sash place 0 $sash0 [lindex $s0 1]
	418	}
	419	set oldwidth($win) $w
	420	}
	421
b5721c72 PM	422	proc allcanvs args {
	423	global canv canv2 canv3
	424	eval $canv $args
	425	eval $canv2 $args
	426	eval $canv3 $args
	427	}
	428
	429	proc bindall {event action} {
	430	global canv canv2 canv3
	431	bind $canv $event $action
	432	bind $canv2 $event $action
	433	bind $canv3 $event $action
	434	}
	435
9a40c50c PM	436	proc about {} {
	437	set w .about
	438	if {[winfo exists $w]} {
	439	raise $w
	440	return
	441	}
	442	toplevel $w
	443	wm title $w "About gitk"
	444	message $w.m -text {
cfb4563c	445	Gitk version 1.1
9a40c50c PM	446
	447