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

# Copyright (C) 2005-2006 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 [exec git rev-parse --git-dir]
    }
}

# A simple scheduler for compute-intensive stuff.
# The aim is to make sure that event handlers for GUI actions can
# run at least every 50-100 ms.  Unfortunately fileevent handlers are
# run before X event handlers, so reading from a fast source can
# make the GUI completely unresponsive.
proc run args {
    global isonrunq runq

    set script $args
    if {[info exists isonrunq($script)]} return
    if {$runq eq {}} {
	after idle dorunq
    }
    lappend runq [list {} $script]
    set isonrunq($script) 1
}

proc filerun {fd script} {
    fileevent $fd readable [list filereadable $fd $script]
}

proc filereadable {fd script} {
    global runq

    fileevent $fd readable {}
    if {$runq eq {}} {
	after idle dorunq
    }
    lappend runq [list $fd $script]
}

proc dorunq {} {
    global isonrunq runq

    set tstart [clock clicks -milliseconds]
    set t0 $tstart
    while {$runq ne {}} {
	set fd [lindex $runq 0 0]
	set script [lindex $runq 0 1]
	set repeat [eval $script]
	set t1 [clock clicks -milliseconds]
	set t [expr {$t1 - $t0}]
	set runq [lrange $runq 1 end]
	if {$repeat ne {} && $repeat} {
	    if {$fd eq {} || $repeat == 2} {
		# script returns 1 if it wants to be readded
		# file readers return 2 if they could do more straight away
		lappend runq [list $fd $script]
	    } else {
		fileevent $fd readable [list filereadable $fd $script]
	    }
	} elseif {$fd eq {}} {
	    unset isonrunq($script)
	}
	set t0 $t1
	if {$t1 - $tstart >= 80} break
    }
    if {$runq ne {}} {
	after idle dorunq
    }
}

# Start off a git rev-list process and arrange to read its output
proc start_rev_list {view} {
    global startmsecs
    global commfd leftover tclencoding datemode
    global viewargs viewfiles commitidx viewcomplete vnextroot
    global showlocalchanges commitinterest mainheadid
    global progressdirn progresscoords proglastnc curview

    set startmsecs [clock clicks -milliseconds]
    set commitidx($view) 0
    set viewcomplete($view) 0
    set vnextroot($view) 0
    set order "--topo-order"
    if {$datemode} {
	set order "--date-order"
    }
    if {[catch {
	set fd [open [concat | git log -z --pretty=raw $order --parents \
			 --boundary $viewargs($view) "--" $viewfiles($view)] r]
    } err]} {
	error_popup "Error executing git rev-list: $err"
	exit 1
    }
    set commfd($view) $fd
    set leftover($view) {}
    if {$showlocalchanges} {
	lappend commitinterest($mainheadid) {dodiffindex}
    }
    fconfigure $fd -blocking 0 -translation lf -eofchar {}
    if {$tclencoding != {}} {
	fconfigure $fd -encoding $tclencoding
    }
    filerun $fd [list getcommitlines $fd $view]
    nowbusy $view
    if {$view == $curview} {
	set progressdirn 1
	set progresscoords {0 0}
	set proglastnc 0
    }
}

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 curview

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

# This makes a string representation of a positive integer which
# sorts as a string in numerical order
proc strrep {n} {
    if {$n < 16} {
	return [format "%x" $n]
    } elseif {$n < 256} {
	return [format "x%.2x" $n]
    } elseif {$n < 65536} {
	return [format "y%.4x" $n]
    }
    return [format "z%.8x" $n]
}

proc getcommitlines {fd view}  {
    global commitlisted commitinterest
    global leftover commfd
    global displayorder commitidx viewcomplete commitrow commitdata
    global parentlist children curview hlview
    global vparentlist vdisporder vcmitlisted
    global ordertok vnextroot idpending

    set stuff [read $fd 500000]
    # git log doesn't terminate the last commit with a null...
    if {$stuff == {} && $leftover($view) ne {} && [eof $fd]} {
	set stuff "\0"
    }
    if {$stuff == {}} {
	if {![eof $fd]} {
	    return 1
	}
	# Check if we have seen any ids listed as parents that haven't
	# appeared in the list
	foreach vid [array names idpending "$view,*"] {
	    # should only get here if git log is buggy
	    set id [lindex [split $vid ","] 1]
	    set commitrow($vid) $commitidx($view)
	    incr commitidx($view)
	    if {$view == $curview} {
		lappend parentlist {}
		lappend displayorder $id
		lappend commitlisted 0
	    } else {
		lappend vparentlist($view) {}
		lappend vdisporder($view) $id
		lappend vcmitlisted($view) 0
	    }
	}
	set viewcomplete($view) 1
	global viewname progresscoords
	unset commfd($view)
	notbusy $view
	set progresscoords {0 0}
	adjustprogress
	# 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} {
	    run chewcommits $view
	}
	return 0
    }
    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 && [string match "commit *" $cmit]} {
	    set ids [string range $cmit 7 [expr {$j - 1}]]
	    if {[string match {[-<>]*} $ids]} {
		switch -- [string index $ids 0] {
		    "-" {set listed 0}
		    "<" {set listed 2}
		    ">" {set listed 3}
		}
		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 log output: {$shortcmit}"
	    exit 1
	}
	set id [lindex $ids 0]
	if {![info exists ordertok($view,$id)]} {
	    set otok "o[strrep $vnextroot($view)]"
	    incr vnextroot($view)
	    set ordertok($view,$id) $otok
	} else {
	    set otok $ordertok($view,$id)
	    unset idpending($view,$id)
	}
	if {$listed} {
	    set olds [lrange $ids 1 end]
	    if {[llength $olds] == 1} {
		set p [lindex $olds 0]
		lappend children($view,$p) $id
		if {![info exists ordertok($view,$p)]} {
		    set ordertok($view,$p) $ordertok($view,$id)
		    set idpending($view,$p) 1
		}
	    } else {
		set i 0
		foreach p $olds {
		    if {$i == 0 || [lsearch -exact $olds $p] >= $i} {
			lappend children($view,$p) $id
		    }
		    if {![info exists ordertok($view,$p)]} {
			set ordertok($view,$p) "$otok[strrep $i]]"
			set idpending($view,$p) 1
		    }
		    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 displayorder $id
	    lappend commitlisted $listed
	} else {
	    lappend vparentlist($view) $olds
	    lappend vdisporder($view) $id
	    lappend vcmitlisted($view) $listed
	}
	if {[info exists commitinterest($id)]} {
	    foreach script $commitinterest($id) {
		eval [string map [list "%I" $id] $script]
	    }
	    unset commitinterest($id)
	}
	set gotsome 1
    }
    if {$gotsome} {
	run chewcommits $view
	if {$view == $curview} {
	    # update progress bar
	    global progressdirn progresscoords proglastnc
	    set inc [expr {($commitidx($view) - $proglastnc) * 0.0002}]
	    set proglastnc $commitidx($view)
	    set l [lindex $progresscoords 0]
	    set r [lindex $progresscoords 1]
	    if {$progressdirn} {
		set r [expr {$r + $inc}]
		if {$r >= 1.0} {
		    set r 1.0
		    set progressdirn 0
		}
		if {$r > 0.2} {
		    set l [expr {$r - 0.2}]
		}
	    } else {
		set l [expr {$l - $inc}]
		if {$l <= 0.0} {
		    set l 0.0
		    set progressdirn 1
		}
		set r [expr {$l + 0.2}]
	    }
	    set progresscoords [list $l $r]
	    adjustprogress
	}
    }
    return 2
}

proc chewcommits {view} {
    global curview hlview viewcomplete
    global selectedline pending_select

    if {$view == $curview} {
	layoutmore
	if {$viewcomplete($view)} {
	    global displayorder commitidx phase
	    global numcommits startmsecs

	    if {[info exists pending_select]} {
		set row [first_real_row]
		selectline $row 1
	    }
	    if {$commitidx($curview) > 0} {
		#set ms [expr {[clock clicks -milliseconds] - $startmsecs}]
		#puts "overall $ms ms for $numcommits commits"
	    } else {
		show_status "No commits selected"
	    }
	    notbusy layout
	    set phase {}
	}
    }
    if {[info exists hlview] && $view == $hlview} {
	vhighlightmore
    }
    return 0
}

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 ordertok idpending
    global children commitrow selectedline thickerline showneartags

    if {$phase ne {}} {
	stop_rev_list
	set phase {}
    }
    set n $curview
    foreach id $displayorder {
	catch {unset children($n,$id)}
	catch {unset commitrow($n,$id)}
	catch {unset ordertok($n,$id)}
    }
    foreach vid [array names idpending "$n,*"] {
	unset idpending($vid)
    }
    set curview -1
    catch {unset selectedline}
    catch {unset thickerline}
    catch {unset viewdata($n)}
    readrefs
    changedrefs
    if {$showneartags} {
	getallcommits
    }
    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 non-blank line of the comment as the headline
    set headline [string trimleft $comment]
    set i [string first "\n" $headline]
    if {$i >= 0} {
	set headline [string range $headline 0 $i]
    }
    set headline [string trimright $headline]
    set i [string first "\r" $headline]
    if {$i >= 0} {
	set headline [string trimright [string range $headline 0 $i]]
    }
    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 tagobjid
    global otherrefids idotherrefs mainhead mainheadid

    foreach v {tagids idtags headids idheads otherrefids idotherrefs} {
	catch {unset $v}
    }
    set refd [open [list | git show-ref -d] r]
    while {[gets $refd line] >= 0} {
	if {[string index $line 40] ne " "} continue
	set id [string range $line 0 39]
	set ref [string range $line 41 end]
	if {![string match "refs/*" $ref]} continue
	set name [string range $ref 5 end]
	if {[string match "remotes/*" $name]} {
	    if {![string match "*/HEAD" $name]} {
		set headids($name) $id
		lappend idheads($id) $name
	    }
	} elseif {[string match "heads/*" $name]} {
	    set name [string range $name 6 end]
	    set headids($name) $id
	    lappend idheads($id) $name
	} elseif {[string match "tags/*" $name]} {
	    # this lets refs/tags/foo^{} overwrite refs/tags/foo,
	    # which is what we want since the former is the commit ID
	    set name [string range $name 5 end]
	    if {[string match "*^{}" $name]} {
		set name [string range $name 0 end-3]
	    } else {
		set tagobjid($name) $id
	    }
	    set tagids($name) $id
	    lappend idtags($id) $name
	} else {
	    set otherrefids($name) $id
	    lappend idotherrefs($id) $name
	}
    }
    catch {close $refd}
    set mainhead {}
    set mainheadid {}
    catch {
	set thehead [exec git symbolic-ref HEAD]
	if {[string match "refs/heads/*" $thehead]} {
	    set mainhead [string range $thehead 11 end]
	    if {[info exists headids($mainhead)]} {
		set mainheadid $headids($mainhead)
	    }
	}
    }
}

