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