[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.

proc gitdir {} {
    global env
    if {[info exists env(GIT_DIR)]} {
	return $env(GIT_DIR)
    } else {
	return ".git"
    }
}

proc getcommits {rargs} {
    global commits commfd phase canv mainfont env
    global startmsecs nextupdate
    global ctext maincursor textcursor leftover

    # check that we can find a .git directory somewhere...
    set gitdir [gitdir]
    if {![file isdirectory $gitdir]} {
	error_popup "Cannot find the git directory \"$gitdir\"."
	exit 1
    }
    set commits {}
    set phase getcommits
    set startmsecs [clock clicks -milliseconds]
    set nextupdate [expr $startmsecs + 100]
    if [catch {
	set parse_args [concat --default HEAD $rargs]
	set parsed_args [split [eval exec git-rev-parse $parse_args] "\n"]
    }] {
	# if git-rev-parse failed for some reason...
	if {$rargs == {}} {
	    set rargs HEAD
	}
	set parsed_args $rargs
    }
    if [catch {
	set commfd [open "|git-rev-list --header --topo-order $parsed_args" r]
    } err] {
	puts stderr "Error executing git-rev-list: $err"
	exit 1
    }
    set leftover {}
    fconfigure $commfd -blocking 0 -translation binary
    fileevent $commfd readable "getcommitlines $commfd"
    $canv delete all
    $canv create text 3 3 -anchor nw -text "Reading commits..." \
	-font $mainfont -tags textitems
    . config -cursor watch
    $ctext config -cursor watch
}

proc getcommitlines {commfd}  {
    global commits parents cdate children nchildren
    global commitlisted phase commitinfo nextupdate
    global stopped redisplaying leftover

    set stuff [read $commfd]
    if {$stuff == {}} {
	if {![eof $commfd]} return
	# set it blocking so we wait for the process to terminate
	fconfigure $commfd -blocking 1
	if {![catch {close $commfd} err]} {
	    after idle finishcommits
	    return
	}
	if {[string range $err 0 4] == "usage"} {
	    set err \
{Gitk: error reading commits: bad arguments to git-rev-list.
(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
    }
    set start 0
    while 1 {
	set i [string first "\0" $stuff $start]
	if {$i < 0} {
	    append leftover [string range $stuff $start end]
	    return
	}
	set cmit [string range $stuff $start [expr {$i - 1}]]
	if {$start == 0} {
	    set cmit "$leftover$cmit"
	    set leftover {}
	}
	set start [expr {$i + 1}]
	if {![regexp {^([0-9a-f]{40})\n} $cmit match id]} {
	    set shortcmit $cmit
	    if {[string length $shortcmit] > 80} {
		set shortcmit "[string range $shortcmit 0 80]..."
	    }
	    error_popup "Can't parse git-rev-list output: {$shortcmit}"
	    exit 1
	}
	set cmit [string range $cmit 41 end]
	lappend commits $id
	set commitlisted($id) 1
	parsecommit $id $cmit 1
	drawcommit $id
	if {[clock clicks -milliseconds] >= $nextupdate} {
	    doupdate
	}
	while {$redisplaying} {
	    set redisplaying 0
	    if {$stopped == 1} {
		set stopped 0
		set phase "getcommits"
		foreach id $commits {
		    drawcommit $id
		    if {$stopped} break
		    if {[clock clicks -milliseconds] >= $nextupdate} {
			doupdate
		    }
		}
	    }
	}
    }
}

proc doupdate {} {
    global commfd nextupdate

    incr nextupdate 100
    fileevent $commfd readable {}
    update
    fileevent $commfd readable "getcommitlines $commfd"
}

proc readcommit {id} {
    if [catch {set contents [exec git-cat-file commit $id]}] return
    parsecommit $id $contents 0
}

proc parsecommit {id contents listed} {
    global commitinfo children nchildren parents nparents cdate ncleft

    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 ncleft($id) 0
    }
    set parents($id) {}
    set nparents($id) 0
    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
			set ncleft($p) 0
		    }
		    lappend parents($id) $p
		    incr nparents($id)
		    # sometimes we get a commit that lists a parent twice...
		    if {$listed && [lsearch -exact $children($p) $id] < 0} {
			lappend children($p) $id
			incr nchildren($p)
			incr ncleft($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 [string trim $line]
	    } else {
		append comment "\n"
	    }
	    if {!$listed} {
		# git-rev-list indents the comment by 4 spaces;
		# if we got this via git-cat-file, add the indentation
		append comment "    "
	    }
	    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 headids idheads
    set tags [glob -nocomplain -types f [gitdir]/refs/tags/*]
    foreach f $tags {
	catch {
	    set fd [open $f r]
	    set line [read $fd]
	    if {[regexp {^[0-9a-f]{40}} $line id]} {
		set direct [file tail $f]
		set tagids($direct) $id
		lappend idtags($id) $direct
		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
		}
	    }
	    close $fd
	}
    }
    set heads [glob -nocomplain -types f [gitdir]/refs/heads/*]
    foreach f $heads {
	catch {
	    set fd [open $f r]
	    set line [read $fd 40]
	    if {[regexp {^[0-9a-f]{40}} $line id]} {
		set head [file tail $f]
		set headids($head) $line
		lappend idheads($line) $head
	    }
	    close $fd
	}
    }
}

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 findtypemenu findloc findstring fstring geometry
    global entries sha1entry sha1string sha1but
    global maincursor textcursor
    global rowctxmenu gaudydiff mergemax

    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
    set findtypemenu [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 Files Pickaxe
    pack .ctop.top.bar.findloc -side right
    pack .ctop.top.bar.findtype -side right
    # for making sure type==Exact whenever loc==Pickaxe
    trace add variable findloc write findlocchange

    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] -back "#aaaaaa"
    if {$gaudydiff} {
	$ctext tag conf hunksep -back blue -fore white
	$ctext tag conf d0 -back "#ff8080"
	$ctext tag conf d1 -back green
    } else {
	$ctext tag conf hunksep -fore blue
	$ctext tag conf d0 -fore red
	$ctext tag conf d1 -fore "#00a000"
	$ctext tag conf m0 -fore red
	$ctext tag conf m1 -fore blue
	$ctext tag conf m2 -fore green
	$ctext tag conf m3 -fore purple
	$ctext tag conf m4 -fore brown
	$ctext tag conf mmax -fore darkgrey
	set mergemax 5
	$ctext tag conf mresult -font [concat $textfont bold]
	$ctext tag conf msep -font [concat $textfont bold]
	$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 %W %x %y}
    #bindall <B1-Motion> {selcanvline %W %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 1}
    bindkey <Key-Return> {findnext 0}
    bindkey ? findprev
    bindkey f nextfile
    bind . <Control-q> doquit
    bind . <Control-f> dofind
    bind . <Control-g> {findnext 0}
    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
    bind $sha1entry <<PasteSelection>> clearsha1

    set maincursor [. cget -cursor]
    set textcursor [$ctext cget -cursor]

    set rowctxmenu .rowctxmenu
    menu $rowctxmenu -tearoff 0
    $rowctxmenu add command -label "Diff this -> selected" \
	-command {diffvssel 0}
    $rowctxmenu add command -label "Diff selected -> this" \
	-command {diffvssel 1}
    $rowctxmenu add command -label "Make patch" -command mkpatch
    $rowctxmenu add command -label "Create tag" -command mktag
    $rowctxmenu add command -label "Write commit to file" -command writecommit
}

# 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 findmergefiles gaudydiff

    if {$stuffsaved} return
    if {![winfo viewable .]} return
    catch {
	set f [open "~/.gitk-new" w]
	puts $f [list set mainfont $mainfont]
	puts $f [list set textfont $textfont]
	puts $f [list set findmergefiles $findmergefiles]
	puts $f [list set gaudydiff $gaudydiff]
	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.2
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
73b6a6cb JH	10	proc gitdir {} {
	11	global env
	12	if {[info exists env(GIT_DIR)]} {
	13	return $env(GIT_DIR)
	14	} else {
	15	return ".git"
	16	}
	17	}
	18
1db95b00	19	proc getcommits {rargs} {
e2ede2b9	20	global commits commfd phase canv mainfont env
9ccbdfbf	21	global startmsecs nextupdate
b490a991	22	global ctext maincursor textcursor leftover
9ccbdfbf	23
e2ede2b9	24	# check that we can find a .git directory somewhere...
73b6a6cb	25	set gitdir [gitdir]
e2ede2b9 PM	26	if {![file isdirectory $gitdir]} {
	27	error_popup "Cannot find the git directory \"$gitdir\"."
	28	exit 1
	29	}
1db95b00	30	set commits {}
1d10f36d	31	set phase getcommits
9ccbdfbf PM	32	set startmsecs [clock clicks -milliseconds]
9ccbdfbf PM	33	set nextupdate [expr $startmsecs + 100]
2efef4b9	34	if [catch {
b490a991	35	set parse_args [concat --default HEAD $rargs]
2efef4b9 PM	36	set parsed_args [split [eval exec git-rev-parse $parse_args] "\n"]
2efef4b9 PM	37	}] {
b490a991	38	# if git-rev-parse failed for some reason...
2efef4b9 PM	39	if {$rargs == {}} {
	40	set rargs HEAD
	41	}
b490a991	42	set parsed_args $rargs
2efef4b9 PM	43	}
2efef4b9 PM	44	if [catch {
4ef17537	45	set commfd [open "\|git-rev-list --header --topo-order $parsed_args" r]
2efef4b9	46	} err] {
cfb4563c	47	puts stderr "Error executing git-rev-list: $err"
1d10f36d PM	48	exit 1
1d10f36d PM	49	}
b490a991 PM	50	set leftover {}
	51	fconfigure $commfd -blocking 0 -translation binary
	52	fileevent $commfd readable "getcommitlines $commfd"
1d10f36d PM	53	$canv delete all
	54	$canv create text 3 3 -anchor nw -text "Reading commits..." \
	55	-font $mainfont -tags textitems
ea13cba1 PM	56	. config -cursor watch
ea13cba1 PM	57	$ctext config -cursor watch
1d10f36d PM	58	}
1d10f36d PM	59
b490a991	60	proc getcommitlines {commfd} {
a823a911	61	global commits parents cdate children nchildren
9ccbdfbf	62	global commitlisted phase commitinfo nextupdate
b490a991	63	global stopped redisplaying leftover
9ccbdfbf	64
b490a991 PM	65	set stuff [read $commfd]
b490a991 PM	66	if {$stuff == {}} {
1d10f36d	67	if {![eof $commfd]} return
f0654861	68	# set it blocking so we wait for the process to terminate
df3d83b1	69	fconfigure $commfd -blocking 1
1d10f36d	70	if {![catch {close $commfd} err]} {
9ccbdfbf	71	after idle finishcommits
1d10f36d PM	72	return
1d10f36d PM	73	}
9a40c50c	74	if {[string range $err 0 4] == "usage"} {
9ccbdfbf PM	75	set err \
	76	{Gitk: error reading commits: bad arguments to git-rev-list.
	77	(Note: arguments to gitk are passed to git-rev-list
	78	to allow selection of commits to be displayed.)}
9a40c50c	79	} else {
df3d83b1	80	set err "Error reading commits: $err"
9a40c50c	81	}
df3d83b1	82	error_popup $err
1d10f36d	83	exit 1
9a40c50c	84	}
b490a991 PM	85	set start 0
	86	while 1 {
	87	set i [string first "\0" $stuff $start]
	88	if {$i < 0} {
7e952e79	89	append leftover [string range $stuff $start end]
b490a991	90	return
9ccbdfbf	91	}
b490a991 PM	92	set cmit [string range $stuff $start [expr {$i - 1}]]
	93	if {$start == 0} {
	94	set cmit "$leftover$cmit"
7e952e79	95	set leftover {}
b490a991 PM	96	}
	97	set start [expr {$i + 1}]
	98	if {![regexp {^([0-9a-f]{40})\n} $cmit match id]} {
7e952e79 PM	99	set shortcmit $cmit
	100	if {[string length $shortcmit] > 80} {
	101	set shortcmit "[string range $shortcmit 0 80]..."
	102	}
	103	error_popup "Can't parse git-rev-list output: {$shortcmit}"
b490a991 PM	104	exit 1
	105	}
	106	set cmit [string range $cmit 41 end]
	107	lappend commits $id
	108	set commitlisted($id) 1
	109	parsecommit $id $cmit 1
	110	drawcommit $id
	111	if {[clock clicks -milliseconds] >= $nextupdate} {
	112	doupdate
	113	}
	114	while {$redisplaying} {
	115	set redisplaying 0
	116	if {$stopped == 1} {
	117	set stopped 0
	118	set phase "getcommits"
	119	foreach id $commits {
	120	drawcommit $id
	121	if {$stopped} break
	122	if {[clock clicks -milliseconds] >= $nextupdate} {
	123	doupdate
	124	}
9ccbdfbf PM	125	}
	126	}
	127	}
	128	}
	129	}
	130
	131	proc doupdate {} {
	132	global commfd nextupdate
	133
	134	incr nextupdate 100
	135	fileevent $commfd readable {}
	136	update
b490a991	137	fileevent $commfd readable "getcommitlines $commfd"
1db95b00 PM	138	}
	139
	140	proc readcommit {id} {
b490a991 PM	141	if [catch {set contents [exec git-cat-file commit $id]}] return
	142	parsecommit $id $contents 0
	143	}
	144
	145	proc parsecommit {id contents listed} {
9ccbdfbf	146	global commitinfo children nchildren parents nparents cdate ncleft
9ccbdfbf	147
1db95b00 PM	148	set inhdr 1
	149	set comment {}
	150	set headline {}
	151	set auname {}
	152	set audate {}
	153	set comname {}
	154	set comdate {}
cfb4563c PM	155	if {![info exists nchildren($id)]} {
	156	set children($id) {}
	157	set nchildren($id) 0
9ccbdfbf	158	set ncleft($id) 0
cfb4563c PM	159	}
	160	set parents($id) {}
	161	set nparents($id) 0
df3d83b1	162	foreach line [split $contents "\n"] {
1db95b00 PM	163	if {$inhdr} {
	164	if {$line == {}} {
	165	set inhdr 0
	166	} else {
	167	set tag [lindex $line 0]
cfb4563c PM	168	if {$tag == "parent"} {
	169	set p [lindex $line 1]
	170	if {![info exists nchildren($p)]} {
	171	set children($p) {}
	172	set nchildren($p) 0
9ccbdfbf	173	set ncleft($p) 0
cfb4563c PM	174	}
	175	lappend parents($id) $p
	176	incr nparents($id)
a823a911	177	# sometimes we get a commit that lists a parent twice...
b490a991	178	if {$listed && [lsearch -exact $children($p) $id] < 0} {
cfb4563c PM	179	lappend children($p) $id
cfb4563c PM	180	incr nchildren($p)
9ccbdfbf	181	incr ncleft($p)
cfb4563c PM	182	}
cfb4563c PM	183	} elseif {$tag == "author"} {
1db95b00 PM	184	set x [expr {[llength $line] - 2}]
	185	set audate [lindex $line $x]
	186	set auname [lrange $line 1 [expr {$x - 1}]]
	187	} elseif {$tag == "committer"} {
	188	set x [expr {[llength $line] - 2}]
	189	set comdate [lindex $line $x]
	190	set comname [lrange $line 1 [expr {$x - 1}]]
	191	}
	192	}
	193	} else {
	194	if {$comment == {}} {
806ce097	195	set headline [string trim $line]
1db95b00 PM	196	} else {
	197	append comment "\n"
	198	}
806ce097 PM	199	if {!$listed} {
	200	# git-rev-list indents the comment by 4 spaces;
	201	# if we got this via git-cat-file, add the indentation
	202	append comment " "
	203	}
1db95b00 PM	204	append comment $line
	205	}
	206	}
	207	if {$audate != {}} {
	208	set audate [clock format $audate -format "%Y-%m-%d %H:%M:%S"]
	209	}
	210	if {$comdate != {}} {
cfb4563c	211	set cdate($id) $comdate
1db95b00 PM	212	set comdate [clock format $comdate -format "%Y-%m-%d %H:%M:%S"]
1db95b00 PM	213	}
e5c2d856 PM	214	set commitinfo($id) [list $headline $auname $audate \
e5c2d856 PM	215	$comname $comdate $comment]
1db95b00 PM	216	}
1db95b00 PM	217
887fe3c4	218	proc readrefs {} {
c2f6a022	219	global tagids idtags headids idheads
73b6a6cb	220	set tags [glob -nocomplain -types f [gitdir]/refs/tags/*]
887fe3c4 PM	221	foreach f $tags {
	222	catch {
	223	set fd [open $f r]
	224	set line [read $fd]
	225	if {[regexp {^[0-9a-f]{40}} $line id]} {
9ccbdfbf PM	226	set direct [file tail $f]
	227	set tagids($direct) $id
	228	lappend idtags($id) $direct
887fe3c4 PM	229	set contents [split [exec git-cat-file tag $id] "\n"]
	230	set obj {}
	231	set type {}
	232	set tag {}
	233	foreach l $contents {
	234	if {$l == {}} break
	235	switch -- [lindex $l 0] {
	236	"object" {set obj [lindex $l 1]}
	237	"type" {set type [lindex $l 1]}
	238	"tag" {set tag [string range $l 4 end]}
	239	}
	240	}
	241	if {$obj != {} && $type == "commit" && $tag != {}} {
	242	set tagids($tag) $obj
	243	lappend idtags($obj) $tag
	244	}
	245	}
c2f6a022 PM	246	close $fd
	247	}
	248	}
73b6a6cb	249	set heads [glob -nocomplain -types f [gitdir]/refs/heads/*]
c2f6a022 PM	250	foreach f $heads {
	251	catch {
	252	set fd [open $f r]
	253	set line [read $fd 40]
	254	if {[regexp {^[0-9a-f]{40}} $line id]} {
	255	set head [file tail $f]
	256	set headids($head) $line
	257	lappend idheads($line) $head
	258	}
	259	close $fd
887fe3c4 PM	260	}
	261	}
	262	}
	263
df3d83b1 PM	264	proc error_popup msg {
	265	set w .error
	266	toplevel $w
	267	wm transient $w .
	268	message $w.m -text $msg -justify center -aspect 400
	269	pack $w.m -side top -fill x -padx 20 -pady 20
	270	button $w.ok -text OK -command "destroy $w"
	271	pack $w.ok -side bottom -fill x
	272	bind $w <Visibility> "grab $w; focus $w"
	273	tkwait window $w
	274	}
	275
1db95b00	276	proc makewindow {} {
e5c2d856	277	global canv canv2 canv3 linespc charspc ctext cflist textfont
b74fd579	278	global findtype findtypemenu findloc findstring fstring geometry
887fe3c4	279	global entries sha1entry sha1string sha1but
ea13cba1	280	global maincursor textcursor
9d2a52ec	281	global rowctxmenu gaudydiff mergemax
9a40c50c PM	282
	283	menu .bar
	284	.bar add cascade -label "File" -menu .bar.file
	285	menu .bar.file
1d10f36d	286	.bar.file add command -label "Quit" -command doquit
9a40c50c PM	287	menu .bar.help
	288	.bar add cascade -label "Help" -menu .bar.help
	289	.bar.help add command -label "About gitk" -command about
	290	. configure -menu .bar
	291
0fba86b3 PM	292	if {![info exists geometry(canv1)]} {
	293	set geometry(canv1) [expr 45 * $charspc]
	294	set geometry(canv2) [expr 30 * $charspc]
	295	set geometry(canv3) [expr 15 * $charspc]
	296	set geometry(canvh) [expr 25 * $linespc + 4]
	297	set geometry(ctextw) 80
	298	set geometry(ctexth) 30
	299	set geometry(cflistw) 30
	300	}
0327d27a	301	panedwindow .ctop -orient vertical
0fba86b3 PM	302	if {[info exists geometry(width)]} {
0fba86b3 PM	303	.ctop conf -width $geometry(width) -height $geometry(height)
17386066 PM	304	set texth [expr {$geometry(height) - $geometry(canvh) - 56}]
	305	set geometry(ctexth) [expr {($texth - 8) /
	306	[font metrics $textfont -linespace]}]
0fba86b3	307	}
98f350e5 PM	308	frame .ctop.top
	309	frame .ctop.top.bar
	310	pack .ctop.top.bar -side bottom -fill x
	311	set cscroll .ctop.top.csb
	312	scrollbar $cscroll -command {allcanvs yview} -highlightthickness 0
	313	pack $cscroll -side right -fill y
	314	panedwindow .ctop.top.clist -orient horizontal -sashpad 0 -handlesize 4
	315	pack .ctop.top.clist -side top -fill both -expand 1
	316	.ctop add .ctop.top
	317	set canv .ctop.top.clist.canv
0fba86b3	318	canvas $canv -height $geometry(canvh) -width $geometry(canv1) \
b5721c72 PM	319	-bg white -bd 0 \
b5721c72 PM	320	-yscrollincr $linespc -yscrollcommand "$cscroll set"
98f350e5 PM	321	.ctop.top.clist add $canv
98f350e5 PM	322	set canv2 .ctop.top.clist.canv2
0fba86b3	323	canvas $canv2 -height $geometry(canvh) -width $geometry(canv2) \
b5721c72	324	-bg white -bd 0 -yscrollincr $linespc
98f350e5 PM	325	.ctop.top.clist add $canv2
98f350e5 PM	326	set canv3 .ctop.top.clist.canv3
0fba86b3	327	canvas $canv3 -height $geometry(canvh) -width $geometry(canv3) \
b5721c72	328	-bg white -bd 0 -yscrollincr $linespc
98f350e5	329	.ctop.top.clist add $canv3
43bddeb4	330	bind .ctop.top.clist <Configure> {resizeclistpanes %W %w}
98f350e5 PM	331
98f350e5 PM	332	set sha1entry .ctop.top.bar.sha1
887fe3c4 PM	333	set entries $sha1entry
	334	set sha1but .ctop.top.bar.sha1label
	335	button $sha1but -text "SHA1 ID: " -state disabled -relief flat \
	336	-command gotocommit -width 8
	337	$sha1but conf -disabledforeground [$sha1but cget -foreground]
98f350e5	338	pack .ctop.top.bar.sha1label -side left
887fe3c4 PM	339	entry $sha1entry -width 40 -font $textfont -textvariable sha1string
887fe3c4 PM	340	trace add variable sha1string write sha1change
98f350e5 PM	341	pack $sha1entry -side left -pady 2
	342	button .ctop.top.bar.findbut -text "Find" -command dofind
	343	pack .ctop.top.bar.findbut -side left
	344	set findstring {}
df3d83b1	345	set fstring .ctop.top.bar.findstring
887fe3c4	346	lappend entries $fstring
df3d83b1	347	entry $fstring -width 30 -font $textfont -textvariable findstring
df3d83b1	348	pack $fstring -side left -expand 1 -fill x
98f350e5	349	set findtype Exact
b74fd579 PM	350	set findtypemenu [tk_optionMenu .ctop.top.bar.findtype \
b74fd579 PM	351	findtype Exact IgnCase Regexp]
98f350e5 PM	352	set findloc "All fields"
98f350e5 PM	353	tk_optionMenu .ctop.top.bar.findloc findloc "All fields" Headline \
b74fd579	354	Comments Author Committer Files Pickaxe
98f350e5 PM	355	pack .ctop.top.bar.findloc -side right
98f350e5 PM	356	pack .ctop.top.bar.findtype -side right
b74fd579 PM	357	# for making sure type==Exact whenever loc==Pickaxe
b74fd579 PM	358	trace add variable findloc write findlocchange
b5721c72	359
5ad588de PM	360	panedwindow .ctop.cdet -orient horizontal
5ad588de PM	361	.ctop add .ctop.cdet
d2610d11 PM	362	frame .ctop.cdet.left
d2610d11 PM	363	set ctext .ctop.cdet.left.ctext
0fba86b3 PM	364	text $ctext -bg white -state disabled -font $textfont \
0fba86b3 PM	365	-width $geometry(ctextw) -height $geometry(ctexth) \
d2610d11 PM	366	-yscrollcommand ".ctop.cdet.left.sb set"
	367	scrollbar .ctop.cdet.left.sb -command "$ctext yview"
	368	pack .ctop.cdet.left.sb -side right -fill y
	369	pack $ctext -side left -fill both -expand 1
	370	.ctop.cdet add .ctop.cdet.left
	371
f0654861 PM	372	$ctext tag conf filesep -font [concat $textfont bold] -back "#aaaaaa"
	373	if {$gaudydiff} {
	374	$ctext tag conf hunksep -back blue -fore white
	375	$ctext tag conf d0 -back "#ff8080"
	376	$ctext tag conf d1 -back green
	377	} else {
	378	$ctext tag conf hunksep -fore blue
	379	$ctext tag conf d0 -fore red
	380	$ctext tag conf d1 -fore "#00a000"
9d2a52ec PM	381	$ctext tag conf m0 -fore red
	382	$ctext tag conf m1 -fore blue
	383	$ctext tag conf m2 -fore green
	384	$ctext tag conf m3 -fore purple
	385	$ctext tag conf m4 -fore brown
	386	$ctext tag conf mmax -fore darkgrey
	387	set mergemax 5
	388	$ctext tag conf mresult -font [concat $textfont bold]
	389	$ctext tag conf msep -font [concat $textfont bold]
f0654861 PM	390	$ctext tag conf found -back yellow
f0654861 PM	391	}
e5c2d856	392
d2610d11 PM	393	frame .ctop.cdet.right
d2610d11 PM	394	set cflist .ctop.cdet.right.cfiles
17386066	395	listbox $cflist -bg white -selectmode extended -width $geometry(cflistw) \
d2610d11 PM	396	-yscrollcommand ".ctop.cdet.right.sb set"
	397	scrollbar .ctop.cdet.right.sb -command "$cflist yview"
	398	pack .ctop.cdet.right.sb -side right -fill y
	399	pack $cflist -side left -fill both -expand 1
	400	.ctop.cdet add .ctop.cdet.right
0fba86b3	401	bind .ctop.cdet <Configure> {resizecdetpanes %W %w}
d2610d11	402
0327d27a	403	pack .ctop -side top -fill both -expand 1
1db95b00	404
c8dfbcf9 PM	405	bindall <1> {selcanvline %W %x %y}
c8dfbcf9 PM	406	#bindall <B1-Motion> {selcanvline %W %x %y}
cfb4563c PM	407	bindall <ButtonRelease-4> "allcanvs yview scroll -5 units"
cfb4563c PM	408	bindall <ButtonRelease-5> "allcanvs yview scroll 5 units"
b5721c72 PM	409	bindall <2> "allcanvs scan mark 0 %y"
b5721c72 PM	410	bindall <B2-Motion> "allcanvs scan dragto 0 %y"
17386066 PM	411	bind . <Key-Up> "selnextline -1"
17386066 PM	412	bind . <Key-Down> "selnextline 1"
cfb4563c PM	413	bind . <Key-Prior> "allcanvs yview scroll -1 pages"
	414	bind . <Key-Next> "allcanvs yview scroll 1 pages"
	415	bindkey <Key-Delete> "$ctext yview scroll -1 pages"
	416	bindkey <Key-BackSpace> "$ctext yview scroll -1 pages"
	417	bindkey <Key-space> "$ctext yview scroll 1 pages"
df3d83b1 PM	418	bindkey p "selnextline -1"
df3d83b1 PM	419	bindkey n "selnextline 1"
cfb4563c PM	420	bindkey b "$ctext yview scroll -1 pages"
	421	bindkey d "$ctext yview scroll 18 units"
	422	bindkey u "$ctext yview scroll -18 units"
b74fd579 PM	423	bindkey / {findnext 1}
b74fd579 PM	424	bindkey <Key-Return> {findnext 0}
df3d83b1	425	bindkey ? findprev
39ad8570	426	bindkey f nextfile
1d10f36d	427	bind . <Control-q> doquit
98f350e5	428	bind . <Control-f> dofind
b74fd579	429	bind . <Control-g> {findnext 0}
98f350e5	430	bind . <Control-r> findprev
1d10f36d PM	431	bind . <Control-equal> {incrfont 1}
	432	bind . <Control-KP_Add> {incrfont 1}
	433	bind . <Control-minus> {incrfont -1}
	434	bind . <Control-KP_Subtract> {incrfont -1}
e5c2d856	435	bind $cflist <<ListboxSelect>> listboxsel
0fba86b3	436	bind . <Destroy> {savestuff %W}
df3d83b1	437	bind . <Button-1> "click %W"
17386066	438	bind $fstring <Key-Return> dofind
887fe3c4	439	bind $sha1entry <Key-Return> gotocommit
ee3dc72e	440	bind $sha1entry <<PasteSelection>> clearsha1
ea13cba1 PM	441
	442	set maincursor [. cget -cursor]
	443	set textcursor [$ctext cget -cursor]
84ba7345	444
c8dfbcf9 PM	445	set rowctxmenu .rowctxmenu
	446	menu $rowctxmenu -tearoff 0
	447	$rowctxmenu add command -label "Diff this -> selected" \
	448	-command {diffvssel 0}
	449	$rowctxmenu add command -label "Diff selected -> this" \
	450	-command {diffvssel 1}
74daedb6	451	$rowctxmenu add command -label "Make patch" -command mkpatch
bdbfbe3d	452	$rowctxmenu add command -label "Create tag" -command mktag
4a2139f5	453	$rowctxmenu add command -label "Write commit to file" -command writecommit
df3d83b1 PM	454	}
	455
	456	# when we make a key binding for the toplevel, make sure
	457	# it doesn't get triggered when that key is pressed in the
	458	# find string entry widget.
	459	proc bindkey {ev script} {
887fe3c4	460	global entries
df3d83b1 PM	461	bind . $ev $script
	462	set escript [bind Entry $ev]
	463	if {$escript == {}} {
	464	set escript [bind Entry <Key>]
	465	}
887fe3c4 PM	466	foreach e $entries {
	467	bind $e $ev "$escript; break"
	468	}
df3d83b1 PM	469	}
	470
	471	# set the focus back to the toplevel for any click outside
887fe3c4	472	# the entry widgets
df3d83b1	473	proc click {w} {
887fe3c4 PM	474	global entries
	475	foreach e $entries {
	476	if {$w == $e} return
df3d83b1	477	}
887fe3c4	478	focus .
0fba86b3 PM	479	}
	480
	481	proc savestuff {w} {
	482	global canv canv2 canv3 ctext cflist mainfont textfont
4ef17537 PM	483	global stuffsaved findmergefiles gaudydiff
4ef17537 PM	484
0fba86b3	485	if {$stuffsaved} return
df3d83b1	486	if {![winfo viewable .]} return
0fba86b3 PM	487	catch {
0fba86b3 PM	488	set f [open "~/.gitk-new" w]
f0654861 PM	489	puts $f [list set mainfont $mainfont]
	490	puts $f [list set textfont $textfont]
	491	puts $f [list set findmergefiles $findmergefiles]
	492	puts $f [list set gaudydiff $gaudydiff]
0fba86b3 PM	493	puts $f "set geometry(width) [winfo width .ctop]"
0fba86b3 PM	494	puts $f "set geometry(height) [winfo height .ctop]"
df3d83b1 PM	495	puts $f "set geometry(canv1) [expr [winfo width $canv]-2]"
	496	puts $f "set geometry(canv2) [expr [winfo width $canv2]-2]"
	497	puts $f "set geometry(canv3) [expr [winfo width $canv3]-2]"
	498	puts $f "set geometry(canvh) [expr [winfo height $canv]-2]"
0fba86b3 PM	499	set wid [expr {([winfo width $ctext] - 8) \
0fba86b3 PM	500	/ [font measure $textfont "0"]}]
0fba86b3	501	puts $f "set geometry(ctextw) $wid"
0fba86b3 PM	502	set wid [expr {([winfo width $cflist] - 11) \
	503	/ [font measure [$cflist cget -font] "0"]}]
	504	puts $f "set geometry(cflistw) $wid"
	505	close $f
	506	file rename -force "~/.gitk-new" "~/.gitk"
	507	}
	508	set stuffsaved 1
1db95b00 PM	509	}
1db95b00 PM	510
43bddeb4 PM	511	proc resizeclistpanes {win w} {
	512	global oldwidth
	513	if [info exists oldwidth($win)] {
	514	set s0 [$win sash coord 0]
	515	set s1 [$win sash coord 1]
	516	if {$w < 60} {
	517	set sash0 [expr {int($w/2 - 2)}]
	518	set sash1 [expr {int($w*5/6 - 2)}]
	519	} else {
	520	set factor [expr {1.0 * $w / $oldwidth($win)}]
	521	set sash0 [expr {int($factor * [lindex $s0 0])}]
	522	set sash1 [expr {int($factor * [lindex $s1 0])}]
	523	if {$sash0 < 30} {
	524	set sash0 30
	525	}
	526	if {$sash1 < $sash0 + 20} {
	527	set sash1 [expr $sash0 + 20]
	528	}
	529	if {$sash1 > $w - 10} {
	530	set sash1 [expr $w - 10]
	531	if {$sash0 > $sash1 - 20} {
	532	set sash0 [expr $sash1 - 20]
	533	}
	534	}
	535	}
	536	$win sash place 0 $sash0 [lindex $s0 1]
	537	$win sash place 1 $sash1 [lindex $s1 1]
	538	}
	539	set oldwidth($win) $w
	540	}
	541
	542	proc resizecdetpanes {win w} {
	543	global oldwidth
	544	if [info exists oldwidth($win)] {
	545	set s0 [$win sash coord 0]
	546	if {$w < 60} {
	547	set sash0 [expr {int($w*3/4 - 2)}]
	548	} else {
	549	set factor [expr {1.0 * $w / $oldwidth($win)}]
	550	set sash0 [expr {int($factor * [lindex $s0 0])}]
	551	if {$sash0 < 45} {
	552	set sash0 45
	553	}
	554	if {$sash0 > $w - 15} {
	555	set sash0 [expr $w - 15]
	556	}
	557	}
	558	$win sash place 0 $sash0 [lindex $s0 1]
	559	}
	560	set oldwidth($win) $w
	561	}
	562
b5721c72 PM	563	proc allcanvs args {
	564	global canv canv2 canv3
	565	eval $canv $args
	566	eval $canv2 $args
	567	eval $canv3 $args
	568	}
	569
	570	proc bindall {event action} {
	571	global canv canv2 canv3
	572	bind $canv $event $action
	573	bind $canv2 $event $action
	574	bind $canv3 $event $action
	575	}
	576
9a40c50c PM	577	proc about {} {
	578	set w .about
	579	if {[winfo exists $w]} {
	580	raise $w
	581	return
	582	}
	583	toplevel $w
	584	wm title $w "About gitk"
	585	message $w.m -text {
c8dfbcf9	586	Gitk version 1.2
9a40c50c PM	587
	588