# skip over fake commits
proc first_real_row {} {
    global nullid nullid2 displayorder numcommits

    for {set row 0} {$row < $numcommits} {incr row} {
	set id [lindex $displayorder $row]
	if {$id ne $nullid && $id ne $nullid2} {
	    break
	}
    }
    return $row
}

# update things for a head moved to a child of its previous location
proc movehead {id name} {
    global headids idheads

    removehead $headids($name) $name
    set headids($name) $id
    lappend idheads($id) $name
}

# update things when a head has been removed
proc removehead {id name} {
    global headids idheads

    if {$idheads($id) eq $name} {
	unset idheads($id)
    } else {
	set i [lsearch -exact $idheads($id) $name]
	if {$i >= 0} {
	    set idheads($id) [lreplace $idheads($id) $i $i]
	}
    }
    unset headids($name)
}

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 confirm_popup msg {
    global confirm_ok
    set confirm_ok 0
    set w .confirm
    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 "set confirm_ok 1; destroy $w"
    pack $w.ok -side left -fill x
    button $w.cancel -text Cancel -command "destroy $w"
    pack $w.cancel -side right -fill x
    bind $w <Visibility> "grab $w; focus $w"
    tkwait window $w
    return $confirm_ok
}

proc makewindow {} {
    global canv canv2 canv3 linespc charspc ctext cflist
    global tabstop
    global findtype findtypemenu findloc findstring fstring geometry
    global entries sha1entry sha1string sha1but
    global diffcontextstring diffcontext
    global maincursor textcursor curtextcursor
    global rowctxmenu fakerowmenu mergemax wrapcomment
    global highlight_files gdttype
    global searchstring sstring
    global bgcolor fgcolor bglist fglist diffcolors selectbgcolor
    global headctxmenu progresscanv progressitem progresscoords statusw
    global fprogitem fprogcoord lastprogupdate progupdatepending
    global have_tk85

    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 "List references" -command showrefs
    .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

    # the gui has upper and lower half, parts of a paned window.
    panedwindow .ctop -orient vertical

    # possibly use assumed geometry
    if {![info exists geometry(pwsash0)]} {
        set geometry(topheight) [expr {15 * $linespc}]
        set geometry(topwidth) [expr {80 * $charspc}]
        set geometry(botheight) [expr {15 * $linespc}]
        set geometry(botwidth) [expr {50 * $charspc}]
        set geometry(pwsash0) "[expr {40 * $charspc}] 2"
        set geometry(pwsash1) "[expr {60 * $charspc}] 2"
    }

    # the upper half will have a paned window, a scroll bar to the right, and some stuff below
    frame .tf -height $geometry(topheight) -width $geometry(topwidth)
    frame .tf.histframe
    panedwindow .tf.histframe.pwclist -orient horizontal -sashpad 0 -handlesize 4

    # create three canvases
    set cscroll .tf.histframe.csb
    set canv .tf.histframe.pwclist.canv
    canvas $canv \
	-selectbackground $selectbgcolor \
	-background $bgcolor -bd 0 \
	-yscrollincr $linespc -yscrollcommand "scrollcanv $cscroll"
    .tf.histframe.pwclist add $canv
    set canv2 .tf.histframe.pwclist.canv2
    canvas $canv2 \
	-selectbackground $selectbgcolor \
	-background $bgcolor -bd 0 -yscrollincr $linespc
    .tf.histframe.pwclist add $canv2
    set canv3 .tf.histframe.pwclist.canv3
    canvas $canv3 \
	-selectbackground $selectbgcolor \
	-background $bgcolor -bd 0 -yscrollincr $linespc
    .tf.histframe.pwclist add $canv3
    eval .tf.histframe.pwclist sash place 0 $geometry(pwsash0)
    eval .tf.histframe.pwclist sash place 1 $geometry(pwsash1)

    # a scroll bar to rule them
    scrollbar $cscroll -command {allcanvs yview} -highlightthickness 0
    pack $cscroll -side right -fill y
    bind .tf.histframe.pwclist <Configure> {resizeclistpanes %W %w}
    lappend bglist $canv $canv2 $canv3
    pack .tf.histframe.pwclist -fill both -expand 1 -side left

    # we have two button bars at bottom of top frame. Bar 1
    frame .tf.bar
    frame .tf.lbar -height 15

    set sha1entry .tf.bar.sha1
    set entries $sha1entry
    set sha1but .tf.bar.sha1label
    button $sha1but -text "SHA1 ID: " -state disabled -relief flat \
	-command gotocommit -width 8 -font uifont
    $sha1but conf -disabledforeground [$sha1but cget -foreground]
    pack .tf.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 .tf.bar.leftbut -image bm-left -command goback \
	-state disabled -width 26
    pack .tf.bar.leftbut -side left -fill y
    button .tf.bar.rightbut -image bm-right -command goforw \
	-state disabled -width 26
    pack .tf.bar.rightbut -side left -fill y

    # Status label and progress bar
    set statusw .tf.bar.status
    label $statusw -width 15 -relief sunken -font uifont
    pack $statusw -side left -padx 5
    set h [expr {[font metrics uifont -linespace] + 2}]
    set progresscanv .tf.bar.progress
    canvas $progresscanv -relief sunken -height $h -borderwidth 2
    set progressitem [$progresscanv create rect -1 0 0 $h -fill green]
    set fprogitem [$progresscanv create rect -1 0 0 $h -fill yellow]
    pack $progresscanv -side right -expand 1 -fill x
    set progresscoords {0 0}
    set fprogcoord 0
    bind $progresscanv <Configure> adjustprogress
    set lastprogupdate [clock clicks -milliseconds]
    set progupdatepending 0

    # build up the bottom bar of upper window
    label .tf.lbar.flabel -text "Find " -font uifont
    button .tf.lbar.fnext -text "next" -command dofind -font uifont
    button .tf.lbar.fprev -text "prev" -command {dofind 1} -font uifont
    label .tf.lbar.flab2 -text " commit " -font uifont
    pack .tf.lbar.flabel .tf.lbar.fnext .tf.lbar.fprev .tf.lbar.flab2 \
	-side left -fill y
    set gdttype "containing:"
    set gm [tk_optionMenu .tf.lbar.gdttype gdttype \
		"containing:" \
		"touching paths:" \
		"adding/removing string:"]
    trace add variable gdttype write gdttype_change
    $gm conf -font uifont
    .tf.lbar.gdttype conf -font uifont
    pack .tf.lbar.gdttype -side left -fill y

    set findstring {}
    set fstring .tf.lbar.findstring
    lappend entries $fstring
    entry $fstring -width 30 -font textfont -textvariable findstring
    trace add variable findstring write find_change
    set findtype Exact
    set findtypemenu [tk_optionMenu .tf.lbar.findtype \
		      findtype Exact IgnCase Regexp]
    trace add variable findtype write findcom_change
    .tf.lbar.findtype configure -font uifont
    .tf.lbar.findtype.menu configure -font uifont
    set findloc "All fields"
    tk_optionMenu .tf.lbar.findloc findloc "All fields" Headline \
	Comments Author Committer
    trace add variable findloc write find_change
    .tf.lbar.findloc configure -font uifont
    .tf.lbar.findloc.menu configure -font uifont
    pack .tf.lbar.findloc -side right
    pack .tf.lbar.findtype -side right
    pack $fstring -side left -expand 1 -fill x

    # Finish putting the upper half of the viewer together
    pack .tf.lbar -in .tf -side bottom -fill x
    pack .tf.bar -in .tf -side bottom -fill x
    pack .tf.histframe -fill both -side top -expand 1
    .ctop add .tf
    .ctop paneconfigure .tf -height $geometry(topheight)
    .ctop paneconfigure .tf -width $geometry(topwidth)

    # now build up the bottom
    panedwindow .pwbottom -orient horizontal

    # lower left, a text box over search bar, scroll bar to the right
    # if we know window height, then that will set the lower text height, otherwise
    # we set lower text height which will drive window height
    if {[info exists geometry(main)]} {
        frame .bleft -width $geometry(botwidth)
    } else {
        frame .bleft -width $geometry(botwidth) -height $geometry(botheight)
    }
    frame .bleft.top
    frame .bleft.mid

    button .bleft.top.search -text "Search" -command dosearch \
	-font uifont
    pack .bleft.top.search -side left -padx 5
    set sstring .bleft.top.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
    radiobutton .bleft.mid.diff -text "Diff" \
	-command changediffdisp -variable diffelide -value {0 0}
    radiobutton .bleft.mid.old -text "Old version" \
	-command changediffdisp -variable diffelide -value {0 1}
    radiobutton .bleft.mid.new -text "New version" \
	-command changediffdisp -variable diffelide -value {1 0}
    label .bleft.mid.labeldiffcontext -text "      Lines of context: " \
	-font uifont
    pack .bleft.mid.diff .bleft.mid.old .bleft.mid.new -side left
    spinbox .bleft.mid.diffcontext -width 5 -font textfont \
	-from 1 -increment 1 -to 10000000 \
	-validate all -validatecommand "diffcontextvalidate %P" \
	-textvariable diffcontextstring
    .bleft.mid.diffcontext set $diffcontext
    trace add variable diffcontextstring write diffcontextchange
    lappend entries .bleft.mid.diffcontext
    pack .bleft.mid.labeldiffcontext .bleft.mid.diffcontext -side left
    set ctext .bleft.ctext
    text $ctext -background $bgcolor -foreground $fgcolor \
	-state disabled -font textfont \
	-yscrollcommand scrolltext -wrap none
    if {$have_tk85} {
	$ctext conf -tabstyle wordprocessor
    }
    scrollbar .bleft.sb -command "$ctext yview"
    pack .bleft.top -side top -fill x
    pack .bleft.mid -side top -fill x
    pack .bleft.sb -side right -fill y
    pack $ctext -side left -fill both -expand 1
    lappend bglist $ctext
    lappend fglist $ctext

    $ctext tag conf comment -wrap $wrapcomment
    $ctext tag conf filesep -font textfontbold -back "#aaaaaa"
    $ctext tag conf hunksep -fore [lindex $diffcolors 2]
    $ctext tag conf d0 -fore [lindex $diffcolors 0]
    $ctext tag conf d1 -fore [lindex $diffcolors 1]
    $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 textfontbold
    $ctext tag conf msep -font textfontbold
    $ctext tag conf found -back yellow

    .pwbottom add .bleft
    .pwbottom paneconfigure .bleft -width $geometry(botwidth)

    # lower right
    frame .bright
    frame .bright.mode
    radiobutton .bright.mode.patch -text "Patch" \
	-command reselectline -variable cmitmode -value "patch"
    .bright.mode.patch configure -font uifont
    radiobutton .bright.mode.tree -text "Tree" \
	-command reselectline -variable cmitmode -value "tree"
    .bright.mode.tree configure -font uifont
    grid .bright.mode.patch .bright.mode.tree -sticky ew
    pack .bright.mode -side top -fill x
    set cflist .bright.cfiles
    set indent [font measure mainfont "nn"]
    text $cflist \
	-selectbackground $selectbgcolor \
	-background $bgcolor -foreground $fgcolor \
	-font mainfont \
	-tabs [list $indent [expr {2 * $indent}]] \
	-yscrollcommand ".bright.sb set" \
	-cursor [. cget -cursor] \
	-spacing1 1 -spacing3 1
    lappend bglist $cflist
    lappend fglist $cflist
    scrollbar .bright.sb -command "$cflist yview"
    pack .bright.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 mainfontbold

    .pwbottom add .bright
    .ctop add .pwbottom

    # restore window position if known
    if {[info exists geometry(main)]} {
        wm geometry . "$geometry(main)"
    }

    if {[tk windowingsystem] eq {aqua}} {
        set M1B M1
    } else {
        set M1B Control
    }

    bind .pwbottom <Configure> {resizecdetpanes %W %w}
    pack .ctop -fill both -expand 1
    bindall <1> {selcanvline %W %x %y}
    #bindall <B1-Motion> {selcanvline %W %x %y}
    if {[tk windowingsystem] == "win32"} {
	bind . <MouseWheel> { windows_mousewheel_redirector %W %X %Y %D }
	bind $ctext <MouseWheel> { windows_mousewheel_redirector %W %X %Y %D ; break }
    } else {
	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"
    bindkey <Key-Right> "goforw"
    bindkey <Key-Left> "goback"
    bind . <Key-Prior> "selnextpage -1"
    bind . <Key-Next> "selnextpage 1"
    bind . <$M1B-Home> "allcanvs yview moveto 0.0"
    bind . <$M1B-End> "allcanvs yview moveto 1.0"
    bind . <$M1B-Key-Up> "allcanvs yview scroll -1 units"
    bind . <$M1B-Key-Down> "allcanvs yview scroll 1 units"
    bind . <$M1B-Key-Prior> "allcanvs yview scroll -1 pages"
    bind . <$M1B-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
    bindkey <F5> updatecommits
    bind . <$M1B-q> doquit
    bind . <$M1B-f> dofind
    bind . <$M1B-g> {findnext 0}
    bind . <$M1B-r> dosearchback
    bind . <$M1B-s> dosearch
    bind . <$M1B-equal> {incrfont 1}
    bind . <$M1B-KP_Add> {incrfont 1}
    bind . <$M1B-minus> {incrfont -1}
    bind . <$M1B-KP_Subtract> {incrfont -1}
    wm protocol . WM_DELETE_WINDOW doquit
    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}
    bind $cflist <Button-3> {pop_flist_menu %W %X %Y %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
    $rowctxmenu add command -label "Create new branch" -command mkbranch
    $rowctxmenu add command -label "Cherry-pick this commit" \
	-command cherrypick
    $rowctxmenu add command -label "Reset HEAD branch to here" \
	-command resethead

    set fakerowmenu .fakerowmenu
    menu $fakerowmenu -tearoff 0
    $fakerowmenu add command -label "Diff this -> selected" \
	-command {diffvssel 0}
    $fakerowmenu add command -label "Diff selected -> this" \
	-command {diffvssel 1}
    $fakerowmenu add command -label "Make patch" -command mkpatch
#    $fakerowmenu add command -label "Commit" -command {mkcommit 0}
#    $fakerowmenu add command -label "Commit all" -command {mkcommit 1}
#    $fakerowmenu add command -label "Revert local changes" -command revertlocal

    set headctxmenu .headctxmenu
    menu $headctxmenu -tearoff 0
    $headctxmenu add command -label "Check out this branch" \
	-command cobranch
    $headctxmenu add command -label "Remove this branch" \
	-command rmbranch

    global flist_menu
    set flist_menu .flistctxmenu
    menu $flist_menu -tearoff 0
    $flist_menu add command -label "Highlight this too" \
	-command {flist_hl 0}
    $flist_menu add command -label "Highlight this only" \
	-command {flist_hl 1}
}

# Windows sends all mouse wheel events to the current focused window, not
# the one where the mouse hovers, so bind those events here and redirect
# to the correct window
proc windows_mousewheel_redirector {W X Y D} {
    global canv canv2 canv3
    set w [winfo containing -displayof $W $X $Y]
    if {$w ne ""} {
	set u [expr {$D < 0 ? 5 : -5}]
	if {$w == $canv || $w == $canv2 || $w == $canv3} {
	    allcanvs yview scroll $u units
	} else {
	    catch {
		$w yview scroll $u units
	    }
	}
    }
}

# 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 ctext entries
    foreach e [concat $entries $ctext] {
	if {$w == $e} return
    }
    focus .
}

