[thirdparty/git.git] / gitk

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

# 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 start_rev_list {view} {
    global startmsecs nextupdate ncmupdate
    global commfd leftover tclencoding datemode
    global viewargs viewfiles commitidx

    set startmsecs [clock clicks -milliseconds]
    set nextupdate [expr {$startmsecs + 100}]
    set ncmupdate 1
    set commitidx($view) 0
    set args $viewargs($view)
    if {$viewfiles($view) ne {}} {
	set args [concat $args "--" $viewfiles($view)]
    }
    set order "--topo-order"
    if {$datemode} {
	set order "--date-order"
    }
    if {[catch {
	set fd [open [concat | git rev-list --header $order \
			  --parents --boundary --default HEAD $args] r]
    } err]} {
	puts stderr "Error executing git rev-list: $err"
	exit 1
    }
    set commfd($view) $fd
    set leftover($view) {}
    fconfigure $fd -blocking 0 -translation lf
    if {$tclencoding != {}} {
	fconfigure $fd -encoding $tclencoding
    }
    fileevent $fd readable [list getcommitlines $fd $view]
    nowbusy $view
}

proc stop_rev_list {} {
    global commfd curview

    if {![info exists commfd($curview)]} return
    set fd $commfd($curview)
    catch {
	set pid [pid $fd]
	exec kill $pid
    }
    catch {close $fd}
    unset commfd($curview)
}

proc getcommits {} {
    global phase canv mainfont curview

    set phase getcommits
    initlayout
    start_rev_list $curview
    show_status "Reading commits..."
}

