#!/usr/local/bin/wish -f
#
#  'cbb' -- Check Book Balancer
#           Front end to the perl engine.
#
#  Written by Curtis Olson.  Started August 25, 1994.
#
#  Copyright (C) 1994  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: cbb,v 1.33 1995/02/23 05:13:12 curt Exp $
# (Log is kept at end of this file)


#------------------------------------------------------------------------------
# lets get this out of the way right away ... increase the precision
#------------------------------------------------------------------------------
set tcl_precision 17


#------------------------------------------------------------------------------
# check command line args.
#------------------------------------------------------------------------------

if { [expr $argc > 1] } {
   puts "Usage:  [file tail $argv0]  \[ file_name \]"
   exit
}


#------------------------------------------------------------------------------
# open a two way pipe to the perl engine.
#------------------------------------------------------------------------------

set eng [open |wrapper.pl r+]


#------------------------------------------------------------------------------
# Set global variables
#------------------------------------------------------------------------------

set selected 0
set next_chk 0
set cur_date ""
set cur_file "noname"
set clean 1
set max_splits 10
set state_start 0.00
set state_end 0.00
set def_cat "default.cat"
set version "Version <not installed>"
set lib_path "."
set icon_xbm "cbb.xbm"
set author_xbm "author.xbm"
set csh_src "csh.src"
set index1 0
set index2 0
set use_mems 1
set no_more_mem 0
set rep_start ""
set rep_end ""
set rep_dest "screen"
set rep_temp ""


#------------------------------------------------------------------------------
# Read in other pieces
#------------------------------------------------------------------------------

source "$lib_path/categories.tk"
source "$lib_path/help.tk"
source "$lib_path/reports.tk"


#------------------------------------------------------------------------------
# Setup window parameters
#------------------------------------------------------------------------------

wm title . "[file tail $argv0] - $cur_file"
wm iconname . "[file tail $argv0] - $cur_file"
wm iconbitmap . @$lib_path/$icon_xbm
# specify absolute placement
#wm geometry . +0+0
# The following options will enable window resizing
#wm minsize . 100 50
#wm maxsize . 1000 700
option add *font -adobe-helvetica-bold-r-normal-*-14-*-*-*-*-*-*-*
set list_height 28
set list_width 70


#------------------------------------------------------------------------------
# Setup container frames
#------------------------------------------------------------------------------

frame .menubar -relief raised -borderwidth 2
frame .head -relief raised -borderwidth 2
frame .trans -relief raised -borderwidth 2
frame .entry -relief raised -borderwidth 2
frame .bar -borderwidth 2
frame .status -relief raised -borderwidth 2
pack .menubar -fill x -expand 1
pack .head -fill x -expand 1
pack .trans -fill both -expand 1
pack .entry -fill both -expand 1
pack .bar -fill x -expand 1
pack .status -fill x -expand 1


#------------------------------------------------------------------------------
# Setup menus
#------------------------------------------------------------------------------

menubutton .menubar.file -text "File " -underline 0 -menu .menubar.file.menu
menubutton .menubar.edit -text "Edit " -underline 0 -menu .menubar.edit.menu
menubutton .menubar.functions -text "Functions " -underline 0 \
	-menu .menubar.functions.menu
menubutton .menubar.help -text "Help " -underline 0 -menu .menubar.help.menu
pack .menubar.file .menubar.edit .menubar.functions .menubar.help -side left

menu .menubar.file.menu
    .menubar.file.menu add command -label "Make Account ..." -underline 0 \
    	    -command { new_acct 0 }
    .menubar.file.menu add command -label "Load Account ..." -underline 0 \
    	    -command { load_acct 0 }
    .menubar.file.menu add separator
    .menubar.file.menu add cascade -label "Import" -underline 0 \
    	    -menu .menubar.file.menu.import
    .menubar.file.menu add cascade -label "Export" -underline 0 \
	    -menu .menubar.file.menu.export
    .menubar.file.menu add separator
    .menubar.file.menu add cascade -label "Preferences" -underline 0 \
	    -menu .menubar.file.menu.prefs
    .menubar.file.menu add separator
    .menubar.file.menu add command -label "Quit" -underline 0 \
    	    -command { quit 0 }

menu .menubar.edit.menu
    .menubar.edit.menu add command -label "Undo" \
	    -underline 0 -command { undo 0 }
    .menubar.edit.menu entryconfig 0 -accel Ctrl+U
    bind Entry <Control-u> { undo 0 }
    .menubar.edit.menu add separator
    .menubar.edit.menu add command -label "New Transaction" \
	    -underline 0 -command { clear_entry_area 0 }
    .menubar.edit.menu entryconfig 2 -accel Meta-N
    bind Entry <Meta-n> { clear_entry_area 0 }
    .menubar.edit.menu add command -label "Edit Transaction" -underline 0 \
	    -command { if { "[.trans.list curselection]" != "" } { \
	                   update_entry_area [.trans.list curselection] \
		       } \
	             }
    .menubar.edit.menu entryconfig 3 -accel Meta-E
    bind Entry <Meta-e> { if { "[.trans.list curselection]" != "" } { \
	                         update_entry_area [.trans.list curselection] \
		             } \
	                   }
    .menubar.edit.menu add command -label "Delete Transaction" -underline 0 \
	    -command { if { "[.trans.list curselection]" != "" } { \
	                   delete_trans [.trans.list curselection] \
		       } \
	             }
    .menubar.edit.menu add separator
    .menubar.edit.menu add command -label "Open Category Splits ... " \
	    -underline 0 -command { open_splits 0; \
	    			    tkwait window .splits; \
	    			    setup_default_tabbing 0 }
    .menubar.edit.menu entryconfig 6 -accel Meta-S
    bind Entry <Meta-s> { open_splits 0; \
    			  tkwait window .splits; \
    			  setup_default_tabbing 0 }

menu .menubar.functions.menu
    .menubar.functions.menu add cascade -label "Goto" -underline 0 \
	    -menu .menubar.functions.menu.goto
    .menubar.functions.menu add cascade -label "Categories" -underline 0 \
	    -menu .menubar.functions.menu.cats
    .menubar.functions.menu add command -label "Balance ..." -underline 0 \
	    -command { balance 0 }
    .menubar.functions.menu add cascade -label "Reports" -underline 0 \
	    -menu .menubar.functions.menu.reports
    .menubar.functions.menu add separator
    .menubar.functions.menu add command -label "M.T. Rehash" \
    	    -underline 0 -command { \
    				puts $eng "rehash_mems"; flush $eng; \
    				puts "Reading result"; gets $eng result; \
    				puts "Rehashing:  $result"; \
    			}

menu .menubar.help.menu
    .menubar.help.menu add command -label "About [file tail $argv0] ..." \
    	    -underline 0 -command { display_about [file tail $argv0] }
    .menubar.help.menu add separator
    .menubar.help.menu add comman -label "View Source ..." \
	    -underline 0 -command { display_src 0 }
    .menubar.help.menu add separator
    .menubar.help.menu add command -label "Help ..." -underline 0 \
	    -command DoHelp

menu .menubar.file.menu.import
    .menubar.file.menu.import add command \
	    -label "Import from Pre-0.50a CBB File ..." -command { \
	            set import_type 0; \
		    import 0 }
    .menubar.file.menu.import add command \
	    -label "Import from Quicken QIF File ..." -command { \
	            set import_type 1; \
		    import 0 }

menu .menubar.file.menu.export
    .menubar.file.menu.export add command \
	    -label "Export to Pre-0.50a CBB File ..." -command { \
	            export_cbb 0 }
    .menubar.file.menu.export add command \
	    -label "Export to Quicken QIF File ..." -command { \
	            export_qif 0 }

menu .menubar.file.menu.prefs
    .menubar.file.menu.prefs add checkbutton \
	-label "Use Memorized Transactions" -variable use_mems

menu .menubar.functions.menu.goto
    .menubar.functions.menu.goto add command -label "Beginning" -underline 0 \
	    -command { goto 0 }
#   .menubar.functions.menu.goto add command -label "Page Up" -underline 5 \
#	    -command { goto [expr [.trans.list yview] - $list_height] }
#   .menubar.functions.menu.goto add command -label "Page Down" -underline 5
    .menubar.functions.menu.goto add command -label "End" -underline 0 \
	    -command { goto [expr [.trans.list size] - $list_height] }

menu .menubar.functions.menu.cats
    .menubar.functions.menu.cats add command -label "Category List ..." \
	    -underline 0 -command { display_categories 0 }
    .menubar.functions.menu.cats add command -label "Add Default Categories" \
	    -underline 0 -command { import_default_cat 0 }

menu .menubar.functions.menu.reports
    .menubar.functions.menu.reports add command -label "Transaction List" \
	    -underline 0 -command { \
	            set rep_title "Transaction List"; \
	            rep_configure 0 }
    .menubar.functions.menu.reports add command -label "Txn List by Category" \
	    -underline 12 -command { \
	            set rep_title "Txn List by Category"; \
	            rep_configure 0 }
    .menubar.functions.menu.reports add command \
	    -label "Short List by Category" -underline 0 -command { \
	    	    set rep_title "Short List by Category"; \
	            rep_configure 0 }


tk_menuBar .menubar .menubar.file .menubar.edit .menubar.functions .menubar.help
tk_bindForTraversal .


