#!/usr/local/bin/wish8.5 -f
#  'CBB' -- Check Book Balancer
#
#   splits.tcl -- Routines to handle splits.
#
#  Written by Curtis Olson.  Started December 7, 1996.
#
#  Copyright (C) 1994 - 1997  Curtis L. Olson  - curt@sledge.mn.org
#
#  This program is free software; you can redistribute it and/or modify
#  it under the terms of the GNU General Public License as published by
#  the Free Software Foundation; either version 2 of the License, or
#  (at your option) any later version.
#
#  This program is distributed in the hope that it will be useful,
#  but WITHOUT ANY WARRANTY; without even the implied warranty of
#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#  GNU General Public License for more details.
#
#  You should have received a copy of the GNU General Public License
#  along with this program; if not, write to the Free Software
#  Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
#
# $Id: splits.tcl,v 2.6 1997/04/23 18:09:42 curt Exp $
# (Log is kept at end of this file)


#------------------------------------------------------------------------------
# Procedures for category split processing
#------------------------------------------------------------------------------

proc cbbWindow.splits {} {
    global cbb desc cat credit debit cats coms amts 

    if {[winfo exists .splits] == 1} {
	destroy .splits
    }

    option add *font $cbb(dialog_font)

    toplevel .splits

    wm title .splits "Category Splits"
    wm iconname .splits "Category Splits"

    frame .splits.frame -borderwidth 2 -relief raised
    pack .splits.frame -side top -fill both -expand 1

    if { "$credit" == "" } {
	set credit 0.00
    }

    if { "$debit" == "" } {
	set debit 0.00
    }

    label .splits.frame.head -text "[string range $desc 0 30] =:= \
	    [format "%.2f" [expr $credit - $debit]]"
    pack .splits.frame.head -anchor w -fill x

    if { $cbb(debug) } { puts $cat }

    set pieces [split $cat |]

    option add *font $cbb(fixed_header_font)
    frame .splits.frame.label
    label .splits.frame.label.cat -text "  Category     "
    label .splits.frame.label.com -text "   Comment     "
    label .splits.frame.label.amt -text " Amount  "
    pack .splits.frame.label -side top -fill x
    pack .splits.frame.label.cat .splits.frame.label.com \
	     .splits.frame.label.amt -side left -expand 1

    option add *font $cbb(fixed_font)

    set i 0
    while { $i < $cbb(max_splits) } {
	# setup widgets
	frame .splits.frame.line$i

	entry .splits.frame.line$i.cat$i -relief sunken -width 15 \
		-textvariable cats($i)

	set command "bindtags .splits.frame.line$i.cat$i \
		{.splits.frame.line$i.cat$i Entry .}"
	eval $command

	# bind .splits.frame.line$i.cat$i <FocusOut> 
	bind .splits.frame.line$i.cat$i <Tab> {
	    splitsLeavingCat %W
	}
	bind .splits.frame.line$i.cat$i <Shift-Tab> {focus [tk_focusPrev %W]}

	entry .splits.frame.line$i.com$i -relief sunken -width 15 \
		-textvariable coms($i)

	entry .splits.frame.line$i.amt$i -relief sunken -width 9 \
		-textvariable amts($i)

	bind .splits.frame.line$i.amt$i <FocusOut> {
	    splitsLeavingAmt %W
	}

	bind .splits.frame.line$i.cat$i <Meta-c> { cbbWindow.catwin }
	bind .splits.frame.line$i.cat$i <Alt-c> { cbbWindow.catwin }
	bind .splits.frame.line$i.com$i <Meta-c> { cbbWindow.catwin }
	bind .splits.frame.line$i.com$i <Alt-c> { cbbWindow.catwin }
	bind .splits.frame.line$i.amt$i <Meta-c> { cbbWindow.catwin }
	bind .splits.frame.line$i.amt$i <Alt-c> { cbbWindow.catwin }

	set cats($i) [lindex $pieces [expr 1 + $i * 3]]
	set coms($i) [lindex $pieces [expr 2 + $i * 3]]
	set amts($i) [lindex $pieces [expr 3 + $i * 3]]
	pack .splits.frame.line$i -side top -fill x -expand 1
	pack .splits.frame.line$i.cat$i .splits.frame.line$i.com$i \
	     .splits.frame.line$i.amt$i -side left -expand 1 -fill x

	incr i
    }

    # try to do some fancier initial splits handling
    if { "[string range $cat 0 0]" != "|" } {
	if { $cbb(debug) } { puts "not a split = $cat" }
	set cats(0) $cat
	set amts(0) [format "%.2f" [expr $credit - $debit]]
    }
    
    label .splits.frame.total -borderwidth 2 \
    	    -text "Sum = [splitsSum]" -font $cbb(dialog_font)
    pack .splits.frame.total -side bottom -after .splits.frame.label \
	-fill x -expand 1

    button .splits.frame.dismiss -text " Dismiss " -font $cbb(button_font) \
	    -takefocus 0 -command {
	# check to see if splits add up
	if { $debit > 0 } {
	    if { [splitsSum] != [format "%.2f" -$debit] } {
		cbbWindow.ok "Warning:  Sum of splits, [splitsSum], does not \
			match transaction value, -$debit."
		tkwait window .ok
	    }
	} else {
	    if { [splitsSum] != [format "%.2f" $credit] } {
		cbbWindow.ok "Warning:  Sum of splits, [splitsSum], does not \
			match transaction value, $credit."
		tkwait window .ok
	    }
	}

	# recreate internal splits category record
	set i 0
	set cat |
	while { $i < $cbb(max_splits) } {
	    if { "$amts($i)" != "" } {
		append cat $cats($i) | $coms($i) | [format "%.2f" $amts($i)] |
	    }
	    incr i
	}
	destroy .splits
    }
    pack .splits.frame.dismiss -side bottom -after .splits.frame.label \
	-fill x -padx 8 -pady 4

    focus .splits.frame.line0.cat0
    update
}


