home *** CD-ROM | disk | FTP | other *** search
/ PC World 1998 October / PCWorld_1998-10_cd.bin / software / prehled / komix / DATA.Z / ne_config.tcl < prev    next >
Text File  |  1996-12-12  |  6KB  |  240 lines
  1. #---------------------------------------------------------------------------
  2. #
  3. # Copyright (c) 1994-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        : @(#)ne_config.tcl    /main/titanic/2
  17. #    Original date    : 27-10-1994
  18. #    Description    : Configuration variables / functions
  19. #              for NewEra and Westmount class library
  20. #
  21. #---------------------------------------------------------------------------
  22. #
  23.  
  24. #
  25. # Configuration variables
  26. #
  27.  
  28. # directory search path for external sources
  29. # could be a list separated by a search path separator
  30. global exsrc_searchpath
  31. # example usage:
  32. # set exsrc_searchpath "c:;c:\\temp"
  33.  
  34. global string::name
  35. set string::name ixString
  36.  
  37. #
  38. # RefSet configuration
  39. #
  40. global set::name
  41. set set::name RefSet
  42. global set::add
  43. set set::add add
  44. global set::add_retval
  45. set set::add_retval BOOLEAN
  46. global set::size
  47. set set::size size
  48. global set::remove
  49. set set::remove remove
  50. proc set::iter {decl_sect impl_sect name type action} {
  51.     set s_name [uncap [set_name $name]]
  52.     set riv [uncap [reference_name $name]]
  53.     expand_text $decl_sect {
  54.         VARIABLE ~$riv ~$type
  55.     }
  56.     expand_text $impl_sect {
  57.  
  58.         LET ~$riv = ~$s_name.first() CAST ~$type
  59.         WHILE ~$riv IS NOT NULL
  60.             ~[eval $action $riv]
  61.             LET ~$riv = ~$s_name.next() CAST ~$type
  62.         END WHILE
  63.     }
  64. }
  65.  
  66. #
  67. # ORefSet configuration
  68. #
  69. global oset::name
  70. set oset::name ORefSet
  71. global oset::add
  72. set oset::add append
  73. global oset::add_retval
  74. set oset::add_retval INTEGER
  75. global oset::size
  76. set oset::size size
  77. global oset::remove
  78. set oset::remove remove
  79. proc oset::iter {decl_sect impl_sect name type action} {
  80.     set os_name [uncap [oset_name $name]]
  81.     set cnt ${os_name}Cnt
  82.     expand_text $decl_sect {
  83.         VARIABLE $cnt INTEGER
  84.     }
  85.     expand_text $impl_sect {
  86.  
  87.         FOR ~$cnt = 1 TO ~$os_name.size()
  88.             ~[eval $action $os_name.get(~$cnt)]
  89.         END FOR
  90.     }
  91. }
  92.  
  93. #
  94. # RefDict configuration
  95. #
  96. global dict::name
  97. set dict::name RefDict
  98. global dict::set
  99. set dict::set set
  100. global dict::size
  101. set dict::size size
  102. global dict::remove
  103. set dict::remove remove
  104.  
  105. # 'return_type' not used here
  106. proc dict::get_and_return {sect name key return_type} {
  107.     expand_text $sect {
  108.         RETURN ~$name.get(~$key) CAST ~$return_type
  109.     }
  110. }
  111.  
  112. proc dict::get_test_and_act {sect name key return_type action} {
  113.     set dct_name [uncap [dict_name $name]]
  114.     set ref_name [uncap [reference_name $return_type]]
  115.     expand_text $sect {
  116.         IF ~$dct_name.get(~$key) IS NOT NULL THEN
  117.             ~[eval $action ~$dct_name.get(~$key)]
  118.         END IF
  119.     }
  120. }
  121.  
  122. proc dict::iter {decl_sect impl_sect name type qual_type action} {
  123.     set dct_name [uncap [dict_name $name]]
  124.     set riv [uncap [reference_name $name]]
  125.     expand_text $decl_sect {
  126.         VARIABLE ~$riv ~$type
  127.     }
  128.     expand_text $impl_sect {
  129.  
  130.         LET ~$riv = ~$dct_name.firstValue() CAST ~$type
  131.         WHILE ~$riv IS NOT NULL
  132.             ~[eval $action $riv]
  133.             LET ~$riv = ~$dct_name.nextValue() CAST ~$type
  134.         END WHILE
  135.     }
  136. }
  137.  
  138. proc dict::initializer {name key value} {
  139.     # not used here 
  140.     return ""
  141. }
  142.  
  143. #
  144. # RSetDict configuration
  145. #
  146. global rsdict::name
  147. set rsdict::name RSetDict
  148. global rsdict::add
  149. set rsdict::add add
  150. global rsdict::add_retval
  151. set rsdict::add_retval BOOLEAN
  152. global rsdict::size
  153. set rsdict::size size
  154. global rsdict::remove
  155. set rsdict::remove remove
  156.  
  157. proc rsdict::get_and_return {sect name key return_type} {
  158.     set sdct_name [uncap [set_dict_name $name]]
  159.     expand_text $sect {
  160.         RETURN ~$sdct_name.get(~$key)
  161.     }
  162. }
  163.  
  164. proc rsdict::iter {decl_sect impl_sect name type qual_type action} {
  165.     set sdct_name [uncap [set_dict_name $name]]
  166.     set riv [uncap [reference_name $name]]
  167.     set rtpnm [$type getName]
  168.     set rsiv [uncap [reference_name [set_name $name]]]
  169.     set rstpnm [set_type_name $type]
  170.     expand_text $decl_sect {
  171.         VARIABLE ~$rsiv ~$rstpnm
  172.         VARIABLE ~$riv ~$rtpnm
  173.     }
  174.     expand_text $impl_sect {
  175.  
  176.         LET ~$rsiv = ~$sdct_name.firstValue() CAST ~$rstpnm
  177.         WHILE ~$rsiv IS NOT NULL
  178.             LET ~$riv = ~$rsiv.first() CAST ~$rtpnm
  179.             WHILE ~$riv IS NOT NULL
  180.                 ~[eval $action $riv]
  181.                 LET ~$riv = ~$rsiv.next() CAST ~$rtpnm
  182.             END WHILE
  183.             LET ~$rsiv = ~$sdct_name.nextValue() CAST ~$rstpnm
  184.         END WHILE
  185.     }
  186. }
  187.  
  188. proc rsdict::initializer {name key value} {
  189.     # not used here 
  190.     return ""
  191. }
  192.  
  193. #
  194. # ORSetDict configuration
  195. #
  196. global orsdict::name
  197. set orsdict::name ORSetDict
  198. global orsdict::add
  199. set orsdict::add append
  200. global orsdict::add_retval
  201. set orsdict::add_retval INTEGER
  202. global orsdict::size
  203. set orsdict::size size
  204. global orsdict::remove
  205. set orsdict::remove remove
  206.  
  207. proc orsdict::get_and_return {sect name key return_type} {
  208.     set osdct_name [uncap [oset_dict_name $name]]
  209.     expand_text $sect {
  210.         RETURN ~$osdct_name.get(~$key)
  211.     }
  212. }
  213.  
  214. proc orsdict::iter {decl_sect impl_sect name type qual_type action} {
  215.     set osdct_name [uncap [oset_dict_name $name]]
  216.     set riv [uncap [reference_name $name]]
  217.     set orsiv [uncap [reference_name [oset_name $name]]]
  218.     set orstpnm [oset_type_name $type]
  219.     set cnt ${orsiv}Cnt
  220.     expand_text $decl_sect {
  221.         VARIABLE ~$orsiv ~orstpnm
  222.         VARIABLE ~$cnt INTEGER
  223.     }
  224.     expand_text $impl_sect {
  225.  
  226.         LET ~$orsiv = ~$osdct_name.firstValue() CAST ~$orstpnm
  227.         WHILE ~$orsiv IS NOT NULL
  228.             FOR ~$cnt = 1 TO ~$orsiv->size()
  229.                 ~[eval $action $orsiv.get($cnt)]
  230.             END FOR
  231.             LET ~$orsiv = ~$osdct_name.nextValue() CAST ~$orstpnm
  232.         END WHILE
  233.     }
  234. }
  235.  
  236. proc orsdict::initializer {name key value} {
  237.     # not used here 
  238.     return ""
  239. }
  240.