home *** CD-ROM | disk | FTP | other *** search
/ PC World 1997 November / PCWorld_1997-11_cd.bin / software / programy / komix / DATA.Z / genada83.tcl < prev    next >
Text File  |  1997-03-24  |  3KB  |  108 lines
  1. ###########################################################################
  2. ##
  3. ##  Copyright (c) 1996 by Cadre Technologies Inc.
  4. ##                          and Scientific Toolworks Inc.
  5. ##
  6. ##  This software is furnished under a license and may be used only in
  7. ##  accordance with the terms of such license and with the inclusion of
  8. ##  the above copyright notice. This software or any other copies thereof
  9. ##  may not be provided or otherwise made available to any other person.
  10. ##  No title to and ownership of the software is hereby transferred.
  11. ##
  12. ##  The information in this software is subject to change without notice
  13. ##  and should not be construed as a commitment by Cadre Technologies Inc.
  14. ##  or Scientific Toolworks Inc.
  15. ##
  16. ###########################################################################
  17.  
  18. require wmt_util.tcl
  19. require ada_util.tcl
  20. require ada_const.tcl
  21.  
  22. global comment_srtring; set comment_string(ada83) "--"
  23.  
  24. require ada_config.tcl
  25. require ada_class.tcl
  26. require ada_funcs.tcl
  27. require ada_disp.tcl
  28. require ada_regen.tcl
  29.  
  30. proc generate_ada {} {
  31.     puts stdout ""
  32.     if {$g_generate_separates} {
  33.         puts stdout "Subunit file generation is enabled."
  34.     }
  35.     if {$g_poly} {
  36.         puts stdout "Polymorphic file generation is enabled.\n"
  37.     }
  38.     find_ada_file_types
  39.     set system [cap [m4_var get M4_system]]
  40.     set tgt_objs [get_tgt_objs]
  41.     if [lempty $tgt_objs] {
  42.         # import new
  43.         generate [get_oopl_model $oomodel]
  44.     } else {
  45.         # import selected
  46.         global gen_file
  47.         set do_ada 0
  48. #        set gen_file(${system}_Types.$ada_spec_type) 1
  49.         foreach file $tgt_objs {
  50.             set gen_file($file) 1
  51.             set type [nt_get_type $file]
  52.  
  53.             if {"$type" == "$ada_body_type" || 
  54.                 "$type" == "$ada_spec_type" ||
  55.                 "$type" == "$ada_sep_type" } {
  56.                 set do_ada 1
  57.             }
  58.         }
  59.         if $do_ada {
  60.             generate [get_oopl_model $oomodel]
  61.         }
  62.     }
  63. }
  64.  
  65. # Search for user defined Tcl files and "source" them. Tcl files are sourced
  66. # in the following order:
  67. #    - u_genada.tcl; EITHER in m4_home/tcl OR in <project_dir>/tcl
  68. #    - all tcl files in the system named "Tcl"
  69. #    - all tcl files in the current system
  70.  
  71.  
  72. # "Source" a tcl file
  73. #
  74. proc source_tcl_file {file} {
  75.     if [catch {source $file}] {
  76.     m4_error $E_USER_TCL $file
  77.     puts stderr $errorInfo
  78.     }
  79. }
  80.  
  81. # "Source" all tcl files in the current system
  82. #
  83. proc source_all_tcl_files {} {
  84.     foreach file [fstorage::dir tcl] {
  85.         source_tcl_file [fstorage::get_uenv_path $file absolute]
  86.     }
  87. }
  88.  
  89. # "Source" all tcl files in the system named "Tcl"
  90. #
  91. proc source_files_in_tcl_sys {} {
  92.     set current_system [m4_var get M4_system]
  93.     if [catch {fstorage::goto_system Tcl}] {
  94.         return
  95.     }
  96.     source_all_tcl_files
  97.     fstorage::goto_system $current_system
  98. }
  99.  
  100. if {![catch { set user_file [m4_path_name tcl u_genada.tcl]}]} {
  101.     source_tcl_file $user_file
  102. }
  103.  
  104. source_files_in_tcl_sys
  105. source_all_tcl_files
  106.  
  107. generate_ada
  108.