#!/usr/local/bin/wishx -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.11 1994/10/18 12:20:39 curt Exp $
# (Log is kept at end of this file)


#------------------------------------------------------------------------------
# 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 |engine.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_path .
set version "Version <not installed>"
set author_xbm "author.xbm"
set index1 0
set index2 0
set use_mems 1
set no_more_mem 0

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

wm title . "[file tail $argv0] - $cur_file"
wm iconname . "[file tail $argv0] - $cur_file"
# 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 "New" -underline 0 \
    	    -command { new_clear 0 }
    .menubar.file.menu add command -label "Open ..." -underline 0 \
    	    -command { open_file 0 }
    .menubar.file.menu add command -label "Save" -underline 0 \
	    -command { if { $cur_file != "noname" } { \
	    		   save_file 0 \
		       } else { \
	    		   save_file_as 0 \
    		       } \
    		     }
    .menubar.file.menu add command -label "Save As ..." -underline 5 \
    	    -command { save_file_as 0 }
    .menubar.file.menu add separator
    .menubar.file.menu add command -label "Import ..." -underline 0 \
    	    -command { import 0 }
    .menubar.file.menu add command -label "Export ..." -underline 0 \
    	    -command { export_file 0 }
    .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 comman -label "Transfer" -underline 0 \
	    -command { \
                ok_mesg "Hey, this is next on the todo list !!!"; \
                tkwait window .ok; \
            }
    .menubar.functions.menu add separator
    .menubar.functions.menu add cascade -label "Goto" -underline 0 \
	    -menu .menubar.functions.menu.goto
    .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 command -label "Help ..." -underline 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.reports
    .menubar.functions.menu.reports add command -label "Report 1" -underline 7
    .menubar.functions.menu.reports add command -label "Report 2" -underline 7
    .menubar.functions.menu.reports add command -label "Report 3" -underline 7

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


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

proc new_clear 0 {
    global eng clean argv0 cur_file def_cat_path

    if { $clean == 1 } {
        # clear our list box
        .trans.list delete 0 end

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

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

        # load default categories
        puts "Loading the category file $def_cat_path/default.cat"
        puts $eng "load_cats $def_cat_path/default"; flush $eng
        puts "Reading result"; gets $eng result; puts "Got result: $result"

        if { "$result" == "error" } {
            ok_mesg "Error opening $def_cat_path/default.cat ... installation problem?"
            tkwait window .ok
	}

	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
    } else {
        ok_mesg "You must save before you can wipe the slate clean!!!"
        tkwait window .ok
    }

    .status.line configure -text "Clearing all transactions."
    update
}


proc open_file 0 {
    global clean

    if { $clean != 1 } {
	ok_mesg "You must save before you can open a new file!!!"
        tkwait window .ok
        return
    }

    toplevel .openwin

    option add *font -adobe-helvetica-bold-r-normal-*-14-*-*-*-*-*-*-*
    wm title .openwin "Open ..."
    wm iconname .openwin "Open ..."
    wm minsize .openwin 1 1
    frame .openwin.frame -borderwidth 2 -relief raised
    frame .openwin.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 .openwin.frame.pwd -width 30 -text $pwd
    entry .openwin.frame.file -textvariable file_name -relief sunken
    set_default_entry_bindings .openwin.frame.file
    set file_name ""
    listbox .openwin.frame.f.list -geometry 30x10 \
    	    -yscrollcommand ".openwin.frame.f.scroll set"
    scrollbar .openwin.frame.f.scroll -command ".openwin.frame.f.list yview" \
    	    -relief sunken
    button .openwin.frame.load -text "Load <no file>" -command { \
	    if { "$file_name" != "" } { \
    	        set temp [pwd]; \
    	        append temp /; \
    	        append temp $file_name; \
	        load_file $temp \
            }; \
	    destroy .openwin }
    button .openwin.frame.cancel -text Cancel -command { destroy .openwin }

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

    load_list .openwin .cbb

    bind .openwin.frame.f.list <Double-Button> { \
    	    set choose [.openwin.frame.f.list get [.openwin.frame.f.list \
    	    	    curselection]]; \
            if { [file exists $choose] == 0 } {
                append choose .cbb
            }
    	    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 .openwin .cbb; \
                .openwin.frame.pwd configure -text $pwd; \
                .openwin.frame.load configure -text "Load <no file>"; \
		set file_name "" \
            } else { \
		set file_name [file root $choose]; \
                .openwin.frame.load configure -text "Load $file_name" \
	    } \
    }

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

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

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]

    $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]
    	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 def_cat_path

    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.cbb"
        tkwait window .ok
    }

    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 %12s" \
	        $check $nicedate $cutdesc $debit $credit $cleared $total $key]
        .trans.list insert end \
    	        [format "%5s  %-8s  %-15s  %-9s %37s" "" "" $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"; flush $eng
    puts "Reading result"; gets $eng result; puts "Got result: $result"

    if { "$result" == "error" } {
        ok_mesg "Error opening $file.cat"
        tkwait window .ok

        # no categories for this file, lets try the default categories
        puts "Loading the category file $file"
        puts $eng "load_cats $def_cat_path/default"; flush $eng
        puts "Reading result"; gets $eng result; puts "Got result: $result"

        if { "$result" == "error" } {
            ok_mesg "Error opening $def_cat_path/default.cat ... installation problem?"
            tkwait window .ok
        }
    }

    set clean 1
}

