home *** CD-ROM | disk | FTP | other *** search
/ PC World 2000 February / PCWorld_2000-02_cd.bin / live / usr / X11R6 / lib / X11 / cbb / reports.tcl < prev    next >
Text File  |  1998-10-07  |  13KB  |  405 lines
  1. #!/usr/bin/wish -f
  2. #  'reports.tcl' -- CBB General Reporting/Graphing Front End
  3. #
  4. #  Written by Curtis Olson.  Started November 17, 1994.
  5. #
  6. #  Copyright (C) 1994 - 1997  Curtis L. Olson  - curt@sledge.mn.org
  7. #
  8. #  This program is free software; you can redistribute it and/or modify
  9. #  it under the terms of the GNU General Public License as published by
  10. #  the Free Software Foundation; either version 2 of the License, or
  11. #  (at your option) any later version.
  12. #
  13. #  This program is distributed in the hope that it will be useful,
  14. #  but WITHOUT ANY WARRANTY; without even the implied warranty of
  15. #  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16. #  GNU General Public License for more details.
  17. #
  18. #  You should have received a copy of the GNU General Public License
  19. #  along with this program; if not, write to the Free Software
  20. #  Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  21. #
  22. # $Id: reports.tcl,v 1.7 1998/08/14 14:28:41 curt Exp $
  23. # (Log is kept at end of this file)
  24.  
  25.  
  26. #------------------------------------------------------------------------------
  27. # Set defaults 
  28. #------------------------------------------------------------------------------
  29.  
  30. set report(cur_file) ""
  31. set report(tmp_file) ""
  32. set report(start) ""
  33. set report(end) ""
  34. set report(dest) "screen"
  35. set report(temp) ""
  36.  
  37.  
  38. #------------------------------------------------------------------------------
  39. # Create report options window
  40. #------------------------------------------------------------------------------
  41.  
  42. proc cbbWindow.rep {} {
  43.     global lib_path cbb report max_files files names
  44.  
  45.     if {[winfo exists .rep] == 1} {
  46.     destroy .rep
  47.     }
  48.  
  49.     toplevel .rep
  50.  
  51.     option add *font $cbb(dialog_font)
  52.  
  53.     if { "$report(type)" == "report" } {
  54.     set name "Report"
  55.     } else {
  56.     set name "Graph"
  57.     }
  58.  
  59.     if { "$report(dest)" != "screen" } {
  60.         if { "$report(dest)" == "file" } {
  61.         set report(dest) "screen"
  62.         }
  63.     } 
  64.  
  65.     wm title .rep "$name Configuration ..."
  66.     wm iconname .rep "$name Configuration ..."
  67.     frame .rep.f -borderwidth 2 -relief raised
  68.     pack .rep.f -side top -fill both -expand 1
  69.  
  70.     frame .rep.f.l 
  71.     frame .rep.f.r 
  72.     pack .rep.f.l .rep.f.r -side left -fill both -expand 1
  73.  
  74.     frame .rep.f.l.rep -borderwidth 2 -relief groove
  75.     frame .rep.f.l.file -borderwidth 2 -relief groove
  76.     pack .rep.f.l.rep .rep.f.l.file -side top -fill both -expand 1 \
  77.         -padx 4 -pady 4
  78.  
  79.     label .rep.f.l.rep.label -text "Select a $name"
  80.     pack .rep.f.l.rep.label -side top -fill x -expand 1
  81.  
  82.     set i 0
  83.     if { $report(type) == "report" } {
  84.         set filehandle [open "$lib_path/reports/reports.conf" r]
  85.     } else {
  86.         set filehandle [open "$lib_path/graphs/graphs.conf" r]
  87.     }
  88.     
  89.     while { [gets $filehandle line] >= 0 } {
  90.         if { "[string range $line 0 0]" == "-" } {
  91.         # ignore this line
  92.         } elseif { "[string range $line 0 0]" == "#" } {
  93.             # ignore this line
  94.         } elseif { [string length $line] < 3  } {
  95.             # ignore this line
  96.         } else {
  97.             set pieces [split $line "\t"]
  98.             set bname [lindex $pieces 0]
  99.             set prog [lindex $pieces 1]
  100.             radiobutton .rep.f.l.rep.rep$i -text $bname -relief flat \
  101.         -variable report(name) -value "$prog"
  102.         pack .rep.f.l.rep.rep$i -side top -anchor w 
  103.  
  104.         if { "$report(name)" == "" } {
  105.         set report(name) "$prog"
  106.         }
  107.         set i [expr $i + 1]
  108.         }
  109.     }
  110.     close $filehandle
  111.  
  112.     label .rep.f.l.file.label -text "Select One or More Files"
  113.     pack .rep.f.l.file.label -side top -fill x -expand 1
  114.  
  115.     set i 0
  116.     set max_files 0
  117.     # cd [file dirname $report(cur_file)]
  118.     if { $cbb(debug) } { puts $report(cur_file) }
  119.     foreach file [lsort [glob -nocomplain \
  120.         [file dirname $report(cur_file)]/*.cbb]] {
  121.     set max_files $i
  122.     checkbutton .rep.f.l.file.file$i -text [file tail $file] -relief flat \
  123.         -variable files($i) 
  124.  
  125.         set files($i) 0
  126.     set names($i) $file
  127.     if { "$file" == "$report(cur_file)" } {
  128.         set files($i) 1
  129.         if { "$report(tmp_file)" != "" } {
  130.             set names($i) $report(tmp_file)
  131.         } 
  132.     }
  133.     
  134.         pack .rep.f.l.file.file$i -side top -anchor w
  135.  
  136.     set i [expr $i + 1]
  137.     }
  138.  
  139.     frame .rep.f.r.conf -borderwidth 2 -relief groove
  140.     frame .rep.f.r.but -borderwidth 2 -relief groove
  141.     pack .rep.f.r.but -side bottom -fill x -padx 4 -pady 4
  142.     pack .rep.f.r.conf -side top -fill x -expand 1 -padx 4 -pady 4 -anchor n
  143.  
  144.     label .rep.f.r.conf.label2 -text "Enter Starting and Ending dates"
  145.     pack .rep.f.r.conf.label2 -side top -fill x -expand 1
  146.  
  147.     frame .rep.f.r.conf.s -borderwidth 2
  148.     frame .rep.f.r.conf.e -borderwidth 2
  149.     pack .rep.f.r.conf.s .rep.f.r.conf.e -side top -fill x -expand 1
  150.  
  151.     if { $report(type) == "report" } {
  152.         frame .rep.f.r.conf.os -borderwidth 2
  153.         frame .rep.f.r.conf.of -borderwidth 2
  154.         frame .rep.f.r.conf.oe -borderwidth 2
  155.  
  156.         pack .rep.f.r.conf.os .rep.f.r.conf.of .rep.f.r.conf.oe \
  157.             -side top -fill x -expand 1
  158.     }
  159.  
  160.     label .rep.f.r.conf.s.label -text "Starting Date"
  161.     set report(start) $cbb(report_sdate)
  162.     entry .rep.f.r.conf.s.entry -textvariable report(start) -relief sunken
  163.     pack .rep.f.r.conf.s.label -side left
  164.     pack .rep.f.r.conf.s.entry -side left -fill x -expand 1
  165.  
  166.     label .rep.f.r.conf.e.label -text "Ending Date"
  167.     entry .rep.f.r.conf.e.entry -textvariable report(end) -relief sunken
  168.     pack .rep.f.r.conf.e.label -side left
  169.     pack .rep.f.r.conf.e.entry -side left -fill x -expand 1
  170.  
  171.  
  172.     if { $report(type) == "report" } {
  173.         radiobutton .rep.f.r.conf.os.screen -text "Send to Screen" -anchor w \
  174.             -font $cbb(button_font) -variable report(dest) -value "screen" \
  175.             -relief flat -command {
  176.         if { "$report(file)" != "" } {
  177.         set report(temp) $report(file)
  178.         set report(file) ""
  179.         update
  180.         }
  181.     }
  182.         radiobutton .rep.f.r.conf.of.file -text "Save to File or Pipe" \
  183.         -anchor w -font $cbb(button_font) -variable report(dest) \
  184.         -value "file" -relief flat -command {
  185.         if { "$report(file)" == "" } {
  186.         if { "$report(temp)" != "" } {
  187.             set report(file) $report(temp)
  188.             update
  189.         }
  190.         }
  191.     } 
  192.         label .rep.f.r.conf.oe.label -text "File Name"
  193.         entry .rep.f.r.conf.oe.file -textvariable report(file) -relief sunken
  194.  
  195.         pack .rep.f.r.conf.os.screen -side left -fill x -expand 1
  196.         pack .rep.f.r.conf.of.file -side left -fill x -expand 1
  197.         pack .rep.f.r.conf.oe.label -side left
  198.         pack .rep.f.r.conf.oe.file -side left -fill x -expand 1
  199.  
  200.     }
  201.  
  202.     button .rep.f.r.but.gen -text "Generate $name ..." -font $cbb(button_font) \
  203.         -command { reportGenerate }
  204.     button .rep.f.r.but.dismiss -text "Dismiss" -font $cbb(button_font) \
  205.             -command { 
  206.     if { "$report(tmp_file)" != "" } { exec rm $report(tmp_file) }
  207.     destroy .rep
  208.     }
  209.     pack .rep.f.r.but.gen .rep.f.r.but.dismiss -side left \
  210.         -fill x -expand 1 -padx 8 -pady 8
  211.  
  212.     focus .rep.f.r.conf.s.entry
  213. }
  214.  
  215.  
  216. #------------------------------------------------------------------------------
  217. # Call the current report with the current start/end dates
  218. #------------------------------------------------------------------------------
  219.  
  220. proc reportGenerate {} {
  221.     global cbb report max_files files names nice_start nice_end lib_path
  222.  
  223.     # build file list
  224.     set i 0
  225.     while { $i <= $max_files } {
  226.     if { $files($i) } {
  227.         append file_list "$names($i) "
  228.     }
  229.     set i [expr $i + 1]
  230.     }
  231.  
  232.     if { $cbb(debug) } { puts $file_list }
  233.  
  234.     if { "$report(start)" != "" } {
  235.     set nice_start "-from $report(start)"
  236.     } else {
  237.     set nice_start ""
  238.     }
  239.  
  240.     if { "$report(end)" != "" } {
  241.     set nice_end "-to $report(end)"
  242.     } else {
  243.     set nice_end ""
  244.     }
  245.  
  246.     if { $cbb(debug) } { puts "From $nice_start To $nice_end" }
  247.  
  248.     if { $report(type) == "report" } {
  249.         if { $cbb(debug) } { 
  250.         puts "open |$lib_path/reports/$report(name) $nice_start \
  251.             $nice_end $file_list r+"
  252.     }
  253.         set report(handle) [open "|$lib_path/reports/$report(name) $nice_start \
  254.         $nice_end $file_list" r]
  255.     if { "$report(dest)" == "screen" } {
  256.         cbbWindow.represult
  257.     } elseif { "$report(dest)" == "file" } {
  258.         if { $cbb(safe_mode) == 0 } {
  259.         set rep_out [open "$report(file)" w]
  260.         while { [gets $report(handle) line] >= 0 } {
  261.             puts $rep_out $line
  262.         }
  263.         close $rep_out
  264.         cbbWindow.ok "Report written to ``$report(file)''"
  265.         tkwait window .ok
  266.  
  267.         close $report(handle)
  268.         } else {
  269.         cbbWindow.ok "Cannot print to a file when running in 'safe' \
  270.             mode." 
  271.         tkwait window .ok
  272.         }
  273.     }
  274.     } else {
  275.     if { $cbb(debug) } { 
  276.         puts "open |$lib_path/graphs/$report(name) $nice_start \
  277.             $nice_end $file_list r+"
  278.     }
  279.         set report(handle) [open "|$lib_path/graphs/$report(name) $nice_start \
  280.         $nice_end $file_list" r+]
  281.     }
  282. }
  283.  
  284.  
  285. proc cbbWindow.represult {} {
  286.     global cbb report nice_start nice_end
  287.  
  288.     option add *font $cbb(dialog_font)
  289.  
  290.     if { [winfo exists .represult] } {
  291.     destroy .represult
  292.     }
  293.  
  294.     toplevel .represult
  295.  
  296.     wm title .represult "$report(name): $report(start) - $report(end)"
  297.     wm iconname .represult "Fix Me"
  298.     frame .represult.frame -borderwidth 2 -relief raised
  299.     frame .represult.frame.l -borderwidth 2
  300.     frame .represult.frame.d -borderwidth 2
  301.  
  302.     pack .represult.frame .represult.frame.l .represult.frame.d -side top \
  303.       -fill both -expand 1
  304.  
  305.     listbox .represult.frame.l.list -width 80 -height 25 -relief sunken \
  306.          -font $cbb(fixed_font) \
  307.          -yscrollcommand ".represult.frame.l.scroll set"
  308.     pack .represult.frame.l.list -side left -fill both -expand 1
  309.  
  310.     scrollbar .represult.frame.l.scroll \
  311.         -command ".represult.frame.l.list yview" -relief flat
  312.     pack .represult.frame.l.scroll -side left -fill y -expand 1
  313.  
  314.     button .represult.frame.d.dismiss -text "Dismiss" -font $cbb(button_font) \
  315.     -command { destroy .represult }
  316.  
  317.     while { [gets $report(handle) line] >= 0 } {
  318.     if { "$line" == "done-graph" } {
  319.         break
  320.     }
  321.     .represult.frame.l.list insert end $line
  322.     }
  323.     close $report(handle)
  324.  
  325.     pack .represult.frame.d.dismiss -side top -fill x -expand 1 \
  326.         -padx 8 -pady 4
  327.  
  328.     bind .represult <KeyPress-Down> { .represult.frame.l.list \
  329.         yview scroll 1 units }
  330.     bind .represult <Control-KeyPress-n> { .represult.frame.l.list \
  331.         yview scroll 1 units }
  332.     bind .represult <KeyPress-n> { .represult.frame.l.list \
  333.         yview scroll 1 units }
  334.     bind .represult <KeyPress-j> { .represult.frame.l.list \
  335.         yview scroll 1 units }
  336.  
  337.     bind .represult <KeyPress-Up> { .represult.frame.l.list \
  338.         yview scroll -1 units }
  339.     bind .represult <Control-KeyPress-p> { .represult.frame.l.list \
  340.         yview scroll -1 units }
  341.     bind .represult <KeyPress-p> { .represult.frame.l.list \
  342.         yview scroll -1 units }
  343.     bind .represult <KeyPress-k> { .represult.frame.l.list \
  344.         yview scroll -1 units }
  345.  
  346.     bind .represult <KeyPress-Next> { .represult.frame.l.list \
  347.         yview scroll 1 pages }
  348.     bind .represult <Control-KeyPress-v> { .represult.frame.l.list \
  349.         yview scroll 1 pages }
  350.  
  351.     bind .represult <KeyPress-Prior> { .represult.frame.l.list \
  352.         yview scroll -1 pages }
  353.     bind .represult <Alt-KeyPress-v> { .represult.frame.l.list \
  354.         yview scroll -1 pages }
  355.  
  356. }
  357.  
  358.  
  359. # ----------------------------------------------------------------------------
  360. # $Log: reports.tcl,v $
  361. # Revision 1.7  1998/08/14 14:28:41  curt
  362. # Added desc-pie graph.
  363. # Added option to eliminate splash screen.
  364. # Other misc. tweaks and bug fixes.
  365. #
  366. # Revision 1.6  1997/03/05 18:58:33  curt
  367. # Added additional bindings to scrolling lists: categories list, balance
  368. # window list, text help, and report list.
  369. #
  370. # Revision 1.5  1996/12/17 14:54:02  curt
  371. # Updated copyright date.
  372. #
  373. # Revision 1.4  1996/12/16 04:18:23  curt
  374. # Continuing the great overhaul of December 1996.
  375. #
  376. # Revision 1.3  1996/12/14 17:15:25  curt
  377. # The great overhaul of December '96.
  378. #
  379. # Revision 1.2  1996/12/13 01:27:01  curt
  380. # Worked on getting reports.tcl to work smoothly.
  381. #
  382. # Revision 1.1  1996/12/13 00:10:18  curt
  383. # conf-reports changed to reports.tcl and merged with main program.
  384. #
  385. # Revision 2.5  1996/12/11 18:33:31  curt
  386. # Ran a spell checker.
  387. #
  388. # Revision 2.4  1996/10/22 21:51:51  curt
  389. # Attempt to alleviate the max_files unknown bug.
  390. #
  391. # Revision 2.3  1996/09/30 15:20:46  curt
  392. # Updated wish path.
  393. #
  394. # Revision 2.2  1996/07/13 02:57:40  curt
  395. # Version 0.65
  396. # Packing Changes
  397. # Documentation changes
  398. # Changes to handle a value in both debit and credit fields.
  399. #
  400. # Revision 2.1  1996/02/27  05:35:39  curt
  401. # Just stumbling around a bit with cvs ... :-(
  402. #
  403. # Revision 2.0  1996/02/27  04:41:51  curt
  404. # Initial 2.0 revision.  (See "Log" files for old history.)
  405.