X-Git-Url: https://gerrit.simantics.org/r/gitweb?a=blobdiff_plain;f=bundles%2Forg.simantics.platform.ui.ontology%2Fscl%2FSimantics%2FPlatformUI.scl;fp=bundles%2Forg.simantics.platform.ui.ontology%2Fscl%2FSimantics%2FPlatformUI.scl;h=07309cb7b2876ea7a233439edea2e57d00e5c0d9;hb=920856257841273193c640607e735f5adf09031d;hp=0000000000000000000000000000000000000000;hpb=0c70b45a35685e50a219dbd4946a2d3caa332f8e;p=simantics%2Fplatform.git

diff --git a/bundles/org.simantics.platform.ui.ontology/scl/Simantics/PlatformUI.scl b/bundles/org.simantics.platform.ui.ontology/scl/Simantics/PlatformUI.scl
new file mode 100644
index 000000000..07309cb7b
--- /dev/null
+++ b/bundles/org.simantics.platform.ui.ontology/scl/Simantics/PlatformUI.scl
@@ -0,0 +1,145 @@
+/*******************************************************************************
+ * Copyright (c) 2019 Association for Decentralized Information Management
+ * in Industry THTH ry.
+ * All rights reserved. This program and the accompanying materials
+ * are made available under the terms of the Eclipse Public License v1.0
+ * which accompanies this distribution, and is available at
+ * http://www.eclipse.org/legal/epl-v10.html
+ *
+ * Contributors:
+ *     VTT Technical Research Centre of Finland - initial API and implementation
+ *     Semantum Oy - reorganization
+ *******************************************************************************/
+include "Simantics/All"
+include "SWT/All"
+import "UI/Progress"
+import "Simantics/IssueUI"
+
+useSelectedHandler :: Variable -> (String -> Maybe String) -> <WriteGraph> String
+useSelectedHandler input parameters = do
+  model = represents input
+  resources = map wseResource $ decodeWSES $ parameters "selection"
+  for resources $ linkSharedOntology model
+  ""
+
+unlinkSelectedHandler :: Variable -> (String -> Maybe String) -> <WriteGraph> String
+unlinkSelectedHandler input parameters = do
+  model = represents input
+  resources = map wseResource $ decodeWSES $ parameters "selection"
+  unlinkSharedOntologyWithUI input resources
+  ""
+
+createNewHandler :: Variable -> (String -> Maybe String) -> <WriteGraph> String
+createNewHandler input parameters = do
+  createSharedOntologyWithUI L0.SharedOntology
+  ""
+
+importHandler :: Variable -> (String -> Maybe String) -> <WriteGraph> String
+importHandler input parameters = do
+  importSharedOntologyWithUI input
+  ""
+
+fooHandler :: Variable -> CommandContext -> <WriteGraph> Maybe CommandResult
+fooHandler self ctx = do
+  val = fromJust $ possibleString ctx "selected"
+  setProjectComponentState self "currentSelection" val
+  Nothing
+  
+availableRanges :: Variable -> <ReadGraph> [String]
+availableRanges input = do
+  u = uri input
+  res = represents input
+  ranges = objectsWithType res L0.ConsistsOf SHEET.Range
+  map nameOf ranges
+  
+defaultRange :: Variable -> <ReadGraph> String
+defaultRange input = do
+  ranges = availableRanges input
+  if (length ranges) == 0 then "" else ranges!0
+
+currentRangeName :: Variable -> Variable -> <ReadGraph> String
+currentRangeName self input = 
+  projectComponentState self "#currentSelection" (defaultRange input)
+
+currentRangeExpressionVariable :: Variable -> Variable -> <ReadGraph> Variable
+currentRangeExpressionVariable self input = do
+  name = projectComponentState self "./Combo#currentSelection" (defaultRange input)
+  browse input ("/" + name + "#cells")
+
+currentRangeExpression :: Variable -> Variable -> <ReadGraph> String
+currentRangeExpression self input = do
+  variable = currentRangeExpressionVariable self input
+  value $ browse variable "#expression"
+
+currentRangeTextAndErrors :: Variable -> Variable -> <ReadGraph> TextAndErrors
+currentRangeTextAndErrors self input = do
+  expression = currentRangeExpression self input
+  createTextAndErrors expression []
+
+fooHandler2 :: Variable -> CommandContext -> <WriteGraph> Maybe CommandResult
+fooHandler2 self ctx = do
+  val = fromJust $ possibleString ctx "text"
+  setExpression self val
+  Nothing
+
+modifyCodeHandler :: Variable -> Variable -> CommandContext -> <WriteGraph> Maybe CommandResult
+modifyCodeHandler self input ctx = do
+  val = fromJust $ possibleString ctx "text"
+  variable = currentRangeExpressionVariable self input
+  setExpression variable val
+  Nothing
+
+standardPropertiesElementTransformation :: Variable -> <ReadGraph> Variable
+standardPropertiesElementTransformation var = do
+  match getPossibleType var with
+    Nothing -> var
+    Just resourceType -> if isInheritedFrom resourceType DIA.Element then do
+        match possibleObject (represents var) MOD.ElementToComponent with
+          Nothing -> var
+          Just component -> resourceVariable component
+      else var
+
+configureButtonClickHandler :: Resource -> CommandContext -> <Proc> Maybe CommandResult
+configureButtonClickHandler indexRoot context = do
+    showIssueConfigurationDialog indexRoot 
+    Nothing
+      
+configureButtonClick :: Variable -> <ReadGraph,Proc> AbstractEventHandler
+configureButtonClick self = do
+  indexRoot = represents $ contextVariable self
+  eventHandler2 $ configureButtonClickHandler indexRoot
+
+validateButtonClickHandler :: Resource -> CommandContext -> <Proc> Maybe CommandResult
+validateButtonClickHandler indexRoot context = do
+    runActiveValidations (createNullProgressMonitor ()) indexRoot
+    Nothing
+
+validateButtonClick :: Variable -> <ReadGraph,Proc> AbstractEventHandler
+validateButtonClick self = do
+  indexRoot = represents $ contextVariable self
+  eventHandler2 $ validateButtonClickHandler indexRoot
+
+issueSourceExplorerCheckHandler :: Resource -> CommandContext -> <Proc> Maybe CommandResult
+issueSourceExplorerCheckHandler indexRoot context = match possibleValue context "item" with
+  Nothing -> Nothing
+  Just issueSource -> match possibleValue context "checked" with
+    Nothing -> Nothing
+    Just value -> if value then do
+        syncWrite $ \_ -> claim issueSource ISSUE.IssueSource.Selected (parent issueSource)
+        Nothing
+      else do
+        syncWrite $ \_ -> denyByPredicate issueSource ISSUE.IssueSource.Selected
+        Nothing  
+
+issueSourceExplorerCheck :: Variable -> <ReadGraph,Proc> AbstractEventHandler
+issueSourceExplorerCheck self = do
+  indexRoot = represents $ contextVariable self
+  eventHandler2 $ issueSourceExplorerCheckHandler indexRoot
+
+usedIssueSources :: Resource -> <ReadGraph> [Resource]
+usedIssueSources indexRoot = do
+   objectsWithType indexRoot L0.ConsistsOf ISSUE.IssueSource
+
+checkedStateRule :: BrowseNodeRule CheckedState
+checkedStateRule (ResourceX r) = if existsStatement3 r ISSUE.IssueSource.Selected (parent r) then CHECKED else NOT_CHECKED
+      
\ No newline at end of file