home *** CD-ROM | disk | FTP | other *** search
/ Enter 2000 February / Enter2_2.iso / live / usr / X11R6 / lib / X11 / cbb / categories.tcl < prev    next >
Encoding:
Tcl/Tk script  |  1998-10-07  |  11.3 KB  |  376 lines
  1. #!/usr/bin/wish -f
  2. #  'CBB' -- Check Book Balancer
  3. #
  4. #   categories.tcl - category specific front end code.
  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: categories.tcl,v 2.7 1997/03/05 18:58:32 curt Exp $
  25. # (Log is kept at end of this file)
  26.  
  27.  
  28. #------------------------------------------------------------------------------
  29. # import the default category list
  30. #------------------------------------------------------------------------------
  31.  
  32. proc catImportDefaults {} {
  33.     global cbb eng lib_path yesno
  34.  
  35.     if { $cbb(safe_mode) == 1 } { 
  36.     return 
  37.     }
  38.  
  39.     # check for a valid file
  40.     if { "$cbb(cur_file)" == "noname.cbb" } {
  41.     cbbWindow.ok "You must either Make or Load an Account First."
  42.     tkwait window .ok
  43.     return
  44.     } elseif { "$cbb(cur_file)" == ""} {
  45.     cbbWindow.ok "You must either Make or Load an Account First."
  46.     tkwait window .ok
  47.     return
  48.     }
  49.  
  50.     cbbWindow.yesno "Do you really wish to import the default categories?"
  51.     tkwait window .yesno
  52.  
  53.     if { "$yesno(result)" == "yes" } {
  54.         if { $cbb(debug) } {
  55.         puts "Importing the default category file $lib_path/$cbb(def_cat)"
  56.     }
  57.         puts $eng "load_cats $lib_path/$cbb(def_cat)"; flush $eng
  58.  
  59.     if { $cbb(debug) } { puts "Reading result" }
  60.     gets $eng result
  61.     if { $cbb(debug) } { puts "Got result: $result" }
  62.     }
  63. }
  64.  
  65.  
  66. #------------------------------------------------------------------------------
  67. # Procedures to handle unknown categories
  68. #------------------------------------------------------------------------------
  69.  
  70. proc cbbWindow.newcat {} {
  71.     global cbb addcat
  72.  
  73.     if {[winfo exists .newcat] == 1} {
  74.         destroy .newcat
  75.     }
  76.  
  77.     option add *font $cbb(dialog_font)
  78.  
  79.     set addcat(desc) $addcat(cat)
  80.     set addcat(tax) 0
  81.  
  82.     toplevel .newcat
  83.  
  84.     if { $addcat(mode) == "normal" } {
  85.     wm title .newcat "Add New Category ..."
  86.     wm iconname .newcat "Add New Category ..."
  87.     } else {
  88.     wm title .newcat "Unknown Category ..."
  89.     wm iconname .newcat "Unknown Category ..."
  90.     }
  91.     frame .newcat.frame -borderwidth 2 -relief raised
  92.  
  93.     if { $addcat(mode) == "normal" } {
  94.     message .newcat.frame.m -width 300 -font $cbb(msg_text_font) -text \
  95.         "Please enter a new category and description:"
  96.     } else {
  97.     message .newcat.frame.m -width 300 -font $cbb(msg_text_font) -text \
  98.         "WARNING:  The category, ``$addcat(cat)'' does not exist.  \
  99.         What would you like to do?"
  100.     }
  101.  
  102.     frame .newcat.frame.c -borderwidth 2
  103.     frame .newcat.frame.d -borderwidth 2
  104.  
  105.     label .newcat.frame.c.label -text "Category"
  106.     entry .newcat.frame.c.entry -textvariable addcat(cat) -relief sunken \
  107.         -font $cbb(default_font)
  108.  
  109.     label .newcat.frame.d.label -text "Description"
  110.     entry .newcat.frame.d.entry -textvariable addcat(desc) -relief sunken \
  111.         -font $cbb(default_font)
  112.  
  113.     checkbutton .newcat.frame.tax -text "Tax Related?" -variable addcat(tax) \
  114.         -anchor w -font $cbb(button_font)
  115.  
  116.     button .newcat.frame.create -text "Add to the category \
  117.         list" -font $cbb(button_font) -command {
  118.     if { $cbb(debug) } { puts "adding $addcat(cat)" }
  119.     if { "$addcat(tax)" == "0" } {
  120.         puts $eng "insert_cat $addcat(cat)\t$addcat(desc)\t"
  121.         flush $eng
  122.     } else {
  123.         puts $eng "insert_cat $addcat(cat)\t$addcat(desc)\tx"
  124.         flush $eng
  125.     }
  126.     gets $eng result
  127.     if { $cbb(debug) } { puts "Adding category: $result" }
  128.     if { $cbb(safe_mode) == 0 } {
  129.         if { $cbb(debug) } { puts "Saving category file" }
  130.         puts $eng "save_cats [file dirname $cbb(cur_file)]/categories"
  131.         flush $eng
  132.         gets $eng result
  133.         if $cbb(debug) { puts "save result=$result" }
  134.     }
  135.     set addcat(result) "yes"
  136.     destroy .newcat 
  137.     }
  138.  
  139.     button .newcat.frame.ignore -text "Do not add to the list" \
  140.         -font $cbb(button_font) -command {
  141.     set addcat(result) "no"
  142.         destroy .newcat 
  143.     }
  144.  
  145.     button .newcat.frame.seecats -text "See category list" \
  146.         -font $cbb(button_font) -command { 
  147.     set addcat(result) "see"
  148.     cbbWindow.catwin
  149.     destroy .newcat 
  150.     }
  151.  
  152.     pack .newcat.frame -side top -fill both -expand 1
  153.     pack .newcat.frame.ignore .newcat.frame.create .newcat.frame.seecats \
  154.         -side bottom -fill x -padx 8 -pady 4
  155.     pack .newcat.frame.m -side top -fill x
  156.     pack .newcat.frame.c .newcat.frame.d -side top -fill x \
  157.         -expand 1
  158.     pack .newcat.frame.tax -side top -fill x -expand 1 -padx 8 -pady 4
  159.     pack .newcat.frame.c.label -side left
  160.     pack .newcat.frame.c.entry -side left -fill x -expand 1
  161.  
  162.     pack .newcat.frame.d.label -side left
  163.     pack .newcat.frame.d.entry -side left -fill x -expand 1
  164.  
  165.  
  166.     focus .newcat.frame.c.entry
  167. }
  168.  
  169.  
  170. #------------------------------------------------------------------------------
  171. # Procedures to interactively view and edit categories
  172. #------------------------------------------------------------------------------
  173.  
  174. proc cbbWindow.catwin {} {
  175.     global cbb lib_path cat addcat
  176.  
  177.     if {[winfo exists .catwin] == 1} {
  178.         destroy .catwin
  179.     }
  180.  
  181.     option add *font $cbb(dialog_font)
  182.     
  183.     toplevel .catwin
  184.  
  185.     wm title .catwin "Category List"
  186.     wm iconname .catwin "Category List"
  187.     frame .catwin.frame -borderwidth 2 -relief raised
  188.     pack .catwin.frame -side top -fill both -expand 1
  189.  
  190.     frame .catwin.frame.l
  191.     frame .catwin.frame.b
  192.     pack .catwin.frame.b -side bottom -fill x
  193.     pack .catwin.frame.l -side top -fill both -expand 1
  194.  
  195.     listbox .catwin.frame.l.list -width 55 -height 15 \
  196.     -exportselection false -relief sunken \
  197.     -yscrollcommand ".catwin.frame.l.scroll set" -font $cbb(fixed_font)
  198.  
  199.     bind .catwin <KeyPress-Down> { .catwin.frame.l.list \
  200.         yview scroll 1 units }
  201.     bind .catwin <Control-KeyPress-n> { .catwin.frame.l.list \
  202.         yview scroll 1 units }
  203.     bind .catwin <KeyPress-n> { .catwin.frame.l.list \
  204.         yview scroll 1 units }
  205.     bind .catwin <KeyPress-j> { .catwin.frame.l.list \
  206.         yview scroll 1 units }
  207.  
  208.     bind .catwin <KeyPress-Up> { .catwin.frame.l.list \
  209.         yview scroll -1 units }
  210.     bind .catwin <Control-KeyPress-p> { .catwin.frame.l.list \
  211.         yview scroll -1 units }
  212.     bind .catwin <KeyPress-p> { .catwin.frame.l.list \
  213.         yview scroll -1 units }
  214.     bind .catwin <KeyPress-k> { .catwin.frame.l.list \
  215.         yview scroll -1 units }
  216.  
  217.     bind .catwin <KeyPress-Next> { .catwin.frame.l.list \
  218.         yview scroll 1 pages }
  219.     bind .catwin <Control-KeyPress-v> { .catwin.frame.l.list \
  220.         yview scroll 1 pages }
  221.  
  222.     bind .catwin <KeyPress-Prior> { .catwin.frame.l.list \
  223.         yview scroll -1 pages }
  224.     bind .catwin <Alt-KeyPress-v> { .catwin.frame.l.list \
  225.         yview scroll -1 pages }
  226.  
  227.     scrollbar .catwin.frame.l.scroll -command ".catwin.frame.l.list yview" \
  228.     -relief flat
  229.     pack .catwin.frame.l.scroll -side right -fill y
  230.     pack .catwin.frame.l.list -side left -fill both -expand 1
  231.  
  232.     bind .catwin.frame.l.list <Double-Button> {
  233.     if { "[.catwin.frame.l.list curselection]" != "" } {
  234.         set cat [string trim [string range \
  235.         [.catwin.frame.l.list get [.catwin.frame.l.list curselection]] \
  236.         3 27]]
  237.     }
  238.     }
  239.  
  240.     button .catwin.frame.b.add -text "Add" -command { 
  241.     set addcat(cat) ""
  242.     set addcat(mode) "normal"
  243.     cbbWindow.newcat
  244.     tkwait window .newcat
  245.     if { [winfo exists .catwin] } {
  246.         # parent could have already been dismissed.
  247.         catLoad .catwin.frame.l.list
  248.     }
  249.     }
  250.     button .catwin.frame.b.delete -text "Delete" -command { 
  251.     if { "[.catwin.frame.l.list curselection]" != "" } { 
  252.         catDelete [.catwin.frame.l.list get \
  253.                 [.catwin.frame.l.list curselection]]
  254.     }
  255.     }
  256.     button .catwin.frame.b.paste -text "Paste" -command {
  257.     if { "[.catwin.frame.l.list curselection]" != "" } {
  258.         set cat [string trim [string range \
  259.         [.catwin.frame.l.list get [.catwin.frame.l.list curselection]] \
  260.         3 27]]
  261.     }
  262.     }
  263.     button .catwin.frame.b.dismiss -text "Dismiss" \
  264.     -command { destroy .catwin }
  265.  
  266.     pack .catwin.frame.b.add .catwin.frame.b.delete .catwin.frame.b.paste \
  267.         .catwin.frame.b.dismiss -side left -fill x -expand 1 -padx 8 -pady 8
  268.  
  269.     catLoad .catwin.frame.l.list
  270. }
  271.  
  272.  
  273. # load the category listbox
  274. proc catLoad win {
  275.     global eng
  276.  
  277.     $win delete 0 end
  278.  
  279.     puts $eng "all_cats"; flush $eng
  280.     gets $eng result; 
  281.     while { $result != "none" } {
  282.     set pieces [split $result "\t"]
  283.     set key [lindex $pieces 0]
  284.     set desc [lindex $pieces 1]
  285.     set tax [lindex $pieces 2]
  286.     
  287.         $win insert end [format "%-2s %-25s %-25s" $tax $key $desc]
  288.         gets $eng result
  289.     }
  290. }
  291.  
  292.  
  293. # actually delete ...
  294. proc catDelete line {
  295.     global cbb del_cat eng yesno
  296.  
  297.     set del_cat [string trim [string range $line 3 28]]
  298.     if { $cbb(debug) } { puts '$del_cat' }
  299.  
  300.     puts $eng "find_cat $del_cat"; flush $eng
  301.     gets $eng result
  302.  
  303.     if { "$result" != "none" } {
  304.     set pieces [split $result "\t"]
  305.     set key [lindex $pieces 0]
  306.     set desc [lindex $pieces 1]
  307.  
  308.     cbbWindow.yesno "Do you really wish to delete the category ``$key''?"
  309.     tkwait window .yesno
  310.     
  311.     if { "$yesno(result)" == "yes" } {
  312.         if { $cbb(debug) } { puts "deleting $del_cat" }
  313.         puts $eng "delete_cat $del_cat"; flush $eng
  314.         gets $eng result
  315.         if { $cbb(debug) } { 
  316.         puts "deleting category: $result"
  317.         }
  318.         catLoad .catwin.frame.l.list
  319.     }
  320.     } else {
  321.     cbbWindow.ok "Cannot locate account ``$del_cat''."
  322.     tkwait window .ok
  323.     }
  324. }
  325.  
  326.  
  327. # ----------------------------------------------------------------------------
  328. # $Log: categories.tcl,v $
  329. # Revision 2.7  1997/03/05 18:58:32  curt
  330. # Added additional bindings to scrolling lists: categories list, balance
  331. # window list, text help, and report list.
  332. #
  333. # Revision 2.6  1996/12/17 14:53:52  curt
  334. # Updated copyright date.
  335. #
  336. # Revision 2.5  1996/12/16 04:18:12  curt
  337. # Continuing the great overhaul of December 1996.
  338. #
  339. # Revision 2.4  1996/12/14 17:15:20  curt
  340. # The great overhaul of December '96.
  341. #
  342. # Revision 2.3  1996/12/11 18:33:27  curt
  343. # Ran a spell checker.
  344. #
  345. # Revision 2.2  1996/12/08 07:39:57  curt
  346. # Rearranged quite a bit of code.
  347. # Put most global variables in cbb() structure.
  348. #
  349. # Revision 2.1  1996/12/07 20:38:14  curt
  350. # Renamed *.tk -> *.tcl
  351. #
  352. # Revision 2.6  1996/10/23 01:32:50  curt
  353. # Fixed a typo that caused an error when attempting to delete a category.
  354. #
  355. # Revision 2.5  1996/10/01 20:25:37  curt
  356. # Added better handling of unknown category when trying to "commit" a
  357. # transaction.
  358. #
  359. # Revision 2.4  1996/09/30 15:14:35  curt
  360. # Updated CBB URL, and hardwired wish path.
  361. #
  362. # Revision 2.3  1996/08/15 15:03:16  curt
  363. # Add view category list button when handling an unknown category.
  364. #
  365. # Revision 2.2  1996/07/13 02:57:35  curt
  366. # Version 0.65
  367. # Packing Changes
  368. # Documentation changes
  369. # Changes to handle a value in both debit and credit fields.
  370. #
  371. # Revision 2.1  1996/02/27  05:35:32  curt
  372. # Just stumbling around a bit with cvs ... :-(
  373. #
  374. # Revision 2.0  1996/02/27  04:41:47  curt
  375. # Initial 2.0 revision.  (See "Log" files for old history.)
  376.