# Platform specific setup for tcl scripts
# Copyright (c) 1999 Andrew Chang
# %W% %@%

proc bk_init {} \
{
	global	tcl_platform dev_null tmp_dir wish sdiffw file_rev
	global	file_start_stop file_stop line_rev keytmp file_old_new
	global 	bk_fs env

	if [catch {wm withdraw .} err] {
		puts "DISPLAY variable not set correctly or not running X"
		exit 1
	}

	set sdiffw [list "sdiff" "-w1" ]
	set dev_null "/dev/null"
	set wish "wish"
	set tmp_dir  "/tmp"
	set keytmp "/var/bitkeeper"

	# Stuff related to the bk field seperator: ^A
	set bk_fs |
	set file_old_new {(.*)\|(.*)\|(.*)}
	set line_rev {([^\|]*)\|(.*)}

	set file_start_stop {(.*)@(.*)\.\.(.*)}
	set file_stop {(.*)@([0-9.]+$)}
	set file_rev {(.*)@([0-9].*)}
	set env(BK_GUI) "YES"
}
proc getConfig {prog} \
{
	global tcl_platform gc app

	set app $prog

	if {$tcl_platform(platform) == "windows"} {
		#set _d(fixedFont) {{Lucida Console} 9}
		#set _d(fixedBoldFont) {{Lucida Console} 9 bold}
		set _d(fixedFont) {6x13}
		set _d(fixedBoldFont) {6x13bold}

		#set _d(fixedBoldFont) {helvetica 9 roman bold}
		#set _d(fixedFont -misc-fixed-medium-r-semicondensed--13-120-75-75-c-60-iso8859-1
		#set _d(fixedBoldFont -misc-fixed-bold-r-semicondensed--13-120-75-75-c-60-iso8859-1
		set _d(buttonFont) {helvetica 9 roman bold}
		set _d(cset.leftWidth) 40
		set _d(cset.rightWidth) 80
		set _d(scrollWidth) 18		;# scrollbar width
		set _d(help.scrollWidth) 20	;# helptool scrollbar width
		set _d(fm.activeOldFont) {{Lucida Console} 9 bold}
		set _d(fm.activeNewFont) {{Lucida Console} 9 bold}
		set _d(ci.filesHeight) 10
	} else {
		set _d(fixedFont) {6x13}
		set _d(fixedBoldFont) {6x13bold}
		set _d(buttonFont) {times 12 roman bold}
		set _d(cset.leftWidth) 55
		set _d(cset.rightWidth) 80
		set _d(scrollWidth) 12		;# scrollbar width
		set _d(help.scrollWidth) 14	;# helptool scrollbar width
		set _d(fm.activeOldFont) {6x13bold}
		set _d(fm.activeNewFont) {6x13bold}
		set _d(ci.filesHeight) 9	;# num files to show in top win
		set _d(fm.editor) "fm2tool"
	}

	if {$tcl_platform(platform) == "windows"} {
		set _d(buttonColor) #d4d0c8	;# menu buttons
		set _d(BG) #d4d0c8		;# default background
	} else {
		set _d(buttonColor) #d0d0d0	;# menu buttons
		set _d(BG) #d9d9d9		;# default background
	}

	set _d(backup) ""		;# Make backups in ciedit: XXX NOTDOC 
	set _d(balloonTime) 1000	;# XXX: NOTDOC
	set _d(buttonColor) #d0d0d0	;# menu buttons
	set _d(diffHeight) 30		;# height of a diff window
	set _d(diffWidth) 65		;# width of side by side diffs
	set _d(geometry) ""		;# default size/location
	set _d(listBG) #e8e8e8		;# topics / lists background
	set _d(mergeHeight) 24		;# height of a merge window
	set _d(mergeWidth) 80		;# width of a merge window
	set _d(newColor) lightblue     	;# color of new revision/diff
	set _d(noticeColor) #b0b0e0	;# messages, warnings
	set _d(oldColor) #d070ff     	;# color of old revision/diff
	set _d(mergeColor) lightblue	;# color of merge region
	set _d(searchColor) yellow	;# highlight for search matches
	set _d(selectColor) lightblue	;# current file/item/topic
	set _d(statusColor) lightblue	;# various status windows
	#XXX: Not documented yet
	set _d(infoColor) powderblue	;# color of info line in difflib
	set _d(textBG) white		;# text background
	set _d(textFG) black		;# text color
	set _d(scrollColor) #d9d9d9	;# scrollbar bars
	set _d(troughColor) lightblue	;# scrollbar troughs
	set _d(warnColor) yellow	;# error messages

	set _d(quit)	Control-q	;# binding to exit tool

	set _d(ci.editHeight) 30	;# editor height
	set _d(ci.editWidth) 80		;# editor width
	set _d(ci.excludeColor) red	;# color of the exclude X
	set _d(ci.editor) ciedit	;# editor: ciedit=builtin, else in xterm
	set _d(ci.display_bytes) 8192	;# number of bytes to show in new files
	set _d(ci.commentsHeight) 6	;# height of comment window
	set _d(ci.diffHeight) 30	;# number of lines in the diff window
	set _d(ci.rescan) 0		;# Do a second scan to see if anything
					;# changed. Values 0 - off 1 - on

	set _d(cset.listHeight) 12

	set _d(diff.diffHeight) 50
	set _d(diff.searchColor) lightblue ;# highlight for search matches

	# fmtool fonts: See operating specific section above
	set _d(fm.activeLeftColor) orange  ;# Color of active left region
	set _d(fm.activeRightColor) yellow ;# Color of active right region
	set _d(fm3.comments) 1		;# show comments window
	set _d(fm3.annotate) 1		;# show annotations
	set _d(fm3.firstdiff) -
	set _d(fm3.lastdiff) +
	set _d(fm3.nextdiff) bracketright
	set _d(fm3.prevdiff) bracketleft
	set _d(fm3.nextconflict) braceright
	set _d(fm3.prevconflict) braceleft
	set _d(fm3.undo) u

	set _d(help.linkColor) blue	;# hyperlinks
	set _d(help.topicsColor) orange	;# highlight for topic search matches
	set _d(help.height) 50		;# number of rows to display
	set _d(help.width) 72		;# number of columns to display
	set _d(help.helptext) ""	;# -f<helptextfile> - undocumented
	set _d(help.exact) 0		;# helpsearch, allows partial matches

	set _d(rename.listHeight) 8

	set _d(rev.canvasBG) #9fb6b8	  ;# graph background
	set _d(rev.commentBG) lightblue   ;# background of comment text
	set _d(rev.arrowColor) darkblue   ;# arrow color
	set _d(rev.mergeOutline) darkblue ;# merge rev outlines
	set _d(rev.revOutline) darkblue   ;# regular rev outlines
	set _d(rev.revColor) #9fb6b8	  ;# unselected box fills
	set _d(rev.localColor) green	  ;# local node (for resolve)
	set _d(rev.remoteColor) red	  ;# remote node (for resolve)
	set _d(rev.tagColor) red	  ;# tag box fills
	set _d(rev.selectColor) #adb8f6   ;# highlight color for selected tag
	set _d(rev.dateColor) #181818	  ;# dates at the bottom of graph
	set _d(rev.commentHeight) 5       ;# height of comment text widget
	set _d(rev.textWidth) 92	  ;# width of text windows
	set _d(rev.textHeight) 30	  ;# height of lower window
	set _d(rev.showHistory) "1M"	  ;# History to show in graph on start
	set _d(rev.showRevs) 50		  ;# Num of revs to show in graph 
	# XXX: not documented yet
	set _d(rev.savehistory) 5	  ;# Max # of files to save in file list
	set _d(rev.hlineColor) white	  ;# Color of highlight lines XXX:NOTDOC
	set _d(rev.sccscat) "-aum"	  ;# Options given to sccscat

	set _d(setup.mandatoryColor) #deeaf4 ;# Color of mandatory fields

	set _d(bug.mandatoryColor) #deeaf4 ;# Color of mandatory fields
	set _d(entryColor) white	   ;# Color of mandatory fields

	if {$tcl_platform(platform) == "windows"} {
		package require registry
		set gc(appdir) [registry get {HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders} AppData]
		set gc(bkdir) [file join $gc(appdir) BitKeeper]
		if {![file isdirectory $gc(bkdir)]} { file mkdir $gc(bkdir) }
		set rcfile [file join $gc(bkdir) _bkgui]
	} else {
		set rcfile "~/.bkgui"
		set gc(bkdir) "~"
	}
	if {[file readable $rcfile]} { source $rcfile }

	# Pass one just copies all the defaults into gc unless they are set
	# already by .bkgui rcfile.
	foreach index [array names _d] {
		if {! [info exists gc($index)]} {
			set gc($index) $_d($index)
			#puts "gc\($index) = $_d($index) (default)"
		}
	}

	# Pass to converts from global field to prog.field
	foreach index [array names gc] {
		if {[string first "." $index] == -1} {
			set i "$prog.$index"
			if {![info exists gc($i)]} {
				set gc($i) $gc($index)
				#puts "gc\($i) = $gc($i) from $index"
			}
		}
    	}
}

