X-Git-Url: https://gerrit.simantics.org/r/gitweb?a=blobdiff_plain;f=bundles%2Forg.simantics.modeling%2Fscl%2FSimantics%2FUserComponent.scl;h=d79db922229d5c9c2bfa114d0f27c41e9f471d3f;hb=64e7d67f61e5cd5916760727eecab48c314d657c;hp=a4c834b4fad74d0c78a080efa071744df1095c17;hpb=0ae2b770234dfc3cbb18bd38f324125cf0faca07;p=simantics%2Fplatform.git

diff --git a/bundles/org.simantics.modeling/scl/Simantics/UserComponent.scl b/bundles/org.simantics.modeling/scl/Simantics/UserComponent.scl
index a4c834b4f..d79db9222 100644
--- a/bundles/org.simantics.modeling/scl/Simantics/UserComponent.scl
+++ b/bundles/org.simantics.modeling/scl/Simantics/UserComponent.scl
@@ -1,6 +1,7 @@
 include "Simantics/Model"
 import "Simantics/Diagram"
 import "Simantics/Flag"
+import "Simantics/Workbench"
 include "Simantics/Ontologies"
 
 type UserComponent = Resource
@@ -13,7 +14,7 @@ importJava "org.simantics.modeling.NewComponentType" where
     
 configurationOfComponentType :: UserComponent -> <ReadGraph> Resource
 configurationOfComponentType component = do
-      config = singleObject (toResource component) STR.IsDefinedBy 
+      config = singleObject component STR.IsDefinedBy 
       config
       
 importJava "org.simantics.modeling.flags.LiftFlag" where
@@ -21,19 +22,18 @@ importJava "org.simantics.modeling.flags.LiftFlag" where
     
 flagToTerminal :: Flag -> <WriteGraph> Resource
 flagToTerminal flag = do
-    result = liftFlag (toResource flag)
+    result = liftFlag flag
     if result == Nothing
-    then singleObject (toResource flag) DIA.IsLiftedAs
-    else do
-        show result
-        (toResource flag)
-    
+    then singleObject flag DIA.IsLiftedAs
+    else flag
+
+@deprecated "Calling this function is unnecessary."  
 configToDiagram :: Resource -> Diagram
-configToDiagram config = do
-    fromResource config
+configToDiagram config = config
 
 populateTerminalToSymbol :: Resource  -> (Double, Double) -> <WriteGraph> Element
-populateTerminalToSymbol terminal (x, y) = do
+populateTerminalToSymbol terminal (x, y) = element
+  where
     uc = singleObject terminal L0.PartOf
     symbol = singleObject uc MOD.ComponentTypeToSymbol
     diagram = singleObject symbol STR.IsDefinedBy
@@ -59,7 +59,7 @@ populateTerminalToSymbol terminal (x, y) = do
         (toDoubleArray [1,0,0,1,x,y])
     addToGraph diagram terminal element
     addCommentMetadata ("Populated terminal " + (show element) + " to user component " + (show uc))
-    (fromResource element)
+    
 
 importJava "org.simantics.modeling.symbolEditor.PopulateTerminal" where
     addToGraph :: Resource -> Resource -> Resource -> <WriteGraph> ()
@@ -133,3 +133,32 @@ addUserComponentScript userComponent scriptName scriptType scriptCode = do
     claimRelatedValue script L0.HasName scriptName
     claimRelatedValue script STR.ComponentTypeScript.type scriptType 
     claimRelatedValue script STR.ComponentTypeScript.code scriptCode 
+
+@private
+possibleSubstructure :: Resource -> <ReadGraph> Maybe Resource
+possibleSubstructure element = do
+     match possibleObject element MOD.ElementToComponent with
+       Nothing -> Nothing
+       Just component -> match possibleTypeOf component STR.Component with
+         Nothing -> Nothing
+         Just componentType -> match possibleObject componentType STR.IsDefinedBy with
+           Nothing -> Nothing
+           Just configuration -> Just configuration
+
+@private
+possibleSubstructureEditor :: Resource -> <ReadGraph,Proc> Maybe (Resource,EditorAdapter)
+possibleSubstructureEditor element = match possibleSubstructure element with
+  Nothing -> Nothing
+  Just configuration -> do
+    adapters = editorAdapters configuration
+    if(length adapters > 0) then Just (configuration, adapters!0) else Nothing
+
+navigateToSubstructureAction :: Resource -> <Proc> ()
+navigateToSubstructureAction element = do
+ match (syncRead (\x -> possibleSubstructureEditor element)) with
+   Nothing -> ()
+   Just (configuration,editor) -> openEditor editor configuration
+
+importJava "org.simantics.modeling.MigrateModel" where
+    "changeAllComponentTypes model oldComponentType newComponentType"
+    changeAllComponentTypes :: Resource -> Resource -> Resource -> <WriteGraph> ()