#------------------------------------------------------------------------------
# File menu procedures
#------------------------------------------------------------------------------

# create a new account
proc new_acct 0 {
    global argv0 cur_file eng clean newacct_name newacct_desc

    spec_new_acct 0
    tkwait window .newacct

    if { "$newacct_name" != "" } {
	new_clear 0
	
	puts "Make Account $newacct_name - $newacct_desc"

	set cur_file $newacct_name
	wm title . "[file tail $argv0] - [file tail $cur_file]"
	wm iconname . "[file tail $argv0] - [file tail $cur_file]"

	# load/create the category file first ... make_acct assumes
	# a category file is already open.
	puts "Loading the category file [file dirname $cur_file]/categories"
	puts $eng "load_cats [file dirname $cur_file]/categories"
	flush $eng
	puts "Reading result"; gets $eng result; puts "Got result: $result"
	    
	if { "$result" == "error" } {
	    ok_mesg "Error opening ``[file dirname $cur_file]/categories''"
	    tkwait window .ok
	}

	# tell engine make the new account
	puts $eng "make_acct $newacct_name $newacct_desc"; flush $eng
	gets $eng result; puts "make_acct(): $result"

	if { "$result" == "error" } {
	    ok_mesg "Error creating ``$cur_file''"
	    tkwait window .ok
	}

	.status.line configure -text "Account Created -- $cur_file."
	update
	
	load_file $cur_file
	save_cbbrc 0
    }
}


# specify new account name & description
proc spec_new_acct 0 {
    global newacct_name newacct_desc

    set newacct_name ""
    set newacct_desc ""

    toplevel .newacct

    option add *font -adobe-helvetica-bold-r-normal-*-14-*-*-*-*-*-*-*
    wm title .newacct "Make Account"
    wm iconname .newacct "Make Account"
    frame .newacct.frame -borderwidth 2 -relief raised
    frame .newacct.frame.n
    frame .newacct.frame.d
    frame .newacct.frame.b

    label .newacct.frame.label -text "Enter New Account Name and Description"

    label .newacct.frame.n.label -text "New Acct"
    entry .newacct.frame.n.entry -textvariable newacct_name -relief sunken
    bind .newacct.frame.n.entry <Return> {focus .newacct.frame.d.entry}
    bind .newacct.frame.n.entry <Tab> {focus .newacct.frame.d.entry}
    bind .newacct.frame.n.entry <Shift-Tab> {focus .newacct.frame.d.entry}
    bind .newacct.frame.n.entry <Up> {focus .newacct.frame.d.entry}
    bind .newacct.frame.n.entry <Down> {focus .newacct.frame.d.entry}
    set_default_entry_bindings .newacct.frame.n.entry

    label .newacct.frame.d.label -text "Acct Description"
    entry .newacct.frame.d.entry -textvariable newacct_desc -relief sunken
    bind .newacct.frame.d.entry <Return> {focus .newacct.frame.n.entry}
    bind .newacct.frame.d.entry <Tab> {focus .newacct.frame.n.entry}
    bind .newacct.frame.d.entry <Shift-Tab> {focus .newacct.frame.n.entry}
    bind .newacct.frame.d.entry <Up> {focus .newacct.frame.n.entry}
    bind .newacct.frame.d.entry <Down> {focus .newacct.frame.n.entry}
    set_default_entry_bindings .newacct.frame.d.entry

    button .newacct.frame.b.create -text "Create Account" \
	    -command { destroy .newacct }
    button .newacct.frame.b.cancel -text "Cancel" \
	    -command { set newacct_name ""; set newacct_desc ""; \
	            destroy .newacct }

    pack .newacct.frame -fill both -expand 1
    pack .newacct.frame.label -fill both -expand 1
    pack .newacct.frame.n .newacct.frame.d .newacct.frame.b -fill both \
	    -expand 1
    pack .newacct.frame.n.label -side left
    pack .newacct.frame.n.entry -side left -fill x -expand 1
    pack .newacct.frame.d.label -side left
    pack .newacct.frame.d.entry -side left -fill x -expand 1
    pack .newacct.frame.b.create .newacct.frame.b.cancel -side left \
	    -fill x -expand 1

    focus .newacct.frame.n.entry 
}


proc new_clear 0 {
    global eng clean argv0 cur_file

    puts "beginning of new_clear"

    # clear our list box
    .trans.list delete 0 end

    # tell engine to clear transactions
    puts $eng "init_trans"; flush $eng
    gets $eng result; puts "init_trans(): $result"

    # tell engine to clear categories
    puts $eng "init_cats"; flush $eng
    gets $eng result; puts "init_cats(): $result"

    set cur_file "noname"
    wm title . "[file tail $argv0] - [file tail $cur_file]"
    wm iconname . "[file tail $argv0] - [file tail $cur_file]"

    clear_entry_area 0
}


proc load_acct 0 {
    global clean select_op select_mask select_result

    set select_op "Load Account"
    set select_mask .dir
    select_file 0
    tkwait window .select

    puts "After select: Load Account [file root $select_result]"

    if { "$select_result" != "" } {
	load_file [file root $select_result]
        save_cbbrc 0
    }
}

proc select_file 0 {
    global select_op select_mask select_result

    set select_result ""
    toplevel .select

    option add *font -adobe-helvetica-bold-r-normal-*-14-*-*-*-*-*-*-*
    wm title .select "$select_op ..."
    wm iconname .select "$select_op ..."
    frame .select.frame -borderwidth 2 -relief raised
    frame .select.frame.f -relief raised

    set pwd [pwd]
    set pwd_length [string length $pwd]
    # puts $pwd_length
    if { $pwd_length > 30 } {
        set tmp "..."
        append tmp [string range $pwd [expr $pwd_length - 27] $pwd_length]
        set pwd $tmp
    }

    label .select.frame.pwd -width 30 -text $pwd
    entry .select.frame.file -textvariable file_name -relief sunken
    set_default_entry_bindings .select.frame.file
    set file_name ""
    listbox .select.frame.f.list -geometry 30x10 \
    	    -yscrollcommand ".select.frame.f.scroll set"
    scrollbar .select.frame.f.scroll -command ".select.frame.f.list yview" \
    	    -relief sunken
    button .select.frame.load -text "$select_op <no file>" -command { \
	    if { "$file_name" != "" } { \
    	        set temp [pwd]; \
    	        append temp /; \
    	        append temp $file_name; \
	        set select_result $temp \
            }; \
	    destroy .select }
    button .select.frame.cancel -text Cancel -command { destroy .select }

    pack .select.frame -side top -fill both -expand 1
    pack .select.frame.pwd .select.frame.file .select.frame.f \
    	    -side top -fill both -expand 1
    pack .select.frame.load .select.frame.cancel -side left -fill x -expand 1
    pack .select.frame.f.list -side left -fill both -expand 1
    pack .select.frame.f.scroll -side left -anchor e -fill y -expand 1

    load_list .select $select_mask

    bind .select.frame.f.list <Double-Button> { \
    	    set choose [.select.frame.f.list get [.select.frame.f.list \
    	    	    curselection]]; \
            if { [file exists $choose] == 0 } {
                append choose $select_mask
            }
    	    set type [file type $choose]; \
    	    if { "$type" == "directory" } { \
    	        cd $choose; \
   	        set pwd [pwd]; \
    	        set pwd_length [string length $pwd]; \
    	        if { $pwd_length > 30 } { \
        	    set tmp "..."; \
        	    append tmp [string range $pwd [expr $pwd_length - 27] $pwd_length]; \
        	    set pwd $tmp; \
    		}; \
    	        load_list .select $select_mask; \
                .select.frame.pwd configure -text $pwd; \
                .select.frame.load configure -text "$select_op <no file>"; \
		set file_name "" \
            } else { \
	        if { "$select_mask" == "*" } { \
		    set file_name $choose; \
		} else { \
		    set file_name [file root $choose]; \
		}; \
                .select.frame.load configure -text "$select_op $file_name" \
	    } \
    }

    bind .select.frame.file <Leave> { \
        if { "$file_name" != "" } { \
            .select.frame.load configure -text "$select_op $file_name" \
        } else { \
	    .select.frame.load configure -text "$select_op <no file>" \
        } \
    }

    bind .select.frame.file <Return> { \
        if { "$file_name" != "" } { \
            .select.frame.load configure -text "$select_op $file_name"; \
    	    set temp [pwd]; \
    	    append temp /; \
    	    append temp $file_name; \
	    set select_result $temp; \
	    destroy .select; \
        } \
    }
}


proc load_list args {
    # load file names

    puts "loading new list"
    set arglist [split $args]
    set w [lindex $arglist 0]
    set mask [lindex $arglist 1]

    puts "Mask is $mask"
    $w.frame.f.list delete 0 end

    $w.frame.f.list insert end "../"

    foreach file [lsort [glob -nocomplain *]] {
    	set base [file tail $file]
    	set type [file type $file]
	# puts "$base = $type"
	# puts "$file / [file extension $file]"
    	if { "$type" == "directory" } {
            append base "/"
    	    $w.frame.f.list insert end "$base"
        } elseif { "$mask" == "*" } {
    	    $w.frame.f.list insert end "$base"
        } elseif { "[file extension $file]" == "$mask" } {
    	    $w.frame.f.list insert end [file root $base]
        }
    }
}