proc getcommitlines {fd view}  {
    global commitlisted nextupdate
    global leftover commfd
    global displayorder commitidx commitrow commitdata
    global parentlist childlist children curview hlview
    global vparentlist vchildlist vdisporder vcmitlisted

    set stuff [read $fd]
    if {$stuff == {}} {
	if {![eof $fd]} return
	global viewname
	unset commfd($view)
	notbusy $view
	# set it blocking so we wait for the process to terminate
	fconfigure $fd -blocking 1
	if {[catch {close $fd} err]} {
	    set fv {}
	    if {$view != $curview} {
		set fv " for the \"$viewname($view)\" view"
	    }
	    if {[string range $err 0 4] == "usage"} {
		set err "Gitk: error reading commits$fv:\
			bad arguments to git rev-list."
		if {$viewname($view) eq "Command line"} {
		    append err \
			"  (Note: arguments to gitk are passed to git rev-list\
			 to allow selection of commits to be displayed.)"
		}
	    } else {
		set err "Error reading commits$fv: $err"
	    }
	    error_popup $err
	}
	if {$view == $curview} {
	    after idle finishcommits
	}
	return
    }
    set start 0
    set gotsome 0
    while 1 {
	set i [string first "\0" $stuff $start]
	if {$i < 0} {
	    append leftover($view) [string range $stuff $start end]
	    break
	}
	if {$start == 0} {
	    set cmit $leftover($view)
	    append cmit [string range $stuff 0 [expr {$i - 1}]]
	    set leftover($view) {}
	} else {
	    set cmit [string range $stuff $start [expr {$i - 1}]]
	}
	set start [expr {$i + 1}]
	set j [string first "\n" $cmit]
	set ok 0
	set listed 1
	if {$j >= 0} {
	    set ids [string range $cmit 0 [expr {$j - 1}]]
	    if {[string range $ids 0 0] == "-"} {
		set listed 0
		set ids [string range $ids 1 end]
	    }
	    set ok 1
	    foreach id $ids {
		if {[string length $id] != 40} {
		    set ok 0
		    break
		}
	    }
	}
	if {!$ok} {
	    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 id [lindex $ids 0]
	if {$listed} {
	    set olds [lrange $ids 1 end]
	    set i 0
	    foreach p $olds {
		if {$i == 0 || [lsearch -exact $olds $p] >= $i} {
		    lappend children($view,$p) $id
		}
		incr i
	    }
	} else {
	    set olds {}
	}
	if {![info exists children($view,$id)]} {
	    set children($view,$id) {}
	}
	set commitdata($id) [string range $cmit [expr {$j + 1}] end]
	set commitrow($view,$id) $commitidx($view)
	incr commitidx($view)
	if {$view == $curview} {
	    lappend parentlist $olds
	    lappend childlist $children($view,$id)
	    lappend displayorder $id
	    lappend commitlisted $listed
	} else {
	    lappend vparentlist($view) $olds
	    lappend vchildlist($view) $children($view,$id)
	    lappend vdisporder($view) $id
	    lappend vcmitlisted($view) $listed
	}
	set gotsome 1
    }
    if {$gotsome} {
	if {$view == $curview} {
	    layoutmore
	} elseif {[info exists hlview] && $view == $hlview} {
	    vhighlightmore
	}
    }
    if {[clock clicks -milliseconds] >= $nextupdate} {
	doupdate
    }
}

proc doupdate {} {
    global commfd nextupdate numcommits ncmupdate

    foreach v [array names commfd] {
	fileevent $commfd($v) readable {}
    }
    update
    set nextupdate [expr {[clock clicks -milliseconds] + 100}]
    if {$numcommits < 100} {
	set ncmupdate [expr {$numcommits + 1}]
    } elseif {$numcommits < 10000} {
	set ncmupdate [expr {$numcommits + 10}]
    } else {
	set ncmupdate [expr {$numcommits + 100}]
    }
    foreach v [array names commfd] {
	set fd $commfd($v)
	fileevent $fd readable [list getcommitlines $fd $v]
    }
}

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

proc updatecommits {} {
    global viewdata curview phase displayorder
    global children commitrow selectedline thickerline

    if {$phase ne {}} {
	stop_rev_list
	set phase {}
    }
    set n $curview
    foreach id $displayorder {
	catch {unset children($n,$id)}
	catch {unset commitrow($n,$id)}
    }
    set curview -1
    catch {unset selectedline}
    catch {unset thickerline}
    catch {unset viewdata($n)}
    discardallcommits
    readrefs
    showview $n
}

proc parsecommit {id contents listed} {
    global commitinfo cdate

    set inhdr 1
    set comment {}
    set headline {}
    set auname {}
    set audate {}
    set comname {}
    set comdate {}
    set hdrend [string first "\n\n" $contents]
    if {$hdrend < 0} {
	# should never happen...
	set hdrend [string length $contents]
    }
    set header [string range $contents 0 [expr {$hdrend - 1}]]
    set comment [string range $contents [expr {$hdrend + 2}] end]
    foreach line [split $header "\n"] {
	set tag [lindex $line 0]
	if {$tag == "author"} {
	    set audate [lindex $line end-1]
	    set auname [lrange $line 1 end-2]
	} elseif {$tag == "committer"} {
	    set comdate [lindex $line end-1]
	    set comname [lrange $line 1 end-2]
	}
    }
    set headline {}
    # take the first line of the comment as the headline
    set i [string first "\n" $comment]
    if {$i >= 0} {
	set headline [string trim [string range $comment 0 $i]]
    } else {
	set headline $comment
    }
    if {!$listed} {
	# git rev-list indents the comment by 4 spaces;
	# if we got this via git cat-file, add the indentation
	set newcomment {}
	foreach line [split $comment "\n"] {
	    append newcomment "    "
	    append newcomment $line
	    append newcomment "\n"
	}
	set comment $newcomment
    }
    if {$comdate != {}} {
	set cdate($id) $comdate
    }
    set commitinfo($id) [list $headline $auname $audate \
			     $comname $comdate $comment]
}

proc getcommit {id} {
    global commitdata commitinfo

    if {[info exists commitdata($id)]} {
	parsecommit $id $commitdata($id) 1
    } else {
	readcommit $id
	if {![info exists commitinfo($id)]} {
	    set commitinfo($id) {"No commit information available"}
	}
    }
    return 1
}

proc readrefs {} {
    global tagids idtags headids idheads tagcontents
    global otherrefids idotherrefs

    foreach v {tagids idtags headids idheads otherrefids idotherrefs} {
	catch {unset $v}
    }
    set refd [open [list | git ls-remote [gitdir]] r]
    while {0 <= [set n [gets $refd line]]} {
	if {![regexp {^([0-9a-f]{40})	refs/([^^]*)$} $line \
	    match id path]} {
	    continue
	}
	if {[regexp {^remotes/.*/HEAD$} $path match]} {
	    continue
	}
	if {![regexp {^(tags|heads)/(.*)$} $path match type name]} {
	    set type others
	    set name $path
	}
	if {[regexp {^remotes/} $path match]} {
	    set type heads
	}
	if {$type == "tags"} {
	    set tagids($name) $id
	    lappend idtags($id) $name
	    set obj {}
	    set type {}
	    set tag {}
	    catch {
		set commit [exec git rev-parse "$id^0"]
		if {"$commit" != "$id"} {
		    set tagids($name) $commit
		    lappend idtags($commit) $name
		}
	    }		
	    catch {
	        set tagcontents($name) [exec git cat-file tag "$id"]
	    }
	} elseif { $type == "heads" } {
	    set headids($name) $id
	    lappend idheads($id) $name
	} else {
	    set otherrefids($name) $id
	    lappend idotherrefs($id) $name
	}
    }
    close $refd
}

proc show_error {w top msg} {
    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 $top"
    pack $w.ok -side bottom -fill x
    bind $top <Visibility> "grab $top; focus $top"
    bind $top <Key-Return> "destroy $top"
    tkwait window $top
}

proc error_popup msg {
    set w .error
    toplevel $w
    wm transient $w .
    show_error $w $w $msg
}

proc makewindow {} {
    global canv canv2 canv3 linespc charspc ctext cflist
    global textfont mainfont uifont
    global findtype findtypemenu findloc findstring fstring geometry
    global entries sha1entry sha1string sha1but
    global maincursor textcursor curtextcursor
    global rowctxmenu mergemax wrapcomment
    global highlight_files gdttype
    global searchstring sstring

    menu .bar
    .bar add cascade -label "File" -menu .bar.file
    .bar configure -font $uifont
    menu .bar.file
    .bar.file add command -label "Update" -command updatecommits
    .bar.file add command -label "Reread references" -command rereadrefs
    .bar.file add command -label "Quit" -command doquit
    .bar.file configure -font $uifont
    menu .bar.edit
    .bar add cascade -label "Edit" -menu .bar.edit
    .bar.edit add command -label "Preferences" -command doprefs
    .bar.edit configure -font $uifont

    menu .bar.view -font $uifont
    .bar add cascade -label "View" -menu .bar.view
    .bar.view add command -label "New view..." -command {newview 0}
    .bar.view add command -label "Edit view..." -command editview \
	-state disabled
    .bar.view add command -label "Delete view" -command delview -state disabled
    .bar.view add separator
    .bar.view add radiobutton -label "All files" -command {showview 0} \
	-variable selectedview -value 0
    
    menu .bar.help
    .bar add cascade -label "Help" -menu .bar.help
    .bar.help add command -label "About gitk" -command about
    .bar.help add command -label "Key bindings" -command keys
    .bar.help configure -font $uifont
    . 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
    frame .ctop.top.lbar
    pack .ctop.top.lbar -side bottom -fill x
    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 "scrollcanv $cscroll"
    .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 -font $uifont
    $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

    image create bitmap bm-left -data {
	#define left_width 16
	#define left_height 16
	static unsigned char left_bits[] = {
	0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,
	0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,
	0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};
    }
    image create bitmap bm-right -data {
	#define right_width 16
	#define right_height 16
	static unsigned char right_bits[] = {
	0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
	0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
	0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
    }
    button .ctop.top.bar.leftbut -image bm-left -command goback \
	-state disabled -width 26
    pack .ctop.top.bar.leftbut -side left -fill y
    button .ctop.top.bar.rightbut -image bm-right -command goforw \
	-state disabled -width 26
    pack .ctop.top.bar.rightbut -side left -fill y

    button .ctop.top.bar.findbut -text "Find" -command dofind -font $uifont
    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
    trace add variable findstring write find_change
    pack $fstring -side left -expand 1 -fill x
    set findtype Exact
    set findtypemenu [tk_optionMenu .ctop.top.bar.findtype \
			  findtype Exact IgnCase Regexp]
    trace add variable findtype write find_change
    .ctop.top.bar.findtype configure -font $uifont
    .ctop.top.bar.findtype.menu configure -font $uifont
    set findloc "All fields"
    tk_optionMenu .ctop.top.bar.findloc findloc "All fields" Headline \
	Comments Author Committer
    trace add variable findloc write find_change
    .ctop.top.bar.findloc configure -font $uifont
    .ctop.top.bar.findloc.menu configure -font $uifont
    pack .ctop.top.bar.findloc -side right
    pack .ctop.top.bar.findtype -side right

    label .ctop.top.lbar.flabel -text "Highlight:  Commits " \
	-font $uifont
    pack .ctop.top.lbar.flabel -side left -fill y
    set gdttype "touching paths:"
    set gm [tk_optionMenu .ctop.top.lbar.gdttype gdttype "touching paths:" \
		"adding/removing string:"]
    trace add variable gdttype write hfiles_change
    $gm conf -font $uifont
    .ctop.top.lbar.gdttype conf -font $uifont
    pack .ctop.top.lbar.gdttype -side left -fill y
    entry .ctop.top.lbar.fent -width 25 -font $textfont \
	-textvariable highlight_files
    trace add variable highlight_files write hfiles_change
    lappend entries .ctop.top.lbar.fent
    pack .ctop.top.lbar.fent -side left -fill x -expand 1
    label .ctop.top.lbar.vlabel -text " OR in view" -font $uifont
    pack .ctop.top.lbar.vlabel -side left -fill y
    global viewhlmenu selectedhlview
    set viewhlmenu [tk_optionMenu .ctop.top.lbar.vhl selectedhlview None]
    $viewhlmenu entryconf 0 -command delvhighlight
    $viewhlmenu conf -font $uifont
    .ctop.top.lbar.vhl conf -font $uifont
    pack .ctop.top.lbar.vhl -side left -fill y
    label .ctop.top.lbar.rlabel -text " OR " -font $uifont
    pack .ctop.top.lbar.rlabel -side left -fill y
    global highlight_related
    set m [tk_optionMenu .ctop.top.lbar.relm highlight_related None \
	       "Descendent" "Not descendent" "Ancestor" "Not ancestor"]
    $m conf -font $uifont
    .ctop.top.lbar.relm conf -font $uifont
    trace add variable highlight_related write vrel_change
    pack .ctop.top.lbar.relm -side left -fill y

    panedwindow .ctop.cdet -orient horizontal
    .ctop add .ctop.cdet
    frame .ctop.cdet.left
    frame .ctop.cdet.left.bot
    pack .ctop.cdet.left.bot -side bottom -fill x
    button .ctop.cdet.left.bot.search -text "Search" -command dosearch \
	-font $uifont
    pack .ctop.cdet.left.bot.search -side left -padx 5
    set sstring .ctop.cdet.left.bot.sstring
    entry $sstring -width 20 -font $textfont -textvariable searchstring
    lappend entries $sstring
    trace add variable searchstring write incrsearch
    pack $sstring -side left -expand 1 -fill x
    set ctext .ctop.cdet.left.ctext
    text $ctext -bg white -state disabled -font $textfont \
	-width $geometry(ctextw) -height $geometry(ctexth) \
	-yscrollcommand scrolltext -wrap none
    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 comment -wrap $wrapcomment
    $ctext tag conf filesep -font [concat $textfont bold] -back "#aaaaaa"
    $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 m5 -fore "#009090"
    $ctext tag conf m6 -fore magenta
    $ctext tag conf m7 -fore "#808000"
    $ctext tag conf m8 -fore "#009000"
    $ctext tag conf m9 -fore "#ff0080"
    $ctext tag conf m10 -fore cyan
    $ctext tag conf m11 -fore "#b07070"
    $ctext tag conf m12 -fore "#70b0f0"
    $ctext tag conf m13 -fore "#70f0b0"
    $ctext tag conf m14 -fore "#f0b070"
    $ctext tag conf m15 -fore "#ff70b0"
    $ctext tag conf mmax -fore darkgrey
    set mergemax 16
    $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
    frame .ctop.cdet.right.mode
    radiobutton .ctop.cdet.right.mode.patch -text "Patch" \
	-command reselectline -variable cmitmode -value "patch"
    radiobutton .ctop.cdet.right.mode.tree -text "Tree" \
	-command reselectline -variable cmitmode -value "tree"
    grid .ctop.cdet.right.mode.patch .ctop.cdet.right.mode.tree -sticky ew
    pack .ctop.cdet.right.mode -side top -fill x
    set cflist .ctop.cdet.right.cfiles
    set indent [font measure $mainfont "nn"]
    text $cflist -width $geometry(cflistw) -background white -font $mainfont \
	-tabs [list $indent [expr {2 * $indent}]] \
	-yscrollcommand ".ctop.cdet.right.sb set" \
	-cursor [. cget -cursor] \
	-spacing1 1 -spacing3 1
    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
    $cflist tag configure highlight \
	-background [$cflist cget -selectbackground]
    $cflist tag configure bold -font [concat $mainfont bold]
    .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> "canvscan mark %W %x %y"
    bindall <B2-Motion> "canvscan dragto %W %x %y"
    bindkey <Home> selfirstline
    bindkey <End> sellastline
    bind . <Key-Up> "selnextline -1"
    bind . <Key-Down> "selnextline 1"
    bind . <Shift-Key-Up> "next_highlight -1"
    bind . <Shift-Key-Down> "next_highlight 1"
    bindkey <Key-Right> "goforw"
    bindkey <Key-Left> "goback"
    bind . <Key-Prior> "selnextpage -1"
    bind . <Key-Next> "selnextpage 1"
    bind . <Control-Home> "allcanvs yview moveto 0.0"
    bind . <Control-End> "allcanvs yview moveto 1.0"
    bind . <Control-Key-Up> "allcanvs yview scroll -1 units"
    bind . <Control-Key-Down> "allcanvs yview scroll 1 units"
    bind . <Control-Key-Prior> "allcanvs yview scroll -1 pages"
    bind . <Control-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 z "goback"
    bindkey x "goforw"
    bindkey i "selnextline -1"
    bindkey k "selnextline 1"
    bindkey j "goback"
    bindkey l "goforw"
    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> dosearchback
    bind . <Control-s> dosearch
    bind . <Control-equal> {incrfont 1}
    bind . <Control-KP_Add> {incrfont 1}
    bind . <Control-minus> {incrfont -1}
    bind . <Control-KP_Subtract> {incrfont -1}
    bind . <Destroy> {savestuff %W}
    bind . <Button-1> "click %W"
    bind $fstring <Key-Return> dofind
    bind $sha1entry <Key-Return> gotocommit
    bind $sha1entry <<PasteSelection>> clearsha1
    bind $cflist <1> {sel_flist %W %x %y; break}
    bind $cflist <B1-Motion> {sel_flist %W %x %y; break}
    bind $cflist <ButtonRelease-1> {treeclick %W %x %y}

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

    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
}

# mouse-2 makes all windows scan vertically, but only the one
# the cursor is in scans horizontally
proc canvscan {op w x y} {
    global canv canv2 canv3
    foreach c [list $canv $canv2 $canv3] {
	if {$c == $w} {
	    $c scan $op $x $y
	} else {
	    $c scan $op 0 $y
	}
    }
}

proc scrollcanv {cscroll f0 f1} {
    $cscroll set $f0 $f1
    drawfrac $f0 $f1
    flushhighlights
}

# 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 uifont
    global stuffsaved findmergefiles maxgraphpct
    global maxwidth showneartags
    global viewname viewfiles viewargs viewperm nextviewnum
    global cmitmode wrapcomment

    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 uifont $uifont]
	puts $f [list set findmergefiles $findmergefiles]
	puts $f [list set maxgraphpct $maxgraphpct]
	puts $f [list set maxwidth $maxwidth]
	puts $f [list set cmitmode $cmitmode]
	puts $f [list set wrapcomment $wrapcomment]
	puts $f [list set showneartags $showneartags]
	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"
	puts -nonewline $f "set permviews {"
	for {set v 0} {$v < $nextviewnum} {incr v} {
	    if {$viewperm($v)} {
		puts $f "{[list $viewname($v) $viewfiles($v) $viewargs($v)]}"
	    }
	}
	puts $f "}"
	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 - a commit viewer for git