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