proc load_file file {
    global key eng date nicedate year month day check desc debit credit cat
    global nicecat com cleared total eng next_chk cur_date list_height 
    global cur_file clean argv0

    puts "ready to load $file"

    new_clear 0

    set cur_file $file

    wm title . "[file tail $argv0] - [file tail $file]"
    wm iconname . "[file tail $argv0] - [file tail $file]"
    # . configure -cursor watch
    .status.line configure -text "Loading transactions from [file tail $file]."
    update

    # load the transactions
    puts "Loading data file $file"
    puts $eng "load_trans $file"; flush $eng
    puts "Reading result"; gets $eng result; puts "Got result: $result"

    if { "$result" == "error" } {
        ok_mesg "Error opening ``$file''"
        tkwait window .ok
	set cur_file "noname"
	wm title . "[file tail $argv0] - $cur_file"
	wm iconname . "[file tail $argv0] - $cur_file"
	update
	return
    }

    puts $eng "all_trans"; flush $eng
    gets $eng result
    while { $result != "none" } {
        update_globals $result

        set cutdesc [string range $desc 0 14]
        set cutcom [string range $com 0 14]
        if { "$check" != "" } {
            set next_chk $check
        }
        # set cur_date $nicedate

        .trans.list insert end \
    	        [format "%5s  %-8s  %-15s  %9.2f  %9.2f  %-1s  %9.2f %14s" \
	        $check $nicedate $cutdesc $debit $credit $cleared $total $key]
        .trans.list insert end \
    	        [format "%5s  %-8s  %-15s  %-9s %39s" "" "" $cutcom $nicecat \
    	        	$key]
        gets $eng result
    }

    # set listbox view to end
    goto [expr [.trans.list size] - $list_height]
    clear_entry_area 0

    # . configure -cursor left_ptr

    # hash out the memorized transactions
    puts "Hashing memorized transactions"
    puts $eng "rehash_mems"; flush $eng
    puts "Reading result"; gets $eng result; puts "Got result: $result"

    # load the categories
    puts "Loading the category file $file"
    puts $eng "load_cats [file dirname $file]/categories"; flush $eng
    puts "Reading result"; gets $eng result; puts "Got result: $result"

    if { "$result" == "error" } {
        ok_mesg "Error opening ``[file dirname $file]/categories''"
        tkwait window .ok
    }

    set clean 1
}


# Select a file to import
proc import 0 {
    global clean import_type select_op select_mask select_result

    if { $import_type == 0 } {
	set select_op "CBB Import"
    } else { 
	set select_op "QIF Import"
    }
    set select_mask *
    select_file 0
    tkwait window .select

    puts "After select: $select_op [file root $select_result]"

    if { "$select_result" != "" } {
	import_file $select_result $import_type
    }
}

# Do the actual import
proc import_file args {
    global key eng date nicedate year month day check desc debit credit cat
    global nicecat com cleared total eng next_chk cur_date list_height 
    global cur_file clean

    set arglist [split $args]
    set file [lindex $arglist 0]
    set type [lindex $arglist 1]

    # clear out the old ... not any more
    # new_clear 0
    # set cur_file noname

    .status.line configure \
	    -text "Importing transactions from [file tail $file]."
    update

    puts "Importing data file $file"

    if { $type == 0 } {
	puts $eng "import_old_cbb $file"; flush $eng
	puts "Reading result"; gets $eng result; puts "Got result: $result"
    } elseif { $type == 1 } {
	puts $eng "import_qif $file"; flush $eng
	puts "Reading result"; gets $eng result; puts "Got result: $result"
    }

    puts $eng "all_trans"; flush $eng
    gets $eng result
    while { $result != "none" } {
        update_globals $result

        set cutdesc [string range $desc 0 14]
        set cutcom [string range $com 0 14]
        if { "$check" != "" } {
            set next_chk $check
        }
        # set cur_date $nicedate

        .trans.list insert end \
    	        [format "%5s  %-8s  %-15s  %9.2f  %9.2f  %-1s  %9.2f %14s" \
	        $check $nicedate $cutdesc $debit $credit $cleared $total $key]
        .trans.list insert end \
    	        [format "%5s  %-8s  %-15s  %-9s %39s" "" "" $cutcom $nicecat \
    	        	$key]
        gets $eng result
    }

    # set listbox view to end
    goto [expr [.trans.list size] - $list_height]
    clear_entry_area 0

    set clean 0
}


# export to an old CBB ".cbb" file
proc export_cbb 0 {
    global eng cur_file

    puts $eng "export_old_cbb $cur_file.cbb"; flush $eng
    gets $eng result

    ok_mesg "File exported to ``$cur_file.cbb'' ... Result = ``$result''"
    tkwait window .ok
}


# export to a quicken ".qif" file
proc export_qif 0 {
    global eng cur_file

    puts $eng "export_qif $cur_file.qif"; flush $eng
    gets $eng result

    ok_mesg "File exported to ``$cur_file.qif'' ... Result = ``$result''"
    tkwait window .ok
}


proc quit 0 {
    global clean

    exit
}


#------------------------------------------------------------------------------
# Help menu procedures
#------------------------------------------------------------------------------

proc display_about name {
    global version author_xbm lib_path

    option add *font "-adobe-new century schoolbook-bold-i-normal-*-14-*-*-*-*-*-*-*"
    
    toplevel .aboutwin

    wm title .aboutwin "About $name"
    wm iconname .aboutwin "About $name"
    frame .aboutwin.frame -borderwidth 2 -relief raised

    button .aboutwin.frame.but -bitmap @$lib_path/$author_xbm -relief ridge 
    label .aboutwin.frame.l1 -text "The wise man saves for the future ..."
    label .aboutwin.frame.l2 -text "... the fool spends everything he gets."
    label .aboutwin.frame.l3 -text "Proverbs 21:20"
    label .aboutwin.frame.l4 -text "``$name'' -- a Check Book Balancer for X"
    label .aboutwin.frame.l5 -text $version
    label .aboutwin.frame.l6 -text "Copyright (C) 1994  Curtis L. Olson"
    button .aboutwin.dismiss -text Dismiss -command "destroy .aboutwin" \
	    -font -adobe-helvetica-bold-r-normal-*-14-*-*-*-*-*-*-*

    pack .aboutwin.frame -side top -fill both -expand 1
    pack .aboutwin.frame.but -padx 4 -pady 4 -side left -fill both -expand 1
    pack .aboutwin.frame.l1 .aboutwin.frame.l2 .aboutwin.frame.l3 \
	    .aboutwin.frame.l4 .aboutwin.frame.l5 \
	    .aboutwin.frame.l6 \
    	    -ipadx 4m -side top -fill both -expand 1
    pack .aboutwin.dismiss -side bottom -fill x
}


proc display_src 0 {
    global csh_src lib_path

    option add *font "-adobe-new century schoolbook-bold-i-normal-*-14-*-*-*-*-*-*-*"
    
    toplevel .srcwin

    wm title .srcwin "View Source :-)"
    wm iconname .srcwin "View Source"
    frame .srcwin.frame -borderwidth 2 -relief raised
    frame .srcwin.framed -borderwidth 2 -relief raised
    pack .srcwin.frame .srcwin.framed -side top -fill both -expand 1

    listbox .srcwin.frame.l -geometry 35x15 \
	 -yscrollcommand ".srcwin.frame.s set"
    pack .srcwin.frame.l -side left -fill both -expand 1

    scrollbar .srcwin.frame.s -command ".srcwin.frame.l yview" -relief sunken
    pack .srcwin.frame.s -side left -fill y -expand 1

    button .srcwin.framed.dismiss -text "Dismiss" \
	-command { destroy .srcwin }
    pack .srcwin.framed.dismiss -side top -fill x -expand 1
    set f [open $lib_path/$csh_src r]

    while { [gets $f line] >= 0 } {
	.srcwin.frame.l insert end $line
    }
}


#------------------------------------------------------------------------------
# Setup headers
#------------------------------------------------------------------------------

label .head.line1 -font -adobe-courier-bold-r-*-*-14-*-*-*-*-*-*-* \
	-text [format "%5s  %-8s  %-15s  %9s  %9s  %1s  %9s" \
	"Chk #" "Date" "Description" "Debit" "Credit" "" "Total"] \
	-padx 5 -pady -1
label .head.line2 -font -adobe-courier-bold-r-*-*-14-*-*-*-*-*-*-* \
	-text [format "%5s  %-8s  %-15s  %-9s" \
	"" "" "Comment" "Category"] -padx 4 -pady -1
pack .head.line1 -side top -anchor w
pack .head.line2 -side top -anchor w


#------------------------------------------------------------------------------
# Setup the transaction listbox and scrollbar
#------------------------------------------------------------------------------

listbox .trans.list -geometry [format "%sx%s" $list_width $list_height] \
	 -yscrollcommand ".trans.scroll set" \
	 -font -adobe-courier-medium-r-*-*-14-*-*-*-*-*-*-*
bind .trans.list <Double-Button> \
	{update_entry_area [.trans.list curselection] }
pack .trans.list -side left -fill both -expand 1

scrollbar .trans.scroll -command ".trans.list yview" -relief sunken
pack .trans.scroll -side right -fill y -expand 1


