From: Antti Villberg Date: Fri, 10 Mar 2017 09:17:28 +0000 (+0200) Subject: Navigate to substructure X-Git-Tag: v1.28.0~60 X-Git-Url: https://gerrit.simantics.org/r/gitweb?a=commitdiff_plain;h=f6e8b2391fa7b6dfdd2cf8dd2b8bbe5750c57c70;p=simantics%2Fplatform.git Navigate to substructure refs #7080 Change-Id: I2b183bf6b2d314577c664c16471c80658ce57450 --- 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 -> 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 -> 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 -> () +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 -> () + +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 -> Vector EditorAdapter + +editorAdapters :: a -> [EditorAdapter] +editorAdapters object = vectorToList $ editorAdapters_ getEditorRegistryInstance object