home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
PC World 2000 February
/
PCWorld_2000-02_cd.bin
/
live
/
usr
/
X11R6
/
lib
/
X11
/
cbb
/
main.tcl
< prev
next >
Wrap
Text File
|
1998-10-07
|
41KB
|
1,386 lines
#!/usr/bin/wish -f
# 'CBB' -- Check Book Balancer
#
# main.tcl -- main window routines.
#
# Written by Curtis Olson. Started August 25, 1994.
#
# Copyright (C) 1994 - 1997 Curtis L. Olson - curt@sledge.mn.org
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
#
# $Id: main.tcl,v 2.28 1998/08/14 14:28:40 curt Exp $
# (Log is kept at end of this file)
#------------------------------------------------------------------------------
# Setup main window
#------------------------------------------------------------------------------
proc setup_main {} {
global cbb lib_path argv0
# Setup main window parameters
wm title . "[file tail $argv0] - $cbb(cur_file)"
wm command . "[file tail $argv0]"
wm group . .
wm iconname . "[file tail $argv0] - $cbb(cur_file)"
wm iconbitmap . @$lib_path/images/$cbb(icon_xbm)
# specify absolute placement
#wm geometry . +0+0
# The following options will enable window resizing
#wm minsize . 100 50
#wm maxsize . 1000 700
option add *font $cbb(default_font)
# Setup container frames
setup_containers
# Setup menu bar
option add *font $cbb(menu_font)
setup_menubar .menubar
setup_file_menu .menubar
setup_edit_menu .menubar
setup_functions_menu .menubar
setup_extern_menu .menubar
if { $cbb(devel) == 1 } {
setup_devel_menu .menubar
}
setup_help_menu .menubar
setup_file_prefs_menu .menubar
setup_prefs_crypt_menu .menubar
setup_prefs_appear_menu .menubar
setup_functions_goto_menu .menubar
# if { $cbb(devel) == 0 } {
# tk_menuBar .menubar .menubar.file .menubar.edit .menubar.functions \
# .menubar.extern .menubar.help
# } else {
# tk_menuBar .menubar .menubar.file .menubar.edit .menubar.functions \
# .menubar.extern .menubar.devel .menubar.help
# }
#
# tk_bindForTraversal .
# Setup headers
setup_headers
# Setup the transaction listbox and scrollbar
setup_listbox
# Setup the entry area
setup_entry_area
# setup auto hiliting of entry fields if desired
if { $cbb(auto_hilite) } {
setup_auto_hilite
}
# Setup the command bar
setup_command_bar
# Setup the account list
setup_acct_listbox
# Setup the status line
setup_status_line
update
wm deiconify .
}
#------------------------------------------------------------------------------
# Setup container frames
#------------------------------------------------------------------------------
proc setup_containers {} {
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 .acct -relief raised -borderwidth 2
frame .status -relief raised -borderwidth 2
pack .menubar -fill x
pack .head -fill x
pack .trans -fill both -expand 1
pack .entry -fill both
pack .bar -fill x
pack .acct -fill x
pack .status -fill x
}
#------------------------------------------------------------------------------
# Setup headers
#------------------------------------------------------------------------------
proc setup_headers {} {
global cbb
label .head.line1 -font $cbb(fixed_header_font) \
-text [format "%5s %-8s %-15s %9s %9s %1s %9s" \
"Chk #" "Date" "Description" "Debit" "Credit" "" "Total"] \
-padx 5 -pady -1 -foreground $cbb(head_color)
label .head.line2 -font $cbb(fixed_header_font) \
-text [format "%5s %-8s %-15s %-9s" \
"" "" "Comment" "Category"] -padx 4 -pady -1 \
-foreground $cbb(head_color)
pack .head.line1 -side top -anchor w
pack .head.line2 -side top -anchor w
}
#------------------------------------------------------------------------------
# Setup the transaction listbox and scrollbar
#------------------------------------------------------------------------------
proc setup_listbox {} {
global cbb
### listbox .trans.list -width $cbb(list_width) -height $cbb(list_height) \
### -takefocus 0 -exportselection false \
### -yscrollcommand ".trans.scroll set" -font $cbb(fixed_font)
text .trans.list -width $cbb(list_width) -height $cbb(list_height) \
-spacing1 1 -takefocus 0 -exportselection false \
-font $cbb(fixed_font) -wrap none \
-state disabled \
-yscrollcommand ".trans.scroll set"
if {[winfo depth .] > 1} {
# .trans.list tag configure color1 -background grey94 \
# -foreground black
# .trans.list tag configure color2 -background grey78 \
# -foreground black
# .trans.list tag configure color2 -underline 1
.trans.list tag configure color1 -background $cbb(list_line1_color) \
-foreground black
.trans.list tag configure color2 -background $cbb(list_line2_color) \
-foreground black
.trans.list tag configure negcolor1 -background $cbb(list_line1_color) \
-foreground red
.trans.list tag configure negcolor2 -background $cbb(list_line2_color) \
-foreground red
.trans.list tag configure cbbSel -background $cbb(hilite_color) \
-foreground black
} else {
.trans.list tag configure color1
.trans.list tag configure color2
}
bind .trans.list <ButtonRelease-1> {
listHiliteTrans [.trans.list index @%x,%y]
}
bind .trans.list <Double-Button> {
listHiliteTrans [.trans.list index @%x,%y]
update_entry_area [.trans.list index @%x,%y]
}
scrollbar .trans.scroll -takefocus 0 -command ".trans.list yview" \
-relief flat
pack .trans.scroll -side right -fill y
pack .trans.list -side left -fill both -expand 1
}
#------------------------------------------------------------------------------
# Setup the entry area
#------------------------------------------------------------------------------
proc setup_entry_area {} {
global cbb lib_path
option add *font $cbb(fixed_font)
image create photo "done" -file "$lib_path/images/mini-exclam.gif"
image create photo "cancel" -file "$lib_path/images/mini-cross.gif"
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
button .entry.line1.done -image done -command done_entering -takefocus 0
cbb_set_balloon .entry.line1.done "Done entering <Enter>"
pack .entry.line1.check -side left
pack .entry.line1.date -padx 7 -side left
pack .entry.line1.desc -side left
pack .entry.line1.debit -padx 7 -side left
pack .entry.line1.credit -side left
pack .entry.line1.clear -padx 6 -side left
pack .entry.line1.done -side right
label .entry.line2.space -width 15
entry .entry.line2.com -width 15 -relief sunken -textvariable com
entry .entry.line2.cat -width 9 -relief sunken -textvariable cat
button .entry.line2.cancel -image cancel -command clear_entry_area \
-takefocus 0
cbb_set_balloon .entry.line2.cancel "Cancel changes and start over <Meta-N>"
pack .entry.line2.space -padx 6 -side left
pack .entry.line2.com -side left
pack .entry.line2.cat -padx 7 -side left
pack .entry.line2.cancel -side right
# setup some bindings
# Change the bindtags so the following bindings execute first
# the break makes sure any other default bindings are skipped.
bindtags .entry.line1.check {.entry.line1.check Entry . all}
bindtags .entry.line1.date {.entry.line1.date Entry . all}
# Don't use "all" bindings on this field so we can control what happens
# with a <Tab> or <Shift-Tab>
bindtags .entry.line1.desc {.entry.line1.desc Entry .}
bindtags .entry.line2.cat {.entry.line2.cat Entry .}
bind .entry.line1.check + {
set check [inc_check $check]
%W icursor end
break
}
bind .entry.line1.check = {
set check [inc_check $check]
%W icursor end
break
}
bind .entry.line1.check - {
set check [dec_check $check]
%W icursor end
break
}
bind .entry.line1.check _ {
set check [dec_check $check]
%W icursor end
break
}
bind .entry.line1.date + {
set nicedate [inc_date $nicedate]
%W icursor end
break
}
bind .entry.line1.date = {
set nicedate [inc_date $nicedate]
%W icursor end
break
}
bind .entry.line1.date - {
set nicedate [dec_date $nicedate]
%W icursor end
break
}
bind .entry.line1.date _ {
set nicedate [dec_date $nicedate]
%W icursor end
break
}
}
#------------------------------------------------------------------------------
# Setup the command bar
#------------------------------------------------------------------------------
proc setup_command_bar { } {
global cbb
option add *font $cbb(button_font)
button .bar.new -text "New" -takefocus 0 -command { clear_entry_area }
cbb_set_balloon .bar.new "Cancel changes and start a new transaction \
<Meta-N>"
button .bar.edit -text "Edit" -takefocus 0 -command {
if { [listGetCurTrans] >= 1 } {
update_entry_area [listGetCurTrans].0
}
}
cbb_set_balloon .bar.edit "Edit the selected transaction <Meta-E>"
button .bar.delete -text "Delete" -takefocus 0 \
-command {
if { [listGetCurTrans] >= 1 } {
if { $cbb(debug) } { puts "Delete [listGetCurTrans].0" }
delete_trans [listGetCurTrans].0
}
}
cbb_set_balloon .bar.delete "Delete the selected transaction"
button .bar.splits -text "Splits" -takefocus 0 -command {
cbbWindow.splits
tkwait window .splits
}
cbb_set_balloon .bar.splits "Open the splits window <Meta-S>"
button .bar.balance -text "Balance" -takefocus 0 -command { balance }
cbb_set_balloon .bar.balance "Open the balance window"
button .bar.save -text "Save" -takefocus 0 -command {
if { $cbb(cur_file) != "noname.cbb" } {
acctSave
} else {
acctSaveAs
}
}
cbb_set_balloon .bar.save "Save the current file"
button .bar.quit -text "Quit" -takefocus 0 -command { cbbQuit }
cbb_set_balloon .bar.quit "Quit <Meta-Q>"
pack .bar.new .bar.edit .bar.delete .bar.splits .bar.balance .bar.save \
.bar.quit -side left -fill x -expand 1 -padx 2 -pady 1
}
#------------------------------------------------------------------------------
# Setup the acct listbox and scrollbar
#------------------------------------------------------------------------------
proc setup_acct_listbox {} {
global cbb yesno
listbox .acct.list -width $cbb(list_width) -height $cbb(acctlist_height) \
-takefocus 0 -exportselection false \
-yscrollcommand ".acct.scroll set" -font $cbb(fixed_font)
bind .acct.list <Double-Button> {
if { "[.acct.list curselection]" != "" } {
set file [.acct.list get [.acct.list curselection]].cbb
if { [acctIsDirty] } {
if { $cbb(auto_save) } {
acctSave
} else {
cbbWindow.yesno "You have not saved your current changes. \
Would you like to save before loading a new \
account?"
tkwait window .yesno
if { "$yesno(result)" == "yes" } {
acctSave
} elseif { "$yesno(result)" == "no" } {
} elseif { "$yesno(result)" == "cancel" } {
return
}
}
}
set dname [file dirname $cbb(cur_file)]
regsub " .*$" $file "" file
acctLoadFile $dname/$file.cbb
}
}
pack .acct.list -side left -fill both -expand 1
scrollbar .acct.scroll -takefocus 0 -command ".acct.list yview" \
-relief flat
pack .acct.scroll -side right -fill y -expand 1
}
proc load_acct_listbox {} {
global cbb eng
set a "no files found"
set dname [file dirname $cbb(cur_file)]
catch {set a [split [exec sh -c "cd $dname; echo *.cbb"] \ ]}
.acct.list delete 0 [.acct.list size]
foreach i $a {
set b "no files found"
set c "no files found"
if { $cbb(use_crypt) } {
catch { set b [exec sh -c "$cbb(decrypt) $cbb(crypt_code) < \
$dname/$i 2>/dev/null | grep '# Current Balance = '"]}
catch { set c [exec sh -c "$cbb(decrypt) $cbb(crypt_code) < \
$dname/$i 2>/dev/null | grep '# Ending Balance = '"]}
} else {
catch {set b [exec grep "# Current Balance = " $dname/$i]}
catch {set c [exec grep "# Ending Balance = " $dname/$i]}
}
regsub ".* " $b "" b
regsub ".* " $c "" c
regsub "\.cbb" $i "" i
# get the account description
puts $eng "get_cat_info \[$i\]"; flush $eng
gets $eng desc
if { "$desc" != "none" } {
set pieces [split $desc "\t"]
set desc [lindex $pieces 0]
}
# .acct.list insert end [format "%-16s %-37s %11s" $i $desc $b]
.acct.list insert end \
[format "%-16s %-24.24s %11s %11s" $i $desc $b $c]
}
update
}
#------------------------------------------------------------------------------
# Setup the status line
#------------------------------------------------------------------------------
proc setup_status_line { } {
global cbb argv0
label .status.line -text "Welcome to [file tail $argv0]" \
-font $cbb(status_line_font)
pack .status.line -fill both -expand 1
}
#------------------------------------------------------------------------------
# Functions for the text box
#------------------------------------------------------------------------------
proc listAddTrans {line1 line2} {
global cbb date start_pos
set total [string range $line1 58 67]
if { $cbb(debug) } { puts " --> $total" }
set total [expr $total + 0]
if { $cbb(debug) } { puts " --> $total" }
if { $total < 0 } {
set negative 1
} else {
set negative 0
}
set tmp_date [string range $line1 72 79]
if { $cbb(debug) } { puts "$date - $tmp_date" }
if { $negative } {
.trans.list insert end "$line1\n" negcolor1
.trans.list insert end "$line2\n" negcolor2
} else {
.trans.list insert end "$line1\n" color1
.trans.list insert end "$line2\n" color2
}
if { $tmp_date <= $date } {
set start_pos [listGetSize]
}
}
proc listGetSize {} {
scan [.trans.list index end] "%d.%d" line col
return [expr $line - 2]
}
proc listGetCurTrans {} {
global cbb
if { "[.trans.list tag nextrange cbbSel 1.0 end ]" != "" } {
scan [.trans.list tag nextrange cbbSel 1.0 end ] "%d.%d" line col
# set line [expr $line + 1]
} else {
set line -1
}
if { $cbb(debug) } { puts $line }
return $line
}
proc listHiliteTrans index {
global cbb
scan $index "%d.%d" line col
.trans.list tag remove sel 1.0 end
.trans.list tag remove cbbSel 1.0 end
if { $line < 1 } {
set line 1
}
if { [ expr $line / 2.0 ] != [ expr $line / 2] } {
set index1 $line
set index2 [ expr $line + 1 ]
} else {
set index1 [ expr $line - 1 ]
set index2 $line
}
.trans.list tag add cbbSel ${index1}.0 ${index2}.0lineend
.trans.list see ${index1}.0
.trans.list see ${index2}.0
}
#------------------------------------------------------------------------------
# Functions for entry area
#------------------------------------------------------------------------------
proc update_globals result {
global cbb eng key 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 "\t"]
set key [lindex $pieces 0]
set date [lindex $pieces 1]
if { [string length $date] == 6 } {
set year "$cbb(century)[string range $date 0 1]"
set month [string range $date 2 3]
set day [string range $date 4 5]
} else {
set year [string range $date 0 3]
set month [string range $date 4 5]
set day [string range $date 6 7]
}
if { $cbb(date_fmt) == 1 } {
set nicedate "$month/$day/[string range $year 2 3]"
} else {
set nicedate "$day.$month.[string range $year 2 3]"
}
set check [lindex $pieces 2]
set desc [lindex $pieces 3]
scan [lindex $pieces 4] "%f" debit
scan [lindex $pieces 5] "%f" credit
set debit [format "%.2f" $debit];
set credit [format "%.2f" $credit];
set cat [lindex $pieces 6]
if { [string range $cat 0 0] == "|" } {
set nicecat "-Splits-"
} else {
set nicecat $cat
}
set nicecat [string range $nicecat 0 8]
set com [lindex $pieces 7]
set cleared [lindex $pieces 8]
scan [lindex $pieces 9] "%f" total
}
# given a memorized transaction, update the relevant fields
proc update_from_mem result {
global eng desc debit credit cat nicecat com
set desc ""; set debit 0.00; set credit 0.00; set cat ""; set nicecat ""
set com "";
set pieces [split $result "\t"]
set desc [lindex $pieces 3]
scan [lindex $pieces 4] "%f" debit
scan [lindex $pieces 5] "%f" credit
set cat [lindex $pieces 6]
if { [string range $cat 0 0] == "|" } {
set nicecat "-Splits-"
} else {
set nicecat $cat
}
set nicecat [string range $nicecat 0 8]
set com [lindex $pieces 7]
set debit [format "%.2f" $debit];
set credit [format "%.2f" $credit];
}
proc find_index_from_key args {
global cbb
# given a newkey, return the index of the first affected transaction
set arglist [split $args]
set cbb(index1) [lindex $arglist 0]
set newkey [lindex $arglist 1]
if { $cbb(debug) } { puts "find: cbb(index1) = $cbb(index1) newkey = $newkey" }
if { [expr $cbb(index1) / 2.0] == [expr $cbb(index1) / 2] } {
set cbb(index1) [expr $cbb(index1) - 1]
}
if { $cbb(index1) < 1 } {
set cbb(index1) 1
}
set line [.trans.list get $cbb(index1).0 $cbb(index1).0lineend ]
set key [string range $line 72 end]
if { $cbb(debug) } { puts "target = $newkey current = $key" }
if { [string compare "$newkey" "$key"] == -1 } {
# we changed the date to something previous
while { [expr [string compare "$newkey" "$key"] == -1 && $cbb(index1) > 0]} {
set cbb(index1) [expr $cbb(index1) - 2]
set line [.trans.list get $cbb(index1).0 $cbb(index1).0lineend ]
set key [string range $line 72 end]
if { $cbb(debug) } { puts "target = $newkey current = $key" }
}
return [expr $cbb(index1)]
} else {
# we changed the date to something forward or this is the trivial case
return [expr $cbb(index1) - 2]
}
}
proc find_index_from_date date {
global cbb
# given a date in the form yyyymmdd, return the index of the transaction
# which is previous to the next higher date
if { $cbb(debug) } { puts "find: date = $date" }
set index [listGetSize]
set line [.trans.list get ${index}.0 ${index}.0lineend ]
set linedate [string range $line 72 79]
if { $cbb(debug) } { puts "target = $date current = $linedate" }
while { [expr [string compare "$date" "$linedate"] == -1 && $index > 0]} {
set index [expr $index - 2]
set line [.trans.list get ${index}.0 ${index}.0lineend ]
set linedate [string range $line 72 79]
if { $cbb(debug) } { puts "target = $date current = $linedate" }
}
return [expr $index]
}
proc update_rest args {
global cbb key eng date nicedate year month day check desc debit credit cat
global nicecat com cleared total
set arglist [split $args]
set cbb(index1) [lindex $arglist 0]
set newkey [lindex $arglist 1]
if { $cbb(debug) } { puts "update_rest: $cbb(index1) $newkey" }
# save the current listbox view ...
set yview_list [.trans.list yview]
if { $cbb(debug) } { puts "Saving current view: $yview_list" }
set yview_saved [lindex $yview_list 0]
if { $cbb(debug) } { puts $yview_saved }
# delete everything from the change forward, then rebuild our list from
# there
set cbb(index1) [find_index_from_key $cbb(index1) $newkey]
if { [expr $cbb(index1) < 0] } {
set cbb(index1) 1
}
set cbb(index2) [expr $cbb(index1) + 1]
if { $cbb(debug) } { puts "deleting from: $cbb(index1).0 to end" }
set line [.trans.list get $cbb(index1).0 $cbb(index1).0lineend ]
set key [string range $line 72 end]
.trans.list configure -state normal
.trans.list delete $cbb(index1).0 end
.trans.list configure -state disabled
if { $cbb(debug) } { puts [string range $line 70 end] }
if { $cbb(debug) } { puts "adding entries from $key to end" }
if { $cbb(index1) == 1 } {
puts $eng "first_trans"; flush $eng
} else {
puts $eng "find_trans $key"; flush $eng
.trans.list configure -state normal
.trans.list insert end "\n"
.trans.list configure -state disabled
}
.trans.list configure -state normal
gets $eng result
while { $result != "none" } {
update_globals $result
set checklen [string length $check]
if { $checklen > 5 } {
set cutcheck [string range $check [expr $checklen - 5] end]
} else {
set cutcheck $check
}
set cutdesc [string range $desc 0 14]
set cutcom [string range $com 0 14]
listAddTrans \
[format "%5s %-8s %-15s %9.2f %9.2f %-1s %9.2f %14s" \
$cutcheck $nicedate $cutdesc $debit $credit $cleared $total \
$key] \
[format "%5s %-8s %-15s %-9s %39s" "" "" $cutcom $nicecat \
$key]
# try keep the selection with the original transaction
if { $key == $newkey } {
set cbb(selected) [expr [listGetSize] - 1]
listHiliteTrans $cbb(selected).0
set cbb(cur_date) $nicedate
if { "$check" != "" } {
set cbb(next_chk) $check
}
}
puts $eng "next_trans"; flush $eng
gets $eng result
}
.trans.list configure -state disabled
# now try to restore the current view ...
.trans.list yview moveto $yview_saved
set temp [listGetCurTrans]
if { $temp >= 1 } {
.trans.list see ${temp}.0
} else {
.trans.list see 1.0
}
}
proc update_line args {
global cbb key eng date nicedate year month day check desc debit credit cat
global nicecat com cleared total
set arglist [split $args]
set cbb(index1) [lindex $arglist 0]
set key [lindex $arglist 1]
set temp [listGetCurTrans]
if { $temp >= 1 } {
set cbb(selected) $temp
} else {
set cbb(selected) 1
}
if { $cbb(debug) } { puts "update_line: $cbb(index1) $key" }
# delete trans and re-insert
set cbb(index2) [expr $cbb(index1) + 1]
if { $cbb(debug) } { puts "deleting from: $cbb(index1) to $cbb(index2)" }
set line [.trans.list get $cbb(index1).0 $cbb(index1).0lineend ]
set key [string range $line 72 end]
.trans.list configure -state normal
.trans.list delete $cbb(index1).0 [expr $cbb(index2) + 1].0
.trans.list configure -state disabled
if { $cbb(debug) } { puts "re-inserting entry" }
puts $eng "find_trans $key"; flush $eng
gets $eng result
update_globals $result
set checklen [string length $check]
if { $checklen > 5 } {
set cutcheck [string range $check [expr $checklen - 5] end]
} else {
set cutcheck $check
}
set cutdesc [string range $desc 0 14]
set cutcom [string range $com 0 14]
.trans.list configure -state normal
.trans.list insert $cbb(index1).0 \
[format "%5s %-8s %-15s %9.2f %9.2f %-1s %9.2f %14s\n" \
$cutcheck $nicedate $cutdesc $debit $credit $cleared $total \
$key] color1
.trans.list insert $cbb(index2).0 \
[format "%5s %-8s %-15s %-9s %39s\n" "" "" $cutcom $nicecat \
$key] color2
.trans.list configure -state disabled
listHiliteTrans $cbb(selected)
}
proc clear_entry_area {} {
global cbb key eng date nicedate year month day check desc debit credit cat
global nicecat com cleared total
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 { "$cbb(cur_date)" != "" } {
set nicedate $cbb(cur_date)
} else {
# set nicedate [fmtclock [getclock] "%m/%d/%y"]
puts $eng "nice_date $cbb(date_fmt)"; flush $eng
gets $eng nicedate
set cbb(cur_date) $nicedate
}
# set date [fmtclock [getclock] "%Y%m%d"]
puts $eng "raw_date"; flush $eng
gets $eng date
# get internal sdate, if sdate is defined
if { $cbb(sdate) != "" } {
puts $eng "start_date $cbb(sdate)"; flush $eng
gets $eng cbb(int_sdate)
}
if { $cbb(debug) } { puts $nicedate; puts $date }
set cbb(no_more_mem) 0
focus .entry.line1.check
}
proc update_entry_area lineindex {
global cbb key eng date nicedate year month day check desc debit credit cat
global nicecat com cleared total
scan $lineindex "%d.%d" item col
set item [expr $item + 1]
set cbb(no_more_mem) 1
set cbb(selected) $item
if { [expr $item / 2.0] == [expr $item / 2] } {
set cbb(index1) $item
set cbb(index2) [expr $item + 1]
} else {
set cbb(index1) [expr $item - 1]
set cbb(index2) $item
}
set line [.trans.list get $cbb(index1).0 $cbb(index1).0lineend ]
set key [string range $line 72 end]
puts $eng "find_trans $key"; flush $eng
gets $eng result
if { $cbb(debug) } { puts $result }
if { $result != "none" } {
update_globals $result
}
# warn if about to edit a closed transaction
if { "$cleared" == "x" } {
cbbWindow.ok "You are about to edit a ``Closed'' transaction. \
Hopefully you know what you are doing."
tkwait window .ok
}
# warn if about to edit a transfer transaction
if { "[string range $cat 0 0]" == "\[" } {
cbbWindow.ok "Notice: You are about to edit a ``Transfer'' transaction. \
The corresponding transaction in the file ``$cat'' \
will also be updated."
tkwait window .ok
}
focus .entry.line1.check
}
proc done_entering {} {
global cbb yesno key eng date nicedate year month day check desc debit
global credit cat nicecat com cleared total addcat
if { $cbb(debug) } { puts "Done entering ..." }
# check for a valid file
if { "$cbb(cur_file)" == "noname.cbb" } {
cbbWindow.ok "You must Make or Load an Account First."
tkwait window .ok
return
} elseif { "$cbb(cur_file)" == ""} {
cbbWindow.ok "You must Make or Load an Account First."
tkwait window .ok
return
}
# we now have something to save
acctSetDirty
# do some consistency checking here
if { "$desc" == "" } {
cbbWindow.yesno "You have not entered anything in the description \
field. Would you like to continue?"
tkwait window .yesno
if { "$yesno(result)" != "yes" } {
return
}
}
# pad date if needed
if { $cbb(date_fmt) == 1 } {
set pieces [split $nicedate /]
set month [lindex $pieces 0]
set day [lindex $pieces 1]
} else {
set pieces [split $nicedate .]
set day [lindex $pieces 0]
set month [lindex $pieces 1]
}
if { [lindex $pieces 2] != "" } {
set year [lindex $pieces 2]
} else {
# get last entered year
set pieces [split $cbb(cur_date) /]
set year [lindex $pieces 2]
}
set month [pad $month]
set day [pad $day]
set year [pad $year]
if { [string length $year] == 2 } {
set year $cbb(century)$year
}
if { $cbb(date_fmt) == 1 } {
if { $cbb(debug) } { puts "$month/$day/$year" }
set nicedate "$month/$day/$year"
} else {
if { $cbb(debug) } { puts "$day.$month.$year" }
set nicedate "$day.$month.$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" == "" } {
cbbWindow.yesno "You have not entered anything in the category \
field. Would you like to continue?"
tkwait window .yesno
if { "$yesno(result)" != "yes" } {
return
}
} else {
set addcat(cat) $cat
set addcat(mode) "missing"
cbbWindow.newcat
tkwait window .newcat
if { $cbb(debug) } { puts $addcat(result) }
if { "$addcat(result)" != "yes" } {
return
}
}
}
# verify cleared field
set cleared [string range $cleared 0 0]
if { "$cleared" == "x" } {
# ok
} elseif { "$cleared" == "*" } {
# ok
} elseif { "$cleared" == "?" } {
# ok
} elseif { "$cleared" == "" } {
# ok
} else {
set cleared ""
}
if { "$key" == "" } {
# new entry ... insert
if { "[string range $cat 0 0]" == "\[" } {
# transfer transaction
puts $eng "create_xfer $year$month$day\t$check\t$desc\t$debit\t$credit\t$cat\t$com\t$cleared\t0.00"
} else {
# normal transaction
puts $eng "create_trans $year$month$day\t$check\t$desc\t$debit\t$credit\t$cat\t$com\t$cleared\t0.00"
}
flush $eng
gets $eng result
if { $cbb(debug) } { puts "result: create_trans $result" }
if { "$result" == "error" } {
cbbWindow.ok "Your transaction entry returned an error: \
'$result'. If it was a transfer transaction, it probably \
couldn't find the ``to'' account. Things could \
potentially be in an unsettled state. You should \
probably save everything and manually make sure things \
are ok."
} else {
undoRegister "insert $result"
}
update_rest [listGetSize] [string range $result 0 10]
} else {
if { [string length "$key"] != 11 } {
# try to make sure we have a valid key
cbbWindow.ok "Bad key value '$key'. This transaction is aborted."
tkwait window .ok
set key ""
return
}
if { [string first "-" "$key"] != 8 } {
# try to make sure we have a valid key
cbbWindow.ok "Bad key value '$key'. This transaction is aborted."
tkwait window .ok
set key ""
return
}
# if { "[string range $cat 0 0]" == "\[" } {
# cbbWindow.ok "You have edited a ``Transfer'' transaction. The \
# corresponding transaction in the file ``$cat'' cannot \
# currently be changed. You must do this manually."
# tkwait window .ok
# }
# first record the official version of this transaction so we can be
# able to undelete it later
puts $eng "find_trans $key"; flush $eng
gets $eng origresult
# updating an existing entry
if { "[string range $cat 0 0]" == "\[" } {
# transfer transaction
puts $eng "update_xfer $key\t$year$month$day\t$check\t$desc\t$debit\t$credit\t$cat\t$com\t$cleared\t0.00"
} else {
puts $eng "update_trans $key\t$year$month$day\t$check\t$desc\t$debit\t$credit\t$cat\t$com\t$cleared\t0.00"
}
flush $eng
gets $eng result
if { "$cbb(index1)" == "" } {
set cbb(index1) [listGetSize]
}
update_rest $cbb(index1) [string range $result 0 10]
undoRegister "edit [string range $result 0 10]\t$origresult"
}
# try keep the entry area in sync with the selection
goto $cbb(selected)
clear_entry_area
}
proc delete_trans lineindex {
global cbb yesno eng cat cleared
scan $lineindex "%d.%d" item col
# set item [expr $item - 1]
acctSetDirty
if { [expr $item / 2.0] != [expr $item / 2] } {
set cbb(index1) $item
set cbb(index2) [expr $item + 1]
} else {
set cbb(index1) [expr $item - 1]
set cbb(index2) $item
}
set line [.trans.list get $cbb(index1).0 $cbb(index1).0lineend ]
set key [string range $line 72 end]
# first record the official version of this transaction so we can be
# able to undelete it later
puts $eng "find_trans $key"; flush $eng
gets $eng result
update_globals $result
undoRegister "delete $result"
if { "[string range $cat 0 0]" == "\[" } {
cbbWindow.ok "Notice: You are deleting a ``Transfer'' transaction. \
The corresponding transaction in the file ``$cat'' will \
also be deleted."
tkwait window .ok
}
if { "$cleared" == "x" } {
cbbWindow.yesno "You are deleting a ``Closed'' transaction. Continue \
with delete?"
tkwait window .yesno
if { "$yesno(result)" == "yes" } {
} elseif { "$yesno(result)" == "no" } {
return
} elseif { "$yesno(result)" == "cancel" } {
return
}
}
if { "[string range $cat 0 0]" == "\[" } {
puts $eng "delete_xfer $key"; flush $eng
} else {
puts $eng "delete_trans $key"; flush $eng
}
gets $eng result
if { $cbb(debug) } { puts "deleting: $result" }
update_rest $cbb(index1) $key
goto $cbb(index1)
clear_entry_area
}
#------------------------------------------------------------------------------
# Miscellaneous functions
#------------------------------------------------------------------------------
proc goto line {
global cbb
if { $cbb(debug) } { puts "Size = [listGetSize] Goto = $line" }
set max [expr [listGetSize] - 1]
if { $line > $max } {
set line $max
}
if { [expr $line / 2.0] == [expr $line / 2] } {
set line [expr $line - 1]
}
### .trans.list see $line
### .trans.list see [expr $line + 1]
### .trans.list selection clear 0 end
### .trans.list selection set $line $line
listHiliteTrans $line
}
proc acctSetClean { } {
global cbb
set cbb(clean) 1
if { [winfo exists .bar.save] } {
.bar.save configure -text "Save"
cbb_set_balloon .bar.save "Save the current file (file is clean)"
}
# update account listbox (if it exists)
if { [winfo exists .acct.list] } {
load_acct_listbox
}
}
proc acctSetDirty { } {
global cbb
set cbb(clean) 0
if { [winfo exists .bar.save] } {
.bar.save configure -text "Save!"
cbb_set_balloon .bar.save \
"Save the current file (file has been changed)"
}
}
proc acctIsDirty { } {
global cbb
return [expr 1 - $cbb(clean)]
}
# ----------------------------------------------------------------------------
# $Log: main.tcl,v $
# Revision 2.28 1998/08/14 14:28:40 curt
# Added desc-pie graph.
# Added option to eliminate splash screen.
# Other misc. tweaks and bug fixes.
#
# Revision 2.27 1997/06/12 21:53:14 curt
# Applied more patches from Martin Schenk <schenkm@ping.at>. His changes
# greatly improved and developed the preferences menu so it is now actually
# usable to set preferences.
# Current data file is now saved in ~/.cbbcur.tcl
#
# Revision 2.26 1997/05/06 01:00:25 curt
# Added patches contributed by Martin Schenk <schenkm@ping.at>
# - Default to umask of 066 so .CBB files get created rw by owner only
# - Added support for pgp encrypting data files
# - Added support for displaying only recent parts of files (avoids
# waiting to load in lots of old txns you don't currently need.)
# - Added a feature to "cache" whole accounts in the perl engine so
# that switching between accounts can be faster.
# - The above options can be turned on/off via the preferrences menu.
#
# Revision 2.25 1997/04/12 01:15:26 curt
# Display current balance rather than ending balance in the account list
# box. This makes a difference if you like to insert future transactions.
#
# Revision 2.24 1997/04/11 20:26:53 curt
# $index1, $index2 wrapped up so they are now $cbb(index1), and $cbb(index2)
#
# Revision 2.23 1997/04/04 22:50:20 curt
# Tweaked the previous fix.
#
# Revision 2.22 1997/04/04 18:44:48 curt
# Commented out some old menubar baggage.
# Fixed a harmless, but annoying bug that caused a pop up tk error message
# on occasion when manipulating the account list box.
#
# Revision 2.21 1997/04/03 03:54:49 curt
# Enable auto save without prompting when switching to a new account.
# Contributed by Jonathan I. Kamens <jik@kamens.brookline.ma.us>
#
# Revision 2.20 1997/04/03 03:42:20 curt
# Heading, line 2 color was hardcoded rather than honoring the header color
# variable.
#
# Revision 2.19 1997/03/04 03:22:39 curt
# Fixed bug which showed up when hitting '+' in a blank check # field after
# an account had been loaded, but before any transactions with a check number
# had been added.
#
# Revision 2.18 1997/02/19 18:08:06 curt
# Fixed a bug with long check numbers (> 5 char) in the balance window.
# Nailed a bug which caused cbb to forget the last check # entered when
# using +/- in the check number field.
#
# Revision 2.17 1997/01/28 03:25:24 curt
# Force strict scoping in all perl scripts.
#
# Revision 2.16 1997/01/16 19:15:42 curt
# Miscellaneous interface tweaks.
#
# Revision 2.15 1997/01/10 22:03:32 curt
# Transfer fixups and a few other misc. fixes contributed by
# Lionel Mallet <Lionel.Mallet@sophia.inria.fr>
#
# Revision 2.14 1997/01/09 04:03:06 curt
# Allow user to specify colors of alternating transaction lines.
#
# Revision 2.13 1997/01/09 03:56:59 curt
# Added contrib script loan.pl.
# User sizable account list.
# Removed some old gnuplot baggage from install.pl.
#
# Revision 2.12 1997/01/02 04:38:36 curt
# Changes over the 1996 holidays:
# - Converted listbox to text widget. This allows us to do nice
# things with alternating background colors, highliting, red
# negative numbers, etc.
# - Negative transactions are now drawn in red.
# - Added a Goto <Today> option.
# - <Home> & <End> were double bound. Now, listbox can be traversed with
# <Meta-Home> and <Meta-End>
#
# Revision 2.11 1996/12/17 20:15:44 curt
# Version incremented to 0.70.
# No longer save running total in .cbb files.
# Miscellaneous tweaks.
#
# Revision 2.10 1996/12/17 14:54:00 curt
# Updated copyright date.
#
# Revision 2.9 1996/12/16 04:18:21 curt
# Continuing the great overhaul of December 1996.
#
# Revision 2.8 1996/12/14 17:15:23 curt
# The great overhaul of December '96.
#
# Revision 2.7 1996/12/13 01:26:59 curt
# Worked on getting reports.tcl to work smoothly.
#
# Revision 2.6 1996/12/11 18:33:38 curt
# Ran a spell checker.
#
# Revision 2.5 1996/12/11 04:32:31 curt
# Several minor tweaks.
#
# Revision 2.4 1996/12/11 01:03:44 curt
# Added balloon help support.
#
# Revision 2.3 1996/12/09 14:38:23 curt
# Added "ok" and "cancel" buttons to entry area. Tweaked check# and data +/-
# bindings.
#
# Revision 2.2 1996/12/08 07:40:01 curt
# Rearranged quite a bit of code.
# Put most global variables in cbb() structure.
#
# Revision 2.1 1996/12/07 20:38:16 curt
# Renamed *.tk -> *.tcl
#
# Revision 2.10 1996/10/03 04:49:00 curt
# Fixed an inconsistency in &raw_date() in common.pl (with how it was
# called.)
#
# Version now is 0.67-beta-x
#
# Revision 2.9 1996/10/03 03:57:37 curt
# Adjusted spacing of 2nd entry line so fields better align with the first.
#
# Revision 2.8 1996/10/02 19:37:20 curt
# Replaced instances of hardcoded century (19) with a variable. We need to
# know the current century in cases where it is not provided and it is
# assumed to be the current century. Someday I need to figure out how
# to determine the current century, but I have a couple of years to do it. :-)
#
# I still need to fix conf-reports and reports.pl
#
# Revision 2.7 1996/10/01 20:25:38 curt
# Added better handling of unknown category when trying to "commit" a
# transaction.
#
# Revision 2.6 1996/09/30 15:14:38 curt
# Updated CBB URL, and hardwired wish path.
#
# Revision 2.5 1996/09/25 17:45:42 curt
# Revamped tab completions in description and category fields.
# Fixed a problem with autohiliting. When tabbing to a blank field, we used
# to leave the previous hilited field hilited.
#
# Revision 2.4 1996/08/29 14:22:33 curt
# <Meta-Tab> changed to <Control-Tab> in desc field.
#
# Revision 2.3 1996/07/13 02:57:49 curt
# Version 0.65
# Packing Changes
# Documenation changes
# Changes to handle a value in both debit and credit fields.
#
# Revision 2.2 1996/03/03 00:16:13 curt
# Modified Files: cbb categories.pl wrapper.pl file.tk main.tk menu.tk
# Added an account list at the bottom of the screen. Thanks to:
# Cengiz Alaettinoglu <cengiz@ISI.EDU> for this great addition.
#
# Revision 2.1 1996/02/27 05:35:48 curt
# Just stumbling around a bit with cvs ... :-(
#
# Revision 2.0 1996/02/27 04:43:01 curt
# Initial 2.0 revision. (See "Log" files for old history.)