# Try to find the project root, limiting ourselves to 40 directories
proc cd2root { {startpath {}} } \
{
	set n 40
	if {$startpath != ""} {
		set dir $startpath
	} else {
		set dir "."
	}
	while {$n > 0} {
		set path [file join $dir BitKeeper etc]
		if {[file isdirectory $path]} {
			cd $dir
			return
		}
		set dir [file join $dir ..]
		incr n -1
	}
	return -1
}

proc displayMessage {msg {exit {}}} \
{
	global tcl_platform

	if {$exit != ""} {
		set title "Error"
		set icon "error"
	} else {
		set title "Info"
		set icon "info"
	}
	tk_messageBox -title $title -type ok -icon $icon -message $msg
	if {$exit == 1} {
		exit 1
	} else {
		return
	}
}

# The balloon stuff was taken from the tcl wiki pages and modified by
# ask so that it can take a command pipe to display
proc balloon_help {w msg {cmd {}}} {

	global gc app

	set tmp ""
	if {$cmd != ""} {
		set msg ""
		set fid [open "|$cmd" r]
		while {[gets $fid tmp] >= 0} {
		#	lappend msg $tmp
			set msg "$msg\n$tmp"
		}
	}
	bind $w <Enter> \
	    "after $gc($app.balloonTime) \"balloon_aux %W [list $msg]\""
	bind $w <Leave> \
	    "after cancel \"balloon_aux %W [list $msg]\"
	    after 100 {catch {destroy .balloon_help}}"
    }

proc balloon_aux {w msg} {
	set t .balloon_help
	catch {destroy $t}
	toplevel $t
	wm overrideredirect $t 1
	label $t.l \
	    -text $msg \
	    -relief solid \
	    -padx 5 -pady 2 \
	    -borderwidth 1 \
	    -justify left \
	    -background lightyellow 
	pack $t.l -fill both
	set x [expr [winfo rootx $w]+6+[winfo width $w]/2]
	set y [expr [winfo rooty $w]+6+[winfo height $w]/2]
	wm geometry $t +$x\+$y
	bind $t <Enter> {after cancel {catch {destroy .balloon_help}}}
	bind $t <Leave> "catch {destroy .balloon_help}"
}

#
# Tcl version 8.0.5 doesn't have array unset 
# Consider moving to common lib area?
#
proc array_unset {var} \
{
	upvar #0 $var lvar

	foreach i [array names lvar] {
		#puts "unsetting $var ($i)"
		unset lvar($i)

	}
}

# From a Cameron Laird post on usenet
proc print_stacktrace {} {
	set depth [info level]
	puts "Current call stack shows"
	for {set i 1} {$i < $depth} {incr i} {
		puts "\t[info level $i]"
	}
}
proc _parray {a {pattern *}} {
	upvar 1 $a array
	if {![array exists array]} {
		error "\"$a\" isn't an array"
	}
	set maxl 0
	foreach name [lsort [array names array $pattern]] {
		if {[string length $name] > $maxl} {
			set maxl [string length $name]
		}
	}
	set maxl [expr {$maxl + [string length $a] + 2}]
	set answer ""
	foreach name [lsort [array names array $pattern]] {
		set nameString [format %s(%s) $a $name]
		append answer \
		    [format "%-*s = %s\n" $maxl $nameString $array($name)]
	}
	return $answer
}
# difflib - view differences; loosely based on fmtool
# Copyright (c) 1999-2000 by Larry McVoy; All rights reserved
# @(#) difflib.tcl 1.24@(#) lm@disks.bitmover.com

proc createDiffWidgets {w} \
{
	global gc app

	# XXX: Need to redo all of the widgets so that we can start being
	# more flexible (show/unshow line numbers, mapbar, statusbar, etc)
	#set w(diffwin) .diffwin
	#set w(leftDiff) $w(diffwin).left.text
	#set w(RightDiff) $w(diffwin).right.text
	frame .diffs
	    frame .diffs.status
		frame .diffs.status.lstat
		frame .diffs.status.llnum
		frame .diffs.status.mstat
		frame .diffs.status.rstat
		frame .diffs.status.rlnum

		label .diffs.status.l \
		    -background $gc($app.oldColor) \
		    -font $gc($app.fixedFont) \
		    -relief sunken -borderwid 2
		label .diffs.status.l_lnum \
		    -background $gc($app.oldColor) \
		    -font $gc($app.fixedFont) \
		    -relief sunken -borderwid 2
		label .diffs.status.r \
		    -background $gc($app.newColor) \
		    -font $gc($app.fixedFont) \
		    -relief sunken -borderwid 2
		label .diffs.status.r_lnum \
		    -background $gc($app.oldColor) \
		    -font $gc($app.fixedFont) \
		    -relief sunken -borderwid 2
		label .diffs.status.middle \
		    -foreground black \
		    -background $gc($app.statusColor) \
		    -font $gc($app.fixedFont) \
		    -wid 15 \
		    -relief sunken -borderwid 2
		pack .diffs.status \
		    .diffs.status.lstat \
		    .diffs.status.mstat \
		    .diffs.status.rstat \
		    -side left -expand true -fill x
		pack configure .diffs.status.lstat -anchor w
		pack configure .diffs.status.rstat -anchor e
		pack .diffs.status.l -in .diffs.status.lstat \
		    -expand 1 -fill x -anchor w
		pack .diffs.status.middle -in .diffs.status.mstat \
		    -expand 1 -fill x
		pack .diffs.status.r -in .diffs.status.rstat \
		    -expand 1 -fill x -anchor e
		pack propagate .diffs.status.lstat 0
		pack propagate .diffs.status.rstat 0

	    text .diffs.left \
		-width $gc($app.diffWidth) \
		-height $gc($app.diffHeight) \
		-bg $gc($app.textBG) \
		-fg $gc($app.textFG) \
		-state disabled \
		-borderwidth 0\
		-wrap none \
		-font $gc($app.fixedFont) \
		-xscrollcommand { .diffs.xscroll set } \
		-yscrollcommand { .diffs.yscroll set }
	    text .diffs.right \
		-width $gc($app.diffWidth) \
		-height $gc($app.diffHeight) \
		-bg $gc($app.textBG) \
		-fg $gc($app.textFG) \
		-state disabled \
		-borderwidth 0 \
		-wrap none \
		-font $gc($app.fixedFont)
	    scrollbar .diffs.xscroll \
		-wid $gc($app.scrollWidth) \
		-troughcolor $gc($app.troughColor) \
		-background $gc($app.scrollColor) \
		-orient horizontal \
		-command { xscroll }
	    scrollbar .diffs.yscroll \
		-wid $gc($app.scrollWidth) \
		-troughcolor $gc($app.troughColor) \
		-background $gc($app.scrollColor) \
		-orient vertical \
		-command { yscroll }

	    grid .diffs.status -row 0 -column 0 -columnspan 5 -stick ew
	    grid .diffs.left -row 1 -column 0 -sticky nsew
	    grid .diffs.yscroll -row 1 -column 1 -sticky ns
	    grid .diffs.right -row 1 -column 2 -sticky nsew
	    grid .diffs.xscroll -row 2 -column 0 -sticky ew
	    grid .diffs.xscroll -columnspan 5
	    grid columnconfigure .diffs.status 0 -weight 1
	    grid columnconfigure .diffs.status 2 -weight 1
	    grid columnconfigure .diffs 0 -weight 1
	    grid columnconfigure .diffs 2 -weight 1

	    .diffs.left tag configure diff -background $gc($app.oldColor)
	    .diffs.right tag configure diff -background $gc($app.newColor)
	    bind .diffs <Configure> { computeHeight "diffs" }
	    bind .diffs.status <Configure> { reconfigureStatus }
}