# Adjust the progress bar for a change in requested extent or canvas size
proc adjustprogress {} {
    global progresscanv progressitem progresscoords
    global fprogitem fprogcoord lastprogupdate progupdatepending

    set w [expr {[winfo width $progresscanv] - 4}]
    set x0 [expr {$w * [lindex $progresscoords 0]}]
    set x1 [expr {$w * [lindex $progresscoords 1]}]
    set h [winfo height $progresscanv]
    $progresscanv coords $progressitem $x0 0 $x1 $h
    $progresscanv coords $fprogitem 0 0 [expr {$w * $fprogcoord}] $h
    set now [clock clicks -milliseconds]
    if {$now >= $lastprogupdate + 100} {
	set progupdatepending 0
	update
    } elseif {!$progupdatepending} {
	set progupdatepending 1
	after [expr {$lastprogupdate + 100 - $now}] doprogupdate
    }
}

proc doprogupdate {} {
    global lastprogupdate progupdatepending

    if {$progupdatepending} {
	set progupdatepending 0
	set lastprogupdate [clock clicks -milliseconds]
	update
    }
}

proc savestuff {w} {
    global canv canv2 canv3 mainfont textfont uifont tabstop
    global stuffsaved findmergefiles maxgraphpct
    global maxwidth showneartags showlocalchanges
    global viewname viewfiles viewargs viewperm nextviewnum
    global cmitmode wrapcomment datetimeformat
    global colors bgcolor fgcolor diffcolors diffcontext selectbgcolor

    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 tabstop $tabstop]
	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 [list set showlocalchanges $showlocalchanges]
	puts $f [list set datetimeformat $datetimeformat]
	puts $f [list set bgcolor $bgcolor]
	puts $f [list set fgcolor $fgcolor]
	puts $f [list set colors $colors]
	puts $f [list set diffcolors $diffcolors]
	puts $f [list set diffcontext $diffcontext]
	puts $f [list set selectbgcolor $selectbgcolor]

	puts $f "set geometry(main) [wm geometry .]"
	puts $f "set geometry(topwidth) [winfo width .tf]"
	puts $f "set geometry(topheight) [winfo height .tf]"
        puts $f "set geometry(pwsash0) \"[.tf.histframe.pwclist sash coord 0]\""
        puts $f "set geometry(pwsash1) \"[.tf.histframe.pwclist sash coord 1]\""
	puts $f "set geometry(botwidth) [winfo width .bleft]"
	puts $f "set geometry(botheight) [winfo height .bleft]"

	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 {} {
    global uifont
    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

Copyright © 2005-2006 Paul Mackerras

Use and redistribute under the terms of the GNU General Public License} \
	    -justify center -aspect 400 -border 2 -bg white -relief groove
    pack $w.m -side top -fill x -padx 2 -pady 2
    $w.m configure -font uifont
    button $w.ok -text Close -command "destroy $w" -default active
    pack $w.ok -side bottom
    $w.ok configure -font uifont
    bind $w <Visibility> "focus $w.ok"
    bind $w <Key-Escape> "destroy $w"
    bind $w <Key-Return> "destroy $w"
}

