home *** CD-ROM | disk | FTP | other *** search
/ PC World 1997 November / PCWorld_1997-11_cd.bin / software / programy / komix / DATA.Z / genwif.tcl < prev    next >
Text File  |  1996-12-09  |  22KB  |  791 lines
  1. #---------------------------------------------------------------------------
  2. #
  3. # Copyright (c) 1995-1996 by Cayenne Software 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 Cayenne Software Inc..
  13. #
  14. #---------------------------------------------------------------------------
  15. #
  16. #    File        : @(#)genwif.tcl    /main/hindenburg/6
  17. #    Original date    : 14-02-1995
  18. #    Description    : 
  19. #
  20. #---------------------------------------------------------------------------
  21. #
  22.  
  23. require wif_const.tcl
  24. require wif_regen.tcl
  25.  
  26. require guiclassin.tcl
  27.  
  28. global ne_wif_sections
  29. set ne_wif_sections {
  30.     wif_sect
  31. }
  32.  
  33. # Entry point for wif generation ...
  34. #
  35. proc class::generate_wif {guiClass} {
  36.     puts stdout "Generating for class '[$guiClass getName]'"
  37.     class2wiftgtfile $guiClass wif_file
  38.     global guiClassInfo
  39.     set guiClassInfo [GuiClassInfo new $guiClass]
  40.     if {[$guiClassInfo initStatus] == -1} {
  41.         # errors are given in GuiClassInfo constructor already
  42.         global ne_error_state
  43.         set ne_error_state 1
  44.         global gen_file
  45.         return
  46.     }
  47.     if [catch {prepare_wif_regeneration $guiClass} result] {
  48.         switch $errorCode {
  49.             ERR_REGEN {puts stderr $result}
  50.             default {error $result $errorInfo $errorCode}
  51.         }
  52.         global gen_file
  53.         catch {unset gen_file($wif_file)}
  54.         unset guiClassInfo
  55.         return
  56.     }
  57.  
  58.     set class [$guiClassInfo refClass]
  59.     if {![genwif::checkRefClassName $guiClass $class]} {
  60.         global ne_error_state
  61.         set ne_error_state 1
  62.         unset guiClassInfo
  63.         return
  64.     }
  65.  
  66.     genwif::version
  67.     genwif::ixwindow $guiClass $class
  68.     genwif::ixsuptbl $guiClass $class
  69.     genwif::ixsupflds $guiClass $class
  70.     genwif::ixsuptblbtns $guiClass $class
  71.     genwif::ixmenus $guiClass
  72.     genwif::calc_geometry $guiClass $class
  73.  
  74.     global ne_sections
  75.     set ne_sections(wif_sect) [TextSection new]
  76.     $ne_sections(wif_sect) indent 0 "\t"
  77.  
  78.     genwif::wif2section $ne_sections(wif_sect)
  79.     do_write_ne_sections [$guiClass getName] $wif_file $ne_wif_sections
  80.     unset guiClassInfo
  81. }
  82.  
  83. proc genwif::checkRefClassName {guiClass class} {
  84.     # make sure that the referred class name is the same as in the wif file.
  85.     set orgName [lindex [wif_regen::get_contained_wif_obj_names ixWindow \
  86.         [ixwindow::genname $guiClass] ixSuperTable] 0]
  87.     if {$orgName == ""} {
  88.         return 1
  89.     }
  90.     set curName [ixsuptbl::genname $class]
  91.     if {$orgName != $curName} {
  92.         puts "ERROR: Property 'Referred Class' of gui-class '[$guiClass\
  93.             getName]' has changed since last Wif generation."
  94.         return 0
  95.     }
  96.     return 1
  97. }
  98.  
  99. proc genwif::version {} {
  100.     global wif_regen
  101.     global WifVersion
  102.  
  103.     if [info exists wif_regen] {
  104.         return
  105.     }
  106.     set wif_regen(VERSION) $WifVersion
  107. }
  108.  
  109. proc genwif::ixwindow {guiClass class} {
  110.     global wif_regen
  111.     global DefWindowProps
  112.     global UserWindowProps
  113.     global WindowProps
  114.     global DefWindowHandlers
  115.     global WindowHandlers
  116.     
  117.     set object_name [uncap [$guiClass getName]]WN
  118.     set wif_obj ixWindow$object_name
  119.     global $wif_obj
  120.  
  121.     if {![info exists wif_regen(OBJECTS)]} {
  122.         set wif_regen(OBJECTS) $wif_obj
  123.         set ${wif_obj}(BEGIN) "BEGIN ixWindow $object_name"
  124.         foreach p $WindowProps {
  125.             if {[info exist UserWindowProps($p)]} {
  126.                 lappend ${wif_obj}(PROPS) \
  127.                     "$p = $UserWindowProps(${p})"
  128.             } elseif {[info exist DefWindowProps($p)]} {
  129.                 lappend ${wif_obj}(PROPS) \
  130.                     "$p *= $DefWindowProps(${p})"
  131.             } else {
  132.                 lappend ${wif_obj}(PROPS) "$p = [\
  133.                     ixwindow::generate_${p} $guiClass]"
  134.             }
  135.         }
  136.         foreach h $WindowHandlers {
  137.             lappend ${wif_obj}(HANDLERS) "[genwif::expand_handler \
  138.                 $guiClass $class ixwindow $h]"
  139.         }
  140.         set ${wif_obj}(END) "END"
  141.         return
  142.     }
  143.  
  144.     global UpdWindowProps
  145.     foreach p $UpdWindowProps {
  146.         wif_regen::update_prop_value ixWindow $object_name $p \
  147.             [ixwindow::generate_$p $guiClass]
  148.     }
  149. }
  150.  
  151. proc ixwindow::generate_title {guiClass} {
  152.     return \"[$guiClass getName]\"
  153. }
  154.  
  155. proc ixwindow::generate_database {guiClass} {
  156.     set cc [ClientContext::global]
  157.     set configV [$cc currentConfig]
  158.  
  159.     if [$configV isNil] {
  160.         return NULL
  161.     }
  162.  
  163.     set tdb_name [$configV getPropertyValue tdbname]
  164.  
  165.     if {$tdb_name == ""} {
  166.         return NULL
  167.     }
  168.  
  169.     return \"$tdb_name\"
  170. }
  171.  
  172. proc ixwindow::generate_classname {guiClass} {
  173.     return \"[$guiClass getName]Window\"
  174. }
  175.  
  176. proc ixwindow::genname {guiClass} {
  177.     return [uncap [$guiClass getName]]WN
  178. }
  179.  
  180. proc ixwindow::generate_name {guiClass} {
  181.     return \"[ixwindow::genname $guiClass]\"
  182. }
  183.  
  184. proc genwif::expand_handler {guiClass class wif_class handler {extra_arg ""}} {
  185.     set tmp_sect [TextSection new]
  186.     $tmp_sect indent 0 "\t"
  187.  
  188.     if {$extra_arg == ""} {
  189.         ${wif_class}::generate_${handler} $tmp_sect $guiClass $class
  190.     } else {
  191.         ${wif_class}::generate_${handler} $tmp_sect $guiClass $class \
  192.             $extra_arg
  193.     }
  194.  
  195.     return [$tmp_sect contents]
  196. }
  197.  
  198. proc ixwindow::generate_pre_body {sect guiClass class} {
  199.     global DefWindowHandlers
  200.     set txt $DefWindowHandlers(pre_body)
  201.     class2tgtfiles $class src_file hdr_file
  202.  
  203.     expand_text $sect $txt
  204. }
  205.  
  206. proc ixwindow::generate_constructor_extension {sect guiClass class} {
  207.     global DefWindowHandlers
  208.     global TYPE_ID_NM
  209.     set txt $DefWindowHandlers(constructor_extension)
  210.     set cl_name [$class getName]
  211.     set class_type_supfld [uncap $cl_name][cap $TYPE_ID_NM]SF
  212.  
  213.     expand_text $sect $txt
  214. }
  215.  
  216. proc genwif::ixsuptbl {guiClass class} {
  217.     global wif_regen
  218.     global DefSupTblProps
  219.     global UserSupTblProps
  220.     global SupTblProps
  221.     global DefSupTblHandlers
  222.     global SupTblHandlers
  223.  
  224.     set object_name [uncap [$class getName]]ST
  225.     set wif_obj ixSuperTable$object_name
  226.     global $wif_obj
  227.  
  228.     if {![info exists $wif_obj]} {
  229.         set wif_containobj ixWindow[uncap [$guiClass getName]]WN
  230.         global $wif_containobj
  231.         lappend ${wif_containobj}(OBJECTS) $wif_obj
  232.         set ${wif_obj}(BEGIN) "BEGIN ixSuperTable $object_name"
  233.         foreach p $SupTblProps {
  234.             if {[info exist UserSupTblProps($p)]} {
  235.                 lappend ${wif_obj}(PROPS) \
  236.                     "$p = $UserSupTblProps(${p})"
  237.             } elseif {[info exist DefSupTblProps($p)]} {
  238.                 lappend ${wif_obj}(PROPS) \
  239.                     "$p *= $DefSupTblProps(${p})"
  240.             } else {
  241.                 lappend ${wif_obj}(PROPS) \
  242.                     "$p = [ixsuptbl::generate_${p} \
  243.                         $guiClass $class]"
  244.             }
  245.         }
  246.         foreach h $SupTblHandlers {
  247.             lappend ${wif_obj}(HANDLERS) "[genwif::expand_handler \
  248.                 $guiClass $class ixsuptbl $h]"
  249.         }
  250.         set ${wif_obj}(END) "END"
  251.         return
  252.     }
  253.  
  254.     global UpdSupTblProps
  255.     foreach p $UpdSupTblProps {
  256.         wif_regen::update_prop_value ixSuperTable $object_name $p \
  257.             [ixsuptbl::generate_$p $guiClass $class]
  258.     }
  259. }
  260.  
  261. # Get a all ancestor classes of the class (including class itself)
  262. #
  263. proc get_hierarchy {class {hierarchy ""}} {
  264.     if {[lsearch -exact $hierarchy $class] != -1} {
  265.         return $hierarchy
  266.     }
  267.     set hierarchy [linsert $hierarchy 0 $class]
  268.     foreach super [$class genNodeSet] {
  269.         set hierarchy [get_hierarchy [$super superClass] $hierarchy]
  270.     }
  271.     return $hierarchy
  272. }
  273.  
  274. proc ixsuptbl::generate_updateTable {guiClass class} {
  275.     set class_hierarchy [get_hierarchy $class]
  276.     return \"[[[lindex $class_hierarchy 0] table] getUniqueName]\"
  277. }
  278.  
  279. proc ixsuptbl::generate_numDisplayedCols {guiClass class} {
  280.     # note: add 1 for class_type field
  281.     set nr [llength [$guiClass dataAttrSet]]
  282.     return [incr nr]
  283. }
  284.  
  285. proc ixsuptbl::generate_selectFromPart {guiClass class} {
  286.     set class_hierarchy [$guiClassInfo refClassHierarchy]
  287.     set table [[lvarpop class_hierarchy] table]
  288.     set from_part [$table getUniqueName]
  289.     while {![lempty $class_hierarchy]} {
  290.         set table [[lvarpop class_hierarchy] table]
  291.         append from_part ", "
  292.         append from_part [$table getUniqueName]
  293.     }
  294.     return \"${from_part}\"
  295. }
  296.  
  297. proc ixsuptbl::generate_selectJoinPart {guiClass class} {
  298.     set class_hierarchy [$guiClassInfo refClassHierarchy]
  299.     set root_class [lvarpop class_hierarchy]
  300.     set rtabnm [[$root_class table] getUniqueName]
  301.     if [lempty $class_hierarchy] {
  302.         return NULL
  303.     }
  304.     foreach cl $class_hierarchy {
  305.         lappend table_names [[$cl table] getUniqueName]
  306.     }
  307.     set key_cols [get_col_list [$root_class table] KEYS_NO_TYPE]
  308.     foreach col $key_cols {
  309.         lappend key_names [$col getUniqueName]
  310.     }
  311.     set first 1
  312.     set join_part ""
  313.     foreach tabnm $table_names {
  314.         foreach key $key_names {
  315.             if !$first {
  316.                 append join_part " AND "
  317.             }
  318.             set first 0
  319.             append join_part "$rtabnm.$key = $tabnm.$key"
  320.         }
  321.     }
  322.             
  323.     return \"${join_part}\"
  324. }
  325.  
  326. proc ixsuptbl::genname {class} {
  327.     return [uncap [$class getName]]ST
  328. }
  329.  
  330. proc ixsuptbl::generate_name {guiClass class} {
  331.     return \"[ixsuptbl::genname $class]\"
  332. }
  333.  
  334. proc ixsuptbl::generate_SQLDelete {sect guiClass class} {
  335.         global DefSupTblHandlers
  336.         set txt $DefSupTblHandlers(SQLDelete)
  337.         set cl_name [$class getName]
  338.  
  339.         expand_text $sect $txt
  340. }
  341.  
  342. proc ixsuptbl::generate_SQLInsert {sect guiClass class} {
  343.         global DefSupTblHandlers
  344.         set txt $DefSupTblHandlers(SQLInsert)
  345.         set cl_name [$class getName]
  346.  
  347.     expand_text $sect $txt
  348. }
  349.  
  350. proc ixsuptbl::generate_SQLUpdate {sect guiClass class} {
  351.         global DefSupTblHandlers
  352.         set txt $DefSupTblHandlers(SQLUpdate)
  353.         set cl_name [$class getName]
  354.  
  355.     expand_text $sect $txt
  356. }
  357.  
  358. proc genwif::ixsupflds {guiClass class} {
  359.     set orgSupFlds [wif_regen::get_contained_wif_obj_names ixSuperTable \
  360.         [ixsuptbl::genname $class] ixSuperField]
  361.     set colNum 1
  362.     foreach col [$guiClassInfo refColumns] {
  363.         genwif::ixsupfld $class $col $colNum
  364.         incr colNum
  365.         set supfldname [ixsupfld::genname $class $col]
  366.         set idx [lsearch $orgSupFlds $supfldname]
  367.         if {$idx != -1} {
  368.             set orgSupFlds [lreplace $orgSupFlds $idx $idx]
  369.         }
  370.         lappend orderedSupFldWifObjs ixSuperField$supfldname
  371.     }
  372.     # The remaining "orgSupFlds" are obsolete; they are not removed, 
  373.     # however, their colNum and SQLRole properties are set to an
  374.     # appropriate value.
  375.     foreach sf $orgSupFlds {
  376.         wif_regen::update_prop_value ixSuperField $sf colNum $colNum
  377.         incr colNum
  378.  
  379.         set sql_role [wif_regen::get_prop_value ixSuperField \
  380.             $sf SQLRole]
  381.         if {$sql_role != "ixSuperField::noRole"} {
  382.             puts "WARNING: Resetting SQLRole property of\
  383.                 ixSuperField '$sf' to 'ixSuperField::noRole'"
  384.             wif_regen::update_prop_value ixSuperField \
  385.                 $sf SQLRole ixSuperField::noRole
  386.         }
  387.         lappend orderedSupFldWifObjs ixSuperField$sf
  388.     }
  389.  
  390.     if 0 {
  391.         # Put the ixSuperFields in the right order in the containing
  392.         # ixSuperTable.
  393.         set wif_containobj ixSuperTable[uncap [$class getName]]ST
  394.         global $wif_containobj
  395.         set btns [wif_regen::get_contained_wif_objs ixSuperTable \
  396.             [ixsuptbl::genname $class] ixButton]
  397.         set ${wif_containobj}(OBJECTS) [concat $orderedSupFldWifObjs \
  398.             $btns]
  399.     }
  400. }
  401.  
  402. proc genwif::ixsupfld {class col colNum} {
  403.     global DefSupFldProps
  404.     global UserSupFldProps
  405.     global SupFldProps
  406.     set object_name [ixsupfld::genname $class $col]
  407.     set wif_obj ixSuperField$object_name
  408.     global $wif_obj
  409.  
  410.     if {![info exists $wif_obj]} {
  411.         set wif_containobj ixSuperTable[uncap [$class getName]]ST
  412.         global $wif_containobj
  413.         lappend ${wif_containobj}(OBJECTS) $wif_obj
  414.         set ${wif_obj}(BEGIN) "BEGIN ixSuperField $object_name"
  415.         foreach p $SupFldProps {
  416.             if {[info exist UserSupFldProps($p)]} {
  417.                 lappend ${wif_obj}(PROPS) \
  418.                     "$p = $UserSupFldProps(${p})"
  419.             } elseif {[info exist DefSupFldProps($p)]} {
  420.                 lappend ${wif_obj}(PROPS) \
  421.                     "$p *= $DefSupFldProps(${p})"
  422.             } else {
  423.                 lappend ${wif_obj}(PROPS) "$p =\
  424.                 [ixsupfld::generate_${p} $class $col $colNum]"
  425.             }
  426.         }
  427.         global TYPE_ID_NM
  428.         if {[$col getName] == $TYPE_ID_NM} {
  429.             wif_regen::update_prop_value ixSuperField $object_name \
  430.             shown FALSE
  431.             wif_regen::update_prop_value ixSuperField $object_name \
  432.             queryState ixSuperField::readOnlyState
  433.             wif_regen::update_prop_value ixSuperField $object_name \
  434.             height 1
  435.             wif_regen::update_prop_value ixSuperField $object_name \
  436.             title_Height 1
  437.         }
  438.         set ${wif_obj}(END) "END"
  439.         return
  440.     }
  441.  
  442.     global UpdSupFldProps
  443.     foreach p $UpdSupFldProps {
  444.         wif_regen::update_prop_value ixSuperField $object_name $p \
  445.             [ixsupfld::generate_$p $class $col $colNum]
  446.     }
  447. }
  448.  
  449. proc ixsupfld::generate_SQLRole {class col colNum} {
  450.     if {[$col getColumnType] == "key"} {
  451.         return ixSuperField::noUpdateRole
  452.     } else {
  453.         return ixSuperField::updateRole
  454.     }
  455. }
  456.  
  457. proc ixsupfld::generate_colNum {class col colNum} {
  458.     return $colNum
  459. }
  460.  
  461. proc ixsupfld::generate_columnName {class col colNum} {
  462.     return \"[$col getUniqueName]\"
  463. }
  464.  
  465. proc ixsupfld::generate_tableName {class col colNum} {
  466.     return \"[[$col table] getUniqueName]\"
  467. }
  468.  
  469. proc ixsupfld::generate_title {class col colNum} {
  470.     return \"[$col getUniqueName]\"
  471. }
  472.  
  473. proc ixsupfld::genname {class col} {
  474.         set ucl_name [uncap [$class getName]]
  475.         set ccol_name [cap [$col getUniqueName]]
  476.         return ${ucl_name}${ccol_name}SF
  477. }
  478.  
  479. proc ixsupfld::generate_name {class col colNum} {
  480.         return \"[ixsupfld::genname $class $col]\"
  481. }
  482.  
  483. proc ixsupfld::generate_encLength {class col colNum} {
  484.     return [map_fgl2enclength [$col getType4GL]]
  485. }
  486.  
  487. proc ixsupfld::generate_initialDataValue {class col colNum} {
  488.     set initval [$col getPropertyValue initial_value]
  489.     if {$initval == ""} {
  490.         return NULL
  491.     }
  492.     if {[string index $initval 0] == "\""} {
  493.         return $initval
  494.     } else {
  495.         return \"${initval}\"
  496.     }
  497. }
  498.  
  499. proc ixsupfld::generate_maxDataChars {class col colNum} {
  500.     return [map_fgl2maxdatachars [$col getType4GL]]
  501. }
  502.  
  503. proc ixsupfld::generate_type {class col colNum} {
  504.     return [map_fgl2sqltype [$col getType4GL]]
  505. }
  506.  
  507. proc ixsupfld::generate_nullable {class col colNum} {
  508.     if {[$col isNullable]} {
  509.         return TRUE
  510.     }
  511.     return FALSE
  512. }
  513.  
  514. proc ixsupfld::generate_primaryKey {class col colNum} {
  515.     if {[$col get_obj_type] == "column" && [$col getColumnType] == "key"} {
  516.         return TRUE
  517.     }
  518.     return FALSE
  519. }
  520.  
  521. proc genwif::ixsuptblbtns {guiClass class} {
  522.     global SupTblBtnProps
  523.     global DefSupTblBtnProps
  524.     global UserSupTblBtnProps
  525.     global SupTblBtnHandlers
  526.     set ucl_name [uncap [$class getName]]
  527.     set wif_containobj ixSuperTable${ucl_name}ST
  528.     global $wif_containobj
  529.  
  530.     foreach oper [$guiClass operationSet] {
  531.         set btn_name [$oper getName]
  532.         set object_name ${ucl_name}${btn_name}BT
  533.         set wif_obj ixButton$object_name
  534.         global $wif_obj
  535.         if {![info exists $wif_obj]} {
  536.             lappend ${wif_containobj}(OBJECTS) $wif_obj
  537.             set ${wif_obj}(BEGIN) "BEGIN ixButton $object_name"
  538.             foreach p $SupTblBtnProps {
  539.                 if {[info exist UserSupTblBtnProps($p)]} {
  540.                     lappend ${wif_obj}(PROPS) \
  541.                         "$p = $UserSupTblBtnProps(${p})"
  542.                 } elseif {[info exist DefSupTblBtnProps($p)]} {
  543.                     lappend ${wif_obj}(PROPS) \
  544.                         "$p *= $DefSupTblBtnProps(${p})"
  545.                 } else {
  546.                     lappend ${wif_obj}(PROPS) "$p =\
  547.                         [ixsuptblbtn::generate_${p} \
  548.                         $ucl_name $btn_name]"
  549.                 }
  550.             }
  551.             foreach h $SupTblBtnHandlers {
  552.                 lappend ${wif_obj}(HANDLERS) \
  553.                     "[genwif::expand_handler $guiClass \
  554.                     $class ixsuptblbtn $h $btn_name]"
  555.             }
  556.             set ${wif_obj}(END) "END"
  557.             continue
  558.         }
  559.  
  560.         global UpdSupTblBtnProps
  561.         foreach p $UpdSupTblBtnProps {
  562.             wif_regen::update_prop_value ixButton $object_name $p \
  563.                 [ixsuptblbtn::generate_$p $ucl_name $btn_name]
  564.         }
  565.     }
  566. }
  567.  
  568. proc ixsuptblbtn::generate_title {ucl_name btn_name} {
  569.     return \"${btn_name}\"
  570. }
  571.  
  572. proc ixsuptblbtn::generate_name {ucl_name btn_name} {
  573.     return \"${ucl_name}${btn_name}BT\"
  574. }
  575.  
  576. proc ixsuptblbtn::generate_activate {sect $guiClass class btn_name} {
  577.     global DefSTBtnActivateHdlrs
  578.  
  579.     if {[info exists DefSTBtnActivateHdlrs($btn_name)]} {
  580.         set txt $DefSTBtnActivateHdlrs($btn_name)
  581.     } else {
  582.         set txt $DefSTBtnActivateHdlrs(NotYetImplemented)
  583.     }
  584.     expand_text $sect $txt
  585. }
  586.  
  587. proc genwif::ixmenus {guiClass} {
  588.     # Note: generation of menus is different from generation of other wif
  589.     # objects. The contents of the customization file "stdixmenus.wif_tmpl"
  590.     # (containing ixMenu objects only) is incorporated in the generated
  591.     # wif file. This is only the case if no ixMenu objects are present
  592.     # yet in the (re)generated wif file.
  593.     set cl_name [$guiClass getName]
  594.     set ucl_name [uncap $cl_name]
  595.     if {[llength [wif_regen::get_contained_wif_objs ixWindow ${ucl_name}WN \
  596.             ixMenu]] != 0} {
  597.         # The containing window already contains menus
  598.         return
  599.     }
  600.     set fileName "stdixmenus"
  601.     set fileType "wif_tmpl"
  602.     set cc [ClientContext::global]
  603.     if {![$cc customFileExists $fileName $fileType etc]} {
  604.         return
  605.     }
  606.     set tmpFile [args_file {}]
  607.     $cc downLoadCustomFile $fileName $fileType etc $tmpFile
  608.     set object_name ${ucl_name}MN
  609.     set wif_obj ixMenu$object_name
  610.     global $wif_obj
  611.     set wif_containobj ixWindow${ucl_name}WN
  612.     global $wif_containobj
  613.     lappend ${wif_containobj}(OBJECTS) $wif_obj
  614.     set sect [TextSection new]
  615.     expand_file $sect $tmpFile current_section $sect guiClass $guiClass
  616.     BasicFS::removeFile $tmpFile
  617.     set ${wif_obj}(BEGIN) [$sect contents]
  618.     set ${wif_obj}(END) ""
  619. }
  620.  
  621. proc genwif::calc_geometry {guiClass class} {
  622.     global SF_interspace
  623.     global SF_title_Width
  624.     global SF_title_interspace
  625.     global BT_interspace
  626.     global BT_height
  627.  
  628.     set curr_top $SF_interspace
  629.     set curr_left [expr $SF_title_Width + 2 * $SF_title_interspace]
  630.     set curr_title_Top $SF_interspace
  631.     set curr_title_Left $SF_title_interspace
  632.     set suptblname [ixsuptbl::genname $class]
  633.  
  634.     set allSupFlds [wif_regen::get_contained_wif_obj_names \
  635.         ixSuperTable $suptblname ixSuperField]
  636.     foreach sf $allSupFlds {
  637.         set left [wif_regen::get_prop_value ixSuperField $sf left]
  638.         if {$left == "NULL"} {
  639.             wif_regen::update_prop_value ixSuperField $sf left \
  640.                 $curr_left
  641.         } else {
  642.             set curr_left $left
  643.         }
  644.  
  645.         set top [wif_regen::get_prop_value ixSuperField $sf top]
  646.         if {$top == "NULL"} {
  647.             wif_regen::update_prop_value ixSuperField $sf top \
  648.                 $curr_top
  649.         } else {
  650.             set curr_top $top
  651.         }
  652.  
  653.         set title_Left [wif_regen::get_prop_value ixSuperField \
  654.             $sf title_Left]
  655.         if {$title_Left == "NULL"} {
  656.             wif_regen::update_prop_value ixSuperField $sf \
  657.                 title_Left $curr_title_Left
  658.         } else {
  659.             set curr_title_Left $title_Left
  660.         }
  661.  
  662.         set title_Top [wif_regen::get_prop_value ixSuperField \
  663.             $sf title_Top]
  664.         if {$title_Top == "NULL"} {
  665.             wif_regen::update_prop_value ixSuperField $sf \
  666.                 title_Top $curr_title_Top
  667.         } else {
  668.             set curr_title_Top $title_Top
  669.         }
  670.  
  671.         incr curr_top [wif_regen::get_prop_value ixSuperField $sf \
  672.             height]
  673.         incr curr_top $SF_interspace
  674.         set curr_title_Top $curr_top
  675.     }
  676.  
  677.     set curr_left $BT_interspace
  678.     incr curr_top [expr $SF_interspace + $BT_interspace]
  679.  
  680.     set suptbl_height [wif_regen::get_prop_value ixSuperTable \
  681.         $suptblname height]
  682.     set minimal_curr_top [expr $suptbl_height - $BT_height - $BT_interspace]
  683.     if { $minimal_curr_top > $curr_top } {
  684.         set curr_top $minimal_curr_top
  685.     }
  686.  
  687.     set allButns [wif_regen::get_contained_wif_obj_names \
  688.         ixSuperTable $suptblname ixButton]
  689.     foreach btn $allButns {
  690.         set left [wif_regen::get_prop_value ixButton $btn left]
  691.         if {$left == "NULL"} {
  692.             wif_regen::update_prop_value ixButton $btn left \
  693.                 $curr_left
  694.         } else {
  695.             set curr_left $left
  696.         }
  697.         set top [wif_regen::get_prop_value ixButton $btn top]
  698.         if {$top == "NULL"} {
  699.             wif_regen::update_prop_value ixButton $btn top \
  700.                 $curr_top
  701.         } else {
  702.             set curr_top $top
  703.         }
  704.         incr curr_left [wif_regen::get_prop_value ixButton $btn width]
  705.         incr curr_left $BT_interspace
  706.     }
  707.  
  708.     incr curr_top [expr $BT_height + $BT_interspace]
  709.  
  710.     set windowname [ixwindow::genname $guiClass]
  711.     set suptbl_width [wif_regen::get_prop_value ixSuperTable \
  712.         $suptblname width]
  713.     set delta_width [expr $curr_left - $suptbl_width]
  714.     if {$delta_width > 0} {
  715.         wif_regen::update_prop_value ixSuperTable $suptblname width \
  716.             $curr_left
  717.         set window_width [wif_regen::get_prop_value ixWindow \
  718.             $windowname width]
  719.         incr window_width $delta_width
  720.         wif_regen::update_prop_value ixWindow $windowname width \
  721.             $window_width
  722.     }
  723.     set delta_height [expr $curr_top - $suptbl_height]
  724.     if {$delta_height > 0} {
  725.         wif_regen::update_prop_value ixSuperTable $suptblname height \
  726.             $curr_top
  727.         set window_height [wif_regen::get_prop_value ixWindow \
  728.             $windowname height]
  729.         incr window_height $delta_height
  730.         wif_regen::update_prop_value ixWindow $windowname height \
  731.             $window_height
  732.     }
  733. }
  734.  
  735. proc genwif::wif2section {sect} {
  736.     global wif_regen
  737.  
  738.     if {[info exist wif_regen(VERSION)]} {
  739.         $sect append "VERSION $wif_regen(VERSION)\n"
  740.     }
  741.     if {[info exist wif_regen(OBJECTS)]} {
  742.         genwif::wifobject2section $wif_regen(OBJECTS) $sect
  743.     }
  744.     catch {unset wif_regen}
  745. }
  746.  
  747. proc genwif::wifobject2section {wifobject sect} {
  748.     global $wifobject
  749.  
  750.     $sect append "[string trimleft [set ${wifobject}(BEGIN)]]\n"
  751.     $sect indent +
  752.     if [info exists ${wifobject}(PROPS)] {
  753.         foreach prop [set ${wifobject}(PROPS)] {
  754.             $sect append "[string trimleft $prop]\n"
  755.         }
  756.     }
  757.     if [info exists ${wifobject}(OBJECTS)] {
  758.         foreach obj [set ${wifobject}(OBJECTS)] {
  759.             genwif::wifobject2section $obj $sect
  760.         }
  761.     }
  762.     set curr_indent [$sect indent]
  763.     if [info exists ${wifobject}(HANDLERS)] {
  764.         foreach handl [set ${wifobject}(HANDLERS)] {
  765.             split_handler $handl start_h body_h end_h
  766.             $sect append "[string trim $start_h]\n"
  767.             $sect indent 0
  768.             $sect append "$body_h"
  769.             $sect indent $curr_indent
  770.             $sect append "[string trim $end_h]\n"
  771.         }
  772.     }
  773.     $sect indent - 
  774.     $sect append "[string trimleft [set ${wifobject}(END)]]\n"
  775.  
  776.     catch {unset $wifobject}
  777. }
  778.  
  779. proc split_handler {handl start_h body_h end_h} {
  780.     upvar $start_h sh
  781.     upvar $body_h bh
  782.     upvar $end_h eh
  783.  
  784.     set first_nl [string first "\n" $handl]
  785.     set last_nl [string last "\n" $handl]
  786.  
  787.     set sh [string range $handl 0 $first_nl]
  788.     set bh [string range $handl [incr first_nl] $last_nl]
  789.     set eh [string range $handl $last_nl end]
  790. }
  791.