#------------------------------------------------------------------------------
# Setup the entry area
#------------------------------------------------------------------------------

option add *font -adobe-courier-medium-r-*-*-14-*-*-*-*-*-*-*

frame .entry.line1 
frame .entry.line2
pack .entry.line1 -side top -fill x -expand 1
pack .entry.line2 -side top -fill x -expand 1

entry .entry.line1.check -relief sunken -width 5 -textvariable check
entry .entry.line1.date -width 8 -relief sunken -textvariable nicedate
entry .entry.line1.desc -width 15 -relief sunken -textvariable desc
entry .entry.line1.debit -width 9 -relief sunken -textvariable debit
entry .entry.line1.credit -width 9 -relief sunken -textvariable credit
entry .entry.line1.clear -width 1 -relief sunken -textvariable cleared

pack .entry.line1.check -padx 4 -side left
pack .entry.line1.date -padx 9 -side left
pack .entry.line1.desc -padx 2 -side left
pack .entry.line1.debit -padx 10 -side left
pack .entry.line1.credit -padx 2 -side left
pack .entry.line1.clear -padx 10 -side left

label .entry.line2.space -width 15 -padx 8
entry .entry.line2.com -width 15 -relief sunken -textvariable com
entry .entry.line2.cat -width 9 -relief sunken -textvariable cat

pack .entry.line2.space -side left
pack .entry.line2.com -side left
pack .entry.line2.cat -padx 12 -side left


#------------------------------------------------------------------------------
# Setup field tabbing and binding
#------------------------------------------------------------------------------

proc setup_default_tabbing 0 {
    global tabList desc add_cat

    set tabList { .entry.line1.check .entry.line1.date .entry.line1.desc \
	    .entry.line1.debit .entry.line1.credit .entry.line2.com \
	    .entry.line2.cat .entry.line1.clear }
    foreach field $tabList {
        bind $field <Return> {done_entering 0}
	if { "$field" == ".entry.line1.desc" } {
	    bind $field <Tab> { \
	    	    if { [expr ($no_more_mem == 0) && ($use_mems == 1)] } { \
		        puts $eng "find_mem $desc"; flush $eng; \
	                gets $eng result; \
		        puts $result; \
		        if { "$result" != "none" } {
		            update_from_mem $result; \
		            set no_more_mem 1; \
		        }; \
		    }; \
		    tab $tabList; \
		}
	    bind $field <Meta-Tab> {tab $tabList; set no_more_mem 1}
	} elseif { "$field" == ".entry.line2.cat" } {
	    bind $field <Tab> { \
                if { "[string range $cat 0 0]" != "|" } { \
                    puts $eng "find_cat $cat"; flush $eng; \
                    gets $eng result; \
                    if { "$result" != "none" } { \
                        set cat $result; \
                    } elseif { "$cat" != "" } { \
		        set add_cat $cat; \
                        add_new_cat 0; \
                        tkwait window .newcat; \
                    }; \
                }; \
		tab $tabList; \
            }
	    bind $field <Meta-Tab> {tab $tabList}
	} else {
	    bind $field <Tab> {tab $tabList}
	    bind $field <Meta-Tab> {tab $tabList}
        }
        bind $field <Shift-Tab> {shifttab $tabList}
        bind $field <Meta-Shift-Tab> {shifttab $tabList}
	set_default_entry_bindings $field
    }
}

proc tab list {
    set i [lsearch -exact $list [focus]]
    incr i
    if {$i >= [llength $list]} {
        set i 0
    }
    focus [lindex $list $i]
    tk_entrySeeCaret [focus]
    return [lindex $list $i]
}

proc shifttab list {
    set i [lsearch -exact $list [focus]]
    set i [expr $i - 1]
    if {$i < 0} {
	set i [expr [llength $list] - 1]
    }
    focus [lindex $list $i]
    tk_entrySeeCaret [focus]
    return [lindex $list $i]
}

bind .entry.line1.check + {set check [inc_check $check]}
bind .entry.line1.check = {set check [inc_check $check]}

bind .entry.line1.check - {set check [dec_check $check]}
bind .entry.line1.check _ {set check [dec_check $check]}

bind .entry.line1.date + {set nicedate [inc_date $nicedate]}
bind .entry.line1.date = {set nicedate [inc_date $nicedate]}

bind .entry.line1.date - {set nicedate [dec_date $nicedate]}
bind .entry.line1.date _ {set nicedate [dec_date $nicedate]}


#------------------------------------------------------------------------------
# Functions for entry area
#------------------------------------------------------------------------------

proc update_globals result {
    global key eng date nicedate year month day check desc debit credit cat
    global nicecat com cleared total

    set date ""; set year ""; set month ""; set day ""; set check ""
    set desc ""; set debit 0.00; set credit 0.00; set cat ""; set nicecat ""
    set com ""; set cleared ""; set total 0.00

    set pieces [split $result :]
    set key [lindex $pieces 0]
    set date [lindex $pieces 1]
    if { [string length $date] == 6 } {
	set year "19[string range $date 0 1]"
	set month [string range $date 2 3]
	set day [string range $date 4 5]
    } else {
	set year [string range $date 0 3]
	set month [string range $date 4 5]
	set day [string range $date 6 7]
    }
    set nicedate "$month/$day/[string range $year 2 3]"
    set check [lindex $pieces 2]
    set desc [lindex $pieces 3]
    scan [lindex $pieces 4] "%f" debit
    scan [lindex $pieces 5] "%f" credit
    set debit [format "%.2f" $debit]; 
    set credit [format "%.2f" $credit]; 
    set cat [lindex $pieces 6]
    if { [string range $cat 0 0] == "|" } {
        set nicecat "-Splits-"
    } else {
    	set nicecat $cat
    }
    set nicecat [string range $nicecat 0 8]
    set com [lindex $pieces 7]
    set cleared [lindex $pieces 8]
    scan [lindex $pieces 9] "%f" total
}

# given a memorized transaction, update the relevant fields
proc update_from_mem result {
    global eng desc debit credit cat
    global nicecat com 

    set desc ""; set debit 0.00; set credit 0.00; set cat ""; set nicecat ""
    set com ""; 

    set pieces [split $result :]
    set desc [lindex $pieces 3]
    scan [lindex $pieces 4] "%f" debit
    scan [lindex $pieces 5] "%f" credit
    set cat [lindex $pieces 6]
    if { [string range $cat 0 0] == "|" } {
        set nicecat "-Splits-"
    } else {
    	set nicecat $cat
    }
    set nicecat [string range $nicecat 0 8]
    set com [lindex $pieces 7]

    set debit [format "%.2f" $debit]; 
    set credit [format "%.2f" $credit]; 
}

proc find_index_from_key args {
    # given a newkey, return the index of the first affected transaction

    set arglist [split $args]
    set index1 [lindex $arglist 0]
    set newkey [lindex $arglist 1]

    set line [.trans.list get $index1]
    set key [string range $line 72 end]

    if { [string compare "$newkey" "$key"] == -1 } {
	# we changed the date to something previous
	while { [expr [string compare "$newkey" "$key"] == -1 && $index1 > 0]} {
	    set index1 [expr $index1 - 2]
            set line [.trans.list get $index1]
            set key [string range $line 72 end]
	}
	return [expr $index1]
    } else {
	# we changed the date to something forward or this is the trivial case
	return [expr $index1 - 2]
    }
}

proc update_rest args {
    global key eng date nicedate year month day check desc debit credit cat
    global nicecat com cleared total selected next_chk cur_date

    set arglist [split $args]
    set index1 [lindex $arglist 0]
    set newkey [lindex $arglist 1]

    puts "update_rest: $index1 $newkey"

    # delete everything from the change forward, then rebuild our list from 
    # there

    set index1 [find_index_from_key $index1 $newkey]
    if { [expr $index1 < 0] } {
        set index1 0
    }
    set index2 [expr $index1 + 1]

    puts "deleting from:  $index1 to end"

    set line [.trans.list get $index1]
    set key [string range $line 72 end]
    .trans.list delete $index1 end
 
    puts [string range $line 70 end]
    puts "adding entries from $key to end"

    if { $index1 == 0 } {
    	puts $eng "first_trans"; flush $eng
    } else {
        puts $eng "find_trans $key"; flush $eng
    }
    gets $eng result
    while { $result != "none" } {
        update_globals $result

        set cutdesc [string range $desc 0 14]
        set cutcom [string range $com 0 14]

        .trans.list insert end \
               [format "%5s  %-8s  %-15s  %9.2f  %9.2f  %-1s  %9.2f %14s" \
               $check $nicedate $cutdesc $debit $credit $cleared $total $key]
        .trans.list insert end \
               [format "%5s  %-8s  %-15s  %-9s %39s" "" "" $cutcom $nicecat \
               		$key]

        # try keep the selection with the original transaction
        if { $key == $newkey } {
            set selected [expr [.trans.list size] - 2]
	    .trans.list select from $selected
	    .trans.list select to $selected

    	    if { "$check" != "" } {
        	set next_chk $check
    	    }
    	    set cur_date $nicedate
        }

        puts $eng "next_trans"; flush $eng
        gets $eng result
    }
}


