#!/usr/bin/env wish

# WISH Checkbook 2009
# (the first public release of WISH Checkbook)
# by David McClamrock <mcclamrock@locl.net>

# A variant of WISH List
# Copyright  2003-2008 David H. McClamrock
# Freely available under Maximum Use License for Everyone
# You should have received a copy of this license with this program.
# If you didn't, e-mail the author to get one.

####################################################

# WISH applications require at least Tcl and Tk 8.5:

set tclo [package vcompare [package require Tcl] 8.5]
set tko [package vcompare [package require Tk] 8.5]
if {$tclo < 0 || $tko < 0} {
	tk_messageBox -message "This program requires Tcl and Tk 8.5 or greater" -type ok
	exit
}
package require Ttk

# Default settings:

set topdir /usr/local
set docdir [file join $topdir doc wishes]
set libdir [file join $topdir lib wishes]
set helpfile [file join $docdir checkhelp_link.txt] ; # User Help Guide
set licfile [file join $docdir mule_license.txt] ; # License
set wishimg [file join $libdir wishcheck.gif] ; # Logo
set version "2009"
set current_scheme AntiqueBisque

# Where program listings and configuration files go
# (Replace old "~/wishes," if any, with new "~/.wishes")

set wishdir [file join $env(HOME) .wishes]
set oldwishdir [file join $env(HOME) wishes]
if {[file exists $wishdir] == 0} {
	if {[file exists $oldwishdir] && [file type $oldwishdir] eq "directory"} {
		file rename $oldwishdir $wishdir
		file link $oldwishdir $wishdir
	} else {
		file mkdir $wishdir
	}
}
set colordir [file join $wishdir colorschemes]

# One or more features may work only on unix platforms (including Linux), 
# so identify the platform:
set platforms [split [array get tcl_platform]]
if {"unix" in $platforms} {
	set platform unix
}

# Where account list files go:

set acctdir [file join $env(HOME) checkaccts]
set accts [file join $acctdir acctlist.wit]
if {[file readable $accts]} {
 	source $accts
} else {
 	set acctlines [list]
}

# Where backups go (to be set below):

set backdir ""
set backlist [list]

# Initialize some variables and things:
set lists 0 ; # Total number of accounts opened in this session
set act 0 ; # ID number of active account
set today [clock format [clock seconds] -format {%Y/%m/%d}] ; # Today's date
set datoa $today ; # Presume today may also be date of transaction
set openaccts [list] ; # No accounts opened yet
set transline "" ; # No account to transfer to or from yet
set transom closed ; # So no transfer is to occur yet
set transfers($datoa) 0 ; # First transfer is yet to be performed
set scheds [list] ; # No scheduled transactions yet
set catlist [list] ; # No categories specified yet
set quittintime 0 ; # Not quitting time yet
set coloron 0; # WISH Color Picker Plus not yet loaded
set helpon 0 ; # WISH User Help not yet loaded either

# Read configuration file, if there is one:
set checkfig [file join $wishdir checkfig.tcl]
if {[file readable $checkfig]} {
	source $checkfig
}

# Initialize variables for color display:

set buttlist [list] ; # Buttons
set entlist [list] ; # Entry widgets
set lublist [list] ; # Listboxes
set spinlist [list] ; # Spinboxes
set winlist [list] ; # Widgets to get window background when disabled

# Procedure to find out whether executable program is in system's PATH or not:

proc inpath {prog} {
	global env
	set exok 0
	set envlist [split $env(PATH) :]
	foreach direc $envlist {
		if {[file executable [file join $direc $prog]]} {
			set exok 1
			break
		}
	}
	return $exok
}
	
# Integer range generator for "foreach"
# (to do a "for" loop without ugly, awkward "for" code):