proc next {} \
{
	global	diffCount lastDiff DiffsEnd search

	if {[searchactive]} {
		set search(dir) "/"
		searchnext
		return
	}
	if {$diffCount == 0} {
		nextFile
		return
	}
	if {[info exists DiffsEnd($lastDiff)] &&
	    ([visible $DiffsEnd($lastDiff)] == 0)} {
		Page "yview" 1 0
		return
	}
	if {$lastDiff >= $diffCount} {
		nextFile
		return
	}
	incr lastDiff
	dot
}

# Override the prev proc from difflib
proc prev {} \
{
	global	Diffs DiffsEnd lastDiff diffCount search

	if {[searchactive]} {
		set search(dir) "?"
		searchnext
		return
	}
	if {$diffCount == 0} {
		prevFile
		return
	}
	if {[info exists Diffs($lastDiff)] && 
	    ([visible $Diffs($lastDiff)] == 0)} {
		Page "yview" -1 0
		return
	}
	if {$lastDiff <= 1} {
		if {[prevFile] == 0} {return}
		set lastDiff $diffCount
		dot
		while {[info exists Diffs($lastDiff)] &&
		       ([visible $DiffsEnd($lastDiff)] == 0)} {
			Page "yview" 1 0
		}
		return
	}
	incr lastDiff -1
	dot
}

proc visible {index} \
{
	if {[llength [.diffs.right bbox $index]] > 0} {
		return 1
	}
	return 0
}

proc dot {} \
{
	global	Diffs DiffsEnd diffCount lastDiff

	if {![info exists Diffs($lastDiff)]} {return}
	scrollDiffs $Diffs($lastDiff) $DiffsEnd($lastDiff)
	highlightDiffs $Diffs($lastDiff) $DiffsEnd($lastDiff)
	.diffs.status.middle configure -text "Diff $lastDiff of $diffCount"
	.menu.dot configure -text "Center on diff $lastDiff"
	if {$lastDiff == 1} {
		.menu.prev configure -state disabled
	} else {
		.menu.prev configure -state normal
	}
	if {$lastDiff == $diffCount} {
		.menu.next configure -state disabled
	} else {
		.menu.next configure -state normal
	}
}

proc highlightDiffs {start stop} \
{
	global	gc app

	.diffs.left tag delete d
	.diffs.right tag delete d
	.diffs.left tag add d $start $stop
	.diffs.right tag add d $start $stop
	.diffs.left tag configure d -font $gc($app.fixedBoldFont)
	.diffs.right tag configure d -font $gc($app.fixedBoldFont)
}

proc topLine {} \
{
	return [lindex [split [.diffs.left index @1,1] "."] 0]
}


proc scrollDiffs {start stop} \
{
	global	gc app

	# Either put the diff beginning at the top of the window (if it is
	# too big to fit or fits exactly) or
	# center the diff in the window (if it is smaller than the window).
	set Diff [lindex [split $start .] 0]
	set End [lindex [split $stop .] 0]
	set size [expr {$End - $Diff}]
	# Center it.
	if {$size < $gc($app.diffHeight)} {
		set j [expr {$gc($app.diffHeight) - $size}]
		set j [expr {$j / 2}]
		set i [expr {$Diff - $j}]
		if {$i < 0} {
			set want 1
		} else {
			set want $i
		}
	} else {
		set want $Diff
	}

	set top [topLine]
	set move [expr {$want - $top}]
	.diffs.left yview scroll $move units
	.diffs.right yview scroll $move units
	.diffs.right xview moveto 0
	.diffs.left xview moveto 0
	.diffs.right see $start
	.diffs.left see $start
}

proc chunks {n} \
{
	global	Diffs DiffsEnd nextDiff

	if {![info exists nextDiff]} {return}
	set l [.diffs.left index "end - 1 char linestart"]
	set Diffs($nextDiff) $l
	set e [expr {$n + [lindex [split $l .] 0]}]
	set DiffsEnd($nextDiff) "$e.0"
	incr nextDiff
}

proc same {r l n} \
{
	global diffCount

	set lines {}
	while {$n > 0} {
		gets $l line
		lappend lines $line
		gets $r line
		incr n -1
	}
	set l [join $lines "\n"]
	.diffs.left insert end "$l\n"
	.diffs.right insert end "$l\n";
}

proc changed {r l n} \
{
	global diffCount

	chunks $n
	set llines {}
	set rlines {}
	while {$n > 0} {
		gets $l line
		lappend llines $line
		gets $r line
		lappend rlines $line
		incr n -1
	}
	set lc [join $llines "\n"]
	set rc [join $rlines "\n"]
	.diffs.left insert end "$lc\n" diff
	.diffs.right insert end "$rc\n" diff
	set loc [.diffs.right index end]
	.diffs.right mark set diff-${diffCount} "$loc - 1 line"
	.diffs.right mark gravity diff-${diffCount} left
}

proc left {r l n} \
{
	global diffCount

	chunks $n
	set lines {}
	set newlines ""
	while {$n > 0} {
		gets $l line
		lappend lines $line
		set newlines "$newlines\n"
		incr n -1
	}
	set lc [join $lines "\n"]
	.diffs.left insert end "$lc\n" diff
	.diffs.right insert end "$newlines" 
	set loc [.diffs.right index end]
	.diffs.right mark set diff-${diffCount} "$loc - 1 line"
	.diffs.right mark gravity diff-${diffCount} left
}

proc right {r l n} \
{
	global diffCount

	chunks $n
	set lines {}
	set newlines ""
	while {$n > 0} {
		gets $r line
		lappend lines $line
		set newlines "$newlines\n"
		incr n -1
	}
	set rc [join $lines "\n"]
	.diffs.left insert end "$newlines" 
	.diffs.right insert end "$rc\n" diff
	set loc [.diffs.right index end]
	.diffs.right mark set diff-${diffCount} "$loc - 1 line"
	.diffs.right mark gravity diff-${diffCount} left
}

# Get the sdiff output. Make sure it contains no \r's from fucking DOS.
proc sdiff {L R} \
{
	global	rmList sdiffw tcl_platform

	set rmList ""

	# On windows, our diff always read in text mode
	# (and write in binary mode). So no need to call bk undos
	# and no need to incure the overhead of calling "grep".
	# cygwin "grep" seems to run in text mode, so it cannot
	# detect CRLF sequence in file anyway.
	#
	# XXX For some reason, Larry's diff --ignore-trailing-cr option
	# XXX have no effect when used in sdiff, need to figure out why.
	if {$tcl_platform(platform) == "windows"} {
		return [open "| $sdiffw \"$L\" \"$R\"" r]
	}

	set a [open "| grep {\r$} \"$L\"" r]
	set b [open "| grep {\r$} \"$R\"" r]
	if { ([gets $a dummy] < 0) && ([gets $b dummy] < 0)} {
		catch { close $a }
		catch { close $b }
		return [open "| $sdiffw \"$L\" \"$R\"" r]
	}
	catch { close $a }
	catch { close $b }
	set dir [file dirname $L]
	if {"$dir" == ""} {
		set dotL .$L
	} else {
		set tail [file tail $L]
		set dotL [file join $dir .$tail]
	}
	catch {exec bk undos $L > $dotL}
	set dir [file dirname $R]
	if {"$dir" == ""} {
		set dotR .$R
	} else {
		set tail [file tail $R]
		set dotR [file join $dir .$tail]
	}
	catch {exec bk undos $R > $dotR}
	set rmList [list $dotL $dotR]
	return [open "| $sdiffw \"$dotL\" \"$dotR\""]
}

