home *** CD-ROM | disk | FTP | other *** search
/ PC World 1998 October / PCWorld_1998-10_cd.bin / software / prehled / komix / DATA.Z / addreqmodh.tcl < prev    next >
Encoding:
Text File  |  1997-11-06  |  6.0 KB  |  201 lines
  1. #---------------------------------------------------------------------------
  2. #
  3. #      (c)     Cayenne Software Inc.    1997
  4. #
  5. #      File:           @(#)addreqmodh.tcl    /main/titanic/6
  6. #      Author:         <generated>
  7. #      Description:
  8. #---------------------------------------------------------------------------
  9. # SccsId = @(#)addreqmodh.tcl    /main/titanic/6   6 Nov 1997 Copyright 1997 Cayenne Software Inc.
  10.  
  11. # Start user added include file section
  12. require "selectmodu.tcl"
  13. require "requiredmo.tcl"
  14. # End user added include file section
  15.  
  16.  
  17. Class AddReqModHandler : {GCObject} {
  18.     constructor
  19.     method destructor
  20.     method addRequiredModules
  21.     method addToReqModInfoSet
  22.     method handleNextReqMod
  23.     method getExistingReqMod
  24.     method handleSelModDlgOkPressed
  25.     method handleSelModDlgCancelPressed
  26.     method addReqModInfo
  27.     method removeReqModInfo
  28.     attribute startingObj
  29.     attribute giveWmtkInfo
  30.     attribute selModDlg
  31.     attribute reqModInfoSet
  32. }
  33.  
  34. global AddReqModHandler::instance
  35. set AddReqModHandler::instance ""
  36.  
  37.  
  38. constructor AddReqModHandler {class this} {
  39.     set this [GCObject::constructor $class $this]
  40.     $this giveWmtkInfo 1
  41.     $this reqModInfoSet [List new]
  42.     # Start constructor user section
  43.     ClassMaker::extend SelectModuleDialog SelectReqModDialog \
  44.         "requiringObj"
  45.     $this selModDlg [SelectReqModDialog new .main.${this}selModDlg \
  46.         -autoPopDown no \
  47.         -okPressed "$this handleSelModDlgOkPressed" \
  48.         -cancelPressed "$this handleSelModDlgCancelPressed" \
  49.         -helpPressed ".main helpOnName addRequirements"] 
  50.     # End constructor user section
  51.     return $this
  52. }
  53.  
  54. method AddReqModHandler::destructor {this} {
  55.     # Start destructor user section
  56.     # End destructor user section
  57. }
  58.  
  59. proc AddReqModHandler::global {} {
  60.     global AddReqModHandler::instance
  61.     if {${AddReqModHandler::instance} == ""} {
  62.         set AddReqModHandler::instance [AddReqModHandler new]
  63.     }
  64.     return ${AddReqModHandler::instance}
  65. }
  66.  
  67. method AddReqModHandler::addRequiredModules {this obj {giveWmtkInfo 1}} {
  68.     if {[$obj select-state] != "on"} {
  69.         if $giveWmtkInfo {
  70.             wmtkinfo "No requirements added for module\
  71.                 '[$obj longName]' with select-state 'off'."
  72.         }
  73.         return
  74.     }
  75.  
  76.     # (re)initialize
  77.     [$this reqModInfoSet] contents "" 
  78.     $this startingObj $obj
  79.     $this giveWmtkInfo $giveWmtkInfo
  80.  
  81.     $this addToReqModInfoSet $obj
  82.     $this handleNextReqMod
  83. }
  84.  
  85. method AddReqModHandler::addToReqModInfoSet {this requiringObj} {
  86.     set requirements [$requiringObj getRequiredElements]
  87.     set reqModules [split [lindex $requirements 0]]
  88.     set reqModuleTypes [split [lindex $requirements 1]]
  89.  
  90.     foreach moduleName $reqModules {
  91.         set reqModInfo [RequiredModuleInfo new \
  92.             -requiringObj $requiringObj \
  93.             -requiredKind "name" \
  94.             -requiredMod $moduleName]
  95.         $this addReqModInfo $reqModInfo
  96.     }
  97.     foreach moduleType $reqModuleTypes {
  98.         set reqModInfo [RequiredModuleInfo new \
  99.             -requiringObj $requiringObj \
  100.             -requiredKind "type" \
  101.             -requiredMod $moduleType]
  102.         $this addReqModInfo $reqModInfo
  103.     }
  104. }
  105.  
  106. method AddReqModHandler::handleNextReqMod {this} {
  107.         if {[[$this reqModInfoSet] length] == 0} {
  108.         if [$this giveWmtkInfo] {
  109.             wmtkinfo "All requirements for module\
  110.                 '[[$this startingObj] longName]' are ok."
  111.         }
  112.                 return
  113.         }
  114.  
  115.         set reqModInfo [[$this reqModInfoSet] index 0]
  116.         [$this reqModInfoSet] remove 0
  117.         set requiringObj [$reqModInfo requiringObj]
  118.         set requiredKind [$reqModInfo requiredKind]
  119.         set requiredMod [$reqModInfo requiredMod]
  120.  
  121.         set requiredObj [$this getExistingReqMod $requiringObj \
  122.                 $requiredKind $requiredMod]
  123.         if {$requiredObj != ""} {
  124.                 $this addToReqModInfoSet $requiredObj
  125.                 $this handleNextReqMod
  126.         } else {
  127.         set moduleDB [ModuleDB::global]
  128.         set modDir [path_name directory [$requiringObj location]]
  129.         set filter [SelModFilter new]
  130.         $filter $requiredKind $requiredMod
  131.         set modPaths [$moduleDB getFilteredModulePaths $modDir $filter]
  132.         if {[$modPaths empty] && $modDir != [$moduleDB defaultModDir]} {
  133.             set modDir [$moduleDB defaultModDir]
  134.             set modPaths [$moduleDB \
  135.                 getFilteredModulePaths $modDir $filter]
  136.         }
  137.         if {[$modPaths length] == 1} {
  138.             set newObject [lindex [[.main editorArea] insertObjects\
  139.                 [list [$modPaths index 0]] $requiringObj] 0]
  140.             wmtkmessage "Added required module\
  141.                 '[$newObject longName]'"
  142.             $this addToReqModInfoSet $newObject
  143.             $this handleNextReqMod
  144.         } else {
  145.             [$this selModDlg] requiringObj $requiringObj
  146.             [$this selModDlg] filter $filter
  147.             [$this selModDlg] title \
  148.                 "Select Module ($requiredKind '$requiredMod')"
  149.             [$this selModDlg] popUp $modDir
  150.         }
  151.         }
  152. }
  153.  
  154. method AddReqModHandler::getExistingReqMod {this requiringObj reqKind reqMod} {
  155.     # requiringObj is the requiring CustModObject
  156.     # reqKind is "name" or "type"
  157.     # reqMod is the name or the type of a required module
  158.     #
  159.     [[.main editorArea] getActiveObjectList] foreach obj {
  160.         if {$obj == $requiringObj} {
  161.             return ""
  162.         }
  163.         if {[$obj $reqKind] == $reqMod} {
  164.             return $obj
  165.         }
  166.     }
  167.  
  168.     return ""
  169. }
  170.  
  171. method AddReqModHandler::handleSelModDlgOkPressed {this} {
  172.     set selectedModules [[$this selModDlg] getSelectedModules]
  173.     if {[llength $selectedModules] != 0} {
  174.         set selectedModule [lindex $selectedModules 0]
  175.         set requiringObj [[$this selModDlg] requiringObj]
  176.         set newObject [lindex [[.main editorArea] insertObjects \
  177.             [list $selectedModule] $requiringObj] 0]
  178.         wmtkmessage "Added required module '[$newObject longName]'"
  179.         $this addToReqModInfoSet $newObject
  180.     }
  181.     [$this selModDlg] popDown
  182.     $this handleNextReqMod
  183. }
  184.  
  185. method AddReqModHandler::handleSelModDlgCancelPressed {this} {
  186.     # First give warning ??
  187.     [$this selModDlg] popDown
  188. }
  189.  
  190. # Do not delete this line -- regeneration end marker
  191.  
  192. method AddReqModHandler::addReqModInfo {this newReqModInfo} {
  193.     [$this reqModInfoSet] append $newReqModInfo
  194.  
  195. }
  196.  
  197. method AddReqModHandler::removeReqModInfo {this oldReqModInfo} {
  198.     [$this reqModInfoSet] removeValue $oldReqModInfo
  199. }
  200.  
  201.