home *** CD-ROM | disk | FTP | other *** search
/ Chip: Linux Special / CorelLinux_CHIP.iso / live / usr / X11R6 / lib / X11 / cbb / menu.tcl < prev    next >
Encoding:
Tcl/Tk script  |  1998-10-07  |  16.5 KB  |  592 lines
  1. #!/usr/bin/wish -f
  2. #  'CBB' -- Check Book Balancer
  3. #
  4. #  menu.tcl -- menu 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: menu.tcl,v 2.15 1997/06/12 21:53:15 curt Exp $
  25. # (Log is kept at end of this file)
  26.  
  27.  
  28. proc setup_menubar m {
  29.     global cbb
  30.  
  31.     menubutton $m.file -text "File" -underline 0 -menu $m.file.menu \
  32.         -takefocus 0
  33.     menubutton $m.edit -text "Edit" -underline 1 -menu $m.edit.menu \
  34.         -takefocus 0
  35.     menubutton $m.functions -text "Functions" -menu $m.functions.menu \
  36.         -takefocus 0
  37.     menubutton $m.extern -text "External" -underline 1 -menu $m.extern.menu \
  38.         -takefocus 0
  39.     if { $cbb(devel) == 1 } {
  40.     menubutton $m.devel -text "Devel" -menu $m.devel.menu \
  41.         -takefocus 0
  42.     }
  43.     menubutton $m.help -text "Help" -underline 0 -menu $m.help.menu \
  44.         -takefocus 0
  45.     
  46.     if { $cbb(devel) == 0 } {
  47.     pack $m.file $m.edit $m.functions $m.extern -side left -ipadx 2
  48.     } else {
  49.     pack $m.file $m.edit $m.functions $m.extern $m.devel -side left -ipadx 2
  50.     }
  51.     pack $m.help -side right -ipadx 1
  52. }
  53.  
  54.  
  55. proc setup_file_menu m {
  56.     set mf $m.file.menu
  57.  
  58.     if { [winfo exists $mf] } {
  59.     destroy $mf
  60.     }
  61.  
  62.     menu $mf -tearoff 0
  63.  
  64.     $mf add command -label "Make New Account ..." -underline 0 \
  65.         -command { acctNew }
  66.     $mf add command -label "Load Account ..." -underline 0 \
  67.             -command { acctLoad }
  68.     $mf add command -label "Save Account" -underline 0 \
  69.             -command { 
  70.         if { $cbb(cur_file) != "noname.cbb" } {
  71.             acctSave
  72.         } else {
  73.             acctSaveAs
  74.         }
  75.         }
  76.     .menubar.file.menu add command -label "Save Account As ..." -underline 5 \
  77.             -command { acctSaveAs }
  78.  
  79.     $mf add separator
  80.  
  81.     $mf add command -label "Import QIF File ..." -underline 0 \
  82.         -command {
  83.         set import_type 1
  84.         acctImport
  85.         }
  86.     $mf add command -label "Export QIF File" -underline 0 \
  87.         -command { acctExportQIF }
  88.  
  89.     $mf add separator
  90.  
  91.     $mf add cascade -label "Preferences" -underline 0 -menu $mf.prefs
  92.  
  93.     $mf add separator
  94.  
  95.     $mf add command -label "Quit" -underline 0 -command { cbbQuit }
  96.     $mf entryconfig 10 -accelerator <Meta-Q>
  97.     bind all <Meta-q> { cbbQuit }
  98.     bind all <Alt-q> { cbbQuit }
  99. }
  100.  
  101.  
  102. proc setup_edit_menu m {
  103.     set me $m.edit.menu
  104.  
  105.     menu $me -tearoff 0
  106.  
  107.     $me add command -label "Undo" -underline 0 -command { undoAction }
  108.     $me entryconfig 0 -accelerator <Meta-U>
  109.     bind all <Meta-u> { undoAction }
  110.     bind all <Alt-u> { undoAction }
  111.  
  112.     $me add separator
  113.  
  114.     $me add command -label "New Transaction" \
  115.         -underline 0 -command { clear_entry_area }
  116.     $me entryconfig 2 -accelerator <Meta-N>
  117.     bind all <Meta-n> { clear_entry_area }
  118.     bind all <Alt-n> { clear_entry_area }
  119.  
  120.     $me add command -label "Edit Transaction" -underline 0 \
  121.         -command { 
  122.     if { [listGetCurTrans] >= 1 } {
  123.         update_entry_area [listGetCurTrans].0
  124.     }
  125.     }
  126.     $me entryconfig 3 -accelerator <Meta-E>
  127.     bind all <Meta-e> { 
  128.     if { [listGetCurTrans] >= 1 } {
  129.         update_entry_area [listGetCurTrans].0
  130.     }
  131.     }
  132.     bind all <Alt-e> { 
  133.     if { [listGetCurTrans] >= 1 } {
  134.         update_entry_area [listGetCurTrans].0
  135.     }
  136.     }
  137.  
  138.     $me add command -label "Delete Transaction" -underline 0 \
  139.         -command { 
  140.     if { "[.trans.list tag nextrange sel 1.0 end ]" != "" } {
  141.         delete_trans [.trans.list tag nextrange sel 1.0 end ]
  142.     }
  143.     }
  144.  
  145.     $me add separator
  146.  
  147.     $me add command -label "Open Category Splits ... " -underline 0 \
  148.         -command { 
  149.     cbbWindow.splits
  150.     tkwait window .splits
  151.     }
  152.     $me entryconfig 6 -accelerator <Meta-S>
  153.     bind all <Meta-s> { 
  154.     cbbWindow.splits
  155.     tkwait window .splits
  156.     }
  157.     bind all <Alt-s> { 
  158.     cbbWindow.splits
  159.     tkwait window .splits
  160.     }
  161. }
  162.  
  163.  
  164. proc setup_functions_menu m {
  165.     global cbb
  166.  
  167.     set mf $m.functions.menu
  168.  
  169.     menu $mf -tearoff 0
  170.  
  171.     $mf add cascade -label "Goto" -underline 0 -menu $mf.goto
  172.  
  173.     $mf add separator
  174.  
  175.     $mf add command -label "Category List ..." \
  176.         -underline 0 -command { cbbWindow.catwin }
  177.     $mf entryconfig 0 -accelerator <Meta-C>
  178.     bind all <Meta-c> { cbbWindow.catwin }
  179.     bind all <Alt-c> { cbbWindow.catwin }
  180.  
  181.     $mf add command -label "Add Default Categories" \
  182.         -underline 0 -command { catImportDefaults }
  183.  
  184.     $mf add separator
  185.  
  186.     $mf add command -label "Balance ..." -underline 0 -command { balance }
  187.  
  188.     $mf add separator
  189.  
  190.     $mf add command -label "Reports ..." -underline 0 -command { 
  191.     set report(type) "report"
  192.     set report(cur_file) $cbb(cur_file)
  193.     set report(tmp_file) "/tmp/cbb-tmp-[pid].cbb"
  194.  
  195.     if { $cbb(debug) } { 
  196.         puts "Temp file is $report(tmp_file) -- saving ..."
  197.     }
  198.     # tell engine to save transactions
  199.     puts $eng "auto_save_trans $report(tmp_file)"; flush $eng
  200.     if { $cbb(debug) } { puts "No result should be returned." }
  201.  
  202.     cbbWindow.rep
  203.     }
  204.  
  205.     $mf add command -label "Graphs ..." -underline 0 -command { 
  206.     set report(type) "graph"
  207.     set report(cur_file) $cbb(cur_file)
  208.     set report(tmp_file) "/tmp/cbb-tmp-[pid].cbb"
  209.  
  210.     if { $cbb(debug) } { 
  211.         puts "Temp file is $report(tmp_file) -- saving ..."
  212.     }
  213.     # tell engine to save transactions
  214.     puts $eng "auto_save_trans $report(tmp_file)"; flush $eng
  215.     if { $cbb(debug) } { puts "No result should be returned." }
  216.  
  217.     cbbWindow.rep
  218.     }
  219. }
  220.  
  221.  
  222. proc setup_extern_menu m {
  223.     global lib_path
  224.  
  225.     set me $m.extern.menu
  226.  
  227.     menu $me -tearoff 0
  228.  
  229.     set filehandle [open "$lib_path/extern.conf" r]
  230.     while { [gets $filehandle line] >= 0 } {
  231.     if { "[string range $line 0 0]" == "-" } {
  232.             $me add separator
  233.     } elseif { "[string range $line 0 0]" == "#" } {
  234.         # ignore this line
  235.     } elseif { [string length $line] < 3  } {
  236.         # ignore this line
  237.         } else {
  238.         set pieces [split $line "\t"]
  239.         set name [lindex $pieces 0]
  240.         set prog [lindex $pieces 1]
  241.             $me add command -label $name -command "launch_extern \"$prog\""
  242.     }
  243.     }
  244.     close $filehandle
  245. }
  246.  
  247.  
  248. proc launch_extern { prog } {
  249.     global report cbb eng
  250.  
  251.     if { $cbb(safe_mode) == 1 } {
  252.         cbbWindow.ok "Cannot launch external scripts when running in 'safe' \
  253.         mode." 
  254.     tkwait window .ok
  255.         return
  256.     }
  257.  
  258.     set report(tmp_file) "/tmp/cbb-tmp-[pid].cbb"
  259.     if { $cbb(debug) } { puts "Temp file is $report(tmp_file) -- saving ..." }
  260.     # tell engine to save transactions
  261.     puts $eng "auto_save_trans $report(tmp_file)"; flush $eng
  262.     if { $cbb(debug) } { puts "No result should be returned." }
  263.  
  264.     regsub -all "%a" $prog $cbb(cur_file) prog
  265.     regsub -all "%t" $prog $report(tmp_file) prog
  266.  
  267.     if { $cbb(debug) } { puts "exec $prog &" }
  268.     eval exec $prog &
  269. }
  270.  
  271.  
  272. proc setup_devel_menu m {
  273.     set mf $m.devel.menu
  274.  
  275.     if { [winfo exists $mf] } {
  276.     destroy $mf
  277.     }
  278.  
  279.     menu $mf -tearoff 0
  280.  
  281.     $mf add command -label "Re-source \"balance.tcl\""  \
  282.         -command {  source "$lib_path/balance.tcl" }
  283.     $mf add command -label "Re-source \"bindings.tcl\""  \
  284.         -command {  source "$lib_path/bindings.tcl" }
  285.     $mf add command -label "Re-source \"categories.tcl\""  \
  286.         -command {  source "$lib_path/categories.tcl" }
  287.     $mf add command -label "Re-source \"common.tcl\""  \
  288.         -command {  source "$lib_path/common.tcl" }
  289.     $mf add command -label "Re-source \"file.tcl\""  \
  290.         -command {  source "$lib_path/file.tcl" }
  291.     $mf add command -label "Re-source \"filebox.tcl\""  \
  292.         -command {  source "$lib_path/filebox.tcl" }
  293.     $mf add command -label "Re-source \"help.tcl\""  \
  294.         -command {  source "$lib_path/help.tcl" }
  295.     $mf add command -label "Re-source \"init.tcl\""  \
  296.         -command {  source "$lib_path/init.tcl" }
  297.     $mf add command -label "Re-source \"main.tcl\""  \
  298.         -command {  source "$lib_path/main.tcl" }
  299.     $mf add command -label "Re-source \"menu.tcl\""  \
  300.         -command {  source "$lib_path/menu.tcl" }
  301.     $mf add command -label "Re-source \"prefs.tcl\""  \
  302.         -command {  source "$lib_path/prefs.tcl" }
  303.     $mf add command -label "Re-source \"reports.tcl\""  \
  304.         -command {  source "$lib_path/reports.tcl" }
  305.     $mf add command -label "Re-source \"splits.tcl\""  \
  306.         -command {  source "$lib_path/splits.tcl" }
  307.     $mf add command -label "Re-source \"undo.tcl\""  \
  308.         -command {  source "$lib_path/undo.tcl" }
  309. }
  310.  
  311.  
  312. proc setup_help_menu m {
  313.     global cbb argv0 libpath
  314.  
  315.     set mh $m.help.menu
  316.     menu $mh -tearoff 0
  317.  
  318.     $mh add command -label "About [file tail $argv0] ..." \
  319.         -underline 0 -command { cbbWindow.aboutwin [file tail $argv0] }
  320.  
  321.     $mh add separator
  322.  
  323.     $mh add command -label "Online HTML Manual ..." -underline 0 -command {
  324.     if { $cbb(safe_mode) == 0 } {
  325.         if { $cbb(web_browser) == "netscape" } {
  326.         # ... so they want to use nutscape ...
  327.         if [catch {exec xwininfo -name "Netscape"} data] {
  328.             # no existing netscape running
  329.             exec $cbb(web_browser) $lib_path/docs/cbb-man/cbb-man.html &
  330.         } else {
  331.             # A running copy of netscape exists
  332.             exec $cbb(web_browser) -remote \
  333.                 openURL($lib_path/docs/cbb-man/cbb-man.html) &
  334.         }
  335.         } elseif { $cbb(web_browser) == "lynx" } {
  336.         exec xterm -sb -e $cbb(web_browser) \
  337.             $lib_path/docs/cbb-man/cbb-man.html &
  338.         } else {
  339.         exec $cbb(web_browser) $lib_path/docs/cbb-man/cbb-man.html &
  340.         }
  341.     } else {
  342.         cbbWindow.ok "The online manual can be read from the CBB web page \
  343.             at: http://www.menet.umn.edu/~curt/cbb/"
  344.         tkwait window .ok
  345.     }
  346.     }
  347.  
  348.     $mh add command -label "Online Text Manual ..." -command { 
  349.     cbbWindow.helpwin
  350.     }
  351. }
  352.  
  353.  
  354. proc setup_file_prefs_menu m {
  355.     set mfp $m.file.menu.prefs
  356.  
  357.     menu $mfp -tearoff 0
  358.  
  359.     $mfp add checkbutton -label "Use Memorized Transactions" \
  360.         -variable cbb(use_mems) -command {
  361.     set cbb(pref_chg) 1
  362.     }
  363.  
  364.     $mfp add checkbutton -label "Use Startdate" \
  365.         -variable cbb(use_sdate) -command {
  366.     set cbb(pref_chg) 1
  367.     }
  368.  
  369.     $mfp add checkbutton -label "Use Account Cache" \
  370.         -variable cbb(cache) -command {
  371.     set cbb(pref_chg) 1
  372.  
  373.     puts $eng "cache $cbb(cache)"; flush $eng;
  374.     gets $eng result;
  375.     }
  376.  
  377.     $mfp add separator
  378.  
  379.     $mfp add command -label "Set Startdate ..." -command { 
  380.     setStartDate
  381.     }
  382.  
  383.     $mfp add separator
  384.  
  385.     $mfp add cascade -label "Appearence" -menu $mfp.appear
  386.  
  387.     $mfp add cascade -label "Cryptography" -menu $mfp.crypt
  388.  
  389.     $mfp add separator
  390.  
  391.     $mfp add command -label "Save Preferences" -command {
  392.     cbbrcSave
  393.     }
  394.  
  395. }
  396.  
  397. proc setup_prefs_appear_menu m {
  398.  
  399.     set mfpa $m.file.menu.prefs.appear
  400.  
  401.     menu $mfpa -tearoff 0
  402.  
  403.     $mfpa add checkbutton -label "Use Balloon Help" \
  404.         -variable cbb(balloon,on) -command {
  405.     set cbb(pref_chg) 1
  406.     }
  407.  
  408.     $mfpa add checkbutton -label "Use Auto Highlight" \
  409.         -variable cbb(auto_hilite) -command {
  410.     set cbb(pref_chg) 1
  411.     if { $cbb(auto_hilite) } {
  412.         setup_auto_hilite
  413.     } else {
  414.         bind Entry <FocusIn> {}
  415.         bind Entry <FocusOut> {}
  416.     }
  417.     }
  418.  
  419.     $mfpa add checkbutton -label "Use US Date Fmt" \
  420.     -variable cbb(date_fmt) -onvalue 1 -offvalue 2 -command {
  421.     set cbb(pref_chg) 1
  422.     }
  423.  
  424.     $mfpa add separator
  425.  
  426.     $mfpa add command -label "Set Dimensions" -command {
  427.     setDimensions
  428.     }
  429. }
  430.  
  431. proc setup_prefs_crypt_menu m {
  432.     set mfpc $m.file.menu.prefs.crypt
  433.  
  434.     menu $mfpc -tearoff 0
  435.  
  436.     $mfpc add checkbutton -label "Use Cryptography" \
  437.         -variable cbb(use_crypt) -command {
  438.     useCrypt
  439.     }
  440.  
  441.     $mfpc add separator
  442.  
  443.     $mfpc add command -label "Set Cryptcode ..." -command {
  444.     setCryptCode
  445.     }
  446.  
  447.     $mfpc add command -label "Set Cryptprogram ..." -command {
  448.     setCryptProgram
  449.     }
  450.  
  451. }
  452.  
  453. proc setup_functions_goto_menu m {
  454.     set mfg $m.functions.menu.goto
  455.  
  456.     menu $mfg -tearoff 0
  457.  
  458.     $mfg add command -label "Home" -underline 0 -command { goto 0 }
  459.     $mfg entryconfig 0 -accelerator <Meta-Home>
  460.     $mfg add command -label "Today" -underline 0 -command { 
  461.     puts $eng "raw_date"; flush $eng
  462.     gets $eng tmpdate
  463.     goto [find_index_from_date $tmpdate] 
  464.     }
  465.     $mfg add command -label "End" -underline 0 -command { 
  466.     goto [expr [listGetSize] - 1]
  467.     }
  468.     $mfg entryconfig 2 -accelerator <Meta-End>
  469.  
  470.     $mfg add separator
  471.  
  472.     $mfg add command -label "Page Up" -underline 5 \
  473.              -command {
  474.     goto [expr [.trans.list curselection] - ($cbb(list_height) - 4)]
  475.     }
  476.     $mfg entryconfig 4 -accelerator <Prior>
  477.     $mfg add command -label "Page Down" -underline 5 \
  478.              -command { 
  479.     goto [expr [.trans.list curselection] + ($cbb(list_height) - 4)]
  480.     }
  481.     $mfg entryconfig 5 -accelerator <Next>
  482.  
  483.     $mfg add separator
  484.  
  485.     $mfg add command -label "Up" -underline 1 \
  486.              -command {
  487.     goto [expr [.trans.list curselection] - 2]
  488.     }
  489.     $mfg entryconfig 7 -accelerator <Up>
  490.     $mfg add command -label "Down" -underline 1 \
  491.              -command { 
  492.     goto [expr [.trans.list curselection] + 2]
  493.     }
  494.     $mfg entryconfig 8 -accelerator <Down>
  495. }
  496.  
  497.  
  498. # ----------------------------------------------------------------------------
  499. # $Log: menu.tcl,v $
  500. # Revision 2.15  1997/06/12 21:53:15  curt
  501. # Applied more patches from Martin Schenk <schenkm@ping.at>.  His changes
  502. # greatly improved and developed the preferences menu so it is now actually
  503. # usable to set preferences.
  504. # Current data file is now saved in ~/.cbbcur.tcl
  505. #
  506. # Revision 2.14  1997/05/06 01:00:28  curt
  507. # Added patches contributed by Martin Schenk <schenkm@ping.at>
  508. # - Default to umask of 066 so .CBB files get created rw by owner only
  509. # - Added support for pgp encrypting data files
  510. # - Added support for displaying only recent parts of files (avoids
  511. #   waiting to load in lots of old txns you don't currently need.)
  512. # - Added a feature to "cache" whole accounts in the perl engine so
  513. #   that switching between accounts can be faster.
  514. # - The above options can be turned on/off via the preferrences menu.
  515. #
  516. # Revision 2.13  1997/04/23 18:10:02  curt
  517. # Changed "clolson" -> "curt"
  518. #
  519. # Revision 2.12  1997/04/14 20:18:23  curt
  520. # If browser is lynx, spawn in an xterm.
  521. #
  522. # Revision 2.11  1997/04/07 21:13:33  curt
  523. # Add a $cbb(web_browser) variable which can be set from ~/.cbbrc.tcl
  524. # If netscape is the browser, and there is a copy running, don't start
  525. # a new copy.
  526. #
  527. # Revision 2.10  1997/01/02 04:38:38  curt
  528. # Changes over the 1996 holidays:
  529. #   - Converted listbox to text widget.  This allows us to do nice
  530. #     things with alternating background colors, highliting, red
  531. #     negative numbers, etc.
  532. #   - Negative transactions are now drawn in red.
  533. #   - Added a Goto <Today> option.
  534. #   - <Home> & <End> were double bound.  Now, listbox can be traversed with
  535. #     <Meta-Home> and <Meta-End>
  536. #
  537. # Revision 2.9  1996/12/17 14:54:01  curt
  538. # Updated copyright date.
  539. #
  540. # Revision 2.8  1996/12/16 04:18:22  curt
  541. # Continuing the great overhaul of December 1996.
  542. #
  543. # Revision 2.7  1996/12/14 17:15:25  curt
  544. # The great overhaul of December '96.
  545. #
  546. # Revision 2.6  1996/12/13 01:27:00  curt
  547. # Worked on getting reports.tcl to work smoothly.
  548. #
  549. # Revision 2.5  1996/12/13 00:12:45  curt
  550. # Added reports.tcl
  551. #
  552. # Revision 2.4  1996/12/11 18:33:40  curt
  553. # Ran a spell checker.
  554. #
  555. # Revision 2.3  1996/12/11 04:18:41  curt
  556. # Removed the categories cascade menu and made the entries directly in the
  557. # functions menu.
  558. #
  559. # Revision 2.2  1996/12/08 07:40:02  curt
  560. # Rearranged quite a bit of code.
  561. # Put most global variables in cbb() structure.
  562. #
  563. # Revision 2.1  1996/12/07 20:38:17  curt
  564. # Renamed *.tk -> *.tcl
  565. #
  566. # Revision 2.6  1996/10/03 21:29:19  curt
  567. # Added a devel menu to assist in development.  Many changes to the code
  568. # can be re-sourced in without restarting the application.
  569. #
  570. # Revision 2.5  1996/09/30 15:14:39  curt
  571. # Updated CBB URL, and hardwired wish path.
  572. #
  573. # Revision 2.4  1996/09/27 21:43:41  curt
  574. # Added a text version of the manual to the Help menu.
  575. #
  576. # Revision 2.3  1996/07/13 02:57:51  curt
  577. # Version 0.65
  578. # Packing Changes
  579. # Documenation changes
  580. # Changes to handle a value in both debit and credit fields.
  581. #
  582. # Revision 2.2  1996/03/03  00:16:14  curt
  583. # Modified Files:  cbb categories.pl wrapper.pl file.tk main.tk menu.tk
  584. #   Added an account list at the bottom of the screen.  Thanks to:
  585. #   Cengiz Alaettinoglu <cengiz@ISI.EDU> for this great addition.
  586. #
  587. # Revision 2.1  1996/02/27  05:35:49  curt
  588. # Just stumbling around a bit with cvs ... :-(
  589. #
  590. # Revision 2.0  1996/02/27  04:43:04  curt
  591. # Initial 2.0 revision.  (See "Log" files for old history.)
  592.