proc splitsLeavingCat { field } {
    global cbb eng cats addcat

    # just left a split category field

    set pos [string last cat $field]
    set cur_split [string range $field [expr $pos + 3] end]

    if { $cbb(debug) } { puts "$cats($cur_split)" }

    puts $eng "find_cat $cats($cur_split)"; flush $eng
    gets $eng result
    if { "$result" != "none" } {
	if { $cbb(debug) } { puts $result }
	if { [string range $result 0 13] == "partial_match:" } {
	    set cats($cur_split) [string range $result 14 end]             
	    .status.line configure -text \
		    "Partial completion:  '$cats($cur_split)'"
	} else {              
	    set cats($cur_split) $result
	    .status.line configure -text "Unique category found."
	    focus [tk_focusNext $field];
	}                                                
    } elseif { "$cats($cur_split)" == "" } {
	# empty field, allow tabbing
	focus [tk_focusNext $field];
    } else {
	set addcat(cat) $cats($cur_split)
	set addcat(mode) "missing"
	cbbWindow.newcat
	tkwait window .newcat
    }
    if { $cbb(debug) } { puts "Leaving $cur_split --> $cats($cur_split)" }
}


proc splitsLeavingAmt { field } {
    global cbb

    # just left an amt field

    set text "Sum = [splitsSum]"
    .splits.frame.total configure -text $text
    if { $cbb(debug) } { puts "Leaving amount field" }
}

proc splitsSum {} {
    global cbb debit credit cats amts

    set trans_total [expr $credit - $debit]

    set total 0
    set i 0
    while { $i < $cbb(max_splits) } {
        set amount $amts($i)
	set diff [format "%.2f" [expr $trans_total - $total]]
	if { "$amount" != "" } {
	    if { "$cats($i)" != "" } {
		if { $cbb(debug) } { puts "$i $amount" }
		set total [expr $total + $amount]
	    } else {
		if { $diff != 0.00 } {
		    set amts($i) $diff
		} else {
		    set amts($i) ""
		}
		set amount $diff
		set total [expr $total + $amount]
		if { $cbb(debug) } { puts "auto replacing difference with $diff" }
	    }
	} else {
	    if { [format "%.2f" $diff] != 0.00 } {
		set amts($i) $diff
		set amount $amts($i)
		set total [expr $total + $amount]
		if { $cbb(debug) } { puts "auto entering difference" }
	    }
	}
        incr i
    }

    return [format "%.2f" $total]
}


# ----------------------------------------------------------------------------
# $Log: splits.tcl,v $
# Revision 2.6  1997/04/23 18:09:42  curt
# Added meta-c binding to splits window to open category list.
#
# Revision 2.5  1997/01/09 03:57:01  curt
# Added contrib script loan.pl.
# User sizable account list.
# Removed some old gnuplot baggage from install.pl.
#
# Revision 2.4  1996/12/17 14:54:03  curt
# Updated copyright date.
#
# Revision 2.3  1996/12/16 04:18:23  curt
# Continuing the great overhaul of December 1996.
#
# Revision 2.2  1996/12/14 17:15:26  curt
# The great overhaul of December '96.
#
# Revision 2.1  1996/12/08 07:37:49  curt
# Initial revision.
#