proc update_line args {
    global key eng date nicedate year month day check desc debit credit cat
    global nicecat com cleared total selected next_chk cur_date

    set arglist [split $args]
    set index1 [lindex $arglist 0]
    set key [lindex $arglist 1]

    puts "update_line: $index1 $key"

    # delete trans and re-insert

    set index2 [expr $index1 + 1]

    puts "deleting from:  $index1 to $index2"

    set line [.trans.list get $index1]
    set key [string range $line 72 end]
    .trans.list delete $index1 $index2
 
    puts "re-inserting entry"

    puts $eng "find_trans $key"; flush $eng
    gets $eng result

    update_globals $result

    set cutdesc [string range $desc 0 14]
    set cutcom [string range $com 0 14]

    .trans.list insert $index1 \
           [format "%5s  %-8s  %-15s  %9.2f  %9.2f  %-1s  %9.2f %14s" \
           $check $nicedate $cutdesc $debit $credit $cleared $total $key]
    .trans.list insert $index2 \
           [format "%5s  %-8s  %-15s  %-9s %39s" "" "" $cutcom $nicecat $key]
}


proc clear_entry_area 0 {
    global key eng date nicedate year month day check desc debit credit cat
    global nicecat com cleared total cur_date no_more_mem

    set key ""; set date ""; set year ""; set month ""; set day ""
    set check ""; set desc ""; set debit 0.00; set credit 0.00; set cat ""
    set nicecat ""; set com ""; set cleared ""; set total 0.00

    if { "$cur_date" != "" } {
    	set nicedate $cur_date
    } else {
        # set nicedate [fmtclock [getclock] "%m/%d/%y"]
    	puts $eng "nice_date"; flush $eng
    	gets $eng nicedate
    }
    # set date [fmtclock [getclock] "%Y%m%d"]
    puts $eng "raw_date"; flush $eng
    gets $eng date

    puts $nicedate
    puts $date

    set no_more_mem 0

    focus .entry.line1.check
}

proc update_entry_area line {
    global key eng date nicedate year month day check desc debit credit cat
    global nicecat com cleared total index1 index2 selected no_more_mem
    global add_cat

    set no_more_mem 1

    set selected $line

    set item [lindex $line 0]

    if { [expr $item / 2.0] == [expr $item / 2] } {
	set index1 $item
	set index2 [expr $item + 1]
    } else {
	set index1 [expr $item - 1]
	set index2 $item
    }

    set line [.trans.list get $index1]
    set key [string range $line 72 end]

    puts $eng "find_trans $key"; flush $eng
    gets $eng result
    # puts $result

    if { $result != "none" } {
    	update_globals $result
    }

    focus .entry.line1.check
}


proc done_entering 0 {
    global key eng date nicedate year month day check desc debit credit cat
    global nicecat com cleared total index1 index2 selected list_height clean
    global cur_file add_cat
    puts "Done entering ..."

    # check for a valid file
    if { "$cur_file" == "noname" } {
	ok_mesg "You must Make or Load an Account First."
	tkwait window .ok
	return
    } elseif { "$cur_file" == ""} {
	ok_mesg "You must Make or Load an Account First."
	tkwait window .ok
	return
    }

    # we now have something to save
    set clean 0

    # do some consistency checking here

    # pad date if needed
    set pieces [split $nicedate /]
    set month [lindex $pieces 0]
    set day [lindex $pieces 1]
    set year [lindex $pieces 2]
    set month [pad $month]
    set day [pad $day]
    set year [pad $year]
    if { [string length $year] == 2 } {
	set year 19$year
    }
    puts "$month/$day/$year"
    set nicedate "$month/$day/$year"

    if { "[string range $cat 0 0]" != "|" } {
        # if not a split, try to match category
        puts $eng "find_cat $cat"; flush $eng
        gets $eng result
        if { "$result" != "none" } {
            set cat $result
        } elseif { "$cat" == "" } {
	    ok_mesg "No category was specified."
	    tkwait window .ok
	} else {
	    set add_cat $cat
            add_new_cat 0
            tkwait window .newcat
        }
    }

    # verify cleared field
    set cleared [string range $cleared 0 0]
    if { "$cleared" == "x" } {
        # ok
    } elseif { "$cleared" == "*" } {
        # ok
    } elseif { "$cleared" == "" } {
        # ok 
    } else {
        set cleared ""
    }

    set orig_sel $selected

    if { "$key" == "" } {
    	# new entry ... insert
	if { "[string range $cat 0 0]" == "\[" } {
	    # transfer transaction
	    puts $eng "create_xfer $year$month$day:$check:$desc:$debit:$credit:$cat:$com:$cleared:0.00"
	} else {
	    # normal transaction
	    puts $eng "create_trans $year$month$day:$check:$desc:$debit:$credit:$cat:$com:$cleared:0.00"
	}
        flush $eng
        gets $eng result
        puts "result:  create_trans $result"

        register_undo "insert $result"

	update_rest [.trans.list size] [string range $result 0 10]
    } else {
	if { "[string range $cat 0 0]" == "\[" } {
	    ok_mesg "You have edited a ``Transfer'' transaction.  The corresponding transaction in the file ``$cat'' cannot currently be changed.  You must do this manually."
	    tkwait window .ok
	}

        # first record the official version of this transaction so we can be
        # able to undelete it later
        puts $eng "find_trans $key"; flush $eng
        gets $eng origresult

        # updating an existing entry
        puts $eng "update_trans $key:$year$month$day:$check:$desc:$debit:$credit:$cat:$com:$cleared:0.00"
        flush $eng
        gets $eng result

	if { "$index1" == "" } {
	    set index1 [.trans.list size]
	}
	update_rest $index1 [string range $result 0 10]
        register_undo "edit [string range $result 0 10]:$origresult"
    }

    # try keep the entry area in sync with the selection
    if { $selected != $orig_sel } {
    	set orig_sel [expr $selected - ($list_height / 2)]
    	if { $orig_sel < 0 } {
    	    set orig_sel 0
        } elseif { $orig_sel > [expr [.trans.list size] - $list_height] } {
            set orig_sel [expr [.trans.list size] - $list_height]
        }
        goto $orig_sel
    }
    clear_entry_area 0
}

proc inc_check check {
    global next_chk

    if { "$check" == "" } {
	set check $next_chk
    }

    return [expr int($check) + 1]
}

proc dec_check check {
    global next_chk

    if { "$check" == "" } {
	set check $next_chk
    }

    if { [expr $check > 1] } {
        return [expr int($check) - 1]
    } else {
        return 1
    }
}

proc pad num {
    set num [expr int($num)]
    if { [expr $num >= 0 && $num <= 9] } {
	return "0$num"
    } else {
	return $num
    }
}


proc inc_date nicedate {

    if { "$nicedate" == "" } {
	set nicedate "01/01/01"
    }

    set pieces [split $nicedate /]
    set month [expr int([lindex $pieces 0])]
    set day [expr int([lindex $pieces 1])]
    set year [expr int([lindex $pieces 2])]
    if { [string length $year] == 2 } {
	set year "19$year"
    }

    set day [incr day]

    if {$day > 31} {
	set day 1
	set month [incr month]
    }

    if {$month > 12} {
	set month 1
	set year [incr year]
    }

    if {$year > 9999} {
	set year 0
    }

    return "[pad $month]/[pad $day]/[string range [pad $year] 2 3]"
}

proc dec_date nicedate {

    if { "$nicedate" == "" } {
        set nicedate "01/01/01"
    }

    set pieces [split $nicedate /]
    set month [expr int([lindex $pieces 0])]
    set day [expr int([lindex $pieces 1])]
    set year [expr int([lindex $pieces 2])]
    if { [string length $year] == 2 } {
	set year "19$year"
    }

    set day [expr $day - 1]

    if {$day < 1} {
        set day 31
        set month [expr int($month - 1)]
    }

    if {$month < 1} {
        set month 12
        set year [expr $year - 1]
    }

    if {$year < 0} {
	set year 99
    }

    return "[pad $month]/[pad $day]/[string range [pad $year] 2 3]"
}


proc set_default_entry_bindings field {
    # set default entry widget bindings for specified field
    # this will allow easy modification for different sets of key bindings

    bind $field <Left> {move_left 1}
    bind $field <Control-b> {move_left 1}
    bind $field <Right> {move_right 1}
    bind $field <Control-f> {move_right 1}
    bind $field <Control-a> {move_home 0}
    bind $field <Control-e> {move_end 0}
    bind $field <Control-d> {delete_char 0}
    bind $field <Control-k> {delete_to_end 0}
}


proc move_left num {
    # move the insertion point left num positions

    set w [focus]

    # puts "left in $w at [$w index insert]"
    $w icursor [expr [$w index insert] - $num]
    tk_entrySeeCaret $w
}


proc move_right num {
    # move the insertion point right num positions

    set w [focus]

    # puts "right in $w at [$w index insert]"
    $w icursor [expr [$w index insert] + $num]
    tk_entrySeeCaret $w
}


proc move_home 0 {
    # move the insertion point home to the beginning

    set w [focus]

    $w icursor 0
    tk_entrySeeCaret $w
}


proc move_end 0 {
    # move the insertion point home to the beginning

    set w [focus]

    $w icursor end
    tk_entrySeeCaret $w
}


proc delete_to_end 0 {
    # delete the next character after the insertion point

    set w [focus]
    $w delete [$w index insert] end
    tk_entrySeeCaret $w
}


