home *** CD-ROM | disk | FTP | other *** search
/ Chip: Linux Special / CorelLinux_CHIP.iso / live / usr / X11R6 / lib / X11 / cbb / splits.tcl < prev    next >
Encoding:
Tcl/Tk script  |  1998-10-07  |  7.9 KB  |  276 lines
  1. #!/usr/bin/wish -f
  2. #  'CBB' -- Check Book Balancer
  3. #
  4. #   splits.tcl -- Routines to handle splits.
  5. #
  6. #  Written by Curtis Olson.  Started December 7, 1996.
  7. #
  8. #  Copyright (C) 1994 - 1997  Curtis L. Olson  - curt@sledge.mn.org
  9. #
  10. #  This program is free software; you can redistribute it and/or modify
  11. #  it under the terms of the GNU General Public License as published by
  12. #  the Free Software Foundation; either version 2 of the License, or
  13. #  (at your option) any later version.
  14. #
  15. #  This program is distributed in the hope that it will be useful,
  16. #  but WITHOUT ANY WARRANTY; without even the implied warranty of
  17. #  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18. #  GNU General Public License for more details.
  19. #
  20. #  You should have received a copy of the GNU General Public License
  21. #  along with this program; if not, write to the Free Software
  22. #  Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  23. #
  24. # $Id: splits.tcl,v 2.6 1997/04/23 18:09:42 curt Exp $
  25. # (Log is kept at end of this file)
  26.  
  27.  
  28. #------------------------------------------------------------------------------
  29. # Procedures for category split processing
  30. #------------------------------------------------------------------------------
  31.  
  32. proc cbbWindow.splits {} {
  33.     global cbb desc cat credit debit cats coms amts 
  34.  
  35.     if {[winfo exists .splits] == 1} {
  36.     destroy .splits
  37.     }
  38.  
  39.     option add *font $cbb(dialog_font)
  40.  
  41.     toplevel .splits
  42.  
  43.     wm title .splits "Category Splits"
  44.     wm iconname .splits "Category Splits"
  45.  
  46.     frame .splits.frame -borderwidth 2 -relief raised
  47.     pack .splits.frame -side top -fill both -expand 1
  48.  
  49.     if { "$credit" == "" } {
  50.     set credit 0.00
  51.     }
  52.  
  53.     if { "$debit" == "" } {
  54.     set debit 0.00
  55.     }
  56.  
  57.     label .splits.frame.head -text "[string range $desc 0 30] =:= \
  58.         [format "%.2f" [expr $credit - $debit]]"
  59.     pack .splits.frame.head -anchor w -fill x
  60.  
  61.     if { $cbb(debug) } { puts $cat }
  62.  
  63.     set pieces [split $cat |]
  64.  
  65.     option add *font $cbb(fixed_header_font)
  66.     frame .splits.frame.label
  67.     label .splits.frame.label.cat -text "  Category     "
  68.     label .splits.frame.label.com -text "   Comment     "
  69.     label .splits.frame.label.amt -text " Amount  "
  70.     pack .splits.frame.label -side top -fill x
  71.     pack .splits.frame.label.cat .splits.frame.label.com \
  72.          .splits.frame.label.amt -side left -expand 1
  73.  
  74.     option add *font $cbb(fixed_font)
  75.  
  76.     set i 0
  77.     while { $i < $cbb(max_splits) } {
  78.     # setup widgets
  79.     frame .splits.frame.line$i
  80.  
  81.     entry .splits.frame.line$i.cat$i -relief sunken -width 15 \
  82.         -textvariable cats($i)
  83.  
  84.     set command "bindtags .splits.frame.line$i.cat$i \
  85.         {.splits.frame.line$i.cat$i Entry .}"
  86.     eval $command
  87.  
  88.     # bind .splits.frame.line$i.cat$i <FocusOut> 
  89.     bind .splits.frame.line$i.cat$i <Tab> {
  90.         splitsLeavingCat %W
  91.     }
  92.     bind .splits.frame.line$i.cat$i <Shift-Tab> {focus [tk_focusPrev %W]}
  93.  
  94.     entry .splits.frame.line$i.com$i -relief sunken -width 15 \
  95.         -textvariable coms($i)
  96.  
  97.     entry .splits.frame.line$i.amt$i -relief sunken -width 9 \
  98.         -textvariable amts($i)
  99.  
  100.     bind .splits.frame.line$i.amt$i <FocusOut> {
  101.         splitsLeavingAmt %W
  102.     }
  103.  
  104.     bind .splits.frame.line$i.cat$i <Meta-c> { cbbWindow.catwin }
  105.     bind .splits.frame.line$i.cat$i <Alt-c> { cbbWindow.catwin }
  106.     bind .splits.frame.line$i.com$i <Meta-c> { cbbWindow.catwin }
  107.     bind .splits.frame.line$i.com$i <Alt-c> { cbbWindow.catwin }
  108.     bind .splits.frame.line$i.amt$i <Meta-c> { cbbWindow.catwin }
  109.     bind .splits.frame.line$i.amt$i <Alt-c> { cbbWindow.catwin }
  110.  
  111.     set cats($i) [lindex $pieces [expr 1 + $i * 3]]
  112.     set coms($i) [lindex $pieces [expr 2 + $i * 3]]
  113.     set amts($i) [lindex $pieces [expr 3 + $i * 3]]
  114.     pack .splits.frame.line$i -side top -fill x -expand 1
  115.     pack .splits.frame.line$i.cat$i .splits.frame.line$i.com$i \
  116.          .splits.frame.line$i.amt$i -side left -expand 1 -fill x
  117.  
  118.     incr i
  119.     }
  120.  
  121.     # try to do some fancier initial splits handling
  122.     if { "[string range $cat 0 0]" != "|" } {
  123.     if { $cbb(debug) } { puts "not a split = $cat" }
  124.     set cats(0) $cat
  125.     set amts(0) [format "%.2f" [expr $credit - $debit]]
  126.     }
  127.     
  128.     label .splits.frame.total -borderwidth 2 \
  129.             -text "Sum = [splitsSum]" -font $cbb(dialog_font)
  130.     pack .splits.frame.total -side bottom -after .splits.frame.label \
  131.     -fill x -expand 1
  132.  
  133.     button .splits.frame.dismiss -text " Dismiss " -font $cbb(button_font) \
  134.         -takefocus 0 -command {
  135.     # check to see if splits add up
  136.     if { $debit > 0 } {
  137.         if { [splitsSum] != [format "%.2f" -$debit] } {
  138.         cbbWindow.ok "Warning:  Sum of splits, [splitsSum], does not \
  139.             match transaction value, -$debit."
  140.         tkwait window .ok
  141.         }
  142.     } else {
  143.         if { [splitsSum] != [format "%.2f" $credit] } {
  144.         cbbWindow.ok "Warning:  Sum of splits, [splitsSum], does not \
  145.             match transaction value, $credit."
  146.         tkwait window .ok
  147.         }
  148.     }
  149.  
  150.     # recreate internal splits category record
  151.     set i 0
  152.     set cat |
  153.     while { $i < $cbb(max_splits) } {
  154.         if { "$amts($i)" != "" } {
  155.         append cat $cats($i) | $coms($i) | [format "%.2f" $amts($i)] |
  156.         }
  157.         incr i
  158.     }
  159.     destroy .splits
  160.     }
  161.     pack .splits.frame.dismiss -side bottom -after .splits.frame.label \
  162.     -fill x -padx 8 -pady 4
  163.  
  164.     focus .splits.frame.line0.cat0
  165.     update
  166. }
  167.  
  168.  
  169. proc splitsLeavingCat { field } {
  170.     global cbb eng cats addcat
  171.  
  172.     # just left a split category field
  173.  
  174.     set pos [string last cat $field]
  175.     set cur_split [string range $field [expr $pos + 3] end]
  176.  
  177.     if { $cbb(debug) } { puts "$cats($cur_split)" }
  178.  
  179.     puts $eng "find_cat $cats($cur_split)"; flush $eng
  180.     gets $eng result
  181.     if { "$result" != "none" } {
  182.     if { $cbb(debug) } { puts $result }
  183.     if { [string range $result 0 13] == "partial_match:" } {
  184.         set cats($cur_split) [string range $result 14 end]             
  185.         .status.line configure -text \
  186.             "Partial completion:  '$cats($cur_split)'"
  187.     } else {              
  188.         set cats($cur_split) $result
  189.         .status.line configure -text "Unique category found."
  190.         focus [tk_focusNext $field];
  191.     }                                                
  192.     } elseif { "$cats($cur_split)" == "" } {
  193.     # empty field, allow tabbing
  194.     focus [tk_focusNext $field];
  195.     } else {
  196.     set addcat(cat) $cats($cur_split)
  197.     set addcat(mode) "missing"
  198.     cbbWindow.newcat
  199.     tkwait window .newcat
  200.     }
  201.     if { $cbb(debug) } { puts "Leaving $cur_split --> $cats($cur_split)" }
  202. }
  203.  
  204.  
  205. proc splitsLeavingAmt { field } {
  206.     global cbb
  207.  
  208.     # just left an amt field
  209.  
  210.     set text "Sum = [splitsSum]"
  211.     .splits.frame.total configure -text $text
  212.     if { $cbb(debug) } { puts "Leaving amount field" }
  213. }
  214.  
  215. proc splitsSum {} {
  216.     global cbb debit credit cats amts
  217.  
  218.     set trans_total [expr $credit - $debit]
  219.  
  220.     set total 0
  221.     set i 0
  222.     while { $i < $cbb(max_splits) } {
  223.         set amount $amts($i)
  224.     set diff [format "%.2f" [expr $trans_total - $total]]
  225.     if { "$amount" != "" } {
  226.         if { "$cats($i)" != "" } {
  227.         if { $cbb(debug) } { puts "$i $amount" }
  228.         set total [expr $total + $amount]
  229.         } else {
  230.         if { $diff != 0.00 } {
  231.             set amts($i) $diff
  232.         } else {
  233.             set amts($i) ""
  234.         }
  235.         set amount $diff
  236.         set total [expr $total + $amount]
  237.         if { $cbb(debug) } { puts "auto replacing difference with $diff" }
  238.         }
  239.     } else {
  240.         if { [format "%.2f" $diff] != 0.00 } {
  241.         set amts($i) $diff
  242.         set amount $amts($i)
  243.         set total [expr $total + $amount]
  244.         if { $cbb(debug) } { puts "auto entering difference" }
  245.         }
  246.     }
  247.         incr i
  248.     }
  249.  
  250.     return [format "%.2f" $total]
  251. }
  252.  
  253.  
  254. # ----------------------------------------------------------------------------
  255. # $Log: splits.tcl,v $
  256. # Revision 2.6  1997/04/23 18:09:42  curt
  257. # Added meta-c binding to splits window to open category list.
  258. #
  259. # Revision 2.5  1997/01/09 03:57:01  curt
  260. # Added contrib script loan.pl.
  261. # User sizable account list.
  262. # Removed some old gnuplot baggage from install.pl.
  263. #
  264. # Revision 2.4  1996/12/17 14:54:03  curt
  265. # Updated copyright date.
  266. #
  267. # Revision 2.3  1996/12/16 04:18:23  curt
  268. # Continuing the great overhaul of December 1996.
  269. #
  270. # Revision 2.2  1996/12/14 17:15:26  curt
  271. # The great overhaul of December '96.
  272. #
  273. # Revision 2.1  1996/12/08 07:37:49  curt
  274. # Initial revision.
  275. #
  276.