home *** CD-ROM | disk | FTP | other *** search
/ PC World 1998 October / PCWorld_1998-10_cd.bin / software / prehled / komix / DATA.Z / cpp_class.tcl < prev    next >
Text File  |  1997-03-20  |  24KB  |  874 lines

  1. #---------------------------------------------------------------------------
  2. #
  3. # Copyright (c) 1993-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        : @(#)cpp_class.tcl    /main/titanic/6
  17. #    Author        : frmo
  18. #    Original date    : 4-2-1993
  19. #    Description    : Class-level functions for C++ generation
  20. #
  21. #---------------------------------------------------------------------------
  22. #
  23.  
  24. #
  25. # Needed for E_FILE_OPEN_WRITE
  26. #
  27.  
  28. require cgen_msg.tcl
  29.  
  30. global cpp_hdr_sections
  31. set cpp_hdr_sections {
  32.     h_hdr_sect
  33.     h_incl_sect
  34.     h_fwd_decl_sect
  35.     h_enum_sect
  36.     h_class_nm_sect
  37.     h_friend_sect
  38.     h_ctor_sect
  39.     h_dtor_sect
  40.     h_pub_func_sect
  41.     h_pub_func_user-defined_sect
  42.     h_pub_func_attrib-access_sect
  43.     h_pub_func_assoc-access_sect
  44.     h_pub_data_sect
  45.     h_prot_func_sect
  46.     h_prot_func_user-defined_sect
  47.     h_prot_func_attrib-access_sect
  48.     h_prot_func_assoc-access_sect
  49.     h_priv_func_sect
  50.     h_priv_func_user-defined_sect
  51.     h_priv_func_attrib-access_sect
  52.     h_priv_func_assoc-access_sect
  53.     h_priv_data_user-defined_sect
  54.     h_priv_data_assoc-storage_sect
  55.     h_priv_data_sect
  56.     h_inl_sect
  57.     h_trailer_sect
  58. }
  59.  
  60. global cpp_src_sections
  61. set cpp_src_sections {
  62.     c_hdr_sect
  63.     c_incl_sect
  64.     c_static_sect
  65.     c_ctor_init_sect
  66.     c_ctor_init_iv_sect
  67.     c_ctor_body_sect
  68.     c_ctor_body_iv_sect
  69.     c_dtor_sect
  70.     c_impl_sect
  71.     c_impl_no_regen_sect
  72. }
  73.  
  74. # for typedef and enum files
  75. global limited_cpp_hdr_sections
  76. set limited_cpp_hdr_sections {
  77.     h_hdr_sect
  78.     h_incl_sect
  79.     h_fwd_decl_sect
  80.     h_inl_sect
  81.     h_trailer_sect
  82. }
  83.  
  84. # Global section array
  85. #
  86. global cpp_sections
  87.  
  88. # Determine the right section based on the accessibility specification and
  89. # whether it is for reading or writing
  90. #
  91. proc get_hdr_sect {access {section_kind ""} {mode ""}} {
  92.     # Fixup for leaving out section_kind while still specifing mode
  93.     if {[lsearch {Public Protected Provate None} $section_kind] != -1} {
  94.         set mode $section_kind
  95.         set section_kind ""
  96.     }
  97.     if {$section_kind != ""} {
  98.         set section_kind "${section_kind}_"
  99.     }
  100.     case [split_access_mode $access $mode] in {
  101.     {Public} {
  102.         if [info exists cpp_sections(h_pub_func_${section_kind}sect)] {
  103.             return $cpp_sections(h_pub_func_${section_kind}sect)
  104.         } else {
  105.             return $cpp_sections(h_pub_func_sect)
  106.         }
  107.     }
  108.     {Protected} {
  109.         if [info exists cpp_sections(h_prot_func_${section_kind}sect)] {
  110.             return $cpp_sections(h_prot_func_${section_kind}sect)
  111.         } else {
  112.             return $cpp_sections(h_prot_func_sect)
  113.         }
  114.     }
  115.     {Private} {
  116.         if [info exists cpp_sections(h_priv_func_${section_kind}sect)] {
  117.             return $cpp_sections(h_priv_func_${section_kind}sect)
  118.         } else {
  119.             return $cpp_sections(h_priv_func_sect)
  120.         }
  121.     }
  122.     {None} {
  123.         return $cpp_sections(dev_null_sect)
  124.     }}
  125. }
  126.  
  127. proc get_src_sect {access {is_inline 0} {mode ""}} {
  128.     if {[split_access_mode $access $mode] == "None"} {
  129.         return $cpp_sections(dev_null_sect)
  130.     }
  131.     if $is_inline {
  132.         return $cpp_sections(h_inl_sect)
  133.     }
  134.     return $cpp_sections(c_impl_no_regen_sect)
  135. }
  136.  
  137. # Split up the access mode and return the right part of it
  138. #
  139. proc split_access_mode {access mode} {
  140.     if {$access == ""} {
  141.         return Public
  142.     }
  143.     set rw_ac_list [split $access -]
  144.     if {[llength $rw_ac_list] == 2} {
  145.         if {$mode == "r"} {
  146.             return [lindex $rw_ac_list 0]
  147.         }
  148.         return [lindex $rw_ac_list 1]
  149.     }
  150.     return $access
  151. }
  152.  
  153. # Determine the section for an assoc accesser function based on
  154. # the attribute "assoc_access"
  155. #
  156. proc get_assoc_hdr_sect {assoc {mode ""}} {
  157.     return [get_hdr_sect [$assoc getPropertyValue assoc_access] assoc-access $mode]
  158. }
  159.  
  160. proc get_assoc_src_sect {assoc {is_inline 0} {mode ""}} {
  161.     return [get_src_sect [$assoc getPropertyValue assoc_access] $is_inline $mode]
  162. }
  163.  
  164. # Determine the section for an attribute accesser function based on
  165. # the attribute "attrib_access"
  166. #
  167. proc get_attrib_hdr_sect {attrib {mode ""}} {
  168.     return [get_hdr_sect [$attrib getPropertyValue attrib_access] attrib-access $mode]
  169. }
  170.  
  171. proc get_attrib_src_sect {attrib {is_inline 0} {mode ""}} {
  172.     return [get_src_sect [$attrib getPropertyValue attrib_access] $is_inline $mode]
  173. }
  174.  
  175. # Determine the type of a given section.  "hdr" or "src" is returned.
  176. # Special sections "hdr" and "src" are understood, and are returned as is.
  177. #
  178. proc determine_sect_type {sect} {
  179.     if {$sect == "src"} {
  180.         set type "src"
  181.     } elseif {$sect == "hdr"} {
  182.         set type "hdr"
  183.     } else {
  184.     global cpp_sections
  185.         foreach n [array names cpp_sections] {
  186.             if {$cpp_sections($n) == $sect} {
  187.                 if {[lsearch $cpp_src_sections $n] != -1} {
  188.                     set type "src"
  189.                 } else {
  190.                     set type "hdr"
  191.                 }
  192.                 break
  193.             }
  194.         }
  195.     }
  196.     return $type
  197. }
  198.  
  199. # Create c++ sections
  200. #
  201. proc create_cpp_sections {sects} {
  202.     global cpp_sections
  203.     foreach sect $sects {
  204.         set cpp_sections($sect) [TextSection new]
  205.         $cpp_sections($sect) indent 0 "\t"
  206.     }
  207.     set cpp_sections(dev_null_sect) [TextSection new]
  208.     global ctor_init_sep ctor_init_iv_sep exists_ctor db_ctor_is_unique
  209.     set ctor_init_sep 1
  210.     set ctor_init_iv_sep 1
  211.     set exists_ctor 0
  212.     set db_ctor_is_unique 0
  213. }
  214.  
  215. # give sections their initial contents
  216.  
  217. proc init_cpp_sections {class} {
  218.     set name [$class getName]
  219.     set is_db [is_db_class $class]
  220.  
  221.     $cpp_sections(h_ctor_sect) append "public:\n"
  222.     $cpp_sections(h_ctor_sect) indent +
  223.     $cpp_sections(h_ctor_sect) append "// Default constructor/destructor\n"
  224.     $cpp_sections(h_dtor_sect) indent +
  225.     if {[$class specNodeSet] == ""} {
  226.         $cpp_sections(h_dtor_sect) append "~${name}();\n\n"
  227.     } else {
  228.         $cpp_sections(h_dtor_sect) append "virtual ~${name}();\n\n"
  229.     }
  230.     $cpp_sections(h_pub_func_sect) indent +
  231.     if {$is_db} { $cpp_sections(h_pub_func_sect) append "// Persistent storage methods\n" }
  232.     if [info exists cpp_sections(h_pub_func_user-defined_sect)] {
  233.         $cpp_sections(h_pub_func_user-defined_sect) indent +
  234.         $cpp_sections(h_pub_func_user-defined_sect) append "// User-defined methods\n"
  235.     }
  236.     if [info exists cpp_sections(h_pub_func_attrib-access_sect)] {
  237.         $cpp_sections(h_pub_func_attrib-access_sect) indent +
  238.         $cpp_sections(h_pub_func_attrib-access_sect) append "// Attribute accessor methods\n"
  239.     }
  240.     if [info exists cpp_sections(h_pub_func_assoc-access_sect)] {
  241.         $cpp_sections(h_pub_func_assoc-access_sect) indent +
  242.         $cpp_sections(h_pub_func_assoc-access_sect) append "// Association accessor methods\n"
  243.     }
  244.     $cpp_sections(h_pub_data_sect) indent +
  245.     if {$is_db} { $cpp_sections(h_pub_data_sect) append "// Persistent storage attributes\n" }
  246.     $cpp_sections(h_prot_func_sect) append "protected:\n"
  247.     $cpp_sections(h_prot_func_sect) indent +
  248.     if [info exists cpp_sections(h_prot_func_user-defined_sect)] {
  249.         $cpp_sections(h_prot_func_user-defined_sect) indent +
  250.         $cpp_sections(h_prot_func_user-defined_sect) append "// User-defined methods\n"
  251.     }
  252.     if [info exists cpp_sections(h_prot_func_attrib-access_sect)] {
  253.         $cpp_sections(h_prot_func_attrib-access_sect) indent +
  254.         $cpp_sections(h_prot_func_attrib-access_sect) append "// Attribute accessor methods\n"
  255.     }
  256.     if [info exists cpp_sections(h_prot_func_assoc-access_sect)] {
  257.         $cpp_sections(h_prot_func_assoc-access_sect) indent +
  258.         $cpp_sections(h_prot_func_assoc-access_sect) append "// Association accessor methods\n"
  259.     }
  260.     $cpp_sections(h_priv_func_sect) append "private:\n"
  261.     $cpp_sections(h_priv_func_sect) indent +
  262.     if [info exists cpp_sections(h_priv_func_user-defined_sect)] {
  263.         $cpp_sections(h_priv_func_user-defined_sect) indent +
  264.         $cpp_sections(h_priv_func_user-defined_sect) append "// User-defined methods\n"
  265.     }
  266.     if [info exists cpp_sections(h_priv_func_attrib-access_sect)] {
  267.         $cpp_sections(h_priv_func_attrib-access_sect) indent +
  268.         $cpp_sections(h_priv_func_attrib-access_sect) append "// Attribute accessor methods\n"
  269.     }
  270.     if [info exists cpp_sections(h_priv_func_assoc-access_sect)] {
  271.         $cpp_sections(h_priv_func_assoc-access_sect) indent +
  272.         $cpp_sections(h_priv_func_assoc-access_sect) append "// Association accessor methods\n"
  273.     }
  274.     if [info exists cpp_sections(h_priv_data_user-defined_sect)] {
  275.         $cpp_sections(h_priv_data_user-defined_sect) indent +
  276.         $cpp_sections(h_priv_data_user-defined_sect) append "// User-defined attributes\n"
  277.     }
  278.     if [info exists cpp_sections(h_priv_data_assoc-storage_sect)] {
  279.         $cpp_sections(h_priv_data_assoc-storage_sect) indent +
  280.         $cpp_sections(h_priv_data_assoc-storage_sect) append "// Association attribute storage\n"
  281.     }
  282.     $cpp_sections(h_priv_data_sect) indent +
  283.     $cpp_sections(c_ctor_body_sect) append "\n\{\n"
  284.     $cpp_sections(c_ctor_body_sect) indent +
  285.     $cpp_sections(c_ctor_body_iv_sect) indent +
  286.     $cpp_sections(c_dtor_sect) append "$name::~${name}()\n\{\n"
  287.     regen_unset "~$name" "()"
  288.     $cpp_sections(c_dtor_sect) indent +
  289.     $cpp_sections(c_impl_no_regen_sect) append "$REGEN_END\n\n"
  290. }
  291.  
  292. # give sections their terminal contents
  293.  
  294. proc exit_cpp_sections {class} {
  295.     if [info exists cpp_sections(h_pub_func_user-defined_sect)] {
  296.         $cpp_sections(h_pub_func_user-defined_sect) append "\n"
  297.     }
  298.     if [info exists cpp_sections(h_pub_func_attrib-access_sect)] {
  299.         $cpp_sections(h_pub_func_attrib-access_sect) append "\n"
  300.     }
  301.     if [info exists cpp_sections(h_pub_func_assoc-access_sect)] {
  302.         $cpp_sections(h_pub_func_assoc-access_sect) append "\n"
  303.     }
  304.     if [info exists cpp_sections(h_prot_func_user-defined_sect)] {
  305.         $cpp_sections(h_prot_func_user-defined_sect) append "\n"
  306.     }
  307.     if [info exists cpp_sections(h_prot_func_attrib-access_sect)] {
  308.         $cpp_sections(h_prot_func_attrib-access_sect) append "\n"
  309.     }
  310.     if [info exists cpp_sections(h_prot_func_assoc-access_sect)] {
  311.         $cpp_sections(h_prot_func_assoc-access_sect) append "\n"
  312.     }
  313.     if [info exists cpp_sections(h_priv_func_user-defined_sect)] {
  314.         $cpp_sections(h_priv_func_user-defined_sect) append "\n"
  315.     }
  316.     if [info exists cpp_sections(h_priv_func_attrib-access_sect)] {
  317.         $cpp_sections(h_priv_func_attrib-access_sect) append "\n"
  318.     }
  319.     if [info exists cpp_sections(h_priv_func_assoc-access_sect)] {
  320.         $cpp_sections(h_priv_func_assoc-access_sect) append "\n"
  321.     }
  322.     if [info exists cpp_sections(h_priv_data_user-defined_sect)] {
  323.         $cpp_sections(h_priv_data_user-defined_sect) append "\n"
  324.     }
  325.     # SKIP THIS ONE: $cpp_sections(h_priv_data_assoc-storage_sect) append "\n"
  326.     $cpp_sections(h_priv_data_sect) indent -
  327.     $cpp_sections(h_priv_data_sect) append "\};\n\n"
  328.     set sect_iv $cpp_sections(c_ctor_init_iv_sect)
  329.     if {[$sect_iv contents] != ""} {
  330.         gen_ctor_sep $cpp_sections(c_ctor_init_sect)
  331.     }
  332.     $cpp_sections(c_ctor_body_iv_sect) indent -
  333.     $cpp_sections(c_ctor_body_iv_sect) append "\}\n\n"
  334.     $cpp_sections(c_dtor_sect) indent -
  335.     $cpp_sections(c_dtor_sect) append "\}\n\n"
  336.     if {[$cpp_sections(c_static_sect) contents] != ""} {
  337.         $cpp_sections(c_static_sect) append "\n"
  338.     }
  339. }
  340.  
  341. # Write the sections to the right file and deallocate them
  342. #
  343. proc write_cpp_sections {class hsects csects} {
  344.     class2tgtfiles $class src_file h_file
  345.     set class_name [$class getName]
  346.     do_write_cpp_sections $class_name $h_file $hsects
  347.     do_write_cpp_sections $class_name $src_file $csects
  348.     unset cpp_sections(dev_null_sect)
  349. }
  350.  
  351. proc do_write_cpp_sections {class_name file_name sects} {
  352.     global cpp_error_state
  353.     set did_save_file 0
  354.     if {[llength $sects] == 0 || $cpp_error_state} {
  355.         return $did_save_file
  356.     }
  357.     set nt $file_name
  358.     global skip_file
  359.     global gen_file
  360.     if {[info exists gen_file($nt)] ||
  361.         ($import_new && ![info exists skip_file($nt)])} {
  362.         set cmp_sect [TextSection new]
  363.         foreach sect $sects {
  364.             set ctor_sect_mtch [string match c_ctor_* $sect]
  365.             if {$exists_ctor || ! $ctor_sect_mtch } {
  366.                 $cmp_sect appendSect $cpp_sections($sect)
  367.             }
  368.             unset cpp_sections($sect)
  369.         }
  370.         if [section_equals_file $cmp_sect $nt] {
  371.             puts "$nt has not changed: file not written"
  372.             return 0
  373.         }
  374.         if {[M4CheckManager::getErrorCount] > 0} {
  375.             puts "Not saving $nt because of previous errors"
  376.             return 0
  377.         }
  378.         puts stdout "Creating $nt"
  379.         if {[catch {set fd [fstorage::open $nt w]} reason]} {
  380.             puts stderr $reason
  381.             m4_error $E_FILE_OPEN_WRITE $nt
  382.         } else {
  383.             if { [catch {fstorage::set_imp_from $nt $class_name} \
  384.                   reason] } {
  385.                 puts stderr $reason
  386.             }
  387.             $cmp_sect write $fd
  388.             fstorage::close $fd
  389.             set did_save_file 1
  390.         }
  391.     }
  392.     return $did_save_file
  393. }
  394.  
  395. proc process_external_class_source {class} {
  396.     set class_name [$class getName]
  397.     set tmp_sect [TextSection new]
  398.     expand_text $tmp_sect [$class getPropertyValue class_source]
  399.     set files [string trim [$tmp_sect contents]]
  400.  
  401.     set first 1
  402.     foreach entry [split $files ,] {
  403.         set entry [string trim $entry]
  404.         # first one is hplus_type
  405.         # all others are cplus_type
  406.         if $first {
  407.             set first 0
  408.             set ftype $hplus_type
  409.         } else {
  410.             set ftype $cplus_type
  411.         }
  412.         set file_name [class2file $class_name]
  413.         set nt ${file_name}.$ftype
  414.         global skip_file
  415.         global gen_file
  416.         if {[info exists gen_file($nt)] ||
  417.             ($import_new && ![info exists skip_file($nt)])} {
  418.             set fullpath [find_file $entry]
  419.             if {$fullpath == ""} {
  420.                 puts -nonewline "ERROR: class '[$class getName]': "
  421.                 puts "external class source file '$entry' not found"
  422.                 continue
  423.             }
  424.             puts "Importing external '$fullpath'"
  425.             puts "Creating $nt"
  426.             if {[catch {set out [fstorage::open $nt w]} reason]} {
  427.                 puts stderr $reason
  428.                 m4_error $E_FILE_OPEN_WRITE $nt
  429.             } else {
  430.                 if { [catch {fstorage::set_imp_from $nt \
  431.                     [$class getName]} reason] } {
  432.                     puts stderr $reason
  433.                 }
  434.                 set max 8092
  435.                 set in [open $fullpath r]
  436.                 while {[set result [read $in $max]] != ""} {
  437.                     puts -nonewline $out $result
  438.                 }
  439.                 close $in
  440.                 fstorage::close $out
  441.             }
  442.         }
  443.     }
  444. }
  445.  
  446. # find file using global 'exsrc_searchpath'
  447.  
  448. proc find_file {file} {
  449.     if [file exists $file] {
  450.         return $file
  451.     }
  452.     global exsrc_searchpath
  453.     if {! [info exists exsrc_searchpath]} {
  454.         return ""
  455.     }
  456.     set sep [searchPathSeparator]
  457.     foreach dir [split $exsrc_searchpath $sep] {
  458.         set fullpath [path_name concat $dir $file]
  459.         if [file exists $fullpath] {
  460.             return $fullpath
  461.         }
  462.     }
  463.     return ""
  464. }
  465.  
  466. # read status arrays and generate 'only-once' code
  467.  
  468. proc gen_delayed_code {{class ""}} {
  469.     # default parameter: don't break old interface
  470.     gen_friends
  471.     gen_hdr_incs $class
  472.     gen_forwards
  473.     gen_src_incs $class
  474.     gen_sets
  475.     gen_osets
  476.     gen_dicts
  477.     gen_set_dicts
  478.     gen_oset_dicts
  479.     gen_funcmaps
  480.  
  481.     global cpp_hdr_incs
  482.     catch {unset cpp_hdr_incs}
  483.     global cpp_hdr_files
  484.     catch {unset cpp_hdr_files}
  485. }
  486.  
  487. # Global friend array
  488. #
  489. global cpp_friends
  490.  
  491. proc add_friend {friend} {
  492.     global cpp_friends
  493.     set cpp_friends([$friend getName]) 1
  494. }
  495.  
  496. proc gen_friends {} {
  497.     global cpp_friends
  498.     if {![info exists cpp_friends]} {
  499.         return
  500.     }
  501.     set sect $cpp_sections(h_friend_sect)
  502.     $sect indent +
  503.     foreach class [lsort [array names cpp_friends]] {
  504.         $sect append "friend class $class;\n"
  505.     }
  506.     $sect indent +
  507.     unset cpp_friends
  508. }
  509.  
  510. #
  511. # forward declaration / class header inclusion management functions
  512. #
  513.  
  514. # Global arrays to store the information
  515. #
  516. global cpp_forwards
  517. global cpp_hdr_incs cpp_hdr_incs_name cpp_hdr_incs_name_ext
  518. global cpp_src_incs cpp_src_incs_name cpp_src_incs_name_ext
  519.  
  520. proc add_forward {class} {
  521.     global cpp_forwards
  522.     set cpp_forwards([$class getName]) $class
  523. }
  524.  
  525. proc add_forward_name {name} {
  526.     global cpp_forwards
  527.     set cpp_forwards($name) 1
  528. }
  529.  
  530. proc add_hdr_inc {class} {
  531.     global cpp_hdr_incs
  532.     set cpp_hdr_incs([$class getName]) $class
  533. }
  534.  
  535. proc add_hdr_inc_name {class_name {ext "hxx"}} {
  536.     global cpp_hdr_incs_name cpp_hdr_incs_name_ext
  537.     set cpp_hdr_incs_name($class_name) 1
  538.     set cpp_hdr_incs_name_ext($class_name) $ext
  539. }
  540.  
  541. proc add_src_inc {class} {
  542.     global cpp_src_incs
  543.     set cpp_src_incs([$class getName]) $class
  544. }
  545.  
  546. proc add_src_inc_name {class_name {ext "hxx"}} {
  547.     global cpp_src_incs_name cpp_src_incs_name_ext
  548.     set cpp_src_incs_name($class_name) 1
  549.     set cpp_src_incs_name_ext($class_name) $ext
  550. }
  551.  
  552. # Generate forwards. If the class definition is also included, the forward
  553. # is not generated.
  554. #
  555. proc gen_forwards {} {
  556.     global cpp_forwards cpp_hdr_incs
  557.     if {![info exists cpp_forwards]} {
  558.         return
  559.     }
  560.     set sect $cpp_sections(h_fwd_decl_sect)
  561.     foreach class [lsort [array names cpp_forwards]] {
  562.         if [info exists cpp_hdr_incs($class)] {
  563.             continue
  564.         }
  565.         $sect append "class $class;\n"
  566.     }
  567.     unset cpp_forwards
  568. }
  569.  
  570. proc gen_hdr_incs {{cur_class ""}} {
  571.     # default parameter: don't break old interface
  572.     global cpp_hdr_incs cpp_hdr_incs_name cpp_hdr_incs_name_ext cpp_hdr_files
  573.     set gen_include_list ""
  574.     set user_include_list ""
  575.     if {$cur_class != ""} {
  576.         set cur_class_name [$cur_class getName]
  577.     } else {
  578.         set cur_class_name ""
  579.     }
  580.     if [info exists cpp_hdr_incs] {
  581.         foreach class [array names cpp_hdr_incs] {
  582.             if {$class == $cur_class_name} {
  583.                 # don't include current header-file in itself
  584.                 continue
  585.             }
  586.             set hdl $cpp_hdr_incs($class)
  587.             set incls [$hdl getPropertyValue include_list]
  588.             if {$incls == ""} {
  589.                 lappend gen_include_list [$hdl getName]
  590.                 set cpp_hdr_files([h_class2file $class]) 1
  591.             } else {
  592.                 foreach incl [config_include_list [split $incls ,]] {
  593.                     lappend user_include_list $incl
  594.                     set cpp_hdr_files($incl) 1
  595.                 }
  596.             }
  597.         }
  598.     }
  599.     if [info exists cpp_hdr_incs_name] {
  600.         foreach entry [array names cpp_hdr_incs_name] {
  601.             set file [h_class2file $entry $cpp_hdr_incs_name_ext($entry)]
  602.             if [info exists cpp_hdr_files($file)] {
  603.                 continue
  604.             }
  605.             lappend gen_include_list $entry
  606.             set cpp_hdr_files($file) 1
  607.         }
  608.     }
  609.     foreach entry [lsort $gen_include_list] {
  610.                 if {[info exists cpp_hdr_incs_name_ext($entry)]} {
  611.                     set ext $cpp_hdr_incs_name_ext($entry)
  612.                 } else {
  613.                     set ext "hxx"
  614.                 }
  615.         # prefer user includes
  616.         set idx [lsearch -exact $user_include_list [h_class2file $entry $ext]]
  617.         if {$idx == -1} {
  618.             gen_include $entry $cpp_sections(h_incl_sect) $ext
  619.         }
  620.     }
  621.     # do not sort ! remove duplicates
  622.     foreach entry $user_include_list {
  623.         if [info exists dup($entry)] {
  624.             continue;
  625.         }
  626.         set dup($entry) 1
  627.         gen_include_filename $entry $cpp_sections(h_incl_sect)
  628.     }
  629.     catch {unset cpp_hdr_incs_name}
  630.     catch {unset cpp_hdr_incs_name_ext}
  631. }
  632.  
  633. # Generate includes for source file. Don't generate if the file is already
  634. # included in the header file.
  635. #
  636. proc gen_src_incs {{cur_class ""}} {
  637.     # default parameter: don't break old interface
  638.     global cpp_src_incs cpp_src_incs_name cpp_src_incs_name_ext cpp_hdr_files
  639.     if {! [info exists cpp_sections(c_hdr_sect)]} {
  640.         catch {unset cpp_src_incs}
  641.         catch {unset cpp_src_incs_name}
  642.         catch {unset cpp_src_incs_name_ext}
  643.  
  644.         return
  645.     }
  646.     if {$cur_class != ""} {
  647.         set cur_class_name [$cur_class getName]
  648.     } else {
  649.         set cur_class_name ""
  650.     }
  651.     set gen_include_list ""
  652.     set user_include_list ""
  653.     if [info exists cpp_src_incs] {
  654.         foreach class [array names cpp_src_incs] {
  655.             if {($class != $cur_class_name) && [info exists cpp_hdr_incs($class)]} {
  656.                 continue
  657.             }
  658.             set hdl $cpp_src_incs($class)
  659.             set incls [$hdl getPropertyValue include_list]
  660.             if {$incls == ""} {
  661.                 lappend gen_include_list [$hdl getName]
  662.                 set src_files([h_class2file $class]) 1
  663.             } else {
  664.                 foreach incl [config_include_list [split $incls ,]] {
  665.                     if [info exists cpp_hdr_files($incl)] {
  666.                         continue
  667.                     }
  668.                     lappend user_include_list $incl
  669.                     set src_files($incl) 1
  670.                 }
  671.             }
  672.         }
  673.     }
  674.     if [info exists cpp_src_incs_name] {
  675.         foreach entry [array names cpp_src_incs_name] {
  676.             set file [h_class2file $entry $cpp_src_incs_name_ext($entry)]
  677.             if [info exists cpp_hdr_files($file)] {
  678.                 continue
  679.             }
  680.             if [info exists src_files($file)] {
  681.                 continue
  682.             }
  683.             lappend gen_include_list $entry
  684.         }
  685.     }
  686.     foreach entry [lsort $gen_include_list] {
  687.                 if {[info exists cpp_src_incs_name_ext($entry)]} {
  688.                     set ext $cpp_src_incs_name_ext($entry)
  689.                 } else {
  690.                     set ext "hxx"
  691.                 }
  692.         # prefer user includes
  693.         set idx [lsearch -exact $user_include_list [h_class2file $entry $ext]]
  694.         if {$idx == -1} {
  695.             gen_include $entry $cpp_sections(c_hdr_sect) $ext
  696.         }
  697.     }
  698.     # do not sort ! remove duplicates
  699.     foreach entry $user_include_list {
  700.         if [info exists dup($entry)] {
  701.             continue;
  702.         }
  703.         set dup($entry) 1
  704.         gen_include_filename $entry $cpp_sections(c_hdr_sect)
  705.     }
  706.     catch {unset cpp_src_incs}
  707.     catch {unset cpp_src_incs_name}
  708.     catch {unset cpp_src_incs_name_ext}
  709.     catch {unset src_files}
  710. }
  711.  
  712. # Template emulation management
  713.  
  714. # Sets to be instantiated
  715. #
  716. global cpp_sets
  717.  
  718. proc instantiate_set {class} {
  719.     if $has_templates {
  720.         return
  721.     }
  722.     global cpp_sets
  723.     set cpp_sets($class) 1
  724. }
  725.  
  726. proc gen_sets {} {
  727.     global cpp_sets
  728.     if {![info exists cpp_sets]} {
  729.         return
  730.     }
  731.     set sect $cpp_sections(h_incl_sect)
  732.     foreach class [lsort [array names cpp_sets]] {
  733.         gen_set_type_def $class $sect
  734.     }
  735.     unset cpp_sets
  736. }
  737.  
  738. # Ordered Sets to be instantiated
  739. #
  740. global cpp_osets
  741.  
  742. proc instantiate_oset {class} {
  743.     if $has_templates {
  744.         return
  745.     }
  746.     global cpp_osets
  747.     set cpp_osets($class) 1
  748. }
  749.  
  750. proc gen_osets {} {
  751.     global cpp_osets
  752.     if {![info exists cpp_osets]} {
  753.         return
  754.     }
  755.     set sect $cpp_sections(h_incl_sect)
  756.     foreach class [lsort [array names cpp_osets]] {
  757.         gen_oset_type_def $class $sect
  758.     }
  759.     unset cpp_osets
  760. }
  761.  
  762. # Dicts to be instantiated
  763. #
  764. global cpp_dicts
  765.  
  766. proc instantiate_dict {key value} {
  767.     if $has_templates {
  768.         return
  769.     }
  770.     global cpp_dicts
  771.     set cpp_dicts($key,$value) 1
  772. }
  773.  
  774. proc gen_dicts {} {
  775.     global cpp_dicts
  776.     if {![info exists cpp_dicts]} {
  777.         return
  778.     }
  779.     set sect $cpp_sections(h_incl_sect)
  780.     foreach keyval [lsort [array names cpp_dicts]] {
  781.         set kv_list [split $keyval ,]
  782.         gen_dict_type_def [lindex $kv_list 0] [lindex $kv_list 1] $sect
  783.     }
  784.     unset cpp_dicts
  785. }
  786.  
  787. # Set Dicts to be instantiated
  788. #
  789. global cpp_set_dicts
  790.  
  791. proc instantiate_set_dict {key value} {
  792.     if $has_templates {
  793.         return
  794.     }
  795.     global cpp_set_dicts
  796.     set cpp_set_dicts($key,$value) 1
  797. }
  798.  
  799. proc gen_set_dicts {} {
  800.     global cpp_set_dicts
  801.     if {![info exists cpp_set_dicts]} {
  802.         return
  803.     }
  804.     set sect $cpp_sections(h_incl_sect)
  805.     foreach keyval [lsort [array names cpp_set_dicts]] {
  806.         set kv_list [split $keyval ,]
  807.         gen_set_dict_type_def [lindex $kv_list 0] \
  808.                 [lindex $kv_list 1] $sect
  809.     }
  810.     unset cpp_set_dicts
  811. }
  812.  
  813. # Ordered Set Dicts to be instantiated
  814. #
  815. global cpp_oset_dicts
  816.  
  817. proc instantiate_oset_dict {key value} {
  818.     if $has_templates {
  819.         return
  820.     }
  821.     global cpp_oset_dicts
  822.     set cpp_oset_dicts($key,$value) 1
  823. }
  824.  
  825. proc gen_oset_dicts {} {
  826.     global cpp_oset_dicts
  827.     if {![info exists cpp_oset_dicts]} {
  828.         return
  829.     }
  830.     set sect $cpp_sections(h_incl_sect)
  831.     foreach keyval [lsort [array names cpp_oset_dicts]] {
  832.         set kv_list [split $keyval ,]
  833.         gen_oset_dict_type_def [lindex $kv_list 0] \
  834.                 [lindex $kv_list 1] $sect
  835.     }
  836.     unset cpp_oset_dicts
  837. }
  838.  
  839. # FuncMaps to be instantiated
  840. #
  841. global cpp_funcmaps
  842.  
  843. proc instantiate_funcmap {func} {
  844.     if $has_templates {
  845.         return
  846.     }
  847.     global cpp_funcmaps
  848.     set cpp_funcmaps($func) 1
  849. }
  850.  
  851. proc gen_funcmaps {} {
  852.     global cpp_funcmaps
  853.     if {![info exists cpp_funcmaps]} {
  854.         return
  855.     }
  856.     set sect $cpp_sections(h_incl_sect)
  857.     foreach func [lsort [array names cpp_funcmaps]] {
  858.         gen_funcmap_type_def $func $sect
  859.     }
  860.     unset cpp_funcmaps
  861. }
  862.  
  863. #
  864. # Return whether the given class is abstact, i.e. has any abstract operations.
  865. #
  866. proc is_abstract_class {class} {
  867.     foreach f [$class featureSet] {
  868.         if {[$f get_obj_type] == "operation" && [$f isAbstract] == "1"} {
  869.             return 1
  870.         }
  871.     }
  872.     return 0
  873. }
  874.