home *** CD-ROM | disk | FTP | other *** search
/ PC World 1997 November / PCWorld_1997-11_cd.bin / software / programy / komix / DATA.Z / genne.tcl < prev    next >
Encoding:
Text File  |  1997-06-04  |  3.1 KB  |  126 lines
  1. #---------------------------------------------------------------------------
  2. #
  3. # Copyright (c) 1993-1995 by Cadre Technologies Inc.
  4. #
  5. # This software is furnished under a license and may be used only in
  6. # accordance with the terms of such license and with the inclusion of
  7. # the above copyright notice. This software or any other copies thereof
  8. # may not be provided or otherwise made available to any other person.
  9. # No title to and ownership of the software is hereby transferred.
  10. #
  11. # The information in this software is subject to change without notice
  12. # and should not be construed as a commitment by Westmount Technology B.V.
  13. #
  14. #---------------------------------------------------------------------------
  15. #
  16. #    File        : @(#)genne.tcl    /main/hindenburg/2
  17. #    Original date    : 19-10-1994
  18. #    Description    : Generate NewEra : entry point
  19. #
  20. #---------------------------------------------------------------------------
  21. #
  22.  
  23. require wmt_util.tcl
  24. require ne_const.tcl
  25. require ne_config.tcl
  26. require ne_class.tcl
  27. require ne_funcs.tcl
  28. require gen_db_fnc.tcl
  29. require oopl_disp.tcl
  30. require ne_regen.tcl
  31. require gen_db_def.tcl
  32. require libsql.tcl
  33.  
  34. require ixval.tcl
  35. require libnesql.tcl
  36. require genwif.tcl
  37.  
  38. global comment_string; set comment_string(ne) "--"
  39. set cc [ClientContext::global]
  40.  
  41. proc before_generate {} {
  42.     add_column_nr_attrs
  43. }
  44.  
  45. proc generate_ne {} {
  46.     find_file_types
  47.  
  48.     set systemName [getCurrentSystemName]
  49.     set tgt_objs [get_tgt_objs]
  50.     if [lempty $tgt_objs] {
  51.         # import new
  52.         global skip_file
  53.         set file_list\
  54.             "$fourgl_type $fourgh_type $wif_type $wif_tmpl_type"
  55.         set old_files [fstorage::dir $file_list]
  56.         foreach file $old_files {
  57.             set skip_file($file) 1
  58.         }
  59.         generate [$oomodel ooplModel]
  60.     } else {
  61.         # import selected
  62.         global gen_file
  63.         set do_ne 0
  64.         foreach file $tgt_objs {
  65.             set gen_file($file) 1
  66.             set type [nt_get_type $file]
  67.             if {"$type" == "$fourgl_type" ||
  68.                 "$type" == "$fourgh_type" ||
  69.                 "$type" == "$wif_type" ||
  70.                 "$type" == "$wif_tmpl_type" } {
  71.                 set do_ne 1
  72.             }
  73.         }
  74.         if $do_ne {
  75.             generate [$oomodel ooplModel]
  76.         }
  77.     }
  78. }
  79.  
  80. # Search for user defined Tcl files and "source" them. Tcl files are sourced
  81. # in the following order:
  82. #    - customization file u_genne.tcl
  83. #    - all tcl files in the system named "Tcl"
  84. #    - all tcl files in the current system
  85.  
  86.  
  87. # "Source" a tcl file
  88. #
  89. proc source_tcl_file {file} {
  90.     if [catch {source $file}] {
  91.     m4_error $E_USER_TCL $file
  92.     puts stderr $errorInfo
  93.     }
  94. }
  95.  
  96. # "Source" all tcl files in the current system
  97. #
  98. proc source_all_tcl_files {} {
  99.     foreach file [fstorage::dir tcl] {
  100.         source_tcl_file [fstorage::get_uenv_path $file absolute]
  101.     }
  102. }
  103.  
  104. # "Source" all tcl files in the system named "Tcl"
  105. #
  106. proc source_files_in_tcl_sys {} {
  107.     set clientCont [ClientContext::global]
  108.     set origSys [$clientCont levelNameAt System]
  109.     if [catch {fstorage::goto_system Tcl.system}] {
  110.         return
  111.     }
  112.     source_all_tcl_files
  113.     fstorage::goto_system $origSys
  114. }
  115.  
  116. if {[$cc customFileExists u_genne tcl "" 0]} {
  117.     require u_genne.tcl
  118. }
  119.  
  120. before_generate
  121.  
  122. source_files_in_tcl_sys
  123. source_all_tcl_files
  124.  
  125. generate_ne
  126.