#
# Show the selected line from the left and the right diff 
# windows above and below one another in the bottom frame
# so that it is easy to see how the lines differ
#
proc stackedDiff {win x y b} \
{
	set curLine [$win index "@$x,$y linestart"]
	#displayMessage "In stackedDiff win=($win) x=($x) y=($y) c=($curLine)"
	if {$curLine == ""} {return}
	set lline [.diffs.left get $curLine "$curLine lineend"]
	set rline [.diffs.right get $curLine "$curLine lineend"]
	set lnum [lindex [split $curLine "."] 0]
	.line.diff configure -state normal
	.line.diff delete 1.0 end
	.line.diff insert end "line $lnum:\n"
	.line.diff insert end "< $lline\n"
	.line.diff insert end "> $rline\n"
	.line.diff configure -state disabled
	return
}

# Displays the flags, modes, and path for files so that the
# user can tell whether the left and right file have been 
# modified, even when the diffs line shows 0 diffs
#
# Also, highlight the differences between the info lines
#
proc displayInfo {lfile rfile {parent {}} {stop {}}} \
{
	
	global app gc

	# Use to keep track of whether a file is a bk file or not so that 
	# we don't bother trying to diff the info lines if not needed.
	set bkfile(left) 1
	set bkfile(right) 1
	set text(left) ""
	set text(right) ""

	.diffs.left tag configure "select" -background $gc($app.infoColor)
	.diffs.right tag configure "select" -background $gc($app.infoColor)
	# 1.0 files do not have a mode line. 
	# XXX: Ask lm if x.0 files have mode lines...
	set dspec1 "{-d:DPN:\n\tFlags = :FLAGS:\n\tMode  = :RWXMODE:\n}"
	set dspec2 "{-d:DPN:\n\tFlags = :FLAGS:\n\n}"

	set files [list left $lfile $parent right $rfile $stop]
	foreach {side f r} $files {
		catch {set fd [open "| bk sfiles -g \"$f\"" r]} err
		if { ([gets $fd fname] <= 0)} {
			set text($side) \
			    "Not a BitKeeper revision controlled file"
			set bkfile($side) 0
		} else {
			if {$r != "1.0"} {
				set p [open "| bk prs -hr$r $dspec1 \"$f\""]
			} else {
				set p [open "| bk prs -hr$r $dspec2 \"$f\""]
			}
			while { [gets $p line] >= 0 } {
				if {$text($side) == ""} {
					set text($side) "$line"
				} else {
					set text($side) "$text($side)\n$line"
				}
			}
			# Get info on a checked out file
			if {$text($side) == ""} {
				# XXX: I did it this fucked up way since
				# file attributes on NT does not return the
				# unix style attributes
				catch {exec ls -l $f} ls
				set perms [lindex [split $ls] 0]
				if {[string length $perms] != 10} {
					set perms "NA"
				}
				set text($side) \
				    "$rfile\n\tFlags = NA\n\tMode = $perms"
			}
			catch {close $p}
		}
		catch {close $fd}
	}
	.diffs.left configure -state normal
	.diffs.right configure -state normal
	.diffs.left delete 1.0 end
	.diffs.right delete 1.0 end
	.diffs.left insert end "$text(left)\n" select
	.diffs.right insert end "$text(right)\n" select
	# Pad out info lines
	if {($bkfile(left) == 0) && ($bkfile(right) == 1)} {
		.diffs.left insert end "\n\n" select
	}
	if {($bkfile(left) == 1) && ($bkfile(right) == 0)} {
		.diffs.right insert end "\n\n" select
	}
	# XXX: Check differences between the info lines
	return
}

# L and R: Names of the left and right files. Might be a temporary
#          file name with the form like: '/tmp/difftool.tcl@1.30-1284'
#
# lname and rname: File name with the revision appended
#
proc readFiles {L R {O {}}} \
{
	global	Diffs DiffsEnd diffCount nextDiff lastDiff dev_null rmList
	global  lname rname finfo app gc
	global  rBoth rDiff rSame nextBoth nextSame maxBoth maxDiff maxSame
	global  types saved done Marks nextMark outputFile

	if {![file exists $L]} {
		displayMessage "Left file ($L) does not exist"
		return 1
	}
	if {![file exists $R]} {
		displayMessage "Right file ($R) does not exist"
		return 1
	}
	.diffs.left configure -state normal
	.diffs.right configure -state normal

	# append time to filename when called by csettool
	# XXX: Probably OK to use same code for difftool, fmtool and csettool???
	if {[info exists finfo(lt)] && ($finfo(lt)!= "")} {
		.diffs.status.l configure -text "$finfo(l) ($finfo(lt))"
		.diffs.status.r configure -text "$finfo(r) ($finfo(rt))"
		balloon_help .diffs.status.l "$finfo(l)\n($finfo(lt))"
		balloon_help .diffs.status.r "$finfo(r)\n($finfo(rt))"
		.diffs.status.middle configure -text "... Diffing ..."
	} elseif {[info exists lname] && ($lname != "")} {
		set lt [clock format [file mtime $L] -format "%X %d%b%y"]
		set rt [clock format [file mtime $R] -format "%X %d%b%y"]
		.diffs.status.l configure -text "$lname ($lt)"
		.diffs.status.r configure -text "$rname ($rt)"
		balloon_help .diffs.status.l "$lname\n($lt)"
		balloon_help .diffs.status.r "$rname\n($rt)"
		.diffs.status.middle configure -text "... Diffing ..."
	} else {
		set l [file tail $L]
		.diffs.status.l configure -text "$l"
		balloon_help .diffs.status.l "$l"
		set r [file tail $R]
		balloon_help .diffs.status.r "$r"
		.diffs.status.r configure -text "$r"
		.diffs.status.middle configure -text "... Diffing ..."
	}
	# fmtool stuff
	if {![catch {.merge.t delete 1.0 end} err]} {
		    .merge.menu.restart config -state normal
		    .merge.menu.skip config -state normal
		    .merge.menu.left config -state normal
		    .merge.menu.right config -state normal
		    # difflib does the delete in displayInfo
		    .diffs.left delete 1.0 end
		    .diffs.right delete 1.0 end
	}; #end fmtool stuff

	. configure -cursor watch
	update
	set lineNo 1; set diffCount 0; set nextDiff 1; set saved 0
	array set DiffsEnd {}
	array set Diffs {}
	set Marks {}; set nextMark 0
	set rBoth {}; set rDiff {}; set rSame {}
	set types {}
	set n 1
	set done 0
	set l [open $L r]
	set r [open $R r]
	set d [sdiff $L $R]
	if {$O != ""} {set outputFile $O}

	gets $d last
	if {[regexp {^Binary files.*differ$} $last]} {
		.diffs.left tag configure warn -background $gc($app.warnColor)
		.diffs.right tag configure warn -background $gc($app.warnColor)
		.diffs.left insert end "Binary Files Differ\n" warn
		.diffs.right insert end "Binary Files Differ\n" warn
		. configure -cursor left_ptr
		set lastDiff 0
		set done 0
		.diffs.status.middle configure -text "Differences"
		catch {close $d}
		return
	}
	if {$last == "" || $last == " "} { set last "S" }
	while { [gets $d diff] >= 0 } {
		incr lineNo 1
		if {$diff == "" || $diff == " "} { set diff "S" }
		if {$diff == $last} {
			incr n 1
		} else {
			switch $last {
			    "S"	{ same $r $l $n }
			    "|"	{ incr diffCount 1; changed $r $l $n }
			    "<"	{ incr diffCount 1; left $r $l $n }
			    ">"	{ incr diffCount 1; right $r $l $n }
			}
			lappend types $last
			# rBoth is built up this way because the tags stuff
			# collapses adjacent tags together.
			set start [expr {$lineNo - $n}]
			lappend rBoth "$start.0" "$lineNo.0"
			# Ditto for diffs
			if {$last != "S"} {
				lappend rDiff "$start.0" "$lineNo.0"
			} else {
				lappend rSame "$start.0" "$lineNo.0"
			}
			set n 1
			set last $diff
		}
	}
	switch $last {
	    "S"	{ same $r $l $n }
	    "|"	{ incr diffCount 1; changed $r $l $n }
	    "<"	{ incr diffCount 1; left $r $l $n }
	    ">"	{ incr diffCount 1; right $r $l $n }
	}
	lappend types $last
	incr lineNo 1
	# rBoth is built up this way because the tags stuff
	# collapses adjacent tags together.
	set start [expr {$lineNo - $n}]
	lappend rBoth "$start.0" "$lineNo.0"
	# Ditto for diffs
	if {$last != "S"} {
		lappend rDiff "$start.0" "$lineNo.0"
	} else {
		lappend rSame "$start.0" "$lineNo.0"
	}
	catch {.merge.menu.l configure -text "$done / $diffCount resolved"}
	catch {close $r}
	catch {close $l}
	catch {close $d}
	if {"$rmList" != ""} {
		foreach rm $rmList {
			catch {file delete $rm}
		}
	}
	set nextSame 0
	set nextDiff 0
	set nextBoth 0
	set maxSame [expr {[llength $rSame] - 2}]
	set maxDiff [expr {[llength $rDiff] - 2}]
	set maxBoth [expr {[llength $rBoth] - 2}]

	.diffs.left configure -state disabled
	.diffs.right configure -state disabled
	. configure -cursor left_ptr
	.diffs.left configure -cursor left_ptr
	.diffs.right configure -cursor left_ptr

	if {$diffCount > 0} {
		set lastDiff 1
		dot
	} else {
		set lastDiff 0
		set done 0
		#displayMessage "done=($done) diffCount=($diffCount)"
		# XXX: Really should check to see whether status lines
		# are different
		.diffs.status.middle configure -text "No differences"
	}
} ;# readFiles

