home *** CD-ROM | disk | FTP | other *** search
/ PC World 2000 February / PCWorld_2000-02_cd.bin / live / usr / X11R6 / lib / X11 / cbb / file.tcl < prev    next >
Text File  |  1998-10-07  |  26KB  |  887 lines
  1. #!/usr/bin/wish -f
  2. #  'CBB' -- Check Book Balancer
  3. #
  4. #   file.tcl -- file management routines.
  5. #
  6. #  Written by Curtis Olson.  Started August 25, 1994.
  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: file.tcl,v 2.18 1998/08/14 14:28:36 curt Exp $
  25. # (Log is kept at end of this file)
  26.  
  27.  
  28. #------------------------------------------------------------------------------
  29. # File menu procedures
  30. #------------------------------------------------------------------------------
  31.  
  32. # create a new account
  33. proc acctNew {} {
  34.     global cbb yesno argv0 eng newacct
  35.  
  36.     if { $cbb(safe_mode) == 1 } {
  37.         cbbWindow.ok "Cannot make new accounts when running in 'safe' mode." 
  38.     tkwait window .ok
  39.         return
  40.     }
  41.  
  42.     if { [acctIsDirty] } {
  43.     if { $cbb(auto_save) } {
  44.         acctSave
  45.     } else {
  46.         cbbWindow.yesno "You have not saved your current changes.  Would \
  47.             you like to save before making a new account?"
  48.         tkwait window .yesno
  49.  
  50.         if { "$yesno(result)" == "yes" } {
  51.         acctSave
  52.         } elseif { "$yesno(result)" == "no" } {
  53.         } elseif { "$yesno(result)" == "cancel" } {
  54.         return
  55.         }
  56.     }
  57.     } 
  58.  
  59.     # use starting directory of current file if it exists
  60.     if { [info exists cbb(cur_file)] && \
  61.         ("[file dirname $cbb(cur_file)]" != "") } {
  62.     set newacct(name) "[file dirname $cbb(cur_file)]/"
  63.     } else {
  64.     set newacct(name) "[mypwd]/"
  65.     }
  66.     if { $cbb(debug) } { puts $newacct(name) }
  67.  
  68.     cbbWindows.newacct
  69.     tkwait window .newacct
  70.  
  71.     if { "$newacct(name)" != "" } {
  72.     acctNewClear
  73.     
  74.     if { $cbb(debug) } {
  75.         puts "Make Account $newacct(name) - $newacct(desc)"
  76.     }
  77.  
  78.     if { "[file extension $newacct(name)]" == ".cbb" } {
  79.         set newacct(name) [file rootname $newacct(name)]
  80.     }
  81.     set cbb(cur_file) "$newacct(name).cbb"
  82.  
  83.     wm title . "[file tail $argv0] - [file tail $cbb(cur_file)]"
  84.     wm iconname . "[file tail $argv0] - [file tail $cbb(cur_file)]"
  85.  
  86.     # load/create the category file first ... make_acct assumes
  87.     # a category file is already open.
  88.     if { $cbb(debug) } {
  89.         puts "Loading the category file \
  90.             [file dirname $cbb(cur_file)]/categories"
  91.     }
  92.     puts $eng "load_cats [file dirname $cbb(cur_file)]/categories"
  93.     flush $eng
  94.  
  95.     if { $cbb(debug) } { puts "Reading result" }
  96.     gets $eng result
  97.     if { $cbb(debug) } { puts "Got result: $result" }
  98.         
  99.     if { "$result" != "ok" } {
  100.         cbbWindow.ok "Error opening \
  101.             ``[file dirname $cbb(cur_file)]/categories'': \
  102.              $result.  An empty categories file will be created.  \
  103.              Please consider importing the default categories."
  104.         tkwait window .ok
  105.  
  106.             # initialize categories
  107.         puts $eng "init_cats"; flush $eng
  108.  
  109.         if { $cbb(debug) } { puts "Reading result" }
  110.         gets $eng result 
  111.         if { $cbb(debug) } { puts "Got result: $result" }
  112.  
  113.         # create an empty categories file 
  114.         puts $eng "save_cats [file dirname $cbb(cur_file)]/categories"
  115.         flush $eng
  116.         
  117.         if { $cbb(debug) } { puts "Reading result" }
  118.         gets $eng result
  119.         if { $cbb(debug) } { puts "Got result: $result" }
  120.     }
  121.  
  122.     # tell engine to make the new account
  123.     if { $cbb(debug) } { 
  124.         puts "make_acct $newacct(name) $newacct(desc)"
  125.     }
  126.     puts $eng "make_acct $newacct(name) $newacct(desc)"
  127.     flush $eng
  128.     gets $eng result; 
  129.         if { $cbb(debug) } { 
  130.         puts "make_acct($newacct(name) $newacct(desc)): $result"
  131.     }
  132.  
  133.     if { "$result" != "ok" } {
  134.         cbbWindow.ok "Error creating ``$cbb(cur_file)'':  $result."
  135.         tkwait window .ok
  136.     }
  137.  
  138.     .status.line configure \
  139.         -text "Account Created -- [file tail $cbb(cur_file)]"
  140.     update
  141.     
  142.     acctLoadFile $cbb(cur_file)
  143.     load_acct_listbox
  144.     cbbcurSave
  145.     }
  146. }
  147.  
  148.  
  149. # specify new account name & description
  150. proc cbbWindows.newacct {} {
  151.     global cbb newacct
  152.  
  153.     if {[winfo exists .newacct] == 1} {
  154.     wm withdraw .newacct
  155.         wm deiconify .newacct
  156.     return                
  157.     }
  158.  
  159.     set newacct(desc) ""
  160.  
  161.     toplevel .newacct
  162.  
  163.     option add *font $cbb(dialog_font)
  164.     wm title .newacct "Make Account"
  165.     wm iconname .newacct "Make Account"
  166.     frame .newacct.frame -borderwidth 2 
  167.     frame .newacct.frame.n
  168.     frame .newacct.frame.d
  169.     frame .newacct.frame.b
  170.  
  171.     label .newacct.frame.label -text \
  172.     "Enter New Account Base Name (including directory) and Description"
  173.  
  174.     label .newacct.frame.n.label -text "New Acct"
  175.     entry .newacct.frame.n.entry -textvariable newacct(name) -relief sunken \
  176.         -font $cbb(default_font)
  177.     # .newacct.frame.n.entry icursor 0
  178.     .newacct.frame.n.entry icursor end
  179.     # tk_entrySeeCaret .newacct.frame.n.entry
  180.  
  181.     label .newacct.frame.d.label -text "Acct Description"
  182.     entry .newacct.frame.d.entry -textvariable newacct(desc) -relief sunken \
  183.         -font $cbb(default_font)
  184.  
  185.     button .newacct.frame.b.create -text "Create Account" \
  186.         -font $cbb(button_font) -command { destroy .newacct }
  187.     button .newacct.frame.b.cancel -text "Cancel" -font $cbb(button_font) \
  188.         -command { 
  189.     set newacct(name) ""
  190.     set newacct(desc) ""
  191.     destroy .newacct
  192.     }
  193.  
  194.     pack .newacct.frame -fill both -expand 1 -padx 4 -pady 4
  195.     pack .newacct.frame.label -padx 4 -pady 2
  196.     pack .newacct.frame.b -side bottom -fill x -padx 4 -pady 2
  197.     pack .newacct.frame.n .newacct.frame.d \
  198.         -fill both -expand 1 -padx 4 -pady 2 
  199.     pack .newacct.frame.n.label -side left
  200.     pack .newacct.frame.n.entry -side left -fill x -expand 1
  201.     pack .newacct.frame.d.label -side left
  202.     pack .newacct.frame.d.entry -side left -fill x -expand 1
  203.     pack .newacct.frame.b.create .newacct.frame.b.cancel -side left \
  204.         -fill x -expand 1 -padx 4 -pady 4
  205.  
  206.     focus .newacct.frame.n.entry 
  207. }
  208.  
  209.  
  210. proc acctNewClear {} {
  211.     global cbb eng argv0
  212.  
  213.     if { $cbb(debug) } { puts "beginning of acctNewClear" }
  214.  
  215.     # clear our list box
  216. ### .trans.list delete 0 end
  217.     .trans.list configure -state normal
  218.     .trans.list delete 0.0 end
  219.     .trans.list configure -state disabled
  220.  
  221.     # tell engine to clear transactions
  222.     puts $eng "init_trans"; flush $eng
  223.     gets $eng result
  224.     if { $cbb(debug) } { puts "init_trans(): $result" }
  225.  
  226.     # tell engine to clear categories
  227.     puts $eng "init_cats"; flush $eng
  228.     gets $eng result
  229.     if { $cbb(debug) } { puts "init_cats(): $result" }
  230.  
  231.     set cbb(cur_file) "noname.cbb"
  232.     wm title . "[file tail $argv0] - [file tail $cbb(cur_file)]"
  233.     wm iconname . "[file tail $argv0] - [file tail $cbb(cur_file)]"
  234.  
  235.     clear_entry_area
  236. }
  237.  
  238.  
  239. proc acctLoad {} {
  240.     global cbb yesno
  241.  
  242.     if { $cbb(safe_mode) == 1 } {
  243.         cbbWindow.ok "Cannot load accounts when running in 'safe' mode." 
  244.     tkwait window .ok
  245.         return
  246.     }
  247.  
  248.     if { [acctIsDirty] } {
  249.     if { $cbb(auto_save) } {
  250.         acctSave
  251.     } else {
  252.         cbbWindow.yesno "You have not saved your current changes.  Would \
  253.             you like to save before loading a new account?"
  254.         tkwait window .yesno
  255.         
  256.         if { "$yesno(result)" == "yes" } {
  257.         acctSave
  258.         } elseif { "$yesno(result)" == "no" } {
  259.         } elseif { "$yesno(result)" == "cancel" } {
  260.         return
  261.         }
  262.     }
  263.     }
  264.  
  265.     option add *font $cbb(default_font)
  266.  
  267.     set select_result [ut:fsbox -prompt "Load Account:" \
  268.         -cancelvalue "noname.cbb" -grab 1 -master . -dir [mypwd] ]
  269.  
  270.     if { $cbb(debug) } { puts "After select: Load Account $select_result" }
  271.  
  272.     if { "$select_result" != "noname.cbb" } {
  273.     acctLoadFile $select_result
  274.     load_acct_listbox
  275.         cbbcurSave
  276.     }
  277. }
  278.  
  279.  
  280. proc acctLoadFile file {
  281.     global cbb argv0 key eng yesno start_pos
  282.     global date nicedate year month day check desc debit credit cat
  283.     global nicecat com cleared total
  284.  
  285.     if { $cbb(debug) } { puts "ready to load $file" }
  286.  
  287.     set auto_save_file "[file dirname $file]/#[file tail $file]#"
  288.     if { [file exists $auto_save_file] } {
  289.     cbbWindow.yesno "CBB has detected an autosave file: \
  290.         ``[file tail $auto_save_file]''.\
  291.         This indicates that CBB was killed or crashed after you\
  292.         made changes to ``[file tail $file]'' but before you could\
  293.         save the changes.  Would you like to load the auto saved\
  294.         version instead?"
  295.     tkwait window .yesno
  296.  
  297.         if { "$yesno(result)" == "yes" } {
  298.         if { [file exists $auto_save_file] } {
  299.         # just in case we have a couple of these nested, lets not try
  300.         # to do this more than once.
  301.         exec mv $file "$file.bak"
  302.         exec mv $auto_save_file $file
  303.         }
  304.         if { [file exists "$auto_save_file.bak"]} {
  305.         exec rm "$auto_save_file.bak"
  306.         }
  307.         } else {
  308.         cbbWindow.ok "Very well, but as a precaution,\
  309.             ``[file tail $file]'' will not be loaded as long as\
  310.             ``[file tail $auto_save_file]'' exists."
  311.         return
  312.         }
  313.     }
  314.  
  315.     acctNewClear
  316.  
  317.     set cbb(cur_file) $file
  318.  
  319.     wm title . "[file tail $argv0] - [file tail $file]"
  320.     wm iconname . "[file tail $argv0] - [file tail $file]"
  321.     # . configure -cursor watch
  322.     .status.line configure -text "Loading transactions from [file tail $file]"
  323.     update
  324.  
  325.     # load the transactions from a data file
  326.     if { $cbb(debug) } { puts "Loading data file $file" }
  327.     puts $eng "load_trans $file"; flush $eng
  328.  
  329.     if { $cbb(debug) } { puts "Reading result" }
  330.     gets $eng result
  331.     if { $cbb(debug) } { puts "Got result: $result" }
  332.  
  333.     if { "$result" != "ok" } {
  334.         cbbWindow.ok "Error opening ``$file'':  $result."
  335.         tkwait window .ok
  336.     set cbb(cur_file) "noname.cbb"
  337.     wm title . "[file tail $argv0] - [file tail $cbb(cur_file)]"
  338.     wm iconname . "[file tail $argv0] - [file tail $cbb(cur_file)]"
  339.     update
  340.     return
  341.     }
  342.  
  343.     .trans.list configure -state normal
  344.     set start_pos 0
  345.     set flag 0
  346.     if { $cbb(use_sdate) } {
  347.     puts $eng "part_trans $cbb(date_fmt) $cbb(int_sdate)"
  348.     } else {
  349.         puts $eng "all_trans $cbb(date_fmt)"
  350.     }
  351.     flush $eng
  352.     gets $eng line1
  353.     while { $line1 != "none" } {
  354.     gets $eng line2
  355.     listAddTrans $line1 $line2
  356.  
  357.     set check [string trim [string range $line1 0 4]]
  358.     if { "$check" != "" } {
  359.         set cbb(next_chk) $check
  360.     }
  361.  
  362.         gets $eng line1
  363.     }
  364.     .trans.list configure -state disabled
  365.  
  366.     # set listbox view to start position
  367.     goto $start_pos
  368.     clear_entry_area
  369.  
  370.     # . configure -cursor left_ptr
  371.  
  372.     # hash out the memorized transactions
  373.     if { $cbb(debug) } { puts "Hashing memorized transactions" }
  374.     puts $eng "rehash_mems"; flush $eng
  375.  
  376.     if { $cbb(debug) } { puts "Reading result" }
  377.     gets $eng result
  378.     if { $cbb(debug) } { puts "Got result: $result" }
  379.  
  380.     # load the categories
  381.     if { $cbb(debug) } {
  382.     puts "Loading the category file [file dirname $file]/categories"
  383.     }
  384.     puts $eng "load_cats [file dirname $file]/categories"; flush $eng
  385.  
  386.     if { $cbb(debug) } { puts "Reading result" }
  387.     gets $eng result
  388.     if { $cbb(debug) } { puts "Got result: $result" }
  389.  
  390.     if { "$result" != "ok" } {
  391.         cbbWindow.ok "Error opening ``[file dirname $file]/categories'':  \
  392.         $result."
  393.         tkwait window .ok
  394.     }
  395.  
  396.     acctSetClean
  397. }
  398.  
  399.  
  400. proc acctSave {} {
  401.     global cbb argv0 eng
  402.  
  403.     wm title . "[file tail $argv0] - [file tail $cbb(cur_file)]"
  404.     wm iconname . "[file tail $argv0] - [file tail $cbb(cur_file)]"
  405.  
  406.     if { $cbb(safe_mode) == 1 } {
  407.         cbbWindow.ok "Cannot save when running in 'safe' mode." 
  408.     tkwait window .ok
  409.         return
  410.     }
  411.  
  412.     .status.line configure \
  413.         -text "Saving transactions to [file tail $cbb(cur_file)]"
  414.     update
  415.  
  416.     # tell engine to save transactions
  417.     puts $eng "save_trans $cbb(cur_file)"; flush $eng
  418.     gets $eng result
  419.     if { $cbb(debug) } { puts "saving transactions ... $result" }
  420.  
  421.     if { "$result" != "ok" } {
  422.         cbbWindow.ok "Error saving ``$cbb(cur_file)'':  $result.  You are \
  423.         advised to use the ``Save As'' function to save to a different \
  424.         file name."
  425.         tkwait window .ok
  426.     }
  427.  
  428.     # tell engine to save categories
  429.     puts $eng "save_cats [file dirname $cbb(cur_file)]/categories"; flush $eng
  430.     gets $eng result
  431.     if { $cbb(debug) } { puts "saving categories ... $result" }
  432.  
  433.     if { "$result" != "ok" } {
  434.         cbbWindow.ok "Error saving \
  435.         ``[file dirname $cbb(cur_file)]/categories'':  \
  436.         $result.  Recent changes to your categories list may not \
  437.         have been saved."
  438.         tkwait window .ok
  439.     }
  440.  
  441.     cbbcurSave
  442.  
  443.     # ok we are clean again
  444.     acctSetClean
  445. }
  446.  
  447.  
  448. proc acctSaveAs {} {
  449.     global cbb
  450.  
  451.     option add *font $cbb(default_font)
  452.  
  453.     if { $cbb(safe_mode) == 1 } {
  454.         cbbWindow.ok "Cannot save as when running in 'safe' mode." 
  455.         tkwait window .ok
  456.         return
  457.     }
  458.  
  459.     set select_result [ut:fsbox -prompt "Save Account As:" \
  460.         -cancelvalue "noname.cbb" -grab 1 -master . -dir [mypwd] ]
  461.  
  462.     if { $cbb(debug) } { puts "After select: Save Account As: $select_result" }
  463.  
  464.     if { "$select_result" != "noname.cbb" } {
  465.     set cbb(cur_file) $select_result
  466.     acctSave
  467.     }
  468. }
  469.  
  470.  
  471. # Select a file to import
  472. proc acctImport {} {
  473.     global cbb import_type
  474.  
  475.     option add *font $cbb(default_font)
  476.  
  477.     if { $cbb(safe_mode) == 1 } {
  478.         cbbWindow.ok "Cannot import when running in 'safe' mode." 
  479.         tkwait window .ok
  480.         return
  481.     }
  482.  
  483.     if { $import_type == 0 } {
  484.     set prompt "CBB Import:"
  485.     } else { 
  486.     set prompt "QIF Import:"
  487.     }
  488.  
  489.     set select_result [ut:fsbox -prompt $prompt -cancelvalue "noname.cbb" \
  490.         -grab 1 -master . -dir [mypwd] ]
  491.  
  492.     if { $cbb(debug) } { puts "After select: Import [file tail $select_result]"}
  493.  
  494.     if { "$select_result" != "noname.cbb" } {
  495.     acctImportFile $select_result $import_type
  496.     }
  497. }
  498.  
  499.  
  500. # Do the actual import
  501. proc acctImportFile args {
  502.     global cbb eng key date nicedate year month day check desc debit credit cat
  503.     global nicecat com cleared total
  504.  
  505.     set arglist [split $args]
  506.     set file [lindex $arglist 0]
  507.     set type [lindex $arglist 1]
  508.  
  509.     # clear out the old ... not any more
  510.     # acctNewClear
  511.     # set cbb(cur_file) noname.cbb
  512.  
  513.     .status.line configure \
  514.         -text "Importing transactions from [file tail $file]."
  515.     update
  516.  
  517.     if { $cbb(debug) } { puts "Importing data file $file" }
  518.  
  519.     if { $type == 0 } {
  520.     puts $eng "load_cbb $file"; flush $eng
  521.  
  522.     if { $cbb(debug) } { puts "Reading result" }
  523.     gets $eng result
  524.     if { $cbb(debug) } { puts "Got result: $result" }
  525.     } elseif { $type == 1 } {
  526.     puts $eng "import_qif $file"; flush $eng
  527.  
  528.     if { $cbb(debug) } { puts "Reading result" }
  529.     gets $eng result
  530.     if { $cbb(debug) } { puts "Got result: $result" }
  531.     }
  532.  
  533.     # clear our list box
  534.     .trans.list delete 0.0 end
  535.  
  536.     .trans.list configure -state normal
  537.     set flag 0
  538.     puts $eng "all_trans $cbb(date_fmt)"; flush $eng
  539.     gets $eng line1
  540.     while { $line1 != "none" } {
  541.     if { $cbb(debug) } { puts "line1 = $line1" }
  542.     gets $eng line2
  543.     listAddTrans $line1 $line2
  544.  
  545.         gets $eng line1
  546.     }
  547.     .trans.list configure -state disabled
  548.  
  549.     # set listbox view to end
  550.     goto [listGetSize]
  551.     clear_entry_area
  552.  
  553.     acctSetDirty
  554. }
  555.  
  556.  
  557. # export to a quicken ".qif" file
  558. proc acctExportQIF {} {
  559.     global cbb eng
  560.  
  561.     if { $cbb(safe_mode) == 1 } {
  562.         cbbWindow.ok "Cannot export when running in 'safe' mode." 
  563.     tkwait window .ok
  564.         return
  565.     }
  566.  
  567.     puts $eng "export_qif [file root $cbb(cur_file)].qif"; flush $eng
  568.     gets $eng result
  569.  
  570.     cbbWindow.ok "File exported to ``[file root $cbb(cur_file)].qif''\n \
  571.          Result = ``$result''"
  572.     tkwait window .ok
  573. }
  574.  
  575.  
  576. proc cbbQuit {} {
  577.     global cbb yesno
  578.  
  579.     if { [acctIsDirty] } {
  580.     if { $cbb(safe_mode) == 0 } {
  581.         if { $cbb(auto_save) } {
  582.         acctSave
  583.         } else {
  584.         cbbWindow.yesno "You have not saved your current changes. \
  585.             Would you like to save before quitting?"
  586.         tkwait window .yesno
  587.  
  588.         if { "$yesno(result)" == "yes" } {
  589.             acctSave
  590.         } elseif { "$yesno(result)" == "no" } {
  591.         } elseif { "$yesno(result)" == "cancel" } {
  592.             return
  593.         }
  594.         }
  595.     } else {
  596.         cbbWindow.ok "You have made changes to this file.  Normally you \
  597.             would be asked if you would like to save your changes.  \
  598.             However, you cannot save files in 'safe' mode so please \
  599.             click ``Dismis'' to continue without saving." 
  600.         tkwait window .ok
  601.     }
  602.     }
  603.  
  604.     if { $cbb(pref_chg) } {
  605.     if { $cbb(safe_mode) == 0 } {
  606.         cbbWindow.yesno "You have not saved your current preferences. \
  607.             Would you like to save before quitting?"
  608.         tkwait window .yesno
  609.  
  610.         if { "$yesno(result)" == "yes" } {
  611.             cbbrcSave
  612.         } elseif { "$yesno(result)" == "no" } {
  613.         } elseif { "$yesno(result)" == "cancel" } {
  614.             return
  615.         }
  616.     } else {
  617.         cbbWindow.ok "You have made changes to your preferences.  \
  618.             Normally you \
  619.             would be asked if you would like to save your changes.  \
  620.             However, you cannot save preferences in 'safe' mode so \
  621.             please click ``Dismis'' to continue without saving." 
  622.         tkwait window .ok
  623.     }
  624.     }
  625.  
  626.     exit
  627. }
  628.  
  629.  
  630. # write out current ~/.cbbcur.tcl file
  631. proc cbbcurSave {} {
  632.     global cbb
  633.  
  634.     if { $cbb(safe_mode) == 1 } {
  635.     return
  636.     }
  637.  
  638.     set now_today [get_sys_date]
  639.  
  640.     set rchandle [open $cbb(save_cur_file) w]
  641.     puts $rchandle "# ~/.cbbcur.tcl"
  642.     puts $rchandle "#"
  643.     puts $rchandle "# Created by CBB $cbb(version)"
  644.     puts $rchandle "# Created on $now_today"
  645.     puts $rchandle "#"
  646.     puts $rchandle "# This is machine generated tcl code.  Please use caution"
  647.     puts $rchandle "# when hand editing!"
  648.     puts $rchandle ""
  649.     puts $rchandle "# File to load when CBB initially starts."
  650.     puts $rchandle "set cbb(cur_file) $cbb(cur_file)"
  651.  
  652.     close $rchandle
  653. }
  654.  
  655. # write out current ~/.cbbrc.tcl file
  656. proc cbbrcSave {} {
  657.     global cbb
  658.  
  659.     set cbb(pref_chg) 0
  660.  
  661.     if { $cbb(safe_mode) == 1 } {
  662.     return
  663.     }
  664.  
  665.     set now_today [get_sys_date]
  666.  
  667.     set rchandle [open $cbb(conf_file) w]
  668.     puts $rchandle "# ~/.cbbrc.tcl"
  669.     puts $rchandle "#"
  670.     puts $rchandle "# Created by CBB $cbb(version)"
  671.     puts $rchandle "# Created on $now_today"
  672.     puts $rchandle "#"
  673.     puts $rchandle "# This is machine generated tcl code.  Please use caution"
  674.     puts $rchandle "# when hand editing!"
  675.     puts $rchandle ""
  676.     puts $rchandle "# Debugging:  0 = disabled, 1 = enabled"  
  677.     puts $rchandle "set cbb(debug) $cbb(debug)"
  678.     puts $rchandle ""
  679.     puts $rchandle "# Enable Balloon Help:  0 = disabled, 1 = enabled"
  680.     puts $rchandle "set cbb(balloon,on) $cbb(balloon,on)"
  681.     puts $rchandle ""
  682.     puts $rchandle "# Enable Splash Screen:  0 = disabled, 1 = enabled"
  683.     puts $rchandle "set cbb(splash) $cbb(splash)"
  684.     puts $rchandle ""
  685.     puts $rchandle "# Auto-highlight entry fields:  0 = disabled, 1 = enabled"  
  686.     puts $rchandle "set cbb(auto_hilite) $cbb(auto_hilite)"
  687.     puts $rchandle ""
  688.     puts $rchandle "# Use Memorized Transactions:  0 = disabled, 1 = enabled"
  689.     puts $rchandle "set cbb(use_mems) $cbb(use_mems)"
  690.     puts $rchandle ""
  691.     puts $rchandle "# Date Format:  1=USA 2=International"
  692.     puts $rchandle "set cbb(date_fmt) $cbb(date_fmt)"
  693.     puts $rchandle ""
  694.     puts $rchandle "# Auto Save Interval (in milleseconds)"
  695.     puts $rchandle "set cbb(save_interval) $cbb(save_interval)"
  696.     puts $rchandle "# Auto-save when switching files or quitting"
  697.     puts $rchandle "set cbb(auto_save) $cbb(auto_save)"
  698.     puts $rchandle ""
  699.     puts $rchandle "# Main List Box Dimensions"
  700.     puts $rchandle "set cbb(list_width) $cbb(list_width)"
  701.     puts $rchandle "set cbb(list_height) $cbb(list_height)"
  702.     puts $rchandle ""
  703.     puts $rchandle "# Height of account list box"
  704.     puts $rchandle "set cbb(acctlist_height) $cbb(acctlist_height)"
  705.     puts $rchandle ""
  706.     puts $rchandle "# Maximum splits per entry"
  707.     puts $rchandle "set cbb(max_splits) $cbb(max_splits)"
  708.     puts $rchandle ""
  709.     puts $rchandle "# Startdate ..."
  710.     puts $rchandle "set cbb(use_sdate) $cbb(use_sdate)"
  711.     puts $rchandle "set cbb(sdate) \"$cbb(sdate)\""
  712.     puts $rchandle "set cbb(report_sdate) \"$cbb(report_sdate)\""
  713.     puts $rchandle ""
  714.     puts $rchandle "# Account Cache ..."
  715.     puts $rchandle "set cbb(cache) $cbb(cache)"
  716.     puts $rchandle ""
  717.     puts $rchandle "# Cryptography ..."
  718.     puts $rchandle "set cbb(use_crypt) $cbb(use_crypt)"
  719.     puts $rchandle "set cbb(encrypt) \"$cbb(encrypt)\""
  720.     puts $rchandle "set cbb(decrypt) \"$cbb(decrypt)\""
  721.     puts $rchandle ""
  722.     puts $rchandle "# Fonts ..."
  723.     puts $rchandle "set cbb(msg_text_font) \"$cbb(msg_text_font)\""
  724.     puts $rchandle "set cbb(button_font) \"$cbb(button_font)\""
  725.     puts $rchandle "set cbb(fixed_header_font) \"$cbb(fixed_header_font)\""
  726.     puts $rchandle "set cbb(fixed_font) \"$cbb(fixed_font)\""
  727.     puts $rchandle "set cbb(status_line_font) \"$cbb(status_line_font)\""
  728.     puts $rchandle "set cbb(menu_font) \"$cbb(menu_font)\""
  729.     puts $rchandle "set cbb(dialog_font) \"$cbb(dialog_font)\""
  730.     puts $rchandle "set cbb(default_font) \"$cbb(default_font)\""
  731.     puts $rchandle ""
  732.     puts $rchandle "# Colors ..."
  733.     puts $rchandle "set cbb(head_color) \"$cbb(head_color)\""
  734.     puts $rchandle "set cbb(hilite_color) \"$cbb(hilite_color)\""
  735.     puts $rchandle "set cbb(list_line1_color) \"$cbb(list_line1_color)\""
  736.     puts $rchandle "set cbb(list_line2_color) \"$cbb(list_line2_color)\""
  737.     puts $rchandle ""
  738.     puts $rchandle "# External web browser"
  739.     puts $rchandle "set cbb(web_browser) \"$cbb(web_browser)\""
  740.  
  741.     close $rchandle
  742. }
  743.  
  744.  
  745. # save the current file at regular intervals in case the computer crashes
  746. # or something
  747. proc setup_auto_save {} {
  748.     global cbb eng
  749.  
  750.     if { $cbb(safe_mode) == 1 } {
  751.     return
  752.     }
  753.  
  754.     after $cbb(save_interval) {
  755.         if { "[file extension $cbb(cur_file)]" == ".cbb" } {
  756.         if { [acctIsDirty] } {
  757.         set auto_save_file \
  758.             "[file dirname $cbb(cur_file)]/#[file tail $cbb(cur_file)]#"
  759.         .status.line configure -text \
  760.              "Auto saving to [file tail $auto_save_file]"
  761.         update
  762.             if { $cbb(debug) } {
  763.             puts "Auto saving to [file tail $auto_save_file]"
  764.         }
  765.  
  766.                 # tell engine to save transactions
  767.                 puts $eng "auto_save_trans $auto_save_file"
  768.         flush $eng
  769.         }
  770.     }
  771.  
  772.     # reset auto save
  773.     setup_auto_save
  774.     }
  775. }
  776.  
  777.  
  778. # ----------------------------------------------------------------------------
  779. # $Log: file.tcl,v $
  780. # Revision 2.18  1998/08/14 14:28:36  curt
  781. # Added desc-pie graph.
  782. # Added option to eliminate splash screen.
  783. # Other misc. tweaks and bug fixes.
  784. #
  785. # Revision 2.17  1997/06/12 21:53:13  curt
  786. # Applied more patches from Martin Schenk <schenkm@ping.at>.  His changes
  787. # greatly improved and developed the preferences menu so it is now actually
  788. # usable to set preferences.
  789. # Current data file is now saved in ~/.cbbcur.tcl
  790. #
  791. # Revision 2.16  1997/05/06 01:00:26  curt
  792. # Added patches contributed by Martin Schenk <schenkm@ping.at>
  793. # - Default to umask of 066 so .CBB files get created rw by owner only
  794. # - Added support for pgp encrypting data files
  795. # - Added support for displaying only recent parts of files (avoids
  796. #   waiting to load in lots of old txns you don't currently need.)
  797. # - Added a feature to "cache" whole accounts in the perl engine so
  798. #   that switching between accounts can be faster.
  799. # - The above options can be turned on/off via the preferrences menu.
  800. #
  801. # Revision 2.15  1997/04/07 21:13:32  curt
  802. # Add a $cbb(web_browser) variable which can be set from ~/.cbbrc.tcl
  803. # If netscape is the browser, and there is a copy running, don't start
  804. # a new copy.
  805. #
  806. # Revision 2.14  1997/04/03 03:54:47  curt
  807. # Enable auto save without prompting when switching to a new account.
  808. # Contributed by Jonathan I. Kamens <jik@kamens.brookline.ma.us>
  809. #
  810. # Revision 2.13  1997/03/04 03:22:38  curt
  811. # Fixed bug which showed up when hitting '+' in a blank check # field after
  812. # an account had been loaded, but before any transactions with a check number
  813. # had been added.
  814. #
  815. # Revision 2.12  1997/01/16 19:15:39  curt
  816. # Miscellaneous interface tweaks.
  817. #
  818. # Revision 2.11  1997/01/13 19:31:48  curt
  819. # Fixed a little typo which caused .qif imports to go into an infinite loop.
  820. #
  821. # Revision 2.10  1997/01/09 04:02:59  curt
  822. # Allow user to specify colors of alternating transaction lines.
  823. #
  824. # Revision 2.9  1997/01/09 03:56:57  curt
  825. # Added contrib script loan.pl.
  826. # User sizable account list.
  827. # Removed some old gnuplot baggage from install.pl.
  828. #
  829. # Revision 2.8  1997/01/02 04:38:34  curt
  830. # Changes over the 1996 holidays:
  831. #   - Converted listbox to text widget.  This allows us to do nice
  832. #     things with alternating background colors, highliting, red
  833. #     negative numbers, etc.
  834. #   - Negative transactions are now drawn in red.
  835. #   - Added a Goto <Today> option.
  836. #   - <Home> & <End> were double bound.  Now, listbox can be traversed with
  837. #     <Meta-Home> and <Meta-End>
  838. #
  839. # Revision 2.7  1996/12/17 14:53:56  curt
  840. # Updated copyright date.
  841. #
  842. # Revision 2.6  1996/12/16 04:18:17  curt
  843. # Continuing the great overhaul of December 1996.
  844. #
  845. # Revision 2.5  1996/12/14 17:15:22  curt
  846. # The great overhaul of December '96.
  847. #
  848. # Revision 2.4  1996/12/11 18:33:36  curt
  849. # Ran a spell checker.
  850. #
  851. # Revision 2.3  1996/12/11 04:32:28  curt
  852. # Several minor tweaks.
  853. #
  854. # Revision 2.2  1996/12/08 07:39:59  curt
  855. # Rearranged quite a bit of code.
  856. # Put most global variables in cbb() structure.
  857. #
  858. # Revision 2.1  1996/12/07 20:38:14  curt
  859. # Renamed *.tk -> *.tcl
  860. #
  861. # Revision 2.6  1996/10/24 15:09:33  curt
  862. # Version number updates.
  863. #
  864. # Revision 2.5  1996/10/23 02:28:21  curt
  865. # Display an error message if a problem is encountered saving the account or
  866. # categories.
  867. #
  868. # Revision 2.4  1996/09/30 15:14:36  curt
  869. # Updated CBB URL, and hardwired wish path.
  870. #
  871. # Revision 2.3  1996/07/13 02:57:44  curt
  872. # Version 0.65
  873. # Packing Changes
  874. # Documentation changes
  875. # Changes to handle a value in both debit and credit fields.
  876. #
  877. # Revision 2.2  1996/03/03  00:16:12  curt
  878. # Modified Files:  cbb categories.pl wrapper.pl file.tk main.tk menu.tk
  879. #   Added an account list at the bottom of the screen.  Thanks to:
  880. #   Cengiz Alaettinoglu <cengiz@ISI.EDU> for this great addition.
  881. #
  882. # Revision 2.1  1996/02/27  05:35:43  curt
  883. # Just stumbling around a bit with cvs ... :-(
  884. #
  885. # Revision 2.0  1996/02/27  04:42:57  curt
  886. # Initial 2.0 revision.  (See "Log" files for old history.)
  887.