proc keys {} {
    global uifont
    set w .keys
    if {[winfo exists $w]} {
	raise $w
	return
    }
    if {[tk windowingsystem] eq {aqua}} {
	set M1T Cmd
    } else {
	set M1T Ctrl
    }
    toplevel $w
    wm title $w "Gitk key bindings"
    message $w.m -text "
Gitk key bindings:

<$M1T-Q>		Quit
<Home>		Move to first commit
<End>		Move to last commit
<Up>, p, i	Move up one commit
<Down>, n, k	Move down one commit
<Left>, z, j	Go back in history list
<Right>, x, l	Go forward in history list
<PageUp>	Move up one page in commit list
<PageDown>	Move down one page in commit list
<$M1T-Home>	Scroll to top of commit list
<$M1T-End>	Scroll to bottom of commit list
<$M1T-Up>	Scroll commit list up one line
<$M1T-Down>	Scroll commit list down one line
<$M1T-PageUp>	Scroll commit list up one page
<$M1T-PageDown>	Scroll commit list down one page
<Shift-Up>	Move to previous highlighted line
<Shift-Down>	Move to next highlighted line
<Delete>, b	Scroll diff view up one page
<Backspace>	Scroll diff view up one page
<Space>		Scroll diff view down one page
u		Scroll diff view up 18 lines
d		Scroll diff view down 18 lines
<$M1T-F>		Find
<$M1T-G>		Move to next find hit
<Return>	Move to next find hit
/		Move to next find hit, or redo find
?		Move to previous find hit
f		Scroll diff view to next file
<$M1T-S>		Search for next hit in diff view
<$M1T-R>		Search for previous hit in diff view
<$M1T-KP+>	Increase font size
<$M1T-plus>	Increase font size
<$M1T-KP->	Decrease font size
<$M1T-minus>	Decrease font size
<F5>		Update
" \
	    -justify left -bg white -border 2 -relief groove
    pack $w.m -side top -fill both -padx 2 -pady 2
    $w.m configure -font uifont
    button $w.ok -text Close -command "destroy $w" -default active
    pack $w.ok -side bottom
    $w.ok configure -font uifont
    bind $w <Visibility> "focus $w.ok"
    bind $w <Key-Escape> "destroy $w"
    bind $w <Key-Return> "destroy $w"
}

