home *** CD-ROM | disk | FTP | other *** search
/ PC World 1998 October / PCWorld_1998-10_cd.bin / software / prehled / komix / DATA.Z / genada95.tcl < prev    next >
Text File  |  1997-10-20  |  3KB  |  105 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 ada95_util.tcl
  20. require ada95_const.tcl
  21.  
  22. global comment_string; set comment_string(ada95) "--"
  23.  
  24. require ada95_config.tcl
  25. require ada95_class.tcl
  26. require ada95_funcs.tcl
  27. require ada95_disp.tcl
  28. require ada95_regen.tcl
  29.  
  30. proc generate_ada95 {} {
  31.     puts stdout ""
  32.     if {$g_generate_separates} {
  33.         puts stdout "Subunit file generation is enabled."
  34.     }
  35.     find_ada95_file_types
  36.     set system [cap [m4_var get M4_system]]
  37.     set tgt_objs [get_tgt_objs]
  38.     if [lempty $tgt_objs] {
  39.         # import new
  40.         generate [get_oopl_model $oomodel]
  41.     } else {
  42.         # import selected
  43.         global gen_file
  44.         set do_ada95 0
  45. #        set gen_file(${system}_Types.$ada95_spec_type) 1
  46.         foreach file $tgt_objs {
  47.             set gen_file($file) 1
  48.             set type [nt_get_type $file]
  49.  
  50.             if {"$type" == "$ada95_body_type" || 
  51.                 "$type" == "$ada95_spec_type" ||
  52.                 "$type" == "$ada95_sep_type" } {
  53.                 set do_ada95 1
  54.             }
  55.         }
  56.         if $do_ada95 {
  57.             generate [get_oopl_model $oomodel]
  58.         }
  59.     }
  60. }
  61.  
  62. # Search for user defined Tcl files and "source" them. Tcl files are sourced
  63. # in the following order:
  64. #    - u_genada95.tcl; EITHER in m4_home/tcl OR in <project_dir>/tcl
  65. #    - all tcl files in the system named "Tcl"
  66. #    - all tcl files in the current system
  67.  
  68.  
  69. # "Source" a tcl file
  70. #
  71. proc source_tcl_file {file} {
  72.     if [catch {source $file}] {
  73.     m4_error $E_USER_TCL $file
  74.     puts stderr $errorInfo
  75.     }
  76. }
  77.  
  78. # "Source" all tcl files in the current system
  79. #
  80. proc source_all_tcl_files {} {
  81.     foreach file [fstorage::dir tcl] {
  82.         source_tcl_file [fstorage::get_uenv_path $file absolute]
  83.     }
  84. }
  85.  
  86. # "Source" all tcl files in the system named "Tcl"
  87. #
  88. proc source_files_in_tcl_sys {} {
  89.     set current_system [m4_var get M4_system]
  90.     if [catch {fstorage::goto_system Tcl}] {
  91.         return
  92.     }
  93.     source_all_tcl_files
  94.     fstorage::goto_system $current_system
  95. }
  96.  
  97. if {![catch { set user_file [m4_path_name tcl u_genada95.tcl]}]} {
  98.     source_tcl_file $user_file
  99. }
  100.  
  101. source_files_in_tcl_sys
  102. source_all_tcl_files
  103.  
  104. generate_ada95
  105.