home *** CD-ROM | disk | FTP | other *** search
/ PC World 1997 November / PCWorld_1997-11_cd.bin / software / programy / komix / DATA.Z / ada_config.tcl < prev    next >
Text File  |  1997-03-24  |  7KB  |  260 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. #
  19. # Configuration variables
  20. #
  21.  
  22. # has_templates: true if compiler supports templates
  23. #
  24. global has_templates
  25. set has_templates 1
  26.  
  27.  
  28. global g_record_name
  29. global g_handle_name
  30. global g_inh_ext
  31. global g_poly
  32. global g_poly_prefix
  33. global o_record_name
  34. global g_ordered_set_cname
  35. global g_ordered_set_rname
  36. global g_unordered_set_cname
  37. global g_unordered_set_rname
  38. global g_qualified_rname
  39. global g_qualified_cname
  40. global g_generate_separates
  41. global g_alt_link_class_ext
  42.  
  43. set g_record_name [m4_var get M4_Ada83_Class_Record_Type_Name]
  44. if {$g_record_name == ""} {set g_record_name "Instance"}
  45.  
  46. set g_handle_name [m4_var get M4_Ada83_Class_Access_Type_Name]
  47. if {$g_handle_name == ""} {set g_handle_name "Link"}
  48.  
  49. set g_inh_ext [m4_var get M4_Ada83_Class_Record_Inh_Attrib_Ext]
  50. if {$g_inh_ext == ""} {set g_inh_ext "_Inh"}
  51.  
  52. set g_poly [m4_var get M4_Ada83_Generate_Polymorphism]
  53. if {$g_poly == ""} {set g_poly "Off"}
  54.  
  55. set g_poly_prefix [m4_var get M4_Ada83_Polymorphism_Prefix]
  56. if {$g_poly_prefix == ""} {set g_poly_prefix "Off"}
  57.  
  58. set o_record_name [m4_var get M4_Ada83_Opaque_Record_Type_Name]
  59. if {$o_record_name == ""} {set o_record_name "Data"}
  60.  
  61. set g_ordered_set_cname [m4_var get M4_Ada83_Ordered_Assoc_Generic_Package_Name]
  62. if {$g_ordered_set_cname == ""} {set g_ordered_set_cname "Generic_Ordered_Set"}
  63.  
  64. set g_ordered_set_rname [m4_var get M4_Ada83_Ordered_Assoc_Type_Name]
  65. if {$g_ordered_set_rname == ""} {set g_ordered_set_rname "Ordered_Set"}
  66.  
  67. set g_unordered_set_cname [m4_var get M4_Ada83_Unordered_Assoc_Generic_Package_Name]
  68. if {$g_unordered_set_cname == ""} {set g_unordered_set_cname "Generic_Unordered_Set"}
  69.  
  70. set g_unordered_set_rname [m4_var get M4_Ada83_Unordered_Assoc_Type_Name]
  71. if {$g_unordered_set_rname == ""} {set g_unordered_set_rname "Unordered_Set"}
  72.  
  73. set g_qualified_cname [m4_var get M4_Ada83_Qualified_Assoc_Generic_Package_Name]
  74. if {$g_qualified_cname == ""} {set g_qualified_cname "Generic_Dictionary"}
  75.  
  76. set g_qualified_rname [m4_var get M4_Ada83_Qualified_Assoc_Type_Name]
  77. if {$g_qualified_rname == ""} {set g_qualified_rname "Dictionary"}
  78.  
  79. set g_generate_separates [m4_var get M4_Ada83_Generate_Subunit_Files]
  80. if {$g_generate_separates == ""} {set g_generate_separates "Off"}
  81.  
  82. set g_alt_link_class_ext [m4_var get M4_Ada83_Alt_Link_Class_Ext]
  83. if {$g_alt_link_class_ext == ""} {set g_alt_link_class_ext "_Alt"}
  84.  
  85. global sysfile_name
  86. set sysfile_name "[cap [getCurrentSystemName]]_Types"
  87.  
  88.  
  89. # directory search path for external sources
  90. # could be a list separated by ':'
  91. global exsrc_searchpath
  92. # example usage:
  93. # set exsrc_searchpath /usr/source:/usr/you/project/src
  94.  
  95. # a String class is used in the persistence layer
  96. global string::name
  97. set string::name String
  98.  
  99. # the funcmap class is used in the persistence layer
  100. global funcmap::key_type_name
  101. set funcmap::key_type_name ${string::name}
  102.  
  103. #
  104. # PtrSet configuration
  105. #
  106. global set::name
  107. set set::name PtrSet
  108. global set::add
  109. set set::add add
  110. global set::remove
  111. set set::remove remove
  112. proc set::iter {sect name type action} {
  113.     set s_name [uncap [set_name $name]]
  114.     set piv [uncap [pointer_name $name]]
  115.     expand_text $sect {
  116.         ~$type *~$piv;
  117.  
  118.         for (~$piv = ~$s_name.first(); ~$piv; ~$piv = ~$s_name.next()) {
  119.             ~[eval $action $piv]
  120.         }
  121.     }
  122. }
  123.  
  124. #
  125. # OPtrSet configuration
  126. #
  127. global oset::name
  128. set oset::name OPtrSet
  129. global oset::add
  130. set oset::add append
  131. global oset::remove
  132. set oset::remove remove
  133. proc oset::iter {sect name type action} {
  134.     set os_name [uncap [oset_name $name]]
  135.     expand_text $sect {
  136.         for (int i = 0; i < ~$os_name.size(); i++) {
  137.             ~[eval $action $os_name\\\[i\\\]]
  138.         }
  139.     }
  140. }
  141.  
  142. #
  143. # PtrDict configuration
  144. #
  145. global dict::name
  146. set dict::name PtrDict
  147. global dict::set
  148. set dict::set set
  149. global dict::remove
  150. set dict::remove remove
  151.  
  152. # 'return_type' not used here
  153. proc dict::get_and_return {sect name key return_type} {
  154.     expand_text $sect {
  155.         return ~$name.get(~$key);
  156.     }
  157. }
  158.  
  159. proc dict::get_test_and_act {sect name key return_type action} {
  160.     set dct_name [uncap [dict_name $name]]
  161.     set ptr_name [uncap [pointer_name $return_type]]
  162.     expand_text $sect {
  163.         ~$return_type *~$ptr_name;
  164.         if (~$ptr_name = ~$dct_name.get(~$key)) {
  165.             ~[eval $action $ptr_name]
  166.         }
  167.     }
  168. }
  169.  
  170. proc dict::iter {sect name type qual_type action} {
  171.     set dct_name [uncap [dict_name $name]]
  172.     set piv [uncap [pointer_name $name]]
  173.     expand_text $sect {
  174.         ~$type *~$piv;
  175.  
  176.         for (~$piv = ~$dct_name.firstValue(); ~$piv; ~$piv = ~$dct_name.nextValue()) {
  177.             ~[eval $action $piv]}
  178.     }
  179. }
  180.  
  181. proc dict::initializer {name key value} {
  182.     # not used here 
  183.     return ""
  184. }
  185.  
  186. #
  187. # PSetDict configuration
  188. #
  189. global psdict::name
  190. set psdict::name PSetDict
  191. global psdict::add
  192. set psdict::add add
  193. global psdict::remove
  194. set psdict::remove remove
  195.  
  196. proc psdict::get_and_return {sect name key return_type} {
  197.     set sdct_name [uncap [set_dict_name $name]]
  198.     expand_text $sect {
  199.         return ~$sdct_name.get(~$key);
  200.     }
  201. }
  202.  
  203. proc psdict::iter {sect name type qual_type action} {
  204.     set sdct_name [uncap [set_dict_name $name]]
  205.     set piv [uncap [pointer_name $name]]
  206.     set psiv [uncap [pointer_name [set_name $name]]]
  207.     expand_text $sect {
  208.         ~[set_type_name $type] *~$psiv;
  209.  
  210.         for (~$psiv = ~$sdct_name.firstValue(); ~$psiv; ~$psiv = ~$sdct_name.nextValue()) {
  211.             ~$type *~$piv;
  212.             for (~$piv = ~$psiv->first(); ~$piv; ~$piv = ~$psiv->next()) {
  213.                 ~[eval $action $piv]
  214.             }
  215.         }
  216.     }
  217. }
  218.  
  219. proc psdict::initializer {name key value} {
  220.     # not used here 
  221.     return ""
  222. }
  223.  
  224. #
  225. # OPSetDict configuration
  226. #
  227. global opsdict::name
  228. set opsdict::name OPSetDict
  229. global opsdict::add
  230. set opsdict::add append
  231. global opsdict::remove
  232. set opsdict::remove remove
  233.  
  234. proc opsdict::get_and_return {sect name key return_type} {
  235.     set osdct_name [uncap [oset_dict_name $name]]
  236.     expand_text $sect {
  237.         return ~$osdct_name.get(~$key);
  238.     }
  239. }
  240.  
  241. proc opsdict::iter {sect name type qual_type action} {
  242.     set osdct_name [uncap [oset_dict_name $name]]
  243.     set piv [uncap [pointer_name $name]]
  244.     set opsiv [uncap [pointer_name [oset_name $name]]]
  245.     expand_text $sect {
  246.         ~[oset_type_name $type] *~$opsiv;
  247.  
  248.         for (~$opsiv = ~$osdct_name.firstValue(); ~$opsiv; ~$opsiv = ~$osdct_name.nextValue()) {
  249.             for (int i = 0; i < ~$opsiv->size(); i++) {
  250.                 ~[eval $action $opsiv->at(i)]
  251.             }
  252.         }
  253.     }
  254. }
  255.  
  256. proc opsdict::initializer {name key value} {
  257.     # not used here 
  258.     return ""
  259. }
  260.