# --------------- Window stuff ------------------
proc yscroll { a args } \
{
	eval { .diffs.left yview $a } $args
	eval { .diffs.right yview $a } $args
}

proc xscroll { a args } \
{
	eval { .diffs.left xview $a } $args
	eval { .diffs.right xview $a } $args
}

#
# Scrolls page up or down
#
# w     window to scroll 
# xy    yview or xview
# dir   1 or 0
# one   1 or 0
#

proc Page {view dir one} \
{
	set p [winfo pointerxy .]
	set x [lindex $p 0]
	set y [lindex $p 1]
	set w [winfo containing $x $y]
	#puts "window=($w)"
	if {[regexp {^.diffs} $w] || [regexp {^.menu} $w]} {
		page ".diffs" $view $dir $one
		return 1
	}
	if {[regexp {^.l.filelist.t} $w]} {
		page ".diffs" $view $dir $one
		return 1
	}
	if {[regexp {^.merge} $w]} {
		page ".merge" $view $dir $one
		return 1
	}
	return 0
}

proc page {w xy dir one} \
{
	global	gc app

	if {$w == ".diffs"} {
		if {$xy == "yview"} {
			set lines [expr {$dir * $gc($app.diffHeight)}]
		} else {
			# XXX - should be width.
			set lines 16
		}
	} else {
		if {$xy == "yview"} {
			set lines [expr {$dir * $gc($app.mergeHeight)}]
		} else {
			# XXX - should be width.
			set lines 16
		}
	}
	if {$one == 1} {
		set lines [expr {$dir * 1}]
	} else {
		incr lines -1
	}
	if {$w == ".diffs"} {
		.diffs.left $xy scroll $lines units
		.diffs.right $xy scroll $lines units
	} else {
		.merge.t $xy scroll $lines units
	}
}

proc fontHeight {f} \
{
	return [expr {[font metrics $f -ascent] + [font metrics $f -descent]}]
}

proc reconfigureStatus {} \
{
	global gc app

	set w [winfo width .diffs.status]
	set mw [winfo width .diffs.status.mstat]
	set w [expr {$w - $mw}]
	set linfo [expr $w * .45]
	set rinfo [expr $w * .45]
	set minfo [expr $w * .10]
	set fh [expr [fontHeight [.diffs.status.l cget -font]] + 6]
	#puts stderr "mw=($mw) w=$w linfo=($linfo) rinfo=$rinfo minfo=($minfo)"
	#puts [pack info .diffs.status.lstat]
	.diffs.status.lstat configure -width $linfo -height $fh
	#.diffs.status.mstat configure $minfo -height 20
	.diffs.status.rstat configure -width $rinfo -height $fh
}

proc computeHeight {w} \
{
	global gc app

	update
	if {$w == "diffs"} {
		set fh [fontHeight [.diffs.left cget -font]]
		set p [winfo height .diffs.left]
		set w [winfo width .]
		set gc($app.diffHeight) [expr {$p / $fh}]
	} else {
		set fh [fontHeight [.merge.t cget -font]]
		set p [winfo height .merge.t]
		set gc($app.mergeHeight) [expr {$p / $fh}]
	}
	return
}
# fm - a file merging program
# Copyright (c) 1998 by Larry McVoy; All rights reserved
# @(#) fmtool.tcl 1.50@(#) lm@work.bitmover.com

# --------------- data structures -------------
# == DIFFS ==
# The list of chunks of text, both diffs and common, is in rBoth,
# 	is indexed by nextBoth, which can't be bigger than maxBoth
# The list of diffs is in rDiff,
# 	is indexed by nextDiff, which can't be bigger than maxDiff
# The list of common text is in rSame,
# 	is indexed by nextSame, which can't be bigger than maxSame
# The list of diff types, "S", "|", "<", ">", is in types and is used
#	to notice that the thing we are adding is actually nothing.
#	Think "foo <    "  and we select right.
#
# We walk forward (and backward) through rBoth, looking at the
# current position in each of rDiff and rSame to figure out who
# is next.
# At the end (start) of all functions, either
#	$rDiff[$nextDiff] == $rBoth[$nextBoth]
# OR	$rSame[$nextSame] == $rBoth[$nextBoth]
#
# == MARKS ==
# As we add stuff to the merge window, each insertion is marked.  The
# marks are named $something$count where count is the sequence number of
# the insertion and something is {same|left|right}.  The mark is at the
# beginning of the text.  The marks are saved, in first to last order, in
# $Marks.  The mark counter, which is really $nextBoth/2, is $nextMark.

# --------------- actions ------------------

# Undo the last diff added and everything that follows it.
# XXX - does not yet check the texts for changes - that would be nice.
proc undo {} \
{
	global rBoth rDiff rSame nextBoth nextDiff nextSame
	global maxBoth maxDiff maxSame nextMark Marks LastDelete
	global done

	if {$done == 0} {return}
	if {[llength $Marks] < 1} { return }
	set m [pop Marks]
	if {! [string match Skipped* $m]} {
		set LastDelete [.merge.t get $m "end - 1 char"]
		.merge.t delete $m "end - 1 char"
	}
	if {[string match same* $m]} {
		incr nextSame -2
		incr nextBoth -2

		# Do it again because we are looking for a diff
		if {[llength $Marks] > 1} { undo }
	} else {
		incr nextDiff -2
		incr nextBoth -2
		resolved -1
		if {! [string match Skipped* $m]} {
			.merge.menu.redo configure -state normal
		}
	}
	scrollDiffs [currentLine rBoth nextBoth]
	#dumpLists Undo ""
}

# Redo the last diff, it was something they wanted.
# This is a lot like useDiff except we are stuffing in the thing
# we deleted (which might have been edited).
proc redo {} \
{
	global nextBoth nextDiff rDiff LastDelete

	set state [.merge.menu.redo cget -state]
	if {$state == "disabled"} { return }
	incr nextBoth 2
	incr nextDiff 2
	.merge.t insert end $LastDelete {tmp redo}
	.merge.t tag configure redo -background pink
	saveMark redo
	resolved 1
	next
	.merge.menu.redo configure -state disabled
}

# If the next is a same chunk, add it in the merge window.
# Finally, scroll down to next diff.
proc next {} \
{
	global rBoth rDiff rSame nextBoth nextDiff nextSame
	global maxBoth maxDiff maxSame

	if {$nextBoth > $maxBoth} {
		return
	}
	set Same [lindex $rSame $nextSame]
	set Both [lindex $rBoth $nextBoth]
	if {$Both == $Same} {
		#dumpLists NEXT Same
		useSame
	} else {
		#dumpLists NEXT Diff
	}

	# If that was it, we're outta here.
	if {$nextBoth > $maxBoth} { return }

	# OK, there is a diff, slide down to it.
	scrollDiffs [currentLine rDiff nextDiff]
}

