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