proc delete_char 0 {
    # delete the next character after the insertion point

    set w [focus]
    $w delete [$w index insert]
    tk_entrySeeCaret $w
}


proc delete_trans item {
    global clean eng cat

    set clean 0

    if { [expr $item / 2.0] == [expr $item / 2] } {
	set index1 $item
	set index2 [expr $item + 1]
    } else {
	set index1 [expr $item - 1]
	set index2 $item
    }

    set line [.trans.list get $index1]
    set key [string range $line 72 end]

    # first record the official version of this transaction so we can be
    # able to undelete it later
    puts $eng "find_trans $key"; flush $eng
    gets $eng result
    update_globals $result
    register_undo "delete $result"

    if { "[string range $cat 0 0]" == "\[" } {
	ok_mesg "You are deleting a ``Transfer'' transaction.  The corresponding transaction in the file ``$cat'' cannot currently be deleted.  You must do this manually."
	tkwait window .ok
    }

    puts $eng "delete_trans $key"; flush $eng
    gets $eng result
    puts "deleting:  $result"

    # .trans.list delete $index1 $index2
    update_rest $index1 $key

    clear_entry_area 0
}


#------------------------------------------------------------------------------
# Procedures to handle undo functionality
#------------------------------------------------------------------------------

proc init_undo 0 {
    global undo_command undo_data

    set undo_command ""
    set undo_data ""
}

proc register_undo arg {
    global undo_command undo_data

    set pos [string first " " $arg]
    set undo_command [string range $arg 0 [expr $pos - 1]]
    set undo_data [string range $arg [expr $pos + 1] end]
}

proc undo 0 {
    global undo_command undo_data key eng

    puts "un$undo_command $undo_data"

    if { "$undo_command" == "delete" } {
    	# reinsert

        update_globals $undo_data
        set key ""
        done_entering 0
    } elseif { "$undo_command" == "insert" } {
        # delete

    	set pos [string first : $undo_data]
        set key [string range $undo_data 0 [expr $pos - 1]]

        puts $eng "delete_trans $key"; flush $eng
        gets $eng result
        puts "deleting:  $result"

        set index1 [find_index_from_key [.trans.list size] $key]
        if { [expr $index1 < 0] } {
            set index1 0
        }
        update_rest $index1 $key
    } elseif { "$undo_command" == "edit" } {
        # change back

	set newkey [string range $undo_data 0 10]
	puts "first need to delete $newkey"
	puts $eng "delete_trans $newkey"; flush $eng
	gets $eng result
	puts "deleting:  $result"

	set index1 [find_index_from_key [.trans.list size] $newkey]
	if { [expr $index1 < 0] } {
	    set index1 0
	}
	update_rest $index1 $newkey

        update_globals [string range $undo_data 10 end]
        done_entering 0
    } else {
        ok_mesg "Nothing to undo  :-("
        tkwait window .ok
    }

    init_undo 0
    clear_entry_area 0
}


#------------------------------------------------------------------------------
# Setup the command bar
#------------------------------------------------------------------------------

option add *font -adobe-helvetica-bold-r-normal-*-14-*-*-*-*-*-*-*
button .bar.new -text "New" -command { clear_entry_area 0 }
button .bar.edit -text "Edit" \
	-command { \
	        if { "[.trans.list curselection]" != "" } { \
                    update_entry_area [.trans.list curselection] \
                } \
        }
button .bar.delete -text "Delete" \
	-command { \
	        if { "[.trans.list curselection]" != "" } { \
                    delete_trans [.trans.list curselection] \
                } \
        } 
button .bar.splits -text "Open Splits" -command { open_splits 0; \
						  tkwait window .splits; \
						  setup_default_tabbing 0 }
button .bar.balance -text "Balance" -command { balance 0 }

pack .bar.new .bar.edit .bar.delete .bar.splits .bar.balance -side left \
	-fill x -expand 1

#------------------------------------------------------------------------------
# Setup the status line
#------------------------------------------------------------------------------

label .status.line -text "Welcome to [file tail $argv0]" \
	-font -adobe-helvetica-bold-r-normal-*-14-*-*-*-*-*-*-*
pack .status.line -fill both -expand 1


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

proc open_splits 0 {
    global desc cat credit debit max_splits cats amts tabList

    option add *font -adobe-courier-medium-r-*-*-14-*-*-*-*-*-*-*

    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 { $debit > 0 } {
        label .splits.frame.head \
		-text "[string range $desc 0 14] \
		       [format "%.2f" [expr -1 * $debit]]"
    } else {
        label .splits.frame.head \
		-text "[string range $desc 0 14] [format "%.2f" $credit]"
    }
    pack .splits.frame.head -anchor w -fill x -expand 1

    # puts $cat
    set pieces [split $cat |]

    set i 0
    while { $i < $max_splits } {
	frame .splits.frame.line$i

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

	bind .splits.frame.line$i.cat$i <Any-Button> { puts noclick }
	bind .splits.frame.line$i.amt$i <Any-Button> { puts noclick }

	set cats($i) [lindex $pieces [expr 1 + $i * 2]]
	set amts($i) [lindex $pieces [expr 2 + $i * 2]]
	pack .splits.frame.line$i -side top
	pack .splits.frame.line$i.cat$i .splits.frame.line$i.amt$i -side left
	incr i
    }

    # setup tabbing for splits window
    set tabList {}
    set i 0
    while { $i < $max_splits } {
        lappend tabList .splits.frame.line$i.cat$i .splits.frame.line$i.amt$i
	incr i
    }
    foreach field $tabList {
        bind $field <Return> { \
		set field [tab $tabList]; \
		set pos [string last cat $field]; \
		if { $pos != -1 } { \
		    set text "Sum = [sum_splits 0]"; \
		    .splits.frame.total configure -text $text; \
		} else { \
		    set pos [string last amt $field]; \
		    set cur_split [string range $field [expr $pos + 3] end]; \
        	    puts $eng "find_cat $cats($cur_split)"; flush $eng; \
        	    gets $eng result; \
        	    if { "$result" != "none" } { \
            		set cats($cur_split) $result; \
		    } elseif { "$cats($cur_split)" == "" } { \
		    } else { \
		        set add_cat $cats($cur_split); \
		        add_new_cat 0; \
			tkwait window .newcat; \
        	    }; \
		    puts "Leaving $cur_split --> $cats($cur_split)"; \
		}; \
	}
        bind $field <Tab> { \
		set field [tab $tabList]; \
		set pos [string last cat $field]; \
		if { $pos != -1 } { \
		    set text "Sum = [sum_splits 0]"; \
		    .splits.frame.total configure -text $text; \
		} else { \
		    set pos [string last amt $field]; \
		    set cur_split [string range $field [expr $pos + 3] end]; \
        	    puts $eng "find_cat $cats($cur_split)"; flush $eng; \
        	    gets $eng result; \
        	    if { "$result" != "none" } { \
            		set cats($cur_split) $result; \
		    } elseif { "$cats($cur_split)" == "" } { \
		    } else { \
		        set add_cat $cats($cur_split); \
		        add_new_cat 0; \
			tkwait window .newcat; \
        	    }; \
		    puts "Leaving $cur_split --> $cats($cur_split)"; \
		}; \
	}
        bind $field <Shift-Tab> { \
		set field [shifttab $tabList]; \
		set pos [string last cat $field]; \
		if { $pos != -1 } { \
		    set text "Sum = [sum_splits 0]"; \
		    .splits.frame.total configure -text $text; \
		} else { \
		    set pos [string last amt $field]; \
		    set cur_split [string range $field [expr $pos + 3] end]; \
		    set cur_split [expr ($cur_split + 1) %% $max_splits]; \
        	    puts $eng "find_cat $cats($cur_split)"; flush $eng; \
        	    gets $eng result; \
        	    if { "$result" != "none" } { \
            		set cats($cur_split) $result; \
		    } elseif { "$cats($cur_split)" == "" } { \
		    } else { \
		        set add_cat $cats($cur_split); \
		        add_new_cat 0; \
			tkwait window .newcat; \
        	    }; \
		    puts "Leaving $cur_split --> $cats($cur_split)"; \
		}; \
	}
        set_default_entry_bindings $field
    }

    label .splits.frame.total -borderwidth 2 -relief raised \
    	    -text "Sum = [sum_splits 0]"
    pack .splits.frame.total -side top -fill x -expand 1

    button .splits.frame.dismiss -text " Dismiss " -command { \
	    set i 0; \
            set cat |; \
            while { $i < $max_splits } { \
	        if { "$amts($i)" != "" } { \
		    append cat $cats($i) | [format "%.2f" $amts($i)] |; \
                } ; \
                incr i; \
            }; \
	    destroy .splits; }
    pack .splits.frame.dismiss -fill x -expand 1

    focus .splits.frame.line0.cat0
    update
}