proc dumpLists {A B} {
	global rBoth rDiff rSame nextBoth nextDiff nextSame
	global maxBoth maxDiff maxSame

	set Same [lindex $rSame $nextSame]
	set Diff [lindex $rDiff $nextDiff]
	set Both [lindex $rBoth $nextBoth]
	puts "$A S($nextSame): $Same D($nextDiff): $Diff B($nextBoth): $Both -> $B"
	puts -nonewline "B: "
	for {set i $nextBoth} {$i <= $maxBoth} {incr i 2} {
		set j [expr {$i + 1}]
		set a [lindex $rBoth $i]
		set b [lindex $rBoth $j]
		puts -nonewline "$a,$b "
	}
	puts ""
	puts -nonewline "S: "
	for {set i $nextSame} {$i <= $maxSame} {incr i 2} {
		set j [expr {$i + 1}]
		set a [lindex $rSame $i]
		set b [lindex $rSame $j]
		puts -nonewline "$a,$b "
	}
	puts ""
	puts -nonewline "D: "
	for {set i $nextDiff} {$i <= $maxDiff} {incr i 2} {
		set j [expr {$i + 1}]
		set a [lindex $rDiff $i]
		set b [lindex $rDiff $j]
		puts -nonewline "$a,$b "
	}
	puts "\n"
}

# We're moving forward, stuff the same data into the merge window
proc useSame {} \
{
	global rBoth rDiff rSame nextBoth nextDiff nextSame
	global maxBoth maxDiff maxSame

	incr nextBoth 2
	set a [lindex $rSame $nextSame]; incr nextSame 1
	set b [lindex $rSame $nextSame]; incr nextSame 1
	set Text [.diffs.left get $a $b]
	.merge.t insert end $Text tmp
	saveMark same
}

# Use the diff that is at the nextDiff.
proc useDiff {which color} \
{
	global maxBoth nextBoth nextSame nextDiff rBoth rSame rDiff types

	if {$nextBoth > $maxBoth} { return; }

	focus .

	# Wipe out the redo button, we no longer have anything.
	.merge.menu.redo configure -state disabled

	# See if it is an empty diff; if so, just call skip and return.
	set type [expr {$nextBoth / 2}]
	set type [lindex $types $type]
	if {$which == "left"} {
		if {$type == ">"} { skip; return }
	} else {
		if {$type == "<"} { skip; return }
	}

	set Same [lindex $rSame $nextSame]
	set Diff [lindex $rDiff $nextDiff]
	set Both [lindex $rBoth $nextBoth]
	# puts "DIFF S: $Same D: $Diff B: $Both USES $which"
	incr nextBoth 2
	set a [lindex $rDiff $nextDiff]; incr nextDiff 1
	set b [lindex $rDiff $nextDiff]; incr nextDiff 1
	set Text [.diffs.$which get $a $b]
	set Here [.merge.t index end]

	.merge.t insert end $Text [list tmp $which]
	.merge.t tag configure $which -background $color

	saveMark $which
	resolved 1
	next
	# What I want is to have the first line of the new stuff at the top
	# of the merge window.
	.merge.t see $Here
	set Here [expr {[lindex [split $Here .] 0] - 1}]
	set top [lindex [split [.merge.t index @1,1] .] 0]
	.merge.t yview scroll [expr {$Here - $top}] units
}

# Skip the current diff.  Isn't this easy?
proc skip {} \
{
	global nextBoth nextDiff maxBoth nextMark Marks

	if {$nextBoth > $maxBoth} { return }
	incr nextBoth 2
	incr nextDiff 2
	set m "Skipped$nextMark"; incr nextMark 1
	set Here [.merge.t index end]
	.merge.t mark set $m $Here
	lappend Marks $m
	resolved 1
	next
	.merge.t see $Here
}

proc useLeft {} { global gc; useDiff "left" $gc(fm.oldColor) }
proc useRight {} { global gc; useDiff "right" $gc(fm.newColor) }

proc saveMark {which} \
{
	global	nextMark Marks

	# Save the mark at the beginning of the text and in the list
	set m "$which$nextMark"; incr nextMark 1
	.merge.t mark set $m [.merge.t index tmp.first]
	.merge.t tag delete tmp
	lappend Marks $m
	.merge.t yview moveto 1
}

proc selectFiles {} \
{
	global lfile rfile outputFile dev_null

	set lfile [tk_getOpenFile -title "Select Left File"] ;
	if {("$lfile" == "")} return;
 	set t [clock format [file mtime $lfile] -format "%r %D"]
	.diffs.status.l configure -text "$lfile ($t)"
	.diffs.left configure -state normal
	set fd [open $lfile r]
	.diffs.left insert end  [read $fd]
	.diffs.left configure -state disabled
	close $fd
	set rfile [tk_getOpenFile -title "Select Right File"];
	if {("$rfile" == "")} return;
	readFiles $lfile $rfile $outputFile
	resolved 0
	next
}

proc selectOutFile {} \
{
	global outputFile

	set outputFile [tk_getSaveFile -title "Select Output File" ]
	.merge.l config -text "$outputFile"
}

proc currentLine {array index} \
{
	upvar	$array	a
	upvar	$index	i

	set tmp [lindex $a $i]
	set tmp [lindex [split $tmp .] 0]
	return $tmp
}

# overrides proc from difflib.tcl
proc highlightDiffs {} \
{
	global	rDiff gc

	.diffs.left tag delete d
	.diffs.right tag delete d
	foreach {Diff End} $rDiff {
		.diffs.left tag add d $Diff $End
		.diffs.right tag add d $Diff $End
		.diffs.left tag add diff $Diff $End
		.diffs.right tag add diff $Diff $End
	}
	.diffs.left tag configure d \
	    -foreground black \
	    -font $gc(fm.activeOldFont)
	.diffs.right tag configure d \
	    -foreground black \
	    -font $gc(fm.activeNewFont)
	.diffs.left tag configure diff \
	    -background $gc(fm.oldColor)
	.diffs.right tag configure diff \
	    -background $gc(fm.newColor)
}

# overrides 'dot' from difflib.tcl
proc dot {} \
{
	highlightDiffs
	#.diffs.status.middle configure -text "Diff $lastDiff of $diffCount"
	.diffs.status.middle configure -text ""
}

# This works much better than that 0..1 shit.
# overrides 'dot' from difflib.tcl, but I think it can be merged in later
proc scrollDiffs {where} \
{
	global	rDiff nextDiff gc

	if {$where == ""} { return }
	.diffs.left see "$where.0"
	.diffs.right see "$where.0"

	# Either put the diff beginning at the top of the window (if it is
	# too big to fit or fits exactly) or
	# center the diff in the window (if it is smaller than the window).
	set Diff [lindex $rDiff $nextDiff]
	set End [lindex $rDiff [expr {1 + $nextDiff}]]
	set size [lindex [split [expr {$End - $Diff}] "."] 0]
	if {$size >= $gc(fm.diffHeight)} {
		set i $where
	} else {
		# Center it.
		set j [expr {$gc(fm.diffHeight) - $size}]
		set j [expr {$j / 2}]
		if {$j > 0} { incr j -1 }
		set i [expr {$where - $j}]
	}
	set l [topLine]
	while {($l < $i) && ($i > $gc(fm.diffHeight))} {
		.diffs.left yview scroll 1 units
		.diffs.right yview scroll 1 units
		# Handles a bug at the end.
		set j [topLine]
		if {$j == $l} { break }
		set l $j
	}

	# Highlight the diff in question so that we can see it.
	.diffs.left tag delete highLight
	.diffs.right tag delete highLight
	.diffs.left tag add highLight $Diff $End
	.diffs.right tag add highLight $Diff $End
	.diffs.left tag configure highLight -font $gc(fm.fixedBoldFont) \
	    -foreground black -background $gc(fm.activeLeftColor)
	.diffs.right tag configure highLight -font $gc(fm.fixedBoldFont) \
	    -foreground black -background $gc(fm.activeRightColor)
}