# Procedures for manipulating the file list window at the
# bottom right of the overall window.

proc treeview {w l openlevs} {
    global treecontents treediropen treeheight treeparent treeindex

    set ix 0
    set treeindex() 0
    set lev 0
    set prefix {}
    set prefixend -1
    set prefendstack {}
    set htstack {}
    set ht 0
    set treecontents() {}
    $w conf -state normal
    foreach f $l {
	while {[string range $f 0 $prefixend] ne $prefix} {
	    if {$lev <= $openlevs} {
		$w mark set e:$treeindex($prefix) "end -1c"
		$w mark gravity e:$treeindex($prefix) left
	    }
	    set treeheight($prefix) $ht
	    incr ht [lindex $htstack end]
	    set htstack [lreplace $htstack end end]
	    set prefixend [lindex $prefendstack end]
	    set prefendstack [lreplace $prefendstack end end]
	    set prefix [string range $prefix 0 $prefixend]
	    incr lev -1
	}
	set tail [string range $f [expr {$prefixend+1}] end]
	while {[set slash [string first "/" $tail]] >= 0} {
	    lappend htstack $ht
	    set ht 0
	    lappend prefendstack $prefixend
	    incr prefixend [expr {$slash + 1}]
	    set d [string range $tail 0 $slash]
	    lappend treecontents($prefix) $d
	    set oldprefix $prefix
	    append prefix $d
	    set treecontents($prefix) {}
	    set treeindex($prefix) [incr ix]
	    set treeparent($prefix) $oldprefix
	    set tail [string range $tail [expr {$slash+1}] end]
	    if {$lev <= $openlevs} {
		set ht 1
		set treediropen($prefix) [expr {$lev < $openlevs}]
		set bm [expr {$lev == $openlevs? "tri-rt": "tri-dn"}]
		$w mark set d:$ix "end -1c"
		$w mark gravity d:$ix left
		set str "\n"
		for {set i 0} {$i < $lev} {incr i} {append str "\t"}
		$w insert end $str
		$w image create end -align center -image $bm -padx 1 \
		    -name a:$ix
		$w insert end $d [highlight_tag $prefix]
		$w mark set s:$ix "end -1c"
		$w mark gravity s:$ix left
	    }
	    incr lev
	}
	if {$tail ne {}} {
	    if {$lev <= $openlevs} {
		incr ht
		set str "\n"
		for {set i 0} {$i < $lev} {incr i} {append str "\t"}
		$w insert end $str
		$w insert end $tail [highlight_tag $f]
	    }
	    lappend treecontents($prefix) $tail
	}
    }
    while {$htstack ne {}} {
	set treeheight($prefix) $ht
	incr ht [lindex $htstack end]
	set htstack [lreplace $htstack end end]
	set prefixend [lindex $prefendstack end]
	set prefendstack [lreplace $prefendstack end end]
	set prefix [string range $prefix 0 $prefixend]
    }
    $w conf -state disabled
}

proc linetoelt {l} {
    global treeheight treecontents

    set y 2
    set prefix {}
    while {1} {
	foreach e $treecontents($prefix) {
	    if {$y == $l} {
		return "$prefix$e"
	    }
	    set n 1
	    if {[string index $e end] eq "/"} {
		set n $treeheight($prefix$e)
		if {$y + $n > $l} {
		    append prefix $e
		    incr y
		    break
		}
	    }
	    incr y $n
	}
    }
}

proc highlight_tree {y prefix} {
    global treeheight treecontents cflist

    foreach e $treecontents($prefix) {
	set path $prefix$e
	if {[highlight_tag $path] ne {}} {
	    $cflist tag add bold $y.0 "$y.0 lineend"
	}
	incr y
	if {[string index $e end] eq "/" && $treeheight($path) > 1} {
	    set y [highlight_tree $y $path]
	}
    }
    return $y
}

proc treeclosedir {w dir} {
    global treediropen treeheight treeparent treeindex

    set ix $treeindex($dir)
    $w conf -state normal
    $w delete s:$ix e:$ix
    set treediropen($dir) 0
    $w image configure a:$ix -image tri-rt
    $w conf -state disabled
    set n [expr {1 - $treeheight($dir)}]
    while {$dir ne {}} {
	incr treeheight($dir) $n
	set dir $treeparent($dir)
    }
}

