home *** CD-ROM | disk | FTP | other *** search
/ PC World 1998 October / PCWorld_1998-10_cd.bin / software / prehled / komix / DATA.Z / moduleedar.tcl < prev    next >
Encoding:
Text File  |  1997-11-21  |  13.5 KB  |  540 lines
  1. #---------------------------------------------------------------------------
  2. #
  3. #      (c)     Cayenne Software Inc.    1997
  4. #
  5. #      File:           @(#)moduleedar.tcl    /main/titanic/18
  6. #      Author:         <generated>
  7. #      Description:
  8. #---------------------------------------------------------------------------
  9. # SccsId = @(#)moduleedar.tcl    /main/titanic/18   21 Nov 1997 Copyright 1997 Cayenne Software Inc.
  10.  
  11. # Start user added include file section
  12. require "custmodobj.tcl"
  13. require "custobjvie.tcl"
  14.  
  15. require "addreqmodh.tcl"
  16. # End user added include file section
  17.  
  18. require "custdefsar.tcl"
  19.  
  20. Class ModuleEdArea : {CustDefsArea} {
  21.     constructor
  22.     method destructor
  23.     method read
  24.     method insertObjects
  25.     method newObjects
  26.     method createObject
  27.     method clearArea
  28.     method readUserObjects
  29.     method addRequiredModules
  30.     method getActiveObjectList
  31.     method findUnsatisfiedRequirements
  32.     method checkRequirements
  33.     method findConflicts
  34.     method checkConflicts
  35.     method findNonExistingLocations
  36.     method checkExistence
  37.     method findAllInvalidObjs
  38.     method checkAll
  39.     method dropEvent
  40.     method save
  41. }
  42.  
  43. constructor ModuleEdArea {class this name} {
  44.     set this [CustDefsArea::constructor $class $this $name]
  45.     # Start constructor user section
  46.  
  47.     # Order of entries is of importance in the module editor
  48.     $this userLevelAlwaysLast 1
  49.  
  50.     $this rowCount 12
  51.     $this columnCount 80
  52.     $this font "[m4_var get M4_font -context uce]"
  53.     $this mode DETAIL
  54.     $this destinationSet "MODULE dropEvent"
  55.     BrowsHeader new $this.name     -label "Long Name"    -width 32
  56.     BrowsHeader new $this.type     -label Type           -width 20
  57.     BrowsHeader new $this.state     -label "Select State" -width 13
  58.     BrowsHeader new $this.specLevel     -label Level          -width 16
  59.     BrowsHeader new $this.path     -label Location       -width 75
  60.  
  61.     # End constructor user section
  62.     return $this
  63. }
  64.  
  65. method ModuleEdArea::destructor {this} {
  66.     # Start destructor user section
  67.  
  68.     # End destructor user section
  69.     $this CustDefsArea::destructor
  70. }
  71.  
  72. method ModuleEdArea::read {this object type} {
  73.     set index [llength [$this objectSet]]
  74.     foreach module [$this readConfig $object modules modules] {
  75.         set spec ""
  76.         lappend spec name
  77.         lappend spec [lindex $module 0]
  78.         lappend spec index
  79.         lappend spec $index
  80.         lappend spec select-state
  81.         lappend spec [lindex $module 1]
  82.         lappend spec location
  83.         set location [lindex $module 2]
  84.         if $win95 {
  85.             regsub -all {\\\\} $location {\\} location
  86.         }
  87.         lappend spec $location
  88.         $this createObject $spec $type
  89.         incr index
  90.     }
  91. }
  92.  
  93. method ModuleEdArea::insertObjects {this locations {beforeObj ""}} {
  94.     $this isChanged 1
  95.  
  96.     if {$beforeObj == ""} {
  97.         # append new objects to the end
  98.         set index [llength [$this objectSet]]
  99.     } else {
  100.         set index [$beforeObj index]
  101.         set len [llength $locations]
  102.         # make place for new objects
  103.         foreach obj [$this objectSet] {
  104.             if {[$obj index] >= $index} {
  105.                 $obj index [expr {[$obj index] + $len}]
  106.             }
  107.         }
  108.     }
  109.  
  110.     set user 0
  111.     if {[$this _level] == "user"} {
  112.         set user 1
  113.     }
  114.  
  115.     set insertedObjects ""
  116.     foreach location $locations {
  117.         set propDict [[ModuleDB::global] getModulePropDict $location]
  118.         set moduleName [$propDict set "name"]
  119.  
  120.         set spec ""
  121.         lappend spec name
  122.         lappend spec $moduleName
  123.         lappend spec location
  124.         lappend spec $location
  125.         lappend spec select-state
  126.         lappend spec "on"
  127.         lappend spec index
  128.         lappend spec $index
  129.         lappend spec userDefined
  130.         lappend spec $user
  131.  
  132.         set newObject [$this createObject $spec [$this _level]]
  133.         lappend insertedObjects $newObject
  134.         incr index
  135.     }
  136.  
  137.     $this sort -command ModuleEdArea::sort
  138.  
  139.     return $insertedObjects
  140. }
  141.  
  142. method ModuleEdArea::newObjects {this locations} {
  143.     set beforeObj ""
  144.     if {[$this _level] != "user"} {
  145.         foreach obj [$this objectSet] {
  146.             if {[$obj specLevel] == "user"} {
  147.                 set beforeObj $obj
  148.                 break
  149.             }
  150.         }
  151.     }
  152.     set insertedObjects [$this insertObjects $locations $beforeObj]
  153.     # The 'Select Module' Dialog has selectionPolicy 'BROWSE', so the 
  154.     # insertedObjects list will contain only one object
  155.     set obj [lindex $insertedObjects 0]
  156.     [AddReqModHandler::global] addRequiredModules $obj 0
  157. }
  158.  
  159. method ModuleEdArea::createObject {this objSpec level} {
  160.  
  161.     global classCount
  162.     set object [CustModObject new $this.Object$classCount $objSpec]
  163.     incr classCount
  164.  
  165.     $this adjustCreatedObject $object $level
  166.  
  167.     # update the object-details in the view 
  168.     $object updateView
  169.  
  170.     return $object
  171. }
  172.  
  173. method ModuleEdArea::clearArea {this} {
  174.     
  175.     foreach obj [$this objectSet] {
  176.         $obj delete
  177.     }
  178.  
  179.     .main selectionChanged
  180. }
  181.  
  182. method ModuleEdArea::readUserObjects {this} {
  183.     set file [path_name concat [location ~ icase] modules modules]
  184.     if [file exists $file] {
  185.         set index [llength [$this objectSet]]
  186.         foreach module [readConfigurationFile $file] {
  187.             set spec ""
  188.             lappend spec name
  189.             lappend spec [lindex $module 0]
  190.             lappend spec index
  191.             lappend spec $index
  192.             lappend spec select-state
  193.             lappend spec [lindex $module 1]
  194.             lappend spec location
  195.             set location [lindex $module 2]
  196.             if $win95 {
  197.                 regsub -all {\\\\} $location {\\} location
  198.             }
  199.             lappend spec $location
  200.             $this createObject $spec user
  201.             incr index
  202.         }
  203.     }
  204. }
  205.  
  206. method ModuleEdArea::addRequiredModules {this obj} {
  207.     set addReqModHdlr [AddReqModHandler::global]
  208.     $addReqModHdlr addRequiredModules $obj
  209. }
  210.  
  211. method ModuleEdArea::getActiveObjectList {this} {
  212.     set activeObjList [List new]
  213.     foreach obj [$this objectSet] {
  214.         set objName [$obj name]
  215.         set objLoc [$obj location]
  216.         set index 0
  217.         set mustAppend [expr {([$obj select-state] == "on") ? 1 : 0}]
  218.         $activeObjList foreach activeObj {
  219.             set activeObjName [$activeObj name]
  220.             set activeObjLoc [$activeObj location]
  221.             if {$objName == $activeObjName} {
  222.                 # obj 'objName' is already active
  223.                 if {[$obj select-state] == "on" &&
  224.                         $objLoc == $activeObjLoc} {
  225.                     # ignore obj
  226.                     set mustAppend 0
  227.                 } else {
  228.                     # remove activeObj
  229.                     $activeObjList remove $index
  230.                 }
  231.                 break
  232.             }
  233.             incr index
  234.         }
  235.         if {$mustAppend} {
  236.             # obj 'objName' in 'objLoc' was not yet active:
  237.             # append obj
  238.             $activeObjList append $obj
  239.         }
  240.     }
  241.     return $activeObjList
  242. }
  243.  
  244. method ModuleEdArea::findUnsatisfiedRequirements {this objs info} {
  245.     upvar $objs objList
  246.     upvar $info infoList
  247.     set curNames [Dictionary new]
  248.     set curTypes [Dictionary new]
  249.  
  250.     [$this getActiveObjectList] foreach obj {
  251.         set requirements [$obj getRequiredElements]
  252.  
  253.         set reqModules [lindex $requirements 0]
  254.         foreach reqModule $reqModules {
  255.             if [$curNames exists $reqModule] {
  256.                 continue
  257.             }
  258.             lappend infoList "[$obj longName]"
  259.             lappend infoList "No module '$reqModule' found."
  260.             lappend objList $obj
  261.         }
  262.         $curNames set [$obj name] 1
  263.  
  264.         set reqModTypes [lindex $requirements 1]
  265.         foreach reqModType $reqModTypes {
  266.             if [$curTypes exists $reqModType] {
  267.                 continue
  268.             }
  269.             lappend infoList "[$obj longName]"
  270.             lappend infoList "No module type '$reqModType' found."
  271.             lappend objList $obj
  272.         }
  273.         $curTypes set [$obj type] 1
  274.     }
  275.  
  276.     return [llength $objList]
  277. }
  278.  
  279. method ModuleEdArea::checkRequirements {this} {
  280.     set objList {}
  281.     set infoList {}
  282.  
  283.     set nrOfErrors [$this findUnsatisfiedRequirements objList infoList]
  284.  
  285.     if {$nrOfErrors == 0} {
  286.         wmtkinfo "All requirements are available."
  287.         return
  288.     }
  289.  
  290.     # make a simple object that can be handled by the infodialog
  291.     ClassMaker::extend GCObject InfoObject {infoList} 0
  292.     set infoObject [InfoObject new]
  293.     $infoObject infoList $infoList
  294.     .main showObjectInfo $infoObject
  295. }
  296.  
  297. method ModuleEdArea::findConflicts {this objs info} {
  298.     upvar $objs objList
  299.     upvar $info infoList
  300.     set activeObjList [$this getActiveObjectList]
  301.  
  302.     $activeObjList foreach obj {
  303.         set conflicts [$obj getConflictingElements]
  304.  
  305.         set conflictModules [lindex $conflicts 0]
  306.         foreach conflictModule $conflictModules {
  307.             $activeObjList foreach otherObj {
  308.                 if {$obj == $otherObj} {
  309.                     # no conflict with itself
  310.                     continue
  311.                 }
  312.                 if {[$otherObj name] != $conflictModule} {
  313.                     continue
  314.                 }
  315.                 lappend infoList "[$obj longName]"
  316.                 lappend infoList "Conflict with module '[\
  317.                     $otherObj longName]'."
  318.                 lappend objList $obj
  319.             }
  320.         }
  321.  
  322.         set conflictModTypes [lindex $conflicts 1]
  323.         foreach conflictModType $conflictModTypes {
  324.             $activeObjList foreach otherObj {
  325.                 if {$obj == $otherObj} {
  326.                     # no conflict with itself
  327.                     continue
  328.                 }
  329.                 if {$conflictModType != [$otherObj type]} {
  330.                     continue
  331.                 }
  332.                 lappend infoList "[$obj longName]"
  333.                 lappend infoList "Type conflict with module '[\
  334.                     $otherObj longName]'\
  335.                     (type '$conflictModType')."
  336.                 lappend objList $obj
  337.             }
  338.         }
  339.     }
  340.  
  341.     return [llength $objList]
  342. }
  343.  
  344. method ModuleEdArea::checkConflicts {this} {
  345.     set objList {}
  346.     set infoList {}
  347.  
  348.     set nrOfErrors [$this findConflicts objList infoList]
  349.  
  350.     if {$nrOfErrors == 0} {
  351.         wmtkinfo "No conflicts found."
  352.         return
  353.     }
  354.  
  355.     # make a simple object that can be handled by the infodialog
  356.     ClassMaker::extend GCObject InfoObject {infoList} 0
  357.     set infoObject [InfoObject new]
  358.     $infoObject infoList $infoList
  359.     .main showObjectInfo $infoObject
  360. }
  361.  
  362. method ModuleEdArea::findNonExistingLocations {this objs info} {
  363.     upvar $objs objList
  364.     upvar $info infoList
  365.  
  366.     [$this getActiveObjectList] foreach obj {
  367.         if [file exists [$obj location]] {
  368.             continue
  369.         }
  370.         lappend infoList "[$obj longName]"
  371.         lappend infoList "Location '[$obj location]' does not exist."
  372.         lappend objList $obj
  373.     }
  374.  
  375.     return [llength $objList]
  376. }
  377.  
  378. method ModuleEdArea::checkExistence {this} {
  379.     set objList {}
  380.     set infoList {}
  381.  
  382.     set nrOfErrors [$this findNonExistingLocations objList infoList]
  383.  
  384.     if {$nrOfErrors == 0} {
  385.         wmtkinfo "All module locations exist."
  386.         return
  387.     }
  388.  
  389.     # make a simple object that can be handled by the infodialog
  390.     ClassMaker::extend GCObject InfoObject {infoList} 0
  391.     set infoObject [InfoObject new]
  392.     $infoObject infoList $infoList
  393.     .main showObjectInfo $infoObject
  394. }
  395.  
  396. method ModuleEdArea::findAllInvalidObjs {this objs info {editablesOnly 0}} {
  397.     upvar $objs objList
  398.     upvar $info infoList
  399.  
  400.     $this findUnsatisfiedRequirements objList infoList
  401.     $this findConflicts objList infoList
  402.     $this findNonExistingLocations objList infoList
  403.  
  404.     if $editablesOnly {
  405.         set i 0
  406.         foreach obj $objList {
  407.             if [$obj editable] {
  408.                 incr i
  409.                 continue
  410.             }
  411.             # remove obj from objList and info from infoList
  412.             set objList [lreplace $objList $i $i]
  413.             set j [expr 2 * $i]
  414.             set infoList [lreplace $infoList $j [incr j]]
  415.         }
  416.             
  417.     }
  418.  
  419.     return [llength $objList]
  420. }
  421.  
  422. method ModuleEdArea::checkAll {this} {
  423.     set objList {}
  424.     set infoList {}
  425.  
  426.     set nrOfErrors [$this findAllInvalidObjs objList infoList]
  427.  
  428.     if {$nrOfErrors == 0} {
  429.         wmtkinfo "All modules are OK."
  430.         return
  431.     }
  432.  
  433.     # make a simple object that can be handled by the infodialog
  434.     ClassMaker::extend GCObject InfoObject {infoList} 0
  435.     set infoObject [InfoObject new]
  436.     $infoObject infoList $infoList
  437.     .main showObjectInfo $infoObject
  438. }
  439.  
  440. method ModuleEdArea::dropEvent {this droppedObject srcIsDst droppedAfterObject droppedForObject} {
  441.  
  442.     if {$srcIsDst == 0} {
  443.         wmtkerror "Drag & drop between tools is not supported (yet)."
  444.         return
  445.     }
  446.     if {![$droppedObject editable]} {
  447.         wmtkerror "Object not moved, reason: object not editable."
  448.         return
  449.     }
  450.     if {$droppedForObject != ""} {
  451.         if {[$droppedForObject specLevel] != [$droppedObject specLevel]} {
  452.         wmtkerror "Object can not be moved to an other higher level."
  453.         return
  454.         }
  455.     }
  456.     set newIndex 0
  457.     set oldIndex [$droppedObject index]
  458.     if {$droppedAfterObject != ""} {
  459.         set newIndex [$droppedAfterObject index]
  460.         if {$newIndex < $oldIndex} {
  461.             incr newIndex
  462.         }
  463.     }
  464.     foreach obj [$this objectSet] {
  465.         set objIndex [$obj index]
  466.         if {$objIndex >= $newIndex && $objIndex < $oldIndex} {
  467.             $obj index [expr $objIndex + 1]
  468.         } elseif {$objIndex > $oldIndex && $objIndex <= $newIndex} {
  469.             $obj index [expr $objIndex - 1]
  470.         }
  471.     }
  472.     $droppedObject index $newIndex
  473.     $this sort -command "ModuleEdArea::sort"
  474.     $this isChanged 1
  475. }
  476.  
  477. method ModuleEdArea::save {this} {
  478.     # Check if everything is OK
  479.     set info {}
  480.     set objs {}
  481.     set editablesOnly 1
  482.     if {[$this findAllInvalidObjs objs info $editablesOnly] == 0} {
  483.         $this CustEdArea::save
  484.         return
  485.     }
  486.  
  487.     ClassMaker::extend YesNoWarningDialog SaveWarning {edArea invalidObjs \
  488.         saveAction}
  489.  
  490.     SaveWarning new .main.saveWarning -title "Warning On Save"
  491.     .main.saveWarning delHelpButton
  492.     .main.saveWarning invalidObjs $objs
  493.     .main.saveWarning edArea $this
  494.     .main.saveWarning saveAction ""
  495.     if [isCommand [.main notSaved]] {
  496.         .main.saveWarning saveAction [[.main notSaved] action]
  497.         # cancel the NotSavedDialog action for now
  498.         [.main notSaved] action ""
  499.     }
  500.     set warning "Check detected error(s) in the module specifications.\
  501.         \n\n\Do you want to correct them yourself before saving?"
  502.     .main.saveWarning message $warning
  503.     .main.saveWarning noPressed {
  504.         set invalidObjs [%this invalidObjs]
  505.         while {![lempty $invalidObjs]} {
  506.             foreach obj $invalidObjs {
  507.                 $obj select-state "off"
  508.                 $obj updateView
  509.             }
  510.             # recursive check ...
  511.             set invalidObjs {}
  512.             [%this edArea] findAllInvalidObjs invalidObjs info 1
  513.         }
  514.         
  515.         CustEdArea::save [%this edArea]
  516.         # go on from where we leave the normal procedure
  517.         if {[%this saveAction] != ""} {
  518.             eval [%this saveAction]
  519.         }
  520.     }
  521.     .main.saveWarning popUp
  522. }
  523.  
  524. proc ModuleEdArea::sort {elmA elmB} {
  525.  
  526.     set idxA [$elmA index]
  527.     set idxB [$elmB index]
  528.  
  529.     if {$idxA > $idxB} {
  530.         return 1
  531.     } elseif {$idxB > $idxA} {
  532.         return -1
  533.     } else {
  534.         return 0
  535.     }
  536. }
  537.  
  538. # Do not delete this line -- regeneration end marker
  539.  
  540.