proc resolved {n} \
{
	global done diffCount
	incr done $n
	.merge.menu.l configure -text "$done / $diffCount resolved"
	# prettier as a 'case' stmt? -ask
	if {($done == 0) && ($diffCount == 0)} { ;# case with no differences
		.merge.menu.save configure -state normal
		.merge.menu.left configure -state disabled
		.merge.menu.right configure -state disabled
		.merge.menu.skip configure -state disabled
	} elseif {$done == 0} { ;# not started yet
		.merge.menu.undo configure -state disabled
		.merge.menu.redo configure -state disabled
		.merge.menu.left configure -state normal
		.merge.menu.right configure -state normal
	} elseif {$done == $diffCount} { ;# we are done
		.merge.menu.save configure -state normal
		.merge.menu.left configure -state disabled
		.merge.menu.right configure -state disabled
		.merge.menu.skip configure -state disabled
	} else { ;# we still have some to go...
		.merge.menu.save configure -state disabled
		.merge.menu.left configure -state normal
		.merge.menu.right configure -state normal
		.merge.menu.skip configure -state normal
	}
	if {$n > 0} {
		.merge.menu.undo configure -state normal
	}
}

proc cmd_done {} \
{
	global done diffCount saved exiting

	if {[info exists exiting]} {return}
	set exiting 1
	.merge.menu.quit configure -state disabled
	if {$done == 0} { exit }
	if {$done < $diffCount} {
		confirm_done \
		    "Only $done out of $diffCount merged" "Keep merging"
	} elseif {$saved == 0} {
		confirm_done "Discard all $done merges?" "Cancel"
	} else {
		exit
	}
}

# Pop the last item from the array and return it
proc pop {array} \
{
	upvar $array a
	set i [llength $a]
	if {$i > 0} {
		incr i -1
		set m [lindex $a $i]
		set a [lreplace $a $i $i]
		return $m
	}
	return {}
}

# Return the last item in an array without popping it
proc last {array} \
{
	upvar $array a
	set i [llength $a]
	if {$i > 0} {
		incr i -1
		return [lindex $a $i]
	}
	return {}
}

# --------------- diffs ------------------

proc save {} \
{
	global	saved done diffCount outputFile

	if {$done < $diffCount} {
		displayMessage "Haven't resolved all diffs"
		return
	}
	.merge.menu.save configure -state disabled
	if {("$outputFile" == "")} selectOutFile
	while {("$outputFile" == "")} {
		set ans [tk_messageBox -icon warning -type yesno -default no \
			-message "No output file selected\nQuit without save?"]
		if {("$ans" == "yes")} {exit 0}
		selectOutFile
	}
	set o [open $outputFile w]
	set Text [.merge.t get 1.0 "end - 1 char"]
	set len [expr {[string length $Text] - 1}]
	set last [string index $Text $len]
	if {"$last" == "\n"} {
		puts -nonewline $o $Text
	} else {
		puts $o $Text
	}
	catch {close $o} err
	exit 0
}

proc height {w} \
{
	global	scroll gc

	set jump 2
	if {$w == ".diffs"} {
		if {$gc(fm.mergeHeight) < $jump} { return }
		incr gc(fm.diffHeight) $jump
		incr gc(fm.mergeHeight) -$jump
	} else {
		if {$gc(fm.diffHeight) < $jump} { return }
		incr gc(fm.diffHeight) -$jump
		incr gc(fm.mergeHeight) $jump
	}
	.diffs.left configure -height $gc(fm.diffHeight)
	.diffs.right configure -height $gc(fm.diffHeight)
	.merge.t configure -height $gc(fm.mergeHeight)
	if {$gc(fm.diffHeight) < $gc(fm.mergeHeight)} {
		set scroll $gc(fm.diffHeight)
	} else {
		set scroll $gc(fm.mergeHeight)
	}
}