proc treeopendir {w dir} {
    global treediropen treeheight treeparent treecontents treeindex

    set ix $treeindex($dir)
    $w conf -state normal
    $w image configure a:$ix -image tri-dn
    $w mark set e:$ix s:$ix
    $w mark gravity e:$ix right
    set lev 0
    set str "\n"
    set n [llength $treecontents($dir)]
    for {set x $dir} {$x ne {}} {set x $treeparent($x)} {
	incr lev
	append str "\t"
	incr treeheight($x) $n
    }
    foreach e $treecontents($dir) {
	set de $dir$e
	if {[string index $e end] eq "/"} {
	    set iy $treeindex($de)
	    $w mark set d:$iy e:$ix
	    $w mark gravity d:$iy left
	    $w insert e:$ix $str
	    set treediropen($de) 0
	    $w image create e:$ix -align center -image tri-rt -padx 1 \
		-name a:$iy
	    $w insert e:$ix $e [highlight_tag $de]
	    $w mark set s:$iy e:$ix
	    $w mark gravity s:$iy left
	    set treeheight($de) 1
	} else {
	    $w insert e:$ix $str
	    $w insert e:$ix $e [highlight_tag $de]
	}
    }
    $w mark gravity e:$ix left
    $w conf -state disabled
    set treediropen($dir) 1
    set top [lindex [split [$w index @0,0] .] 0]
    set ht [$w cget -height]
    set l [lindex [split [$w index s:$ix] .] 0]
    if {$l < $top} {
	$w yview $l.0
    } elseif {$l + $n + 1 > $top + $ht} {
	set top [expr {$l + $n + 2 - $ht}]
	if {$l < $top} {
	    set top $l
	}
	$w yview $top.0
    }
}

proc treeclick {w x y} {
    global treediropen cmitmode ctext cflist cflist_top

    if {$cmitmode ne "tree"} return
    if {![info exists cflist_top]} return
    set l [lindex [split [$w index "@$x,$y"] "."] 0]
    $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
    $cflist tag add highlight $l.0 "$l.0 lineend"
    set cflist_top $l
    if {$l == 1} {
	$ctext yview 1.0
	return
    }
    set e [linetoelt $l]
    if {[string index $e end] ne "/"} {
	showfile $e
    } elseif {$treediropen($e)} {
	treeclosedir $w $e
    } else {
	treeopendir $w $e
    }
}

proc setfilelist {id} {
    global treefilelist cflist

    treeview $cflist $treefilelist($id) 0
}

image create bitmap tri-rt -background black -foreground blue -data {
    #define tri-rt_width 13
    #define tri-rt_height 13
    static unsigned char tri-rt_bits[] = {
       0x00, 0x00, 0x00, 0x00, 0x10, 0x00, 0x30, 0x00, 0x70, 0x00, 0xf0, 0x00,
       0xf0, 0x01, 0xf0, 0x00, 0x70, 0x00, 0x30, 0x00, 0x10, 0x00, 0x00, 0x00,
       0x00, 0x00};
} -maskdata {
    #define tri-rt-mask_width 13
    #define tri-rt-mask_height 13
    static unsigned char tri-rt-mask_bits[] = {
       0x08, 0x00, 0x18, 0x00, 0x38, 0x00, 0x78, 0x00, 0xf8, 0x00, 0xf8, 0x01,
       0xf8, 0x03, 0xf8, 0x01, 0xf8, 0x00, 0x78, 0x00, 0x38, 0x00, 0x18, 0x00,
       0x08, 0x00};
}
image create bitmap tri-dn -background black -foreground blue -data {
    #define tri-dn_width 13
    #define tri-dn_height 13
    static unsigned char tri-dn_bits[] = {
       0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x07, 0xf8, 0x03,
       0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
       0x00, 0x00};
} -maskdata {
    #define tri-dn-mask_width 13
    #define tri-dn-mask_height 13
    static unsigned char tri-dn-mask_bits[] = {
       0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0x1f, 0xfe, 0x0f, 0xfc, 0x07,
       0xf8, 0x03, 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00,
       0x00, 0x00};
}

image create bitmap reficon-T -background black -foreground yellow -data {
    #define tagicon_width 13
    #define tagicon_height 9
    static unsigned char tagicon_bits[] = {
       0x00, 0x00, 0x00, 0x00, 0xf0, 0x07, 0xf8, 0x07,
       0xfc, 0x07, 0xf8, 0x07, 0xf0, 0x07, 0x00, 0x00, 0x00, 0x00};
} -maskdata {
    #define tagicon-mask_width 13
    #define tagicon-mask_height 9
    static unsigned char tagicon-mask_bits[] = {
       0x00, 0x00, 0xf0, 0x0f, 0xf8, 0x0f, 0xfc, 0x0f,
       0xfe, 0x0f, 0xfc, 0x0f, 0xf8, 0x0f, 0xf0, 0x0f, 0x00, 0x00};
}
set rectdata {
    #define headicon_width 13
    #define headicon_height 9
    static unsigned char headicon_bits[] = {
       0x00, 0x00, 0x00, 0x00, 0xf8, 0x07, 0xf8, 0x07,
       0xf8, 0x07, 0xf8, 0x07, 0xf8, 0x07, 0x00, 0x00, 0x00, 0x00};
}
set rectmask {
    #define headicon-mask_width 13
    #define headicon-mask_height 9
    static unsigned char headicon-mask_bits[] = {
       0x00, 0x00, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f,
       0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0x00, 0x00};
}
image create bitmap reficon-H -background black -foreground green \
    -data $rectdata -maskdata $rectmask
image create bitmap reficon-o -background black -foreground "#ddddff" \
    -data $rectdata -maskdata $rectmask

proc init_flist {first} {
    global cflist cflist_top selectedline difffilestart

    $cflist conf -state normal
    $cflist delete 0.0 end
    if {$first ne {}} {
	$cflist insert end $first
	set cflist_top 1
	$cflist tag add highlight 1.0 "1.0 lineend"
    } else {
	catch {unset cflist_top}
    }
    $cflist conf -state disabled
    set difffilestart {}
}

proc highlight_tag {f} {
    global highlight_paths

    foreach p $highlight_paths {
	if {[string match $p $f]} {
	    return "bold"
	}
    }
    return {}
}

proc highlight_filelist {} {
    global cmitmode cflist

    $cflist conf -state normal
    if {$cmitmode ne "tree"} {
	set end [lindex [split [$cflist index end] .] 0]
	for {set l 2} {$l < $end} {incr l} {
	    set line [$cflist get $l.0 "$l.0 lineend"]
	    if {[highlight_tag $line] ne {}} {
		$cflist tag add bold $l.0 "$l.0 lineend"
	    }
	}
    } else {
	highlight_tree 2 {}
    }
    $cflist conf -state disabled
}

proc unhighlight_filelist {} {
    global cflist

    $cflist conf -state normal
    $cflist tag remove bold 1.0 end
    $cflist conf -state disabled
}

proc add_flist {fl} {
    global cflist

    $cflist conf -state normal
    foreach f $fl {
	$cflist insert end "\n"
	$cflist insert end $f [highlight_tag $f]
    }
    $cflist conf -state disabled
}

proc sel_flist {w x y} {
    global ctext difffilestart cflist cflist_top cmitmode

    if {$cmitmode eq "tree"} return
    if {![info exists cflist_top]} return
    set l [lindex [split [$w index "@$x,$y"] "."] 0]
    $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
    $cflist tag add highlight $l.0 "$l.0 lineend"
    set cflist_top $l
    if {$l == 1} {
	$ctext yview 1.0
    } else {
	catch {$ctext yview [lindex $difffilestart [expr {$l - 2}]]}
    }
}

proc pop_flist_menu {w X Y x y} {
    global ctext cflist cmitmode flist_menu flist_menu_file
    global treediffs diffids

    stopfinding
    set l [lindex [split [$w index "@$x,$y"] "."] 0]
    if {$l <= 1} return
    if {$cmitmode eq "tree"} {
	set e [linetoelt $l]
	if {[string index $e end] eq "/"} return
    } else {
	set e [lindex $treediffs($diffids) [expr {$l-2}]]
    }
    set flist_menu_file $e
    tk_popup $flist_menu $X $Y
}