proc sum_splits 0 {
    global debit credit max_splits amts

    # set total [expr -1 * ($debit + $credit)]
    set total 0
    set i 0
    while { $i < $max_splits } {
        set amount $amts($i)
	if { "$amount" != "" } {
	    # puts "$i $amount"
	    set total [expr $total + $amount]
	}
        incr i
    }

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


#------------------------------------------------------------------------------
# Procedures for balancing
#------------------------------------------------------------------------------

proc balance 0 {
    global key eng date nicedate year month day check desc debit credit cat
    global nicecat com cleared total state_start state_end debits credits diff

    set debits 0.00
    set credits 0.00
    set diff [calc_diff 0]

    toplevel .bal
    
    option add *font -adobe-helvetica-bold-r-normal-*-14-*-*-*-*-*-*-*

    wm title .bal "Balance ..."
    wm iconname .bal "Balance ..."
    frame .bal.frame -borderwidth 2 -relief raised
    frame .bal.frame.head1 -relief raised
    frame .bal.frame.head2 -relief raised
    frame .bal.frame.head3 -relief raised
    frame .bal.frame.f -relief raised
    frame .bal.frame.bar -relief sunken

    label .bal.frame.head1.label -text "Statement Starting Balance = "
    entry .bal.frame.head1.entry -textvariable state_start -relief sunken
        bind .bal.frame.head1.entry <Return> {focus .bal.frame.head2.entry}
        bind .bal.frame.head1.entry <Tab> {focus .bal.frame.head2.entry}
        bind .bal.frame.head1.entry <Shift-Tab> {focus .bal.frame.head2.entry}
        bind .bal.frame.head1.entry <Up> {focus .bal.frame.head2.entry}
        bind .bal.frame.head1.entry <Down> {focus .bal.frame.head2.entry}
        set_default_entry_bindings .bal.frame.head1.entry 
    label .bal.frame.head2.label -text "Statement Ending Balance = "
    entry .bal.frame.head2.entry -textvariable state_end -relief sunken
        bind .bal.frame.head2.entry <Return> {focus .bal.frame.head1.entry}
        bind .bal.frame.head2.entry <Tab> {focus .bal.frame.head1.entry}
        bind .bal.frame.head2.entry <Shift-Tab> {focus .bal.frame.head1.entry}
        bind .bal.frame.head2.entry <Up> {focus .bal.frame.head1.entry}
        bind .bal.frame.head2.entry <Down> {focus .bal.frame.head1.entry}
        bind .bal.frame.head2.entry <Right> {move_right 1}
        set_default_entry_bindings .bal.frame.head2.entry 
    label .bal.frame.head3.label \
    	    -text "Debits = $debits  Credits = $credits  Difference = $diff"

    listbox .bal.frame.f.list -geometry 47x15 \
	    -yscrollcommand ".bal.frame.f.scroll set" \
	    -font -adobe-courier-medium-r-*-*-14-*-*-*-*-*-*-*
    scrollbar .bal.frame.f.scroll -command ".bal.frame.f.list yview" -relief sunken

    button .bal.frame.bar.update -text "Update" -command { \
	    update_selected .bal.frame.f.list; \
	    destroy .bal; \
        }
    button .bal.frame.bar.dismiss -text "Dismiss" -command "destroy .bal"

    pack .bal.frame -side top -fill both -expand 1
    pack .bal.frame.head1 -side top -fill both -expand 1
    pack .bal.frame.head2 -side top -fill both -expand 1
    pack .bal.frame.head3 -side top -fill both -expand 1
    pack .bal.frame.f -side top -fill both -expand 1
    pack .bal.frame.bar -side top -fill both -expand 1

    pack .bal.frame.head1.label .bal.frame.head1.entry -side left -anchor w
    pack .bal.frame.head2.label .bal.frame.head2.entry -side left -anchor w
    pack .bal.frame.head3.label -side top -anchor w
    pack .bal.frame.f.list -side left -fill both -expand 1
    pack .bal.frame.f.scroll -side left -fill y -expand 1
    pack .bal.frame.bar.update .bal.frame.bar.dismiss -side left -fill x -expand 1

    # get the statement starting balance
    puts $eng "get_cleared_bal"; flush $eng
    gets $eng state_start

    # load the list
    puts $eng "first_uncleared_trans"; flush $eng
    gets $eng result
    while { $result != "none" } {
        update_globals $result

	if { $debit > 0 } {
	    set amt [expr -1.0 * $debit]
	} else {
	    set amt $credit
	}
	set cutdesc [string range $desc 0 14]

        puts $eng "get_current_index"; flush $eng
        gets $eng index
	
        .bal.frame.f.list insert end [format "%1s %5s %8s %-15s %12.2f   %-9s %5s"\
        	$cleared $check $nicedate $cutdesc $amt $key $index]

        if { "$cleared" == "*" } {
	    if { $debit > 0 } {
	        set debits [expr $debits + $debit]
	    } else {
	        set credits [expr $credits + $credit]
	    }
        }

        puts $eng "next_uncleared_trans"; flush $eng
        gets $eng result
    }

    # avoid something like 6.5999999999999
    set debits [format "%.2f" $debits]
    set credits [format "%.2f" $credits]

    bind .bal.frame.head1.entry <Leave> { \
        set diff [calc_diff 0]; \
        .bal.frame.head3.label configure \
    	     -text "Debits = $debits  Credits = $credits  Difference = $diff"; \
    }

    bind .bal.frame.head2.entry <Leave> { \
        set diff [calc_diff 0]; \
        .bal.frame.head3.label configure \
    	     -text "Debits = $debits  Credits = $credits  Difference = $diff"; \
    }

    bind .bal.frame.f.list <Double-Button> { \
        update_bal_list .bal.frame.f.list [.bal.frame.f.list curselection]; \
        set diff [calc_diff 0]; \
        .bal.frame.head3.label configure \
    	     -text "Debits = $debits  Credits = $credits  Difference = $diff" \
    }
    focus .bal.frame.head1.entry
}

proc calc_diff 0 {
    global state_end state_start debits credits

    set value [expr $state_start - $state_end - $debits + $credits]
    return [format "%.2f" $value]
}

proc update_bal_list args {
    global eng debits credits diff

    set arglist [split $args]
    set list [lindex $arglist 0]
    set sel [lindex $arglist 1]

    puts "$list $sel"

    set line [$list get $sel]
    set key [string range $line 48 58]
    set index [expr [string range $line 60 64] * 2]
    set tail [string range $line 2 end]
    set amt [string range $line 34 45]
    puts "amt = $amt"

    $list delete $sel
    if { "[string range $line 0 0]" != "*" } {
        $list insert $sel "* $tail"
        puts $eng "select_trans $key"; flush $eng
        gets $eng result

        if { [expr $amt < 0 ] } {
            set debits [expr $debits - $amt]
        } else {
            set credits [expr $credits + $amt]
        }
    } else {
        $list insert $sel "  $tail"
        puts $eng "unselect_trans $key"; flush $eng
        gets $eng result

        if { [expr $amt < 0] } {
            set debits [expr $debits + $amt]
        } else {
            set credits [expr $credits - $amt]
        }
    }

    # avoid something like 6.5999999999999
    set debits [format "%.2f" $debits]
    set credits [format "%.2f" $credits]

    update_line $index $key

    puts $line
    puts $key
    puts $index
}


proc update_selected list {
    global eng list_height

    .status.line configure -text "Updating all cleared transactions."
    update

    puts $eng "clear_trans"; flush $eng
    gets $eng result

    update_rest 0 00000000-00

    goto [expr [.trans.list size] - $list_height]
}


#------------------------------------------------------------------------------
# Ok message for general use
#------------------------------------------------------------------------------

proc ok_mesg mesg {
    set w ".ok"

    option add *font "-adobe-new century schoolbook-bold-i-normal-*-14-*-*-*-*-*-*-*"
    
    toplevel $w

    wm title $w "Ok ..."
    wm iconname $w "Ok ..."
    frame $w.frame -borderwidth 2 -relief raised

    message $w.frame.m -width 300 -text $mesg
    button $w.frame.dismiss -text " Dismiss " -command "destroy $w"

    pack $w.frame -side top -fill both -expand 1
    pack $w.frame.m $w.frame.dismiss -side top -fill x -expand 1
}


#------------------------------------------------------------------------------
# Miscellaneous functions
#------------------------------------------------------------------------------

proc goto h {
    .trans.list yview $h
}


# write out current ~/.cbbrc file
proc save_cbbrc 0 {
    global cur_file

    set rchandle [open "~/.cbbrc" w]
    puts $rchandle $cur_file
    close $rchandle
}


# read in current ~/.cbbrc file
proc load_cbbrc 0 {
    global cur_file

    set rchandle [open "~/.cbbrc" r]
    gets $rchandle cur_file
    close $rchandle
}


#------------------------------------------------------------------------------
# Load a data file if one is specified on command line or in the ~/.cbbrc
#------------------------------------------------------------------------------

if { [expr $argc == 1] } {
    # if file specified on command line

    set cur_file $argv
    load_file $cur_file
} elseif { [file exists "~/.cbbrc"] } {
    # if rc file exists set cur_file from ~/.cbbrc

    load_cbbrc 0
    load_file $cur_file
} else {
    # no file to load

    new_clear 0
}

# make sure our tabbing gets initialized
setup_default_tabbing 0

# initialize undo
init_undo 0


#------------------------------------------------------------------------------
# This should remain the last thing in the script ... it leaves a welcome
# message at the bottom of the window
#------------------------------------------------------------------------------

.status.line configure -text "Welcome to the Check Book Balancer."
update


# ----------------------------------------------------------------------------
# $Log: cbb,v $
# Revision 1.33  1995/02/23  05:13:12  curt
# Removed dependencies on tclX (wishx).
#
# Revision 1.32  1995/01/23  03:15:04  curt
# Fixed another 19.99999999999998 bug.
#
# Revision 1.31  1995/01/07  01:50:47  curt
# Figured out why report balance didn't match actual balance ... included
# warning now when printing mis-entered splits.
#
# Changed splits Difference -> Sum.
#
# Revision 1.30  1994/12/20  02:44:17  curt
# Added a "by category summary report"
#
# Revision 1.29  1994/12/01  12:47:49  clolson
# Added an icon bitmap
#
# Revision 1.28  1994/11/29  04:24:14  curt
# squished a precision problem [bug]
#
# Revision 1.27  1994/11/28  19:46:00  clolson
# Additional work on reporting
#
# Revision 1.26  1994/11/14  04:16:41  curt
# Eliminating 0.32999999999999901 problems.
#
# Revision 1.25  1994/11/09  21:59:22  clolson
# worked on category editing
#
# Revision 1.24  1994/11/07  23:14:14  clolson
# Working on interactive category viewing/editing
#
# Revision 1.23  1994/11/07  19:13:52  clolson
# Fixed balance bug.
# Added hypertext online help.
#
# Revision 1.22  1994/11/06  14:23:49  curt
# Fixed precision bug!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
#
# Revision 1.21  1994/11/04  19:39:02  clolson
# Warning when deleting a transfer transaction.
#
# Revision 1.20  1994/11/04  19:32:53  clolson
# Added Transfers between Accounts.
#
# Revision 1.19  1994/11/04  13:51:16  clolson
# Changed from 2-digit dates to 4-digit dates.
# Look out!  Hopefully nothing broke!
#
# Revision 1.18  1994/11/02  12:57:17  curt
# Calculate the statement starting balance for the Balance operation.
#
# Revision 1.17  1994/11/01  22:41:50  clolson
# Cleaned up import code somewhat
#
# Revision 1.16  1994/10/31  23:14:43  clolson
# Started tracking towards cbbsh (the text only version).  Chris Browne has
# some good ideas, so I am trying to incorperate them, and make my stuff
# compatible with his.
#
# Revision 1.15  1994/10/31  16:04:53  curt
# Beginning some massive changes to start tracking towards cbbsh.
#
# Revision 1.14  1994/10/20  14:06:55  clolson
# Added some double quotes around things in messages.
#
# Revision 1.13  1994/10/19  13:27:23  curt
# Added export .qif files.
#
# Revision 1.12  1994/10/18  15:31:54  clolson
# $w in about window -> .aboutwin
#
# Revision 1.11  1994/10/18  12:20:39  curt
# Stubbed in a tranfer button ...
#
# Revision 1.10  1994/10/17  13:24:27  curt
# Make category completion work when tabbing from category.
# Change window naming scheme.
#
# Revision 1.9  1994/10/14  19:07:48  clolson
# Added my wife's and my's picture to the about window!
#
# Revision 1.8  1994/10/14  17:05:12  clolson
# Miscellaneous cleanups in preparation for releasing verion 0.40a
#
# Revision 1.7  1994/10/14  03:02:13  curt
# changes with regard to Version
#
# Revision 1.6  1994/10/13  23:57:12  curt
# Finished memorized transactions.
#
# Revision 1.5  1994/10/13  21:16:53  clolson
# Unknown categories can be added in splits window now.
# Started memorized transactions.
#
# Revision 1.4  1994/10/13  15:55:45  curt
# Added unknown category handling.
#
# Revision 1.3  1994/10/12  12:39:40  curt
# Fixed a couple of bindings glitches.
#
# Revision 1.2  1994/10/11  21:22:04  clolson
# Beat key binding into submission.
#
# Revision 1.1  1994/10/11  15:04:59  curt
# Official name is now cbb (for now)
#
# Revision 1.27  1994/10/11  13:07:08  curt
# More tweaking of key bindings.
#
# Revision 1.26  1994/10/11  12:57:39  curt
# Working on key bindings.
#
# Revision 1.25  1994/10/10  21:23:09  clolson
# Added left/right arrow key bindings to entry fields.
#
# Revision 1.24  1994/10/10  15:20:49  clolson
# Added some error checking to improve robustness ...
#
# Revision 1.23  1994/10/04  15:40:31  curt
# Categories saved when data is saved.
#
# Revision 1.22  1994/10/03  03:25:35  curt
# Add a path variable for the default.cat file.
#
# Revision 1.21  1994/10/03  01:54:03  curt
# *.dat changed to *.cbb
# Splits window wording --> total changed to difference
#
# Revision 1.20  1994/10/02  03:25:45  curt
# First stab at an undo ... functional at least.
#
# Revision 1.18  1994/09/30  19:49:29  clolson
# Working on split category completion.
#
# Revision 1.17  1994/09/30  17:54:24  clolson
# category tweaking ... exploring options for getting split category completion
# to work.
#
# Revision 1.16  1994/09/30  12:13:45  curt
# Now category is checked against the category list ... type the first few
# letters, the rest is filled in.
#
# Revision 1.15  1994/09/28  13:44:24  curt
# Restructured things so that data files look like file.dat, file.bat, file.cat
# Loading and saving are done by basename, i.e. file, data files from previous
# versions will have to be renamed to something.dat
#
# Also fixed a small bug where default tab bindings weren't being set at
# startup.
#
# Revision 1.14  1994/09/25  03:47:13  curt
# Spiffed up file operation windows (load/save as/import) ... added a cancel
#   button, generally improved operation.
# Added field tabbing to the balance window and splits window.
#
# Revision 1.13  1994/09/25  02:56:43  curt
# - Save-as function added.
# - If no file specified, defaults to noname
# - Check for "clean" before allowing an open or import.
# - <Return> in file dialog box (entry area) performs corresponding load/save/
#   import of specified file.
#
# Revision 1.11  1994/09/21  12:21:03  curt
# Added a command line option to specify data file to load.
# Added current file name to window title.
# Hooked the delete button to the right function.
#
# Revision 1.10  1994/09/20  14:12:41  clolson
# Subjected code to gnu public license :)
#
# Revision 1.9  1994/09/19  02:45:19  curt
# Menu bar cosmetic change
#
# Revision 1.8  1994/09/14  23:31:02  curt
# Added statement starting balance entry field
# Fixed balance window so, previously checked debits/credit are added in
# when list is loaded (in case we are restarting the balance procedure)
# Previously debit/credit were only updated when their line was double-clicked.
#
# Revision 1.7  1994/09/14  13:22:49  curt
# Worked on balance section -- keeping track of debits, credits, and difference
# as transactions are being checked off.
#
# Revision 1.6  1994/09/14  03:48:06  clolson
# delete_trans(), worked on balance section
#
# Revision 1.5  1994/09/12  15:21:20  curt
# Worked on balancing section.
# Miscellaneous tweaks.
#
# Revision 1.4  1994/09/09  20:26:10  clolson
# Open splits is now functional, although not polished.
#
# Revision 1.3  1994/09/08  21:51:35  clolson
# Global key bindings to menu options.
#
# Revision 1.2  1994/09/08  05:09:10  curt
# Worked on splits ...
#
# Revision 1.1  1994/09/08  03:59:03  curt
# Changed name of front.tk --> cbb
#
# Revision 1.16  1994/09/07  23:10:19  clolson
# Added a command bar, status line, and import file chooser.
# Also added initial support for a ~/.cbbrc file
#
# Revision 1.15  1994/09/07  12:51:37  curt
# clean flag, ok message, fiddle with open window
#
# Revision 1.14  1994/09/06  22:38:41  clolson
# Worked on File-->Open stuff.
#
# Revision 1.13  1994/09/06  04:37:32  curt
# File-New, File-Open, & misc tweaks
#
# Revision 1.12  1994/09/03  02:47:01  clolson
# Working on updating entries
#
# Revision 1.11  1994/09/02  03:52:03  curt
# Many changes/additions for editing transactions.
#
# Revision 1.10  1994/09/01  20:37:33  clolson
# Added a goto menu under Functions
# Added a goto command
# Gave listbox flexible dimensions
# Put cleared field at the end of tabbing order
# Added $key to listbox entries for dereferencing back to original data file
# Started work on update entry area procedure.
#
# Revision 1.9  1994/09/01  19:08:06  clolson
# Worked on key bindings for check# and date fields (+/-)
#
# Revision 1.8  1994/09/01  15:17:41  clolson
# Started work on tabbing from field to field in entry area.
#
# Revision 1.7  1994/08/30  01:53:42  clolson
# Worked on entry area.
#
# Revision 1.6  1994/08/29  03:53:38  curt
# Added header to listbox (needs tweaking)
# Category now says -Splits- if there are splits.
#
# Revision 1.5  1994/08/29  00:17:13  curt
# Worked on transaction listing format.
#
# Revision 1.4  1994/08/26  21:49:15  clolson
# More work on interface ... added list box with attached scroll bar
# Working on reading in transactions.
#
# Revision 1.3  1994/08/26  13:18:54  curt
# Experimenting with interface ...
#
# Revision 1.2  1994/08/25  20:46:43  clolson
# Appearance twiddling.
#
# Revision 1.1  1994/08/25  18:46:58  clolson
# Started stubbing in user interface.
#