proc save_file 0 {
    global argv0 eng cur_file clean use_mems

    wm title . "[file tail $argv0] - [file tail $cur_file]"
    wm iconname . "[file tail $argv0] - [file tail $cur_file]"
    .status.line configure -text "Saving transactions to [file tail $cur_file]."
    update

    # tell engine to save transactions
    puts $eng "save_trans $cur_file"; flush $eng
    gets $eng result
    puts "saving transactions ... $result"

    # tell engine to save categories
    puts $eng "save_cats $cur_file"; flush $eng
    gets $eng result
    puts "saving categories ... $result"

    # save $cur_file into rc
    set rchandle [open "~/.cbbrc" w]
    puts $rchandle $cur_file
    puts $rchandle $use_mems
    close $rchandle

    # ok we are clean again
    set clean 1
}

proc save_file_as 0 {
    global cur_file

    toplevel .saveaswin

    option add *font -adobe-helvetica-bold-r-normal-*-14-*-*-*-*-*-*-*
    wm title .saveaswin "Save As ..."
    wm iconname .saveaswin "Save As ..."
    wm minsize .saveaswin 1 1
    frame .saveaswin.frame -borderwidth 2 -relief raised
    frame .saveaswin.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 .saveaswin.frame.pwd -width 30 -text $pwd
    entry .saveaswin.frame.file -textvariable file_name -relief sunken
    set_default_entry_bindings .saveaswin.frame.file
    set file_name ""
    listbox .saveaswin.frame.f.list -geometry 30x10 \
    	    -yscrollcommand ".saveaswin.frame.f.scroll set"
    scrollbar .saveaswin.frame.f.scroll \
	    -command ".saveaswin.frame.f.list yview" -relief sunken
    button .saveaswin.frame.load -text "Save As <no file>" -command { \
	    if { "$file_name" != "" } { \
    	        set temp [pwd]; \
    	        append temp /; \
    	        append temp $file_name; \
	        set cur_file $temp; \
	        save_file 0 \
            }; \
	    destroy .saveaswin }
    button .saveaswin.frame.cancel -text Cancel -command { destroy .saveaswin }

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

    load_list .saveaswin .cbb

    bind .saveaswin.frame.f.list <Double-Button> { \
    	    set choose [.saveaswin.frame.f.list get [.saveaswin.frame.f.list \
    	    	    curselection]]; \
    	    if { [file exists $choose] == 0 } {
    	        append choose .cbb
    	    }
    	    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 .saveaswin *; \
                .saveaswin.frame.pwd configure -text $pwd; \
                .saveaswin.frame.load configure -text "Save As <no file>"; \
		set file_name "" \
            } else { \
		set file_name [file root $choose]; \
                .saveaswin.frame.load configure -text "Save As $file_name" \
	    } \
    }

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

    bind .saveaswin.frame.file <Return> { \
        if { "$file_name" != "" } { \
            .saveaswin.frame.load configure -text "Save As $file_name"; \
    	    set temp [pwd]; \
    	    append temp /; \
    	    append temp $file_name; \
	    set cur_file $temp; \
	    save_file 0; \
	    destroy .saveaswin \
        } \
    }
}

# Select a file to import
proc import 0 {
    global clean 

    if { $clean != 1 } {
	ok_mesg "You must save before you can import a new file!!!"
        tkwait window .ok
        return
    }

    toplevel .importwin

    option add *font -adobe-helvetica-bold-r-normal-*-14-*-*-*-*-*-*-*
    wm title .importwin "Import ..."
    wm iconname .importwin "Import ..."
    wm minsize .importwin 1 1
    frame .importwin.frame -borderwidth 2 -relief raised
    frame .importwin.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 .importwin.frame.pwd -width 30 -text $pwd
    entry .importwin.frame.file -textvariable file_name -relief sunken
    set_default_entry_bindings .importwin.frame.file
    set file_name ""
    listbox .importwin.frame.f.list -geometry 30x10 \
    	    -yscrollcommand ".importwin.frame.f.scroll set"
    scrollbar .importwin.frame.f.scroll \
	    -command ".importwin.frame.f.list yview" -relief sunken
    button .importwin.frame.load -text "Import <no file>" -command { \
	    if { "$file_name" != "" } { \
    	        set temp [pwd]; \
    	        append temp /; \
    	        append temp $file_name; \
	        import_file $temp \
            }; \
	    destroy .importwin }
    button .importwin.frame.cancel -text Cancel -command { destroy .importwin }

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

    load_list .importwin *

    bind .importwin.frame.f.list <Double-Button> { \
    	    set choose [.importwin.frame.f.list get [.importwin.frame.f.list \
    	    	    curselection]]; \
    	    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 .importwin *; \
                .importwin.frame.pwd configure -text $pwd; \
                .importwin.frame.load configure -text "Import <no file>"; \
		set file_name "" \
            } else { \
		set file_name $choose; \
                .importwin.frame.load configure -text "Import $choose" \
	    } \
    }

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

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

proc import_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

    # clear out the old ...
    new_clear 0

    set cur_file noname

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

    puts "Importing data file $file"
    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 %12s" \
	        $check $nicedate $cutdesc $debit $credit $cleared $total $key]
        .trans.list insert end \
    	        [format "%5s  %-8s  %-15s  %-9s %37s" "" "" $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
}

proc quit 0 {
    global clean

    if { $clean == 1 } {
        exit
    } else {
        ok_mesg "You must save before you can quit!!!"
        tkwait window .ok
    }
}


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

proc display_about name {
    global version author_xbm

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

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

    button .aboutwin.frame.but -bitmap @$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
}


#------------------------------------------------------------------------------
# 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

    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" != "" } { \
                        add_new_cat $cat; \
                        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]
    set year [string range $date 0 1]
    set month [string range $date 2 3]
    set day [string range $date 4 5]
    set nicedate "$month/$day/$year"
    set check [lindex $pieces 2]
    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 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]
}

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 "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 %12s" \
               $check $nicedate $cutdesc $debit $credit $cleared $total $key]
        .trans.list insert end \
               [format "%5s  %-8s  %-15s  %-9s %37s" "" "" $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 %12s" \
           $check $nicedate $cutdesc $debit $credit $cleared $total $key]
    .trans.list insert $index2 \
           [format "%5s  %-8s  %-15s  %-9s %37s" "" "" $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"]
    }
    set date [fmtclock [getclock] "%y%m%d"]

    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

    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
    puts "Done entering ..."

    # 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]
    # 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 {
            add_new_cat $cat
            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
        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 8]
    } else {
        # 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 8]
        register_undo "edit [string range $result 0 8]:$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])]

    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 > 99} {
	set year 0
    }

    return "[pad $month]/[pad $day]/[pad $year]"
}

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])]

    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]/[pad $year]"
}


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

    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
    register_undo "delete $result"

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

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


#------------------------------------------------------------------------------
# Procedures to handle unknown categories
#------------------------------------------------------------------------------

proc add_new_cat cat {
    option add *font "-adobe-new century schoolbook-bold-i-normal-*-14-*-*-*-*-*-*-*"

    toplevel .newcat

    wm title .newcat "Unknown Category ..."
    wm iconname .newcat "Unknown Category ..."
    wm minsize .newcat 1 1
    frame .newcat.frame -borderwidth 2 -relief raised

    message .newcat.frame.m -width 300 -text \
    	"WARNING:  The category, ``$cat'' does not exist.  What would you like to do?"
    button .newcat.frame.create -text "Add ``$cat'' to the category list" \
    	-command { \
			puts $eng "insert_cat $cat:$cat:"; flush $eng; \
        		gets $eng result; \
        		puts "Adding category: $result"; \
			destroy .newcat }
    button .newcat.frame.ignore -text "Do not add ``$cat'' to the list" \
    	-command { destroy .newcat }

    pack .newcat.frame -side top -fill both -expand 1
    pack .newcat.frame.m .newcat.frame.create .newcat.frame.ignore -side top \
	    -fill x -expand 1
}


#------------------------------------------------------------------------------
# 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 8]
	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"
    wm minsize .splits 1 1

    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] [expr -1 * $debit]"
    } else {
        label .splits.frame.head \
		-text "[string range $desc 0 14] $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 "Difference = [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 { \
		        add_new_cat $cats($cur_split); \
			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 "Difference = [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 { \
		        add_new_cat $cats($cur_split); \
			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 "Difference = [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 { \
		        add_new_cat $cats($cur_split); \
			tkwait window .newcat; \
        	    }; \
		    puts "Leaving $cur_split --> $cats($cur_split)"; \
		}; \
	}
        set_default_entry_bindings $field
    }

    label .splits.frame.total -borderwidth 2 -relief raised \
    	    -text "Difference = [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 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 ..."
    wm minsize .bal 1 1
    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 44x15 \
	    -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 .bal.frame.f.scroll -side left -fill both -expand 1
    pack .bal.frame.bar.update .bal.frame.bar.dismiss -side left -fill x -expand 1

    # 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 %9.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
    }

    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 45 53]
    set index [expr [string range $line 55 59] * 2]
    set tail [string range $line 2 end]
    set amt [string range $line 34 42]
    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]
        }
    }

    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 000000-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 ..."
    wm minsize $w 1 1
    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
}


#------------------------------------------------------------------------------
# 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 rchandle [open "~/.cbbrc" r]

    gets $rchandle cur_file
    gets $rchandle use_mems
    if { "$use_mems" == "" } {
	set use_mems 1
    }
    load_file $cur_file

    close $rchandle
} 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.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.
#