proc flist_hl {only} {
    global flist_menu_file findstring gdttype

    set x [shellquote $flist_menu_file]
    if {$only || $findstring eq {} || $gdttype ne "touching paths:"} {
	set findstring $x
    } else {
	append findstring " " $x
    }
    set gdttype "touching paths:"
}

# Functions for adding and removing shell-type quoting

proc shellquote {str} {
    if {![string match "*\['\"\\ \t]*" $str]} {
	return $str
    }
    if {![string match "*\['\"\\]*" $str]} {
	return "\"$str\""
    }
    if {![string match "*'*" $str]} {
	return "'$str'"
    }
    return "\"[string map {\" \\\" \\ \\\\} $str]\""
}

proc shellarglist {l} {
    set str {}
    foreach a $l {
	if {$str ne {}} {
	    append str " "
	}
	append str [shellquote $a]
    }
    return $str
}

proc shelldequote {str} {
    set ret {}
    set used -1
    while {1} {
	incr used
	if {![regexp -start $used -indices "\['\"\\\\ \t]" $str first]} {
	    append ret [string range $str $used end]
	    set used [string length $str]
	    break
	}
	set first [lindex $first 0]
	set ch [string index $str $first]
	if {$first > $used} {
	    append ret [string range $str $used [expr {$first - 1}]]
	    set used $first
	}
	if {$ch eq " " || $ch eq "\t"} break
	incr used
	if {$ch eq "'"} {
	    set first [string first "'" $str $used]
	    if {$first < 0} {
		error "unmatched single-quote"
	    }
	    append ret [string range $str $used [expr {$first - 1}]]
	    set used $first
	    continue
	}
	if {$ch eq "\\"} {
	    if {$used >= [string length $str]} {
		error "trailing backslash"
	    }
	    append ret [string index $str $used]
	    continue
	}
	# here ch == "\""
	while {1} {
	    if {![regexp -start $used -indices "\[\"\\\\]" $str first]} {
		error "unmatched double-quote"
	    }
	    set first [lindex $first 0]
	    set ch [string index $str $first]
	    if {$first > $used} {
		append ret [string range $str $used [expr {$first - 1}]]
		set used $first
	    }
	    if {$ch eq "\""} break
	    incr used
	    append ret [string index $str $used]
	    incr used
	}
    }
    return [list $used $ret]
}

proc shellsplit {str} {
    set l {}
    while {1} {
	set str [string trimleft $str]
	if {$str eq {}} break
	set dq [shelldequote $str]
	set n [lindex $dq 0]
	set word [lindex $dq 1]
	set str [string range $str $n end]
	lappend l $word
    }
    return $l
}

# Code to implement multiple views

proc newview {ishighlight} {
    global nextviewnum newviewname newviewperm uifont newishighlight
    global newviewargs revtreeargs

    set newishighlight $ishighlight
    set top .gitkview
    if {[winfo exists $top]} {
	raise $top
	return
    }
    set newviewname($nextviewnum) "View $nextviewnum"
    set newviewperm($nextviewnum) 0
    set newviewargs($nextviewnum) [shellarglist $revtreeargs]
    vieweditor $top $nextviewnum "Gitk view definition"
}

proc editview {} {
    global curview
    global viewname viewperm newviewname newviewperm
    global viewargs newviewargs

    set top .gitkvedit-$curview
    if {[winfo exists $top]} {
	raise $top
	return
    }
    set newviewname($curview) $viewname($curview)
    set newviewperm($curview) $viewperm($curview)
    set newviewargs($curview) [shellarglist $viewargs($curview)]
    vieweditor $top $curview "Gitk: edit view $viewname($curview)"
}

proc vieweditor {top n title} {
    global newviewname newviewperm viewfiles
    global uifont

    toplevel $top
    wm title $top $title
    label $top.nl -text "Name" -font uifont
    entry $top.name -width 20 -textvariable newviewname($n) -font uifont
    grid $top.nl $top.name -sticky w -pady 5
    checkbutton $top.perm -text "Remember this view" -variable newviewperm($n) \
	-font uifont
    grid $top.perm - -pady 5 -sticky w
    message $top.al -aspect 1000 -font uifont \
	-text "Commits to include (arguments to git rev-list):"
    grid $top.al - -sticky w -pady 5
    entry $top.args -width 50 -textvariable newviewargs($n) \
	-background white -font uifont
    grid $top.args - -sticky ew -padx 5
    message $top.l -aspect 1000 -font uifont \
	-text "Enter files and directories to include, one per line:"
    grid $top.l - -sticky w
    text $top.t -width 40 -height 10 -background white -font uifont
    if {[info exists viewfiles($n)]} {
	foreach f $viewfiles($n) {
	    $top.t insert end $f
	    $top.t insert end "\n"
	}
	$top.t delete {end - 1c} end
	$top.t mark set insert 0.0
    }
    grid $top.t - -sticky ew -padx 5
    frame $top.buts
    button $top.buts.ok -text "OK" -command [list newviewok $top $n] \
	-font uifont
    button $top.buts.can -text "Cancel" -command [list destroy $top] \
	-font uifont
    grid $top.buts.ok $top.buts.can
    grid columnconfigure $top.buts 0 -weight 1 -uniform a
    grid columnconfigure $top.buts 1 -weight 1 -uniform a
    grid $top.buts - -pady 10 -sticky ew
    focus $top.t
}

proc doviewmenu {m first cmd op argv} {
    set nmenu [$m index end]
    for {set i $first} {$i <= $nmenu} {incr i} {
	if {[$m entrycget $i -command] eq $cmd} {
	    eval $m $op $i $argv
	    break
	}
    }
}

proc allviewmenus {n op args} {
    # global viewhlmenu

    doviewmenu .bar.view 5 [list showview $n] $op $args
    # doviewmenu $viewhlmenu 1 [list addvhighlight $n] $op $args
}

proc newviewok {top n} {
    global nextviewnum newviewperm newviewname newishighlight
    global viewname viewfiles viewperm selectedview curview
    global viewargs newviewargs viewhlmenu

    if {[catch {
	set newargs [shellsplit $newviewargs($n)]
    } err]} {
	error_popup "Error in commit selection arguments: $err"
	wm raise $top
	focus $top
	return
    }
    set files {}
    foreach f [split [$top.t get 0.0 end] "\n"] {
	set ft [string trim $f]
	if {$ft ne {}} {
	    lappend files $ft
	}
    }
    if {![info exists viewfiles($n)]} {
	# creating a new view
	incr nextviewnum
	set viewname($n) $newviewname($n)
	set viewperm($n) $newviewperm($n)
	set viewfiles($n) $files
	set viewargs($n) $newargs
	addviewmenu $n
	if {!$newishighlight} {
	    run showview $n
	} else {
	    run addvhighlight $n
	}
    } else {
	# editing an existing view
	set viewperm($n) $newviewperm($n)
	if {$newviewname($n) ne $viewname($n)} {
	    set viewname($n) $newviewname($n)
	    doviewmenu .bar.view 5 [list showview $n] \
		entryconf [list -label $viewname($n)]
	    # doviewmenu $viewhlmenu 1 [list addvhighlight $n] \
		# entryconf [list -label $viewname($n) -value $viewname($n)]
	}
	if {$files ne $viewfiles($n) || $newargs ne $viewargs($n)} {
	    set viewfiles($n) $files
	    set viewargs($n) $newargs
	    if {$curview == $n} {
		run updatecommits
	    }
	}
    }
    catch {destroy $top}
}

