From f6e8b2391fa7b6dfdd2cf8dd2b8bbe5750c57c70 Mon Sep 17 00:00:00 2001
From: Antti Villberg <antti.villberg@semantum.fi>
Date: Fri, 10 Mar 2017 11:17:28 +0200
Subject: [PATCH] Navigate to substructure

refs #7080

Change-Id: I2b183bf6b2d314577c664c16471c80658ce57450
---
 .../graph/ModelingViewpoint.pgraph            |  3 +++
 .../scl/Simantics/All.scl                     |  1 +
 .../scl/Simantics/UserComponent.scl           | 27 +++++++++++++++++++
 .../scl/Simantics/Workbench.scl               | 21 +++++++++++++++
 4 files changed, 52 insertions(+)
 create mode 100644 bundles/org.simantics.modeling/scl/Simantics/Workbench.scl

diff --git a/bundles/org.simantics.modeling.ontology/graph/ModelingViewpoint.pgraph b/bundles/org.simantics.modeling.ontology/graph/ModelingViewpoint.pgraph
index fa0f29cba..c838c0a36 100644
--- a/bundles/org.simantics.modeling.ontology/graph/ModelingViewpoint.pgraph
+++ b/bundles/org.simantics.modeling.ontology/graph/ModelingViewpoint.pgraph
@@ -636,6 +636,9 @@ ACTIONS.CompilePGraphs : ACT.Action
 ACTIONS.RenameDiagramComponents : ACT.Action
 ACTIONS.Help : ACT.Action
 
+ACTIONS.NavigateToSubstructure
+  @MOD.sclAction "navigateToSubstructureAction"
+
 ACTIONS.NewProceduralComponentType : ACT.Action
 ACTIONS.NewComponentType : ACT.Action
 
diff --git a/bundles/org.simantics.modeling/scl/Simantics/All.scl b/bundles/org.simantics.modeling/scl/Simantics/All.scl
index 0ea045959..02457e67f 100644
--- a/bundles/org.simantics.modeling/scl/Simantics/All.scl
+++ b/bundles/org.simantics.modeling/scl/Simantics/All.scl
@@ -25,6 +25,7 @@ include "Simantics/Query"
 include "Simantics/Datatypes"
 include "Spreadsheet/All"
 include "Simantics/WorkbenchSelection"
+include "Simantics/Workbench"
 include "Simantics/Structural"
 include "SWT/All"
 include "Simantics/UI"
diff --git a/bundles/org.simantics.modeling/scl/Simantics/UserComponent.scl b/bundles/org.simantics.modeling/scl/Simantics/UserComponent.scl
index ecc84dcc6..ad62e1d6a 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
@@ -132,3 +133,29 @@ 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
+                
\ No newline at end of file
diff --git a/bundles/org.simantics.modeling/scl/Simantics/Workbench.scl b/bundles/org.simantics.modeling/scl/Simantics/Workbench.scl
new file mode 100644
index 000000000..25061240f
--- /dev/null
+++ b/bundles/org.simantics.modeling/scl/Simantics/Workbench.scl
@@ -0,0 +1,21 @@
+import "Simantics/DB"
+
+importJava "org.simantics.ui.workbench.editor.EditorAdapter" where
+    data EditorAdapter
+    openEditor :: EditorAdapter -> a -> <Proc> ()
+
+importJava "org.simantics.ui.workbench.editor.EditorRegistry" where
+
+    @private
+    @JavaName getInstance
+    getEditorRegistryInstance :: IEditorRegistry
+
+importJava "org.simantics.ui.workbench.editor.IEditorRegistry" where
+    data IEditorRegistry
+    
+    @private
+    @JavaName getAdaptersFor
+    editorAdapters_ :: IEditorRegistry -> a -> <ReadGraph> Vector EditorAdapter
+
+editorAdapters :: a -> <ReadGraph> [EditorAdapter]
+editorAdapters object = vectorToList $ editorAdapters_ getEditorRegistryInstance object
-- 
2.43.2