proc widgets {L R O} \
{
	global	scroll wish tcl_platform gc d app

	getConfig "fm"
	option add *background $gc(BG)
	set g [wm geometry .]
	if {("$g" == "1x1+0+0") && ("$gc(fm.geometry)" != "")} {
		wm geometry . $gc(fm.geometry)
	}
	if {$gc(fm.diffHeight) < $gc(fm.mergeHeight)} {
		set scroll $gc(fm.diffHeight)
	} else {
		set scroll $gc(fm.mergeHeight)
	}
	keyboard_bindings
	wm title . "File Merge"

	frame .diffs
	    frame .diffs.status
		label .diffs.status.l -background $gc(fm.oldColor) \
		    -font $gc(fm.buttonFont) -relief sunken -borderwid 2
		label .diffs.status.r -background $gc(fm.newColor) \
		    -font $gc(fm.buttonFont) -relief sunken -borderwid 2
		label .diffs.status.middle -background $gc(fm.oldColor) \
		    -foreground black -background $gc(fm.statusColor) \
		    -font  $gc(fm.fixedFont) -wid 20 \
		    -font $gc(fm.buttonFont) -relief sunken -borderwid 2
		    grid .diffs.status.l -row 0 -column 0 -sticky ew
		    grid .diffs.status.middle -row 0 -column 1
		    grid .diffs.status.r -row 0 -column 2 -sticky ew
	    text .diffs.left -width $gc(fm.diffWidth) \
		-height $gc(fm.diffHeight) \
		-background $gc(fm.textBG) -fg $gc(fm.textFG) \
		-state disabled -wrap none -font $gc(fm.fixedFont) \
		-xscrollcommand { .diffs.xscroll set } \
		-yscrollcommand { .diffs.yscroll set }
	    text .diffs.right -width $gc(fm.diffWidth) \
		-height $gc(fm.diffHeight) \
		-background $gc(fm.textBG) -fg $gc(fm.textFG) \
		-state disabled -wrap none -font $gc(fm.fixedFont)
	    scrollbar .diffs.xscroll -wid $gc(fm.scrollWidth) \
		-troughcolor $gc(fm.troughColor) \
		-background $gc(fm.scrollColor) \
		-orient horizontal -command { xscroll }
	    scrollbar .diffs.yscroll -wid $gc(fm.scrollWidth) \
		-troughcolor $gc(fm.troughColor) \
		-background $gc(fm.scrollColor) \
		-orient vertical -command { yscroll }
	    grid .diffs.status -row 0 -column 0 -columnspan 3 -stick ew
	    grid .diffs.left -row 1 -column 0 -sticky nsew
	    grid .diffs.yscroll -row 1 -column 1 -sticky ns
	    grid .diffs.right -row 1 -column 2 -sticky nsew
	    grid .diffs.xscroll -row 2 -column 0 -sticky ew
	    grid .diffs.xscroll -columnspan 3

	frame .merge
	    label .merge.l -background $gc(fm.buttonColor) \
		-font $gc(fm.fixedBoldFont)
	    text .merge.t -width $gc(fm.mergeWidth) \
		-height $gc(fm.mergeHeight) \
		-background $gc(fm.textBG) -fg $gc(fm.textFG) \
		-wrap none -font $gc(fm.fixedFont) \
		-xscrollcommand { .merge.xscroll set } \
		-yscrollcommand { .merge.yscroll set }
	    scrollbar .merge.xscroll -wid $gc(fm.scrollWidth) \
		-troughcolor $gc(fm.troughColor) \
		-background $gc(fm.scrollColor) \
		-orient horizontal -command { .merge.t xview }
	    scrollbar .merge.yscroll -wid $gc(fm.scrollWidth) \
		-troughcolor $gc(fm.troughColor) \
		-background $gc(fm.scrollColor) \
		-orient vertical -command { .merge.t yview }
	    frame .merge.menu
		button .merge.menu.open -width 7 -bg $gc(fm.buttonColor) \
		    -font $gc(fm.buttonFont) -text "Open" \
		    -command selectFiles
		button .merge.menu.restart -font $gc(fm.buttonFont) \
		    -bg $gc(fm.buttonColor) \
		    -text "Restart" -width 7 -state disabled -command startup
		button .merge.menu.undo -font $gc(fm.buttonFont) \
		    -bg $gc(fm.buttonColor) \
		    -text "Undo" -width 7 -state disabled \
		    -command undo
		button .merge.menu.redo -font $gc(fm.buttonFont) \
		    -bg $gc(fm.buttonColor) \
		    -text "Redo" -width 7 -state disabled \
		    -command redo
		button .merge.menu.skip -font $gc(fm.buttonFont) \
		    -bg $gc(fm.buttonColor) \
		    -text "Skip" -width 7 -state disabled \
		    -command skip
		button .merge.menu.left -font $gc(fm.buttonFont) \
		    -bg $gc(fm.buttonColor) \
		    -text "Use\nLeft" -width 7 -state disabled \
		    -command useLeft
		button .merge.menu.right -font $gc(fm.buttonFont) \
		    -bg $gc(fm.buttonColor) \
		    -text "Use\nright" -width 7 -state disabled \
		    -command useRight
		label .merge.menu.l -font $gc(fm.buttonFont) \
		    -bg $gc(fm.buttonColor) \
		    -width 20 -relief groove -pady 2
		button .merge.menu.save -font $gc(fm.buttonFont) \
		    -bg $gc(fm.buttonColor) \
		    -text "Done" -width 7 -command save -state disabled
		button .merge.menu.help -width 7 -bg $gc(fm.buttonColor) \
		    -font $gc(fm.buttonFont) -text "Help" \
		    -command { exec bk helptool fmtool & }
		button .merge.menu.quit -font $gc(fm.buttonFont) \
		    -bg $gc(fm.buttonColor) \
		    -text "Quit" -width 7 -command cmd_done
		grid .merge.menu.l -row 0 -column 0 -columnspan 2 -sticky ew
		grid .merge.menu.open -row 1 -sticky ew
		grid .merge.menu.restart -row 1 -column 1 -sticky ew
		grid .merge.menu.undo -row 2 -column 0 -sticky ew
		grid .merge.menu.redo -row 2 -column 1 -sticky ew
		grid .merge.menu.skip -row 3 -column 0 -sticky ew
		grid .merge.menu.save -row 3 -column 1 -sticky ew
		grid .merge.menu.left -row 4 -column 0 -sticky ew
		grid .merge.menu.right -row 4 -column 1 -sticky ew
		grid .merge.menu.help -row 5 -column 0 -sticky ew
		grid .merge.menu.quit -row 5 -column 1 -sticky ew
	    grid .merge.l -row 0 -column 0 -columnspan 2 -sticky ew
	    grid .merge.t -row 1 -column 0 -sticky nsew
	    grid .merge.yscroll -row 1 -column 1 -sticky ns
	    grid .merge.menu -row 0 -rowspan 3 -column 2 -sticky n
	    grid .merge.xscroll -row 2 -rowspan 2 -column 0 \
		-columnspan 2 -sticky ew

	label .status -relief sunken \
	    -borderwidth 2 -anchor w -font {clean 12 roman}

	grid .diffs -row 0 -column 0 -sticky nsew
	grid .merge -row 1 -column 0 -sticky nsew
	grid .status -row 2 -column 0 -sticky sew
	grid rowconfigure .diffs 1 -weight 1
	grid rowconfigure .merge 1 -weight 1
	grid rowconfigure . 0 -weight 1
	grid rowconfigure . 1 -weight 1
	grid columnconfigure .diffs.status 0 -weight 1
	grid columnconfigure .diffs.status 2 -weight 1
	grid columnconfigure .diffs 0 -weight 1
	grid columnconfigure .diffs 2 -weight 1
	grid columnconfigure .merge 0 -weight 1
	grid columnconfigure . 0 -weight 1

	# smaller than this doesn't look good.
	wm minsize . 300 300

	.status configure \
	    -text "Welcome to filemerge!"

	bind .merge <Configure> { computeHeight "merge" }
	bind .diffs <Configure> { computeHeight "diffs" }
	bindhelp .merge.menu.restart "Discard all merges and restart"
	bindhelp .merge.menu.save "Save merges and exit"
	bindhelp .merge.menu.help "Run helptool to get detailed help"
	bindhelp .merge.menu.quit "Quit without saving any merges"
	bindhelp .merge.menu.redo "Redo last undo"
	bindhelp .merge.menu.open "Open Left and Right Files"
	bindhelp .merge.menu.undo "(Control-Up)  undo the last diff selection"
	bindhelp .merge.menu.skip \
	"(Control-Down)  Skip this diff, adding neither left nor right changes"
	bindhelp .merge.menu.left \
	    "(Control-Left)  Use the highlighted change from the left"
	bindhelp .merge.menu.right \
	    "(Control-Right)  Use the highlighted change from the right"
	.merge.menu.redo configure -state disabled
	foreach w {.diffs.left .diffs.right .merge.t} {
		bindtags $w {all Text .}
	}
	set foo [bindtags .diffs.left]
	computeHeight "diffs"
	computeHeight "merge"
	. configure -background $gc(BG)
	wm protocol . WM_DELETE_WINDOW { cmd_done }
	wm deiconify .
}

proc bindhelp {w msg} \
{
	eval "bind $w <Enter> { .status configure -text \"$msg\" }"
	eval "bind $w <Leave> { .status configure -text {} }"
}

# Set up keyboard accelerators.
proc keyboard_bindings {} \
{
	global gc

	bind all <Prior> { if {[Page "yview" -1 0] == 1} { break } }
	bind all <Next> { if {[Page "yview" 1 0] == 1} { break } }
	bind all <Up> { if {[Page "yview" -1 1] == 1} { break } }
	bind all <Down> { if {[Page "yview" 1 1] == 1} { break } }
	bind all <Left> { if {[Page "xview" -1 1] == 1} { break } }
	bind all <Right> { if {[Page "xview" 1 1] == 1} { break } }
	bind all <Alt-Up> "height .merge"
	bind all <Alt-Down> "height .diffs"
	bind all <Control-Left> {useLeft}
	bind all <Control-Right> {useRight}
	bind all <Control-Down> {skip}
	bind all <Control-Up> {undo}
	bind all <$gc(fm.quit)> cmd_done 
}

proc confirm_done {msg l} \
{
	global exiting

	toplevel .c
	    frame .c.top
		label .c.top.icon -bitmap questhead
		label .c.top.msg -text $msg
		pack .c.top.icon -side left
		pack .c.top.msg -side right
	    frame .c.sep -height 2 -borderwidth 1 -relief sunken
	    frame .c.controls
		button .c.controls.discard -text "Discard merges" -command exit
		button .c.controls.cancel -text $l -command {
		    unset exiting
		    .merge.menu.quit configure -state normal
		    destroy .c
		}
		grid .c.controls.discard -row 0 -column 0 -padx 4
		grid .c.controls.cancel -row 0 -column 2 -padx 4
	    pack .c.top -padx 8 -pady 8
	    pack .c.sep -fill x -pady 4
	    pack .c.controls -pady 4
	set x [expr {[winfo rootx .merge.menu] - 150}]
	set y [expr {[winfo rooty .merge.menu] - 60}]
	wm geometry .c "+$x+$y"
	wm transient .c .
}

# --------------- main ------------------
proc startup {{buildwidgets {}}} \
{
	global argv0 argv argc dev_null done lfile rfile outputFile

	if {(($argc != 0) && ($argc != 3))} {
		puts "usage:\t$argv0 <left> <right> <output>\n\t$argv0"
		exit
	}
	set done 0
	if {$argc == 3} {
		set lfile ""; set rfile ""; set outputFile ""
		set a [split $argv " "]
		set lfile [lindex $argv 0]
		set rfile [lindex $argv 1]
		set outputFile [lindex $argv 2]
		if {![file exists $lfile] && ![file readable $lfile]} {
			displayMessage \
			    "File \"$lfile\" does not exist or is not readable"
			exit 1
		}
		if {![file exists $rfile] && ![file readable $rfile]} {
			displayMessage \
			    "File \"$rfile\" does not exist or is not readable"
			exit 1
		}
		if {$buildwidgets == 1} {widgets $lfile $rfile $outputFile}
		readFiles $lfile $rfile $outputFile
		resolved 0
		next
	} else {
		if {$buildwidgets == 1} {
			set lfile ""; set rfile ""; set outputFile ""
			widgets $lfile $rfile $outputFile
		} else {
			readFiles $lfile $rfile $outputFile
			resolved 0
			next
		}
	}
}

bk_init
startup 1