proc delview {} {
    global curview viewdata viewperm hlview selectedhlview

    if {$curview == 0} return
    if {[info exists hlview] && $hlview == $curview} {
	set selectedhlview None
	unset hlview
    }
    allviewmenus $curview delete
    set viewdata($curview) {}
    set viewperm($curview) 0
    showview 0
}

proc addviewmenu {n} {
    global viewname viewhlmenu

    .bar.view add radiobutton -label $viewname($n) \
	-command [list showview $n] -variable selectedview -value $n
    #$viewhlmenu add radiobutton -label $viewname($n) \
    #	-command [list addvhighlight $n] -variable selectedhlview
}

proc flatten {var} {
    global $var

    set ret {}
    foreach i [array names $var] {
	lappend ret $i [set $var\($i\)]
    }
    return $ret
}

proc unflatten {var l} {
    global $var

    catch {unset $var}
    foreach {i v} $l {
	set $var\($i\) $v
    }
}

proc showview {n} {
    global curview viewdata viewfiles
    global displayorder parentlist rowidlist rowisopt rowfinal
    global colormap rowtextx commitrow nextcolor canvxmax
    global numcommits commitlisted
    global selectedline currentid canv canvy0
    global treediffs
    global pending_select phase
    global commitidx
    global commfd
    global selectedview selectfirst
    global vparentlist vdisporder vcmitlisted
    global hlview selectedhlview commitinterest

    if {$n == $curview} return
    set selid {}
    if {[info exists selectedline]} {
	set selid $currentid
	set y [yc $selectedline]
	set ymax [lindex [$canv cget -scrollregion] 3]
	set span [$canv yview]
	set ytop [expr {[lindex $span 0] * $ymax}]
	set ybot [expr {[lindex $span 1] * $ymax}]
	if {$ytop < $y && $y < $ybot} {
	    set yscreen [expr {$y - $ytop}]
	} else {
	    set yscreen [expr {($ybot - $ytop) / 2}]
	}
    } elseif {[info exists pending_select]} {
	set selid $pending_select
	unset pending_select
    }
    unselectline
    normalline
    if {$curview >= 0} {
	set vparentlist($curview) $parentlist
	set vdisporder($curview) $displayorder
	set vcmitlisted($curview) $commitlisted
	if {$phase ne {} ||
	    ![info exists viewdata($curview)] ||
	    [lindex $viewdata($curview) 0] ne {}} {
	    set viewdata($curview) \
		[list $phase $rowidlist $rowisopt $rowfinal]
	}
    }
    catch {unset treediffs}
    clear_display
    if {[info exists hlview] && $hlview == $n} {
	unset hlview
	set selectedhlview None
    }
    catch {unset commitinterest}

    set curview $n
    set selectedview $n
    .bar.view entryconf Edit* -state [expr {$n == 0? "disabled": "normal"}]
    .bar.view entryconf Delete* -state [expr {$n == 0? "disabled": "normal"}]

    run refill_reflist
    if {![info exists viewdata($n)]} {
	if {$selid ne {}} {
	    set pending_select $selid
	}
	getcommits
	return
    }

    set v $viewdata($n)
    set phase [lindex $v 0]
    set displayorder $vdisporder($n)
    set parentlist $vparentlist($n)
    set commitlisted $vcmitlisted($n)
    set rowidlist [lindex $v 1]
    set rowisopt [lindex $v 2]
    set rowfinal [lindex $v 3]
    set numcommits $commitidx($n)

    catch {unset colormap}
    catch {unset rowtextx}
    set nextcolor 0
    set canvxmax [$canv cget -width]
    set curview $n
    set row 0
    setcanvscroll
    set yf 0
    set row {}
    set selectfirst 0
    if {$selid ne {} && [info exists commitrow($n,$selid)]} {
	set row $commitrow($n,$selid)
	# try to get the selected row in the same position on the screen
	set ymax [lindex [$canv cget -scrollregion] 3]
	set ytop [expr {[yc $row] - $yscreen}]
	if {$ytop < 0} {
	    set ytop 0
	}
	set yf [expr {$ytop * 1.0 / $ymax}]
    }
    allcanvs yview moveto $yf
    drawvisible
    if {$row ne {}} {
	selectline $row 0
    } elseif {$selid ne {}} {
	set pending_select $selid
    } else {
	set row [first_real_row]
	if {$row < $numcommits} {
	    selectline $row 0
	} else {
	    set selectfirst 1
	}
    }
    if {$phase ne {}} {
	if {$phase eq "getcommits"} {
	    show_status "Reading commits..."
	}
	run chewcommits $n
    } elseif {$numcommits == 0} {
	show_status "No commits selected"
    }
}

# Stuff relating to the highlighting facility

proc ishighlighted {row} {
    global vhighlights fhighlights nhighlights rhighlights

    if {[info exists nhighlights($row)] && $nhighlights($row) > 0} {
	return $nhighlights($row)
    }
    if {[info exists vhighlights($row)] && $vhighlights($row) > 0} {
	return $vhighlights($row)
    }
    if {[info exists fhighlights($row)] && $fhighlights($row) > 0} {
	return $fhighlights($row)
    }
    if {[info exists rhighlights($row)] && $rhighlights($row) > 0} {
	return $rhighlights($row)
    }
    return 0
}

proc bolden {row font} {
    global canv linehtag selectedline boldrows

    lappend boldrows $row
    $canv itemconf $linehtag($row) -font $font
    if {[info exists selectedline] && $row == $selectedline} {
	$canv delete secsel
	set t [eval $canv create rect [$canv bbox $linehtag($row)] \
		   -outline {{}} -tags secsel \
		   -fill [$canv cget -selectbackground]]
	$canv lower $t
    }
}

proc bolden_name {row font} {
    global canv2 linentag selectedline boldnamerows

    lappend boldnamerows $row
    $canv2 itemconf $linentag($row) -font $font
    if {[info exists selectedline] && $row == $selectedline} {
	$canv2 delete secsel
	set t [eval $canv2 create rect [$canv2 bbox $linentag($row)] \
		   -outline {{}} -tags secsel \
		   -fill [$canv2 cget -selectbackground]]
	$canv2 lower $t
    }
}

proc unbolden {} {
    global boldrows

    set stillbold {}
    foreach row $boldrows {
	if {![ishighlighted $row]} {
	    bolden $row mainfont
	} else {
	    lappend stillbold $row
	}
    }
    set boldrows $stillbold
}

proc addvhighlight {n} {
    global hlview curview viewdata vhl_done vhighlights commitidx

    if {[info exists hlview]} {
	delvhighlight
    }
    set hlview $n
    if {$n != $curview && ![info exists viewdata($n)]} {
	set viewdata($n) [list getcommits {{}} 0 0 0]
	set vparentlist($n) {}
	set vdisporder($n) {}
	set vcmitlisted($n) {}
	start_rev_list $n
    }
    set vhl_done $commitidx($hlview)
    if {$vhl_done > 0} {
	drawvisible
    }
}

proc delvhighlight {} {
    global hlview vhighlights

    if {![info exists hlview]} return
    unset hlview
    catch {unset vhighlights}
    unbolden
}

proc vhighlightmore {} {
    global hlview vhl_done commitidx vhighlights
    global displayorder vdisporder curview

    set max $commitidx($hlview)
    if {$hlview == $curview} {
	set disp $displayorder
    } else {
	set disp $vdisporder($hlvi