home *** CD-ROM | disk | FTP | other *** search
/ PC World 1997 November / PCWorld_1997-11_cd.bin / software / programy / komix / DATA.Z / gencpp.tcl < prev    next >
Encoding:
Text File  |  1997-02-17  |  3.7 KB  |  139 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 Cadre Technologies Inc.
  13. #
  14. #---------------------------------------------------------------------------
  15. #
  16. #    File        : @(#)gencpp.tcl    /main/hindenburg/1
  17. #    Author        : frmo
  18. #    Original date    : 4-2-1993
  19. #    Description    : Generate C++ : entry point
  20. #
  21. #---------------------------------------------------------------------------
  22. #
  23.  
  24. require wmt_util.tcl
  25. require cpp_const.tcl
  26.  
  27. set cc [ClientContext::global]
  28.  
  29. if {! [$cc customFileExists cpp_config tcl "" 0]} {
  30.     set msg "couldn't read file 'cpp_config.tcl': C++ environment not configured"
  31.     error $msg "" ERR_CPP_CONFIG
  32. }
  33.  
  34. require cpp_config.tcl
  35. require cpp_class.tcl
  36. require cpp_funcs.tcl
  37. require cpp_disp.tcl
  38. require cpp_regen.tcl
  39. require libsql.tcl
  40. require gen_db_def.tcl
  41. require gen_db_fnc.tcl
  42.  
  43. proc generate_cpp {} {
  44.     find_file_types
  45.  
  46.     set systemName [getCurrentSystemName]
  47.     set tgt_objs [get_tgt_objs]
  48.     if [lempty $tgt_objs] {
  49.         # import new
  50.         global skip_file
  51.         global do_struct_file
  52.         set struct_file ${systemName}Struct.$hplus_type
  53.         set file_list "$esqlcplus_type $cplus_type $hplus_type"
  54.         set old_files [fstorage::dir $file_list]
  55.         foreach file $old_files {
  56.             if {$file != $struct_file || !$do_struct_file} {
  57.             set skip_file($file) 1
  58.             }
  59.         }
  60.  
  61.         if {![info exists skip_file($struct_file)]} {
  62.             generate [$oomodel sqlModel]
  63.         }
  64.  
  65.         generate [$oomodel ooplModel]
  66.         # (Re)generate the makefile if there are new files
  67.         set new_files [fstorage::dir $file_list]
  68.         if {"$old_files" != "$new_files"} {
  69.             require_with_reload makemake.tcl
  70.         }
  71.     } else {
  72.         # import selected
  73.         global gen_file
  74.         set do_cpp 0
  75.         foreach file $tgt_objs {
  76.             set gen_file($file) 1
  77.             if {"$file" == "${systemName}Struct.$hplus_type"} {
  78.                 continue
  79.             }
  80.             set type [nt_get_type $file]
  81.             if {"$type" == "$cplus_type" || "$type" == "$hplus_type"
  82.                  || "$type" == "$esqlcplus_type"} {
  83.                 set do_cpp 1
  84.             }
  85.         }
  86.         if {[info exists gen_file(${systemName}Struct.$hplus_type)]} {
  87.             generate [$oomodel sqlModel]
  88.         }
  89.         if $do_cpp {
  90.             generate [$oomodel ooplModel]
  91.         }
  92.     }
  93. }
  94.  
  95. # Search for user defined Tcl files and "source" them. Tcl files are sourced
  96. # in the following order:
  97. #    - u_gencpp.tcl; EITHER in m4_home/tcl OR in <project_dir>/tcl
  98. #    - all tcl files in the system named "Tcl"
  99. #    - all tcl files in the current system
  100.  
  101.  
  102. # "Source" a tcl file
  103. #
  104. proc source_tcl_file {file} {
  105.     if [catch {source $file}] {
  106.     m4_error $E_USER_TCL $file
  107.     puts stderr $errorInfo
  108.     }
  109. }
  110.  
  111. # "Source" all tcl files in the current system
  112. #
  113. proc source_all_tcl_files {} {
  114.     foreach file [fstorage::dir tcl] {
  115.         source_tcl_file [fstorage::get_uenv_path $file absolute]
  116.     }
  117. }
  118.  
  119. # "Source" all tcl files in the system named "Tcl"
  120. #
  121. proc source_files_in_tcl_sys {} {
  122.     set clientCont [ClientContext::global]
  123.     set origSys [$clientCont levelNameAt System]
  124.     if [catch {fstorage::goto_system Tcl.system}] {
  125.         return
  126.     }
  127.     source_all_tcl_files
  128.     fstorage::goto_system $origSys
  129. }
  130.  
  131. if {[$cc customFileExists u_gencpp tcl "" 0]} {
  132.     require u_gencpp.tcl
  133. }
  134.  
  135. source_files_in_tcl_sys
  136. source_all_tcl_files
  137.  
  138. generate_cpp
  139.