proc range {start cutoff finish {step 1}} {
			
	# "Step" has to be an integer, and
	# no infinite loops that go nowhere are allowed:
	if {$step == 0 || [string is integer -strict $step] == 0} {
		error "range: Step must be an integer other than zero"
	}
	
	# Does the range include the last number?
	switch $cutoff {
		"to" {set inclu 1}
		"no" {set inclu 0}
		default {
			error "range: Use \"to\" for an inclusive range,\
			or \"no\" for a noninclusive range"
		}
	}
		
	# Is the range ascending or descending (or neither)?
	set ascendo [expr $finish - $start]
	if {$ascendo > -1} {
		set up 1
	} else {
		set up 0
	}
	
	# If range is descending and step is positive but doesn't have a "+" sign,
	# change step to negative:
	if {$up == 0 && $step > 0 && [string first "+" $start] != 0} {
		set step [expr $step * -1]
	}
	
	set ranger [list] ; # Initialize list variable for generated range
	switch "$up $inclu" {
		"1 1" {set op "<=" ; # Ascending, inclusive range}
		"1 0" {set op "<" ; # Ascending, noninclusive range}
		"0 1" {set op ">=" ; # Descending, inclusive range}
		"0 0" {set op ">" ; # Descending, noninclusive range}
	}
	
	# Generate a list containing the specified range of integers:
	for {set i $start} "\$i $op $finish" {incr i $step} {
		lappend ranger $i
	}
	return $ranger
}


############


# GUI SETUP

# Make the program window:

wm title . "WISH Checkbook"
set introfons "helvetica 12 bold"
set lilfons "helvetica 10 bold"

canvas .listcan -width 126 -height 270
image create photo wishcheck -file $wishimg
.listcan create image 1 1 -anchor nw -image wishcheck
grid .listcan -row 0 -column 0 -rowspan 3 -sticky news

frame .fr0
button .newacct -text "New Account" -font $introfons -command newacct
button .usedacct -text "Used Account" -font $introfons -command {
	usedacct [.nomen get [.nomen curselection]]	
}
button .junkacct -activebackground red -text "Junk Account" \
	-font $introfons -command junkacct
lappend buttlist .newacct .usedacct .junkacct
pack .newacct .usedacct .junkacct -in .fr0 -side left -expand 1 -fill both
grid .fr0 -row 0 -column 1 -sticky news

frame .frnom
listbox .nomen -height 10 -width 42 -border 1 \
	-font "helvetica 12 bold" -selectmode single -listvariable acctlines
lappend lublist .nomen
ttk::scrollbar .nomroll -command ".nomen yview"
.nomen configure -yscrollcommand ".nomroll set"
pack .nomen .nomroll -in .frnom -side left -expand 1 -fill both
grid .frnom -row 1 -column 1 -sticky news
bind .nomen <Button-3> {
	selection clear
	set clixel %y
	set clickline [.nomen nearest $clixel]
	.nomen selection set $clickline
	usedacct [.nomen get [.nomen curselection]]
}
bind .nomen <Double-Button-1> {usedacct [.nomen get [.nomen curselection]]}

frame .frbot
button .help -text "H  E  L  P" -font $introfons -command listhelp
lappend buttlist .help
button .colors -text "Color Display" -font $introfons -command colodisp
button .oot -text "Q  U  I  T" -font $introfons -command shootdown
lappend buttlist .help .colors .oot
pack .help .colors .oot -in .frbot -side left -expand 1 -fill both
grid .frbot -row 2 -column 1 -sticky news


############


# PROCEDURES TO GO WITH BUTTONS AND LISTBOX IN PROGRAM WINDOW


# PROGRAM WINDOW -- NEW ACCOUNT

# Procedure for setting up new account, part 1:

proc newacct {} {
	global act listnom nomlist nomleng widlist highlist linlist \
		rollo rollist unrollist
	frame .frew
	label .newaccto -text "Name: " -padx 2
	entry .newacctent -bg $::textback -fg $::textfore -width 24
	button .newacctok -bg $::buttback -fg $::buttfore -text "OK" \
		-default normal -relief solid -padx 2 -pady 0 -command okacct
	button .newacctno -bg $::buttback -fg $::buttfore -text "No" \
		-default normal -padx 2 -pady 0 -command {
		if {[info exists rollo]} {
			set rollo "no"
			unset rollist unrollist
		}
		destroy .frew
	}
	pack .newaccto .newacctent .newacctok .newacctno -in .frew \
		-side left -expand 1 -fill both
	bind . <Key-Return> okacct
	grid .frew -row 1 -column 1 -sticky new
	.newacctent delete 0 end
	focus .newacctent
}

# Procedure to set up new account, part 2:

proc okacct {} {
	global act listnom nomlist nomleng widlist highlist linlist catlist \
		lists acctlines acctdir acctfile accts newie boxlist backie backlist \
		openaccts rollo
	set newaccto [.newacctent get]
	if {$newaccto eq ""} {
		tk_messageBox -message "Please enter a name for this account" -type ok
		return
	}
	if {$newaccto in $acctlines}  {
		tk_messageBox -message "Account \"$newaccto\" already exists. Please\
			choose another name for this new account, or select \"$newaccto\"\
			and click \"Junk Account\" to delete the existing account of that\
			name" -type ok
		return
	}
	if {$acctdir eq ""} {
		set acctdir [file join $env(HOME) checkaccts]
		if {[file exists $acctdir] == 0} {
			file mkdir $acctdir
		}
		tk_messageBox -message "Your account directory will be:\
			\n$acctdir\nunless you select another directory\
			after clicking \"OK\"" -type ok
		set newdir [tk_chooseDirectory -title "Choose Account Directory" \
			-initialdir $acctdir]
		if {$newdir ne "" && $newdir ne $acctdir} {
			set acctdir $newdir
		}
	}
	destroy .frew
	lappend acctlines $newaccto
	if {$newaccto ni $backlist} {
		lappend backlist $newaccto
	}
	set acctlines [lsort -dictionary $acctlines]
	set newie 1
	incr lists
	set act $lists
	set newlist [string map "{ } {_}" $newaccto]
	set acctfile($act) [file join $acctdir $newlist.wit]
	set backie($act) ""
	set nomlist($act) [list Date Num Transaction Category \
		Deposit Withdraw Cl Total Stated] ; # Column names
	set nomleng($act) [llength $nomlist($act)] 
	set widlist($act) [list 9 5 36 24 9 9 2 9 9] ; # Column widths
	set highlist($act) 26 ; # List height
	set linlist($act) "" ; # No account data yet
	set backie($act) "" ; # No backup file yet
	set catlist($act) [list] ; # No list of categories yet
	set acctup "# WISH List/Tcl (.wit) account list for WISH Checkbook\
		\n\nset acctlines \[list $acctlines\]"
	set fileo [open $accts w]
	puts -nonewline $fileo $acctup
	close $fileo
	set listnom($act) $newaccto
	list_setup
	.li($act).ent(Transaction) insert 0 "OPENING STATED BALANCE"
	.li($act).ent(Stated) configure -bg $::entback
	foreach box [list .li($act).ent(Deposit) .li($act).ent(Withdraw) \
		.li($act).ent(Cl) .li($act).ent(Total)] {
		$box configure -disabledbackground $::winback -state disabled
	}
	# Add the new account to the list of open accounts:
	lappend openaccts [list $act $newaccto]
	focus .li($act).ent(Stated)
	
	# Check to make sure no open accounts have been sneaked out
	# without being properly closed:
	set openleng [expr {[llength $openaccts] - 1}]
	foreach num [range $openleng to 0] {
		set acto [lindex $openaccts $num 0]
		if {[winfo exists .li($acto)] == 0} {
			set openaccts [lreplace $openaccts $num $num]
		}
	}
	if {$rollo eq "yes"} {
		tk_messageBox -message "Enter the opening date of the fiscal period\
			for the new account \"$newaccto\" and the closing balance of the\
			last statement of the old fiscal period, which will be the\
			opening balance of the new account" -type ok
	}
}


# PROGRAM WINDOW -- USED ACCOUNT

# Procedure to open used account:

proc usedacct {acctname} {
	global acctdir act listnom nomlist nomleng widlist highlist linlist \
		boxlist newie acctlist backlist acctfile openaccts lists \
		scheds today catlist
	incr lists
	set act $lists
	set newie 0
	set newname [string map "{ } {_}" $acctname]
	set acctfile($act) [file join $acctdir $newname.wit]
	if {$acctname ni $backlist} {
		lappend backlist $acctname
	}
	source $acctfile($act)
	list_setup
	foreach box [list .li($act).ent(Total) .li($act).ent(Stated)] {
		$box configure -disabledbackground $::winback -state disabled
	}
	set linleng [expr {[llength $linlist($act)] - 1}]
	
	# Add the new account to the list of open accounts:
	lappend openaccts [list $act $acctname]
	focus .li($act).ent(Num)
	
	# Check to make sure no open accounts have been sneaked out
	# without being properly closed:
	set openleng [expr {[llength $openaccts] - 1}]
	foreach num [range $openleng to 0] {
		set acto [lindex $openaccts $num 0]
		if {[winfo exists .li($acto)] == 0} {
			set openaccts [lreplace $openaccts $num $num]
		}
	}
	
	# See if any scheduled transactions are due; ask whether to get them if so:
	if {[info exists scheds]} {
		set scheduli [lsearch -index 0 $scheds $listnom($act)]
		if {$scheduli >= 0} {
			set todaynum [string map "{/} {}" $today]
			foreach num [range 0 no [llength $scheduli]] {
				set schedunum [lindex $scheduli $num]
				set sched_date [lindex $scheds $schedunum 1]
				set sched_num [string map "{/} {}" $sched_date]
				if {$sched_num < $todaynum} {
					set getorno [tk_messageBox -message "Scheduled\
						transaction(s) in account \"$listnom($act)\"\
						due or overdue. See schedule?" -type yesno]
					if {$getorno eq "yes"} {
						getscheds $listnom($act)
						break
					}
				}
			}
		}
	}
}


# PROGRAM WINDOW -- JUNK ACCOUNT

# Procedure to delete an account listing:

proc junkacct {} {
	global acctdir acctlines accts backlist
	set delthis [.nomen curselection]
	if {[llength $delthis] < 1 } {
		tk_messageBox -message "Please select an account \
			to delete, if you wish" -type ok
		return
	} else {
		set areyousure [tk_messageBox -message "Data in a deleted account\
			will be lost if not backed up. OK?" -type okcancel]
		if {$areyousure ne "ok"} {return}
		set delnom [.nomen get $delthis]
		set junkwhere [lsearch $acctlines $delnom]
		lset acctlines $junkwhere {}
		lset backlist $junkwhere {}
		set acctup "# WISH List/Tcl (.wit) account list for WISH Checkbook\
			\n\nset acctlines \[list $acctlines\]"
		set fileo [open $accts w]
		puts -nonewline $fileo $acctup
		close $fileo
		set delnom [string map "{ } {_}" $delnom]
		set delfile [file join $acctdir $delnom.wit]
		if {[file exists $delfile]} {
			file delete $delfile
		} else {
			tk_messageBox -message "file $delfile not found"
		}
	}
}


# PROGRAM WINDOW -- HELP

# Use WISH User Help for user help guide:

# Procedure for setting up user help display:

proc listhelp {} {
	global helpon libdir
	if {$helpon == 0} {
		source [file join $libdir wishuhelp.tcl]
		set helpon 1
	}
	uhelp ; # Set up user help window--from WISH User Help
	wm title .uhelp "WISH Checkbook - User Help"
	set helplink [open $::helpfile r]
	set helpcontents [read $helplink]
	close $helplink
	.uhelp.tx insert 1.0 $helpcontents
	helplink .uhelp.tx; # Show links in text--from WISH User Help
	.uhelp.tx mark set insert 1.0
	.uhelp.tx configure -state disabled
}


# PROGRAM WINDOW -- COLOR DISPLAY

# Procedure to set up GUI box for configuring color display:

proc colodisp {} {
	global color red green blue whatfig whatbutt colorlist colordir \
		winback winfore selback selfore buttback buttfore textback \
		textfore headback headfore lightback lightfore coloron wishdir \
		libdir current_scheme bogomips
	if {$coloron == 0} {
		source [file join $libdir wishcolorplus.tcl]
		set coloron 1
	}
	wishcolorplus ; # This does all the work--from WISH Color Picker Plus
	wm title .colo "WISH Checkbook : WISH Color Picker Plus"
}


# PROGRAM WINDOW -- QUIT

# Procedure to save configuration:

proc savefig {} {
	global transfers datoa
	if {[info exists transfers($datoa)] == 0} {
		set transfers($datoa) 1
	}
	set figlines "# WISH Checkbook configuration file (checkfig.tcl)\
	\n\nset acctdir $::acctdir\
	\nset backdir $::backdir\
	\nset acctlines \[list $::acctlines\]\
	\nset backlist \[list $::backlist\]\
	\nset catlist \[list $::catlist\]\
	\nset scheds \[list $::scheds\]\
	\nset current_scheme $::current_scheme\
	\nset transfers($datoa) $transfers($datoa)
	\narray set transfers \"[array get transfers]\""
	set filid [open $::checkfig w]
	puts -nonewline $filid $figlines
	close $filid
}

# Procedure to make sure everything gets closed out right:

proc shootdown {} {
	global act lists answer chugger quittintime openaccts
	set quittintime 1
	savefig
	foreach num [range 0 no [llength $openaccts]] {
		set acctline [lindex $openaccts $num]
		set act [lindex $acctline 0]
		if {[winfo exists .li($act)]} {
			closeup 
		}
	}
	exit
}


############

# PROCEDURES: LIST SETUP

# Procedure to set up entry and treeview (multi-column list) widgets:

proc list_setup {} {
	global act acctfile listnom nomlist nomleng widlist highlist \
		listfont lists actold boxborder entwid sortcol linlist today \
		buttlist numero nombre spinlist entlist winlist

	# Make new toplevel window for new list:
	toplevel .li($act)
	wm title .li($act) "WISH Checkbook : $listnom($act)"
	
	# Set some variables:
	set backie($act) "" ; # Backup file
	set sortcol($act) "Date" ; # Start with list sorted by date
	
	# Mini-toolbar:
	frame .li($act).frini
	button .li($act).editcop -text "Copy" -command editcop
	button .li($act).transfer -text "Transfer" -command transbox
	button .li($act).sched -text "Schedule" -command schedtrans
	button .li($act).seesched -text "See Sched" -command {
		if {[winfo exists .sched($act)]} {
			wm deiconify .sched($act)
		} else {
			getscheds $listnom($act)
		}
	}
	button .li($act).cats -text "Categories" -command catbox
	button .li($act).cantran -text "Cancel" -command cantran
	button .li($act).delete -text "Delete" -activebackground red -command delrows
	button .li($act).find -text "Find" -command findbox
	button .li($act).deselall -text "Deselect" -command deselall
	button .li($act).backup -text "Backup" -command list_backup
	button .li($act).clear -text "Clear" -command markclear
	button .li($act).balance -text "Balance" -command balanstat
	button .li($act).quit -text "Close" -command closeup
	foreach butt [list .li($act).editcop .li($act).transfer .li($act).sched \
		.li($act).seesched .li($act).cats .li($act).cantran \
		.li($act).delete .li($act).find .li($act).deselall \
		.li($act).backup .li($act).clear .li($act).balance .li($act).quit] {
		$butt configure -pady 0 -padx 0 -bg $::buttback -fg $::buttfore
		lappend buttlist $butt
	} 
	pack .li($act).editcop .li($act).transfer .li($act).sched .li($act).seesched \
		.li($act).cats .li($act).cantran .li($act).delete \
		.li($act).find .li($act).deselall .li($act).backup \
		.li($act).clear .li($act).balance .li($act).quit -in .li($act).frini \
		-side left -expand 1 -fill both
	grid .li($act).frini -row 0 -column 0 -columnspan 2 -sticky news
	
	# Make spinboxes, entry widgets, and treeview widget with scrollbars:
	set entwid 2
	set boxborder 1
	frame .li($act).entframe
	foreach c [range 0 to 8] {
		set n [lindex $nomlist($act) $c]
		if {$c == 0} {
			spinbox .li($act).ent(Date) -width 10 -bg $::textback \
				-fg $::textfore -buttonbackground $::buttback -command {
				set way %d
				datespin $way %W
			}
			.li($act).ent(Date) insert 0 $today
			lappend entlist .li($act).ent(Date)
			lappend spinlist .li($act).ent(Date)
		} elseif {$c == 1} {
			spinbox .li($act).ent(Num) -from 1 -to 99999 -width 5 \
				-bg $::textback -fg $::textfore -buttonbackground $::buttback
			lappend entlist .li($act).ent(Date)	
			lappend spinlist .li($act).ent(Num)
		} elseif {$c < 7} {
			entry .li($act).ent($n) -width [lindex $widlist($act) $c] \
				-bg $::textback -fg $::textfore
			lappend entlist .li($act).ent($n)
		} else {
			entry .li($act).ent($n) -width [lindex $widlist($act) $c]
			lappend winlist .li($act).ent($n)
		}
		pack .li($act).ent($n) -in .li($act).entframe \
			-side left -expand 1 -fill both
	}
	grid .li($act).entframe -row 1 -column 0 -sticky news
	grid [ttk::treeview .li($act).tree -columns $nomlist($act) \
		-show headings -height $highlist($act)] -row 2 -column 0 -sticky news
	.li($act).tree tag configure neggie -foreground red
	foreach num [range 0 no [llength $nomlist($act)]] {
		set nombre [lindex $nomlist($act) $num]
		switch $nombre {
			Date -
			Transaction -
			Category {
				.li($act).tree heading $nombre -text $nombre \
					-command "sortlist $act $nombre"
				.li($act).tree column $nombre -width [winfo reqwidth \
					.li($act).ent($nombre)]
			}
			Num {
				.li($act).tree heading Num -text Num -command "sortlist $act Num"
				.li($act).tree column Num -anchor e -width [winfo reqwidth \
					.li($act).ent(Num)]
			}
			Deposit -
			Withdraw -
			Total -
			Stated {
		 		.li($act).tree heading $nombre -text $nombre
				.li($act).tree column $nombre -anchor e -width [winfo reqwidth \
					.li($act).ent($nombre)]
			}
			Cl {
				.li($act).tree heading Cl -text Cl
				.li($act).tree column Cl -anchor center -width [winfo reqwidth \
					.li($act).ent(Cl)]
			}
			default {
				# Do nothing--this shouldn't happen
			}
		}
	}
	if {[llength $linlist($act)] > 0} {
		foreach lin $linlist($act) {
			.li($act).tree insert {} end -values $lin
		}
		totall $act ; # Calculate balances
	}
	
	# Finish up with scrollbars, menu, etc.:
	grid [ttk::scrollbar .li($act).rolly -command ".li($act).tree yview"] \
		-row 1 -column 1 -rowspan 3 -sticky news
	grid [ttk::scrollbar .li($act).rollex -command ".li($act).tree xview" \
		-orient horizontal] -row 3 -column 0 -sticky news
	.li($act).tree configure -yscroll ".li($act).rolly set" \
		-xscroll ".li($act).rollex set"
	grid rowconfigure .li($act) 2 -weight 1
	grid columnconfigure .li($act) 0 -weight 1
	bind .li($act) <Key-Return> {addrow reg}
	bind .li($act) <KP_Enter> {addrow reg}
	bind .li($act) <Control-Tab> editcop
	bind .li($act) <FocusIn> {
		set topo [winfo toplevel [focus]]
		set act [string trim $topo ".li()"]
	}
	bind .li($act).tree <Double-Button-1> {getrow [%W focus]}
	bind .li($act).tree <Button-3> {
		set id [.li($act).tree identify row %x %y]
		getrow $id
	}
	listmenu
	.li($act).tree tag configure highline -background green
	.li($act).ent(Num) delete 0 end
	focus .li($act).ent(Num)
}

# Procedure to get spinbox to display correct date:

proc datespin {way w} {
	set datoa [$w get]
	set oldsecs [clock scan $datoa -format {%Y/%m/%d}]
	if {$way eq "up"} {
		set newsecs [clock add $oldsecs 1 day]
	} else {
		set newsecs [clock add $oldsecs "-1" day]
	}
	set datoa [clock format $newsecs -format {%Y/%m/%d}]
	$w delete 0 end
	$w insert 0 $datoa
}

# Procedure to create list menu:

proc listmenu {} {
	global lists act actold nomleng matchpick viewmode foundlist
	menu .li($act).menu -tearoff 0

	# File menu:
	menu .li($act).menu.file -tearoff 0
	.li($act).menu add cascade -label "File" \
		-underline 0 -menu .li($act).menu.file
	.li($act).menu.file add command -label "Backup" \
		-underline 0 -command list_backup
	.li($act).menu.file add command -label "Backup As" -command list_backup_as
	.li($act).menu.file add separator
	.li($act).menu.file add command -label "Export .tsv (text-tab-text)" \
		-underline 1 -command "exporto .tsv"
	.li($act).menu.file add command -label "Export .csv (text,text)" \
		-underline 3 -command "exporto .csv"
	.li($act).menu.file add command -label "Export .html (HTML table)" \
		-underline 3 -command "exporto .html"
	.li($act).menu.file add separator
	.li($act).menu.file add command -label "Roll Over to New Account" \
		-underline 0 -command rollover
	.li($act).menu.file add separator
	.li($act).menu.file add command -label "Close" \
		-underline 0 -command closeup

	# Edit menu:
	menu .li($act).menu.edit -tearoff 0
	.li($act).menu add cascade -label "Edit" \
		-underline 0 -menu .li($act).menu.edit
	.li($act).menu.edit add command -label "Add Transaction" \
		-underline 0 -command {addrow reg}
	.li($act).menu.edit add command -label "Edit Transaction" \
		-underline 0 -command editrow
	.li($act).menu.edit add command -label "Edit Copy of Transaction" \
		-underline 0 -command editcop
	.li($act).menu.edit add separator
	.li($act).menu.edit add command -label "Transfer" -command transbox
	.li($act).menu.edit add command -label "Schedule" -command schedtrans
	.li($act).menu.edit add command -label "See Schedule" \
		-command {getscheds $listnom($act)}
	.li($act).menu.edit add separator
	.li($act).menu.edit add command -label "Cancel Transaction" \
		-underline 0 -command cantran
	.li($act).menu.edit add command -label "Delete Transaction(s)" \
		-underline 0 -command delrows
		
	# Search/Select menu:
	menu .li($act).menu.search -tearoff 0
	.li($act).menu add cascade -label "Search/Select" \
		-underline 0 -menu .li($act).menu.search
	.li($act).menu.search add command -label "Find" \
		-underline 0 -command findbox -accelerator F2
	bind .li($act) <F2> findbox
	.li($act).menu.search add separator
	.li($act).menu.search add command -label "Select Category" \
		-underline 7 -command catbox
	.li($act).menu.search add separator
	.li($act).menu.search add command -label "Deselect All" -command deselall \
		-underline 0 -accelerator Ctrl+\\
	bind .li($act) <Control-backslash> deselall
	
	# Sort/Balance menu:
	menu .li($act).menu.sort -tearoff 0
	.li($act).menu add cascade -label "Sort/Balance" \
		-underline 5 -menu .li($act).menu.sort
	.li($act).menu.sort add command -label "Sort by Date" \
		-underline 0 -command "sortlist $act Date"
	.li($act).menu.sort add command -label "Sort by Number" \
		-underline 0 -command "sortlist $act Num"
	.li($act).menu.sort add command -label "Sort by Transaction" \
		-underline 0 -command "sortlist $act Transaction"
	.li($act).menu.sort add command -label "Sort by Category" \
		-underline 0 -command "sortlist $act Category"
	.li($act).menu.sort add separator
	.li($act).menu.sort add command -label "Mark Cleared" \
		-underline 0 -command markclear
	.li($act).menu.sort add separator
	.li($act).menu.sort add command -label "Balance Statement" \
		-underline 0 -command balanstat
		
	# Help menu:
	menu .li($act).menu.help -tearoff 0
	.li($act).menu add cascade -label "Help" \
		-underline 0 -menu .li($act).menu.help
	.li($act).menu.help add command -label "About WISH Checkbook" \
		-underline 0 -command {
		tk_messageBox -message "WISH Checkbook $version\nby David\
			McClamrock\n<mcclamrock@locl.net>" -type ok
	}
	.li($act).menu.help add command -label "User Help Guide" \
		-underline 0 -command checkhelp

	# Make the menu visible:
	.li($act) configure -menu .li($act).menu
}


############


# PROCEDURES: FILE MENU

# All procedures for opening lists and making new lists are defined in
# "Procedures to Go with Buttons and Listbox in Program Window," above


# FILE -- SAVE

set savetypes {
	{"WISH List/Tcl" {".wit"}}
}
set exportypes {
	{"Tab-delimited text" {".tsv"}}
	{"Comma-delimited text" {".csv"}}
	{"Single-column text" {".txt"}}
	{"Single-column HTML" {".htm"}} 
	{"HTML table" {".html"}}
}

# Procedure to save entire list to file
# (Excluding totals--these will be automatically
# calculated when file is opened):

proc list_save {num} {
	global act acctfile finalist answer nomleng listnom nomlist widlist \
		highlist linlist catlist divver badmess listo acctdir
	if {$num eq $act} {
		set brats [.li($num).tree children {}]
		set linlist($num) [list]
		foreach brat $brats {
			set lin [.li($num).tree item $brat -values]
			lappend linlist($num) [lrange $lin 0 6]
		}
	}
	set lisco "set listnom(\$act) \"$listnom($num)\""
	set nomcom "set nomlist(\$act) \[list $nomlist($num)\]"
	set lencom "set nomleng(\$act) [llength $nomlist($num)]"
	set widcom "set widlist(\$act) \[list $widlist($num)\]"
	set hicom "set highlist(\$act) $highlist($num)"
	set lincom "set linlist(\$act) \[list $linlist($num)\]"
	set finalist \
		"# WISH List/Tcl (.wit) data and configuration source\
		file for WISH Checkbook\
		\n\n$lisco\n$nomcom\n$lencom\n$widcom\n$hicom\n$lincom"
	set titulo [string map "{ } {_}" $listnom($num)]
	set fileo [file join $acctdir $titulo.wit]
	set fileid [open $fileo "w"]
	puts -nonewline $fileid $finalist
	close $fileid
}

# FILE -- BACKUP

proc list_backup {} {
	global act acctdir acctfile chugger backdir backlist
	if {$backdir eq ""} {
		set newdir [tk_chooseDirectory]
		if {$newdir ne ""} {
			set backdir $newdir
		} else {
			tk_messageBox -message "Please choose a backup directory" -type ok
			return
		}
	}
	list_save $act
	foreach acctoid $backlist {
		set newname [string map "{ } {_}" $acctoid]
		file copy -force [file join $acctdir $newname.wit] $backdir
	}
	wm title .li($act) "WISH Checkbook : Accounts backed up to $backdir"
	after 1500 {wm title .li($act) "WISH Checkbook : $listnom($act)"}
}

proc list_backup_as {} {
	global act acctfile chugger backie backiedir backie listnom
	list_save $act
	set backie($act) [tk_getSaveFile -title "Backup As"]
	if {$backie($act) ne ""} {
		set backiedir [file dirname $backie($act)]
		file copy -force $acctfile($act) $backie($act)
		wm title .li($act) "WISH Checkbook: Account backed up as $backie($act)"
		after 1500 {wm title .li($act) "WISH Checkbook : $listnom($act)"}
	}
}

# FILE -- EXPORT

proc exporto {filex} {
	global act listnom nomlist widlist linlist acctdir chugger
	list_save $act
	set totalsin [tk_messageBox -message "Include totals?" -type yesnocancel]
	if {$totalsin eq "yes"} {
		set linleng 18
		set colnum 8
	} elseif {$totalsin eq "no"} {
		set linleng 14
		set colnum 6
	} else {
		return
	} 
	set exponom($act) ""
	set expotext($act) ""
	set brats [.li($act).tree children {}]
	switch $filex {
		.tsv {
			# Tab-delimited text file:
			append expotext($act) "[join $nomlist($act) {\t}]\n"
			foreach brat $brats {
				set lin [.li($act).tree set $brat]
				set vals [list]
				foreach val [range 1 no $linleng 2] {
					lappend vals [lindex $lin $val]
				}
				set vals [string map {"\t" "    "} $vals]
				append expotext($act) "[join $vals {\t}]\n"
			}
		}
		.csv {
			# Comma-delimited text file:
			append expotext($act) "[join $nomlist($act) {,}]\n"
			foreach brat $brats {
				set lin [.li($act).tree set $brat]
				set vals [list]
				foreach val [range 1 no $linleng 2] {
					lappend vals [lindex $lin $val]
				}
				set vals [string map {"," ";"} $vals]
				append expotext($act) "[join $vals {,}]\n"
			}
		}
		.html {
			# HTML table:
			set firstab "<html>\n<head>\
				\n\t<title>$listnom($act): HTML Table</title>\
				\n\t<meta name=\"generator\" content=\"WISH Checkbook\" />\
				\n\t<meta http-equiv=\"Content-Type\"\
				content=\"text/html;	charset=ISO-8859-1\" />\
				\n</head>\n<body>\n\
				<center><h1>$listnom($act)</h1></center><br /><table\
				border=\"1\">\n\t<tr>\n"
			set totwid 0.0
			foreach wid $widlist($act) {
				set totwid [expr {$wid + $totwid}]
			}
			set wiperlist ""
			foreach wid $widlist($act) {
				set wiper [expr {100/$totwid * $wid}]
				set wiper [expr {int($wiper)}]
					lappend wiperlist $wiper
			}
			set wipertot 0
			foreach wiper $wiperlist {
				set wipertot [expr {$wipertot + $wiper}]
			}
			set wipernum [expr {100 - $wipertot}]
			foreach w [range 0 no $wipernum] {
				set newip [incr [lindex $wiperlist $w]]
				set wiperlist [lreplace $wiperlist $w $w $newip]
			}
			set tabulo ""
			foreach n [range 0 to $colnum] {
				set nomtab [lindex $nomlist($act) $n]
				set widnom [lindex $wiperlist $n]
				set tabnom "\t\t<th valign=\"top\"\
					width=\"${widnom}%\">$nomtab</th>\n"
				append tabulo $tabnom
			}
			append tabulo "\t</tr>\n"
			foreach brat $brats {
				set lin [.li($act).tree set $brat]
				append tabulo "\t<tr>\n"
				foreach val [range 1 no $linleng 2] {
					append tabulo "\t\t<td>[lindex $lin $val]</td>\n"
				}
				append tabulo "\t</tr>\n"
			}
			set lastab "</table>\n</body>\n</html>"
			set expotext($act) "$firstab$tabulo$lastab"
		}
		default {
			tk_messageBox -message "WISH Checkbook will export\
				account lists only in .tsv (tab-delimited text),\
				.csv (comma-delimited text), and .html (HTML table)\
				formats" -type ok
		}
	}
	set titulo [string map "{ } {_}" $listnom($act)]
	set fileo [file join $acctdir ${titulo}$filex]
	set fileid [open $fileo "w"]
	puts -nonewline $fileid $expotext($act)
	close $fileid
	wm title .li($act) "WISH Checkbook: Exported $fileo"
	after 1500 {
		wm title .li($act) "WISH Checkbook : $listnom($act)"
	}
}


# FILE -- ROLL OVER TO NEW ACCOUNT

proc rollover {} {
	global act oldact rollo linlist rollist unrollist
	set unclist [lsearch -all -index 6 $linlist($act) {}]
	if {[llength $unclist] < 1} {
		tk_messageBox -message "No uncleared transactions found" -type ok
		return
	}
	set brats [.li($act).tree children {}]
	set rollist [list]
	set unrollist [list]
	foreach unc $unclist {
		.li($act).tree selection add [lindex $brats $unc]
		lappend rollist [lrange [lindex $linlist($act) $unc] 0 6]
	}
	for {set i 0} {$i < [llength $brats]} {incr i} {
		if {[lsearch $unclist $i] < 0} {
			lappend unrollist [lrange [lindex $linlist($act) $i] 0 6]
		}
	}
	.li($act).tree see [lindex $brats end]
	set rollo [tk_messageBox -message "Uncleared transactions have been highlighted.\
		To roll them over to a new account, enter a new account name in the main\
		program window, but leave the old account window open until the rollover\
		is completed.\n\nThe old account window will then automatically close, and\
		the highlighted transactions will then remain only in the new account.\n\n\
		Proceed?" -type yesno]
	if {$rollo eq "yes"} {
		set oldact $act
		newacct
	} else {
		unset rollist unrollist
		deselall
	}
}


# FILE -- CLOSE

# Procedure to close list window:

proc closeup {} {
	global act listnom nomlist nomleng widlist highlist \
		linlist catlist quittintime openaccts
	list_save $act
 	if {$quittintime == 0} {
		savefig
	}
	set acctline [list $act $listnom($act)]
	set openline [lsearch $openaccts $acctline]
	lset openaccts $openline {}
	foreach actor [list listnom($act) nomlist($act) nomleng($act) \
		widlist($act) highlist($act) linlist($act) catlist($act)] {
		if {[info exists $actor]}	 {
			unset $actor
		}
	}
	if {[winfo exists .sched($act)]} {
		destroy .sched($act)
	}
	destroy .li($act)
}


############


# PROCEDURES: EDIT MENU


# EDIT -- ADD ROW

# Procedure to format number with at least one place before decimal point
# and exactly two places after, or else:

proc deciform {num} {
	if {[string is integer -strict $num]} {
		set num "$num.00"
	}
	if {[string first "." $num] == 0} {
		set num "0$num"
	}
	if {[string is double -strict $num]} {
		set num [format %.2f $num]
	} else {
		tk_messageBox -message "Please enter a number with two decimal places" -type ok
		return
	}
	return $num
}

# Procedure to tot up all lines:

proc totall {num} {
	set brats [.li($num).tree children {}]
	set bratnum [expr {[llength $brats] -1}]
	set bratone [lindex $brats 0]
	set bratend [lindex $brats end]
	set depone [.li($num).tree set $bratone Deposit]
	set widwone [.li($num).tree set $bratone Withdraw]
	set clone [.li($num).tree set $bratone Cl]
	
	# First line:
	if {$depone ne {}} {
		set depone [deciform $depone]
		.li($num).tree set $bratone Total $depone
		if {$clone ne {}} {
			.li($num).tree set $bratone Stated $depone
		} else {
			.li($num).tree set $bratone Stated "0.00"
		}
	} elseif {$widwone ne {}} {
		set widwone [deciform $widwone]
		.li($num).tree set $bratone Total "-$widwone"
		.li($num).tree item $bratone -tags neggie
		if {$clone ne {}} {
			.li($num).tree set $bratone Stated "-$widwone"
		} else {
			.li($num).tree set $bratone Stated "0.00"
		}
	}
	# Subsequent lines:
	foreach numero [range 1 to $bratnum] {
		set oldnum [lindex $brats [expr {$numero-1}]]
		set newnum [lindex $brats $numero]
		set oldtot [.li($num).tree set $oldnum Total]
		set oldstat [.li($num).tree set $oldnum Stated]
		set newdep [.li($num).tree set $newnum Deposit]
		set newwid [.li($num).tree set $newnum Withdraw]
		set newclear [.li($num).tree set $newnum Cl]
		if {$newdep ne {}} {
			set newtot [expr {$oldtot + $newdep}]
		} elseif {$newwid ne {}} {
			set newtot [expr {$oldtot - $newwid}]
		} else {
			set newtot $oldtot
		}
		if {$newtot < 0} {
			.li($num).tree item $newnum -tags neggie
		} else {
			.li($num).tree item $newnum -tags {}
		}
		if {$newclear ne {}} {
			if {$newdep ne {}} {
				set newstat [expr {$oldstat + $newdep}]
			} elseif {$newwid ne {}} {
				set newstat [expr {$oldstat - $newwid}]
			}
		} else {
			set newstat $oldstat
		}
		.li($num).tree set $newnum Total [deciform $newtot]
		.li($num).tree set $newnum Stated [deciform $newstat]
	}
	list_save $num	
}

# Procedure to add row to list:

proc addrow {whence {snum ""}} {
	global act oldact nomleng nomlist boxlist listnom catlist linlist \
		newie receiver sortcol bratend tranbox datoa rollo rollist unrollist
	set brats [.li($act).tree children {}]
	set datoa [.li($act).ent(Date) get]
	if {[regexp {^[0-9]{4}?/[0-9]{2}?/[0-9]{2}$} $datoa] == 0} {
		tk_messageBox -message "Please enter date in YYYY/MM/DD format" -type ok
		return
	}
	# First line:
	if {$newie} {
		set tranny [.li($act).ent(Transaction) get]
		set catty [.li($act).ent(Category) get]
		set statbal [.li($act).ent(Stated) get]
		set statbal [deciform $statbal]
		set lin [list $datoa {} $tranny $catty $statbal \
			{} x $statbal $statbal]
		.li($act).tree insert {} 0 -values $lin
		foreach box [list Num Transaction Category Stated] {
			.li($act).ent($box) delete 0 end	
		}
		.li($act).ent(Total) configure -background {} -state disabled
		.li($act).ent(Stated) configure -background {} -state disabled
		foreach box [list .li($act).ent(Deposit) .li($act).ent(Withdraw) \
			.li($act).ent(Cl)] {
			$box configure -state normal
		}
		if {$statbal < 0} {
			.li($act).tree item [lindex [.li($act).tree children {}] 0] \
			-tags neggie 
		}
		set newie 0
		if {[info exists rollo] && $rollo eq "yes"} {
			set linlist($oldact) $unrollist
			if {[llength $rollist] > 0} {
				foreach lin $rollist {
					.li($act).tree insert {} end -values $lin
				}
				totall $act ; # Calculate balances
			}
		}
	} else {
		set numbo [.li($act).ent(Num) get]
		set tranny [.li($act).ent(Transaction) get]
		set catty [.li($act).ent(Category) get]
		set depo [.li($act).ent(Deposit) get]
		set widwo [.li($act).ent(Withdraw) get]
		set cl [.li($act).ent(Cl) get]
		if {$tranny eq ""} {
			tk_messageBox -message "Please give this transaction a name" -type ok
			return
		}
		if {$depo ne ""} {
			set depo [deciform $depo]
		}
		if {$widwo ne ""} {
			set widwo [deciform $widwo]
		}
		if {$depo ne "" && $widwo ne ""} {
			tk_messageBox -message "A transaction must be either\
				a deposit or a withdrawal, not both" -type ok
			return
		}
		set lastbrat [lindex $brats end]
		set latedate [string map "{/} {}" [.li($act).tree set $lastbrat Date]]
		set nowdate [string map "{/} {}" $datoa]
		.li($act).tree insert {} end -values [list $datoa $numbo $tranny \
			$catty $depo $widwo $cl {} {}]
		set linleng [expr {[llength $linlist($act)] - 1}]
		sortlist $act $sortcol($act)
		if {[regexp "^Transfer" $catty]} {
			set receiver [regsub "^Transfer: " $catty {}]
			set receivy "Transfer: $listnom($act)"
			set transpack [list $datoa {} $tranny $receivy $widwo $depo $cl]
			transit add $receiver $transpack
		}
		.li($act).ent(Num) delete 0 end
		if {[string is integer -strict $numbo]} {
			set numbo [expr {$numbo+1}]
			.li($act).ent(Num) insert 0 $numbo
			.li($act).ent(Num) selection range 0 end
		}
	}
	foreach cat [list Transaction Category Deposit Withdraw Cl] {
		 .li($act).ent($cat) delete 0 end	
	}
	if {$catty ne "" && $catty ne "Transfer"} {
		if {$catty ni $catlist} {
			lappend catlist $catty
			set catlist [lsort -dictionary $catlist]
		}
	}
	list_save $act
	if {[info exists rollo] && $rollo eq "yes"} {
		list_save $oldact
		unset rollo rollist unrollist
	}
	savefig
	set brats [.li($act).tree children {}]
	set bratend [lindex $brats end]
	focus .li($act).ent(Num)
	after 10 {
		.li($act).tree see $bratend
	}
}


# EDIT -- EDIT ROW

# Procedure to get contents of row for editing:

proc getrow {item} {
	global act listnom highline nomlist acctlines transline transom isitran
	if {[info exists highline($act)] && $highline($act) ne ""} {
		catch {.li($act).tree item $highline($act) -tags {}}
	}
	set highline($act) $item
	.li($act).tree item $highline($act) -tags highline
	set gitlin [.li($act).tree item $highline($act) -values]
	foreach c [range 1 to 8] {
		set n [lindex $nomlist($act) $c]
		.li($act).ent($n) delete 0 end
		.li($act).ent($n) insert 0 [lindex $gitlin $c]
	}
	bind .li($act) <Key-Return> editrow
	bind .li($act) <KP_Enter> editrow
}

# Procedure to edit highlighted row:

proc editrow {} {
	global act highline nomlist listnom linlist receiver catlist sortcol
	if {[info exists highline($act)] == 0 || $highline($act) eq ""} {
		tk_messageBox -message "Please double-click or right-click to select\
			a transaction to edit" -type ok
		return
	}
	set datoa [.li($act).ent(Date) get]
	if {[regexp {^[0-9]{4}?/[0-9]{2}?/[0-9]{2}$} $datoa] == 0} {
		tk_messageBox -message "Please enter date in YYYY/MM/DD format" -type ok
		return
	}
	set numbo [.li($act).ent(Num) get]
	set tranny [.li($act).ent(Transaction) get]
	if {$tranny eq ""} {
		tk_messageBox -message "Please give this transaction a name" -type ok
		return
	}
	set catty [.li($act).ent(Category) get]
	set depo [string trim [.li($act).ent(Deposit) get]]
	if {$depo ne ""} {
		set depo [deciform $depo]
	}
	set widwo [string trim [.li($act).ent(Withdraw) get]]
	if {$widwo ne ""} {
		set widwo [deciform $widwo]
	}
	if {$depo ne "" && $widwo ne ""} {
		tk_messageBox -message "A transaction must be either\
			a deposit or a withdrawal, not both" -type ok
		return
	}
	set cl [.li($act).ent(Cl) get]
	.li($act).tree item $highline($act) -values [list $datoa $numbo \
		$tranny $catty $depo $widwo $cl {} {}]
	.li($act).tree item $highline($act) -tags {}
	sortlist $act $sortcol($act)
	if {[regexp "^Transfer" $catty]} {
		set receiver [regsub "^Transfer: " $catty {}]
		set receivy "Transfer: $listnom($act)"
		set transpack [list $datoa {} $tranny $receivy $widwo $depo $cl]
		transit add $receiver $transpack
	}
	foreach numero [range 1 to 6] {
		set nom [lindex $nomlist($act) $numero]
		.li($act).ent($nom) delete 0 end
	}
	if {$catty ne "" && $catty ne "Transfer"} {
		if {$catty ni $catlist} {
			lappend catlist $catty
			set catlist [lsort -dictionary $catlist]
		}
	}
	set highline($act) ""
	bind .li($act) <Key-Return> {addrow reg}
	bind .li($act) <KP_Enter> {addrow reg}
	list_save $act
	focus .li($act).ent(Num)
	after 10 {
		.li($act).tree see $highline($act)
	}
}


# EDIT -- EDIT COPY

proc editcop {} {
	global act nomlist linlist findline looklist
	foreach nom [list Transaction Category Deposit Withdraw] {
		.li($act).ent($nom) delete 0 end
	}
	set sel [.li($act).tree selection]
	if {[llength $sel] != 1} {
		tk_messageBox -message "Please select exactly one item to copy\
			for editing" -type ok
		return
	}
	.li($act).ent(Transaction) insert 0 [.li($act).tree set $sel Transaction]
	.li($act).ent(Category) insert 0 [.li($act).tree set $sel Category]
	.li($act).ent(Deposit) insert 0 [.li($act).tree set $sel Deposit]
	.li($act).ent(Withdraw) insert 0 [.li($act).tree set $sel Withdraw]
	deselall
}


# EDIT -- TRANSFER

# Procedure to make GUI box to select account for transfer:

proc transbox {} {
	global act acctlines
	toplevel .li($act).trans
	wm title .li($act).trans "WISH Checkbook: Transfer"
	frame .li($act).trans.list
	listbox .li($act).trans.accts -bg $::textback -fg $::textfore \
		-height [llength $acctlines] -border 1 -selectmode single \
		-width [.li($act).ent(Transaction) cget -width] -listvariable acctlines
	ttk::scrollbar .li($act).trans.roll -command ".li($act).trans.accts yview"
	.li($act).trans.accts configure -yscrollcommand ".li($act).trans.roll set"
	pack .li($act).trans.accts .li($act).trans.roll  -in .li($act).trans.list \
		-side left -expand 1 -fill both
	grid .li($act).trans.list -sticky news
	frame .li($act).trans.butts
	button .li($act).trans.ok -bg $::buttback -fg $::buttfore \
		-default normal -relief solid -text "OK" -command "transact reg"
	button .li($act).trans.can -bg $::buttback -fg $::buttfore -text "Cancel" \
		-default normal -command "destroy .li($act).trans"
	pack .li($act).trans.ok .li($act).trans.can -in .li($act).trans.butts \
		-side left -expand 1 -fill both
	grid .li($act).trans.butts -sticky news
	bind .li($act).trans.accts <Button-3> {
		selection clear
		set clixel %y
		.li($act).trans.accts selection set [.li($act).trans.accts nearest $clixel]
		transact reg
	}
	bind .li($act).trans.accts <Double-Button-1> "transact reg"
	bind .li($act).trans <Key-Return> "transact reg"
	bind .li($act).trans <KP_Enter> "transact reg"
}

# Procedure to get ready to record transfer from one account to another:

proc transact {whence} {
	global act linlist openaccts acctlines receiver listnom nomlist nomleng \
		highlist widlist catlist transfers datoa snum tranbox
	if {$whence eq "reg"} {
		# Non-scheduled transaction:
		set isitrans [.li($act).trans.accts get [.li($act).trans.accts curselection]]
		if {$isitrans eq $listnom($act)} {
			tk_messageBox -message "Please select a different account, not\
				the same account, to receive a transfer" -type ok
			return
		}
		set datoa [.li($act).ent(Date) get]
	} else {
		# Scheduled transaction:
		set datoa [.sched($act).dat($snum) get]
		set isitrans [.sched($act).cat($snum) get]
		set isitrans [regsub "^Transfer: " $isitrans ""]
	}
	if {[info exists transfers($datoa)] == 0} {
		set transfers($datoa) 0
	}
	incr transfers($datoa)
	set receiver $isitrans
	.li($act).ent(Transaction) delete 0 end
	.li($act).ent(Transaction) insert 0 "Transfer $datoa ($transfers($datoa))"
	.li($act).ent(Category) delete 0 end
	.li($act).ent(Category) insert 0 "Transfer: $receiver"
	if {$whence eq "sched"} {
		.li($act).ent(Deposit) insert 0 [.sched($act).dep($snum) get]
		.li($act).ent(Withdraw) insert 0 [.sched($act).wid($snum) get]
	}
	if {[winfo exists .li($act).trans]} {
		destroy .li($act).trans
	}
}

# Procedure to record transfer (invoked from "addrow" above,
# or from "delrows" below):

proc transit {how where what} {
	global act linlist lists listnom nomlist nomleng widlist highlist \
		acctdir openaccts transom boxlist transfers today delfirst sortcol datoa
	set isitope [lsearch -index end $openaccts $where] ; # Is receiving account open?
	set oldact $act
	if {$how eq "del"} {
		set tranny $what ; # Here "$what" is only "Transaction"
		if {$isitope >= 0} {
			set openup [lindex $openaccts $isitope]
			set actup [lindex $openup 0]
			set toobrats [.li($actup).tree children {}]
			set foundbrat 0
			foreach brat $toobrats {
				set bratrans [.li($actup).tree set $brat Transaction]
				if {$bratrans eq $tranny} {
					set foundbrat 1
					.li($actup).tree delete $brat
					break
				}
			}
			if {$foundbrat} {
				totall $actup
			} else {
				tk_messageBox -message "Transfer \"$what\" not found in\
					receiving account" -type ok
				return
			}
		} else {
			set actup [expr {$lists+1}]
			set act $actup
			set newname [string map "{ } {_}" $where]
			set acctfile($actup) [file join $acctdir $newname.wit]
			source $acctfile($actup)
			if {[info exists catlist($actup)] == 0} {
				set catlist($actup) [list]
			}
			set isatrans [lsearch -index 2 $linlist($actup) $what]
			if {$isatrans >= 0} {
				set linlist($actup) [lreplace $linlist($actup) $isatrans $isatrans]
			} else {
				tk_messageBox -message "Transfer \"$what\" not found in\
					receiving account" -type ok
				return
			}
		}
	} else {
		if {$isitope >= 0} {
			set openup [lindex $openaccts $isitope]
			set actup [lindex $openup 0]
			if {$how eq "add"} {
				.li($actup).tree insert {} end -values $what ; # Here "$what" \
					is entire data line
			} else {
				set tranny [lindex $what 2]
				set toobrats [.li($actup).tree children {}]
				set bratleng [llength $brats]
				set foundbrat 0
				foreach numero [range 0 no $bratleng] {
					set brat [lindex $brats $numero]
					set transmatch [.li($actup).tree set $brat -values]
					if {$transmatch eq $tranny} {
						set foundbrat 1
						.li($actup).tree item $brat -values $what
						break
					}
				}
				if {$foundbrat} {
					sortlist $actup $sortcol($actup)
				} else {
					tk_messageBox -message "Transfer \"$what\" not found in\
						receiving account" -type ok
					return
				}
			}
		} else {
			set actup [expr {$lists+1}]
			set act $actup
			set newname [string map "{ } {_}" $where]
			set acctfile($actup) [file join $acctdir $newname.wit]
			source $acctfile($actup)
			if {[info exists catlist($actup)] == 0} {
				set catlist($actup) [list]
			}
			if {$how eq "add"} {
				lappend linlist($actup) $what
				set linlist($actup) [lsort -dictionary -index 0 $linlist($actup)]
			} else {
				set transmatch [lsearch -index 2 $linlist($actup) $tranny]
				if {$transmatch >= 0} {
					lset linlist($actup) $transmatch $what
				}
			}
		}
	}
	set act $oldact
	list_save $actup
}

# EDIT -- SCHEDULE TRANSACTION(S)

# Procedure to set up GUI frame for scheduling transactions:

set freq months

proc schedtrans {} {
	global act freq
	if {[llength [.li($act).tree selection]] != 1} {
		tk_messageBox -message "Please select exactly one transaction\
			to schedule" -type ok
		return
	}
	frame .li($act).schedu
	label .li($act).schedu.star -text "Next due date: "
	spinbox .li($act).schedu.spin -bg $::textback -fg $::textfore \
		-borderwidth $::entwid -relief sunken -width 10 -command {
		set way %d
		datespin $way %W
	}
	.li($act).schedu.spin insert 0 [clock format [clock seconds] -format {%Y/%m/%d}]
	label .li($act).schedu.blab -text "Frequency: "
	radiobutton .li($act).schedu.evmo -text "Every " -selectcolor white \
		-variable freq -value months -padx 0
	spinbox .li($act).schedu.spinmo -width 2 -from 1 -to 12 \
		-bg $::textback -fg $::textfore
	.li($act).schedu.spinmo delete 0 end
	.li($act).schedu.spinmo insert 0 "1"
	label .li($act).schedu.labmo -text " month(s)"
	radiobutton .li($act).schedu.evwk -text "Every " -selectcolor white \
		-variable freq -value weeks -padx 0
	spinbox .li($act).schedu.week -width 2 -from 1 -to 12 \
		-bg $::textback -fg $::textfore
	.li($act).schedu.week delete 0 end
	.li($act).schedu.week insert 0 "2"
	label .li($act).schedu.labweek -text " week(s)"
	radiobutton .li($act).schedu.evday -text "Every " -selectcolor white \
		-variable freq -value days -padx 0
	spinbox .li($act).schedu.day -width 2 -from 1 -to 12 \
		-bg $::textback -fg $::textfore
	.li($act).schedu.day delete 0 end
	.li($act).schedu.day insert 0 "7"
	label .li($act).schedu.labday -text " day(s)"
	button .li($act).schedu.ok -text "OK" -pady 0 -default normal \
		-relief solid -command gosched
	button .li($act).schedu.can -text "Cancel" -pady 0 -default normal -command {
		bind .li($act) <Key-Return> {addrow reg}
		destroy .li($act).schedu
	}
	pack .li($act).schedu.star .li($act).schedu.spin .li($act).schedu.blab \
		.li($act).schedu.evmo .li($act).schedu.spinmo .li($act).schedu.labmo \
		.li($act).schedu.evwk .li($act).schedu.week .li($act).schedu.labweek \
		.li($act).schedu.evday .li($act).schedu.day .li($act).schedu.labday \
		.li($act).schedu.ok .li($act).schedu.can -in .li($act).schedu \
		-side left -expand 1 -fill both
	grid .li($act).schedu -row 0 -column 0 -columnspan 9 -sticky news
	bind .li($act) <Key-Return> gosched
}

# Procedure to schedule transaction:

proc gosched {} {
	global act linlist listnom scheds freq
	bind .li($act) <Key-Return> {addrow reg}
	set duedate [.li($act).schedu.spin get]
	if {[regexp {^[0-9]{4}?/[0-9]{2}?/[0-9]{2}$} $duedate] == 0} {
		tk_messageBox -message "Please enter date in YYYY/MM/DD format" -type ok
		return
	}
	switch $freq {
		months {set noom [.li($act).schedu.spinmo get]}
		weeks {set noom [.li($act).schedu.week get]}
		days {set noom [.li($act).schedu.day get]}
	}
	if {[string is integer -strict $noom] == 0} {
		tk_messageBox -message "Number of ${freq}s must be an integer" -type ok
		bind .li($act) <Key-Return> gosched
		return
	}
	destroy .li($act).schedu
	set schedvals [.li($act).tree item [.li($act).tree selection] -values]
	set schedline [list $listnom($act) $duedate $noom $freq \
		[lrange $schedvals 2 5]]
	# Hack out transfer number:
	set tranny [lindex $schedline 4 0]
	if {[regexp "^Transfer" $tranny]} {
		tk_messageBox -message $schedline -type ok
		lset schedline 4 0 [lindex $schedline 4 0 0]
		tk_messageBox -message $schedline -type ok
	}
	if {[lsearch $scheds $schedline] < 0} {
		lappend scheds $schedline
	}
	# e.g., {{Family Checking} 11/22/2007 7 days {Trans Cat {} 5.00}}
	# or, when blanked out: {{} {} {} {} {{} {} {} {}}}
	savefig
}

# Procedure to make GUI box for retrieving scheduled transactions
# (or not, as the case may be):

proc getscheds {account} {
	global act listnom scheds highlist today acctlines scheduli snum transfers
	if {[lsearch $acctlines $account] < 0} {
		tk_messageBox -message "Account \"$account\" not found" -type ok
		return
	}
	set scheds [lsort -index 1 $scheds] ; # Sort by date
	set scheduli [lsearch -all -inline -index 0 $scheds $account]
	set schedleng [llength $scheduli]
	if {$schedleng > 20} {
		set schedleng 20
		set outdate [lindex $scheduli $schedleng 1]
		tk_messageBox -message "Transactions scheduled for $outdate or beyond\
			may not be displayed yet" -type ok
	}
	if {$schedleng == 0} {
		tk_messageBox -message "No scheduled transactions found" -type ok
		return
	}
	toplevel .sched($act)
	wm title .sched($act) "$listnom($act) : Scheduled Transactions"
	grid [label .sched($act).tra -text "S C H E D U L E D  \
		T R A N S A C T I O N S" -relief sunken -font "helvetica 14 bold"] \
		-row 0 -column 0 -columnspan 9 -sticky news
	foreach num [range 0 no $schedleng] {
		set snum $num
		frame .sched($act).new($snum)
		spinbox .sched($act).dat($snum) -bg $::textback -fg $::textfore \
			-relief sunken -width 10 -command {
			set way %d
			datespin $way %W
		}
		.sched($act).dat($snum) insert 0 [lindex $scheduli $snum 1]
		entry .sched($act).trans($snum) -width 42
		entry .sched($act).cat($snum) -width 28
		entry .sched($act).dep($snum) -width 10
		entry .sched($act).wid($snum) -width 10
		set tranny [lindex $scheduli $snum end 0]
		set catty [lindex $scheduli $snum end 1]
		.sched($act).trans($snum) insert 0 $tranny
		.sched($act).cat($snum) insert 0 $catty
		.sched($act).dep($snum) insert 0 [lindex $scheduli $snum end 2]
		.sched($act).wid($snum) insert 0 [lindex $scheduli $snum end 3]
		foreach ent [list .sched($act).dat($snum) .sched($act).trans($snum) \
			.sched($act).cat($snum) .sched($act).dep($snum) \
			.sched($act).wid($snum)] {
			$ent configure -bg $::textback -fg $::textfore \
			-borderwidth 1 -relief sunken
		}
		button .sched($act).add($snum) -text "Add" -pady 0 -padx 4 -bord 1
		bind .sched($act).add($snum) <Button-1> {
			set wiggie %W
			set snum [string trim [regexp -inline {\([0-9]+?\)$} $wiggie] "()"]
			gripsched
			chugsched $snum regular
		}
		button .sched($act).defer($snum) -text "Defer" -pady 0 -padx 4	-bord 1
		bind .sched($act).defer($snum) <Button-1> {
			set wiggie %W
			set snum [string trim [regexp -inline {\([0-9]+?\)$} $wiggie] "()"]
			chugsched $snum [.sched($act).dat($snum) get]
		}
		button .sched($act).del($snum) -activebackground red -text "Delete" \
			-pady 0 -padx 4 -bord 1
		bind .sched($act).del($snum) <Button-1> {
			set wiggie %W
			set snum [string trim [regexp -inline {\([0-9]+?\)$} $wiggie] "()"]
			delsched $snum
		}	
		pack .sched($act).dat($snum) .sched($act).trans($snum) \
			.sched($act).cat($snum) .sched($act).dep($snum) \
			.sched($act).wid($snum) .sched($act).add($snum) \
			.sched($act).defer($snum) .sched($act).del($snum) \
			-in .sched($act).new($snum) -side left -expand 1 -fill both
		grid .sched($act).new($snum) -row [expr {$num+1}] -column 0 \
			-columnspan 9 -sticky news
	}
	grid [button .sched($act).butt -text "C  L  O  S  E" -pady 1 -command\
		"destroy .sched($act)"] -row [expr {$num+2}] -column 0 \
		-columnspan 9 -sticky news	
}

# Procedure to get scheduled transaction and put it on entry line:

proc gripsched {} {
	global act snum transfers datoa
	set datoa [.li($act).ent(Date) get]
	if {[info exists transfers($datoa)] == 0 || $transfers($datoa) < 1} {
		set transfers($datoa) 1
	} else {
		incr transfers($datoa)
	}
	.li($act).ent(Transaction) delete 0 end
	set tranny [.sched($act).trans($snum) get]
	.li($act).ent(Transaction) insert 0 $tranny
	if {[regexp "^Transfer" $tranny]} {
		.li($act).ent(Transaction) insert end " $datoa ($transfers($datoa))"
	}
	.li($act).ent(Category) delete 0 end
	.li($act).ent(Category) insert 0 [.sched($act).cat($snum) get]
	.li($act).ent(Deposit) delete 0 end
	.li($act).ent(Deposit) insert 0 [.sched($act).dep($snum) get]
	.li($act).ent(Withdraw) delete 0 end
	.li($act).ent(Withdraw) insert 0 [.sched($act).wid($snum) get]
	wm iconify .sched($act)
	focus .li($act).ent(Num)
}

# Procedure to reschedule transaction:
	
proc chugsched {snum how} {
	global act scheds today scheduli listnom
	set oldline [lindex $scheduli $snum]
	set noom [lindex $oldline 2]
	set freq [lindex $oldline 3]
	if {$how eq "regular"} {
		set olddate [.sched($act).dat($snum) get]
		set oldsecs [clock scan $olddate -format {%Y/%m/%d}]
		set newsecs [clock add $oldsecs $noom $freq]
		set newdate [clock format $newsecs -format {%Y/%m/%d}]
	} elseif {[regexp {^[0-9]{4}?/[0-9]{2}?/[0-9]{2}$} $how]} {
		set hownow [string map "{/} {}" $how]
		set rightnow [string map "{/} {}" $today]
		if {$hownow > $rightnow} {
			set newdate $how
		} else {
			tk_messageBox -message "Please select a future date before\
				clicking \"Defer\"" -type ok
			return
		}
	} else {
		tk_messageBox -message "Please enter a future date\
			in YYYY/MM/DD format" -type ok
		return
	}
	set tranny [.sched($act).trans($snum) get]
	set catty [.sched($act).cat($snum) get]
	set dep [.sched($act).dep($snum) get]
	set wid [.sched($act).wid($snum) get]
	set newline [list $listnom($act) $newdate $noom $freq \
		[list $tranny $catty $dep $wid]]
	set schedplatz [lsearch $scheds $oldline]
	if {$schedplatz < 0} {
		lappend scheds $newline
	} else {
		lset scheds $schedplatz $newline
	}
	savefig
	grid forget .sched($act).new($snum)
}

# Procedure to delete transaction from schedule:

proc delsched {snum} {
	global act scheds
	set scheds [lreplace $scheds $snum $snum \
		[list {} {} {} {} [list {} {} {} {}]]]
	savefig
	grid forget .sched($act).new($snum)
}


# EDIT -- DELETE TRANSACTION(S)

proc delrows {} {
	global act linlist
	set lins [.li($act).tree selection]
	foreach lin $lins {
		set tranny [.li($act).tree set $lin Transaction]
		set catty [.li($act).tree set $lin Category]
		.li($act).tree delete $lin
		if {[regexp ^Transfer $catty]} {
			set where [regsub {^Transfer: } $catty {}]
			transit del "$where" "$tranny"
		}
	}
	totall $act
	list_save $act
}


# EDIT -- CANCEL TRANSACTION

proc cantran {} {
	global act nomlist highline boxlist findline transline transom
	foreach numero [range 2 to 8] {
		set nom [lindex $nomlist($act) $numero]
		.li($act).ent($nom) delete 0 end
	}
	if {[info exists highline($act)] && $highline($act) ne ""} {
		.li($act).tree item $highline($act) -tags {}
		set highline($act) ""
	}
}


# PROCEDURES: SEARCH/SELECT MENU

# SEARCH/SELECT -- SELECT CATEGORY

# Procedure to set up GUI box for selecting category:

proc catbox {} {
	global act catlist
	toplevel .cat
	wm title .cat "Categories: WISH Checkbook"
	frame .cat.catcher
	frame .cat.crap
	listbox .cat.list -bg $::textback -fg $::textfore -border 1 \
		-selectmode single -width 36 -listvariable catlist
	scrollbar .cat.roll -width 12 -command ".cat.list yview"
	.cat.list configure -yscrollcommand ".cat.roll set"
	pack .cat.list .cat.roll  -in .cat.crap \
		-side left -expand 1 -fill both
	frame .cat.butts
	button .cat.ok -bg $::buttback -fg $::buttfore \
		-text "OK" -command catact
	button .cat.can -bg $::buttback -fg $::buttfore -text "Cancel" \
		-command "destroy .cat"
	pack .cat.ok .cat.can -in .cat.butts \
		-side left -expand 1 -fill both
	pack .cat.crap .cat.butts -in .cat.catcher -side top -expand 1 -fill both
	bind .cat.list <Button-3> {
		set clixel %y
		.cat.list selection set [.cat.list nearest $clixel]
		catact
	}
	bind .cat.list <Double-Button-1> catact
	if {[llength $catlist] < 20} {
		.cat.list configure -height [llength $catlist]
	} else {
		.cat.list configure -height 20
	}
	grid .cat.catcher
}

# Procedure to select category:

proc catact {} {
	global act
	set cat [.cat.list get [.cat.list curselection]]
	.li($act).ent(Category) delete 0 end
	.li($act).ent(Category) insert 0 $cat
	destroy .cat
}


# SEARCH/SELECT -- FIND

# Procedure to set up GUI frame to find things in lists:

proc findbox {} {
	global nomlist act typoo
	set typoo "Transaction"
	frame .li($act).findo
	set usetext "Use . (period) to substitute for any one character,\
		? for one or more, or * for zero or more characters"
	label .li($act).findo.use -bg $::lightback -fg $::lightfore -text $usetext -pady 6
	frame .li($act).findo.fer
	button .li($act).findo.o -text "F  I  N  D  :" -bg $::headback -fg $::headfore \
		-default normal -relief solid -pady 1 -command findmatch
	entry .li($act).findo.ent -bg $::textback -fg $::textfore -width 50
	label .li($act).findo.in -text "  in : "
	radiobutton .li($act).findo.trans -variable typoo -value Transaction \
		-text "Transaction" -selectcolor white
	radiobutton .li($act).findo.cat -variable typoo -value Category \
		-text "Category" -selectcolor white -padx 0
	radiobutton .li($act).findo.dat -variable typoo -value Date \
		-text "Date" -selectcolor white
	radiobutton .li($act).findo.num -variable typoo -value Num \
		-text "Num" -selectcolor white
	button .li($act).findo.clo -text "Close" -bg $::buttback -fg $::buttfore \
		-default normal -pady 1 -command {
		destroy .li($act).findo
		bind .li($act) <Key-Return>	{addrow reg}
	}
	pack .li($act).findo.o .li($act).findo.ent .li($act).findo.in .li($act).findo.trans \
		.li($act).findo.cat .li($act).findo.dat .li($act).findo.num .li($act).findo.clo \
		-in .li($act).findo.fer -side left -expand 1 -fill x
	pack .li($act).findo.use .li($act).findo.fer \
		-in .li($act).findo -side top -expand 1 -fill both
	grid .li($act).findo -row 0 -column 0 -rowspan 3 -columnspan 9 -sticky new
	focus .li($act).findo.ent
	bind .li($act) <Key-Return> findmatch
}


# Procedure to find transactions matching search criteria:

proc findmatch {} {
	global act linlist typoo pickline pickview boxlist
	deselall
	set critter [.li($act).findo.ent get]
	if {$critter eq ""} {
		tk_messageBox -message "Please enter search criteria" -type ok
		return
	}
	set critreg [string map "{?} {.\{1\}?} {*} {.*?}" $critter]
	switch $typoo {
		Date {set col 0}
		Num {set col 1}
		Category {set col 3}
		default {set col 2}
	}
	set findlines [lsearch -all -regexp -nocase -index $col $linlist($act) $critreg]
	set brats [.li($act).tree children {}]
	foreach find $findlines {
		.li($act).tree selection add [lindex $brats $find]
	}
	destroy .li($act).findo
	bind .li($act) <Key-Return>	{addrow reg}
	tk_messageBox -message "[llength $findlines] matching transactions\
		found. Scroll up or down to view them;\
		right-click or double-click to edit them; \"Deselect\"\
		when done" -type ok
}


# SEARCH/SELECT: DESELECT ALL

proc deselall {} {
	global highline act
	.li($act).tree selection set {}
	if {[info exists highline($act)]} {
		.li($act).tree item $highline($act) -tags {}
		set highline($act) ""
	}
}


####################################################################

# SORT/BALANCE: SORT

proc sortlist {num how} {
	global linlist boxlist nomleng nomlist act selcolor acctfile sortcol
	switch $how {
		Date {
			set sortcol($num) Date
			set sortbox .li($num).list(Date)
			set sortnum 0
		}
		Num {
			set sortcol($num) Num
			set sortbox .li($num).list(Num)
			set sortnum 1
		}
		Transaction {
			set sortcol($num) Transaction
			set sortbox .li($num).list(Transaction)
			set sortnum 2
		}
		Category {
			set sortcol($num) Category
			set sortbox .li($num).list(Category)
			set sortnum 3
		}
		default {
			tk_messageBox -message "Just click the title button of the Date,\
				Number, Transaction, or Category column to sort account list\
				by contents of that column" -type ok
			return
		}
	}
	set brats [.li($num).tree children {}]
	set linlist($num) [list]
	foreach brat $brats {
		lappend linlist($num) [lrange [.li($num).tree item $brat -values] 0 6]
	}
	set linlist($num) [lsort -index $sortnum $linlist($num)]
	.li($num).tree delete $brats
	foreach lin $linlist($num) {
		.li($num).tree insert {} end -values $lin
	}
	totall $num
	.li($num).ent(Num) selection range 0 end
	focus .li($num).ent(Num)
}


# SORT/BALANCE: CLEAR

proc markclear {} {
	global linlist act
	foreach lin [.li($act).tree selection] {
		.li($act).tree set $lin Cl "x"
	}
	.li($act).tree selection set {}
	totall $act
	list_save $act
}


# SORT/BALANCE: BALANCE STATEMENT

# Procedure to set up GUI frame for balancing statement:

proc balanstat {} {
	global act listfont
	frame .li($act).bal
	label .li($act).bal.asof -text "Statement closing date: " -pady 1
	spinbox .li($act).bal.closedate -bg $::textback -fg $::textfore \
		-buttonbackground $::buttback -width 10 -command {
		set way %d
		datespin $way %W
	}
	label .li($act).bal.clos -text " Official closing balance: " -pady 1
	entry .li($act).bal.closinent -bg $::textback -fg $::textfore -width 10
	button .li($act).bal.stat -bg $::buttback -fg $::buttfore -default normal \
		-relief solid -text "BALANCE" -command {
			balanceup 
			destroy .li($act).balfour
			bind .li($act) <Key-Return> {addrow reg}
			bind .li($act) <KP_Enter> {addrow reg}
	}
	button .li($act).bal.can -bg $::buttback -fg $::buttfore -default normal \
		-pady 1 -text "Cancel" -command {
		destroy .li($act).balfour
		bind .li($act) <Key-Return> {addrow reg}
		bind .li($act) <KP_Enter> {addrow reg}
	}
	pack .li($act).bal.asof .li($act).bal.closedate .li($act).bal.clos \
		.li($act).bal.closinent .li($act).bal.stat .li($act).bal.can \
		-in .li($act).bal -side left -expand 1 -fill x
	grid .li($act).bal -row 0 -column 0 -columnspan 9 -sticky news
	set nowsecs [clock format [clock seconds] -format {%Y/%m/%d}]
	bind .li($act) <Key-Return> {
		balanceup 
		destroy .li($act).bal
		bind .li($act) <Key-Return> {addrow reg}
	}
	bind .li($act) <KP_Enter> {
		balanceup 
		destroy .li($act).bal
		bind .li($act) <Key-Return> {addrow reg}
	}
	.li($act).bal.closedate delete 0 end
	.li($act).bal.closedate insert 0 $nowsecs
	focus .li($act).bal.closinent
}

# Procedure to find last transaction before specified date:

proc lastrans {closing} {
	global act linlist
	set clonum [string map "{/} {}" $closing]
	set endoline [expr {[llength $linlist($act)] -1}]
	set closeup ""
	for {set e $endoline} {$e >= 0} {incr e -1} {
		set datenum [string map "{/} {}" [lindex $linlist($act) $e 0]]
		if {$datenum <= $clonum} {
			set closeup [lindex $linlist($act) $e]
			break
		}
	}
	return $closeup
}

# Procedure to do the job and get the result:

proc balanceup {} {
	global act linlist sortcol
	if {$sortcol($act) ne "Date"} {
		sortlist $act Date
	}
	set balupo [deciform [.li($act).bal.closinent get]]
	set clodata [.li($act).bal.closedate get]
	if {$balupo ne ""} {
		set brats [.li($act).tree children {}]
		set linlist($act) [list]
		foreach brat $brats {
			lappend linlist($act) [.li($act).tree item $brat -values]
		}
		set clotrans [lsearch -all -inline -index 0 $linlist($act) $clodata]
		if {$clotrans eq ""} {
			set clotrans [lastrans $clodata]
		}
		if {$clotrans ne ""} {
			set clobal [lindex $clotrans end end]
		} else {
			tk_messageBox -message "Closing balance not found!" -type ok
			return
		}
		if {$clobal > $balupo} {
			tk_messageBox -message "Your stated closing balance of $clobal\
				as of $clodata is	greater	than the official closing balance\
				of $balupo	by [format %.2f [expr {$clobal - $balupo}]].\
				You may need to enter and clear additional withdrawals, or mark\
				additional existing withdrawals as cleared." -type ok
				
		} elseif {$balupo > $clobal} {
			tk_messageBox -message "Your stated closing balance of $clobal as of\
				$clodata is	less than the official closing balance of $balupo\
				by [format %.2f [expr {$balupo - $clobal}]].\
				You may need to enter and clear additional deposits, or mark\
				additional existing deposits as cleared." -type ok
		} else {
			tk_messageBox -message "YOU WIN! Your stated closing balance\
				as of $clodata is equal to the official closing balance\
				of $balupo." -type ok
		}
	}
}

# Load most recently used color scheme, if specified in configuration
# file; if not, load "AntiqueBisque" color scheme as default; if not
# that either, complain:

if {[info exists current_scheme]} {
	if {[file readable [file join $colordir $current_scheme.tcl]]} {
		source [file join $colordir $current_scheme.tcl]
	} else {
		tk_messageBox -message "Color scheme file \"$current_scheme.tcl\"\
		not found in $colordir" -type ok
	}
} elseif {[file readable [file join $colordir AntiqueBisque.tcl]]} {
	source [file join $colordir AntiqueBisque.tcl]
} else {
	tk_messageBox -message "Color scheme file not found in $colordir" -type ok
}

