bundles/org.simantics.platform.ui.ontology/scl/Simantics/PlatformUI.scl

   1 include "Simantics/All"
   2 include "SWT/All"
   3 import "UI/Progress"
   4 import "Simantics/IssueUI"
   5
   6 useSelectedHandler :: Variable -> (String -> Maybe String) -> <WriteGraph> String
   7 useSelectedHandler input parameters = do
   8   model = represents input
   9   resources = map wseResource $ decodeWSES $ parameters "selection"
  10   for resources $ linkSharedOntology model
  11   ""
  12
  13 unlinkSelectedHandler :: Variable -> (String -> Maybe String) -> <WriteGraph> String
  14 unlinkSelectedHandler input parameters = do
  15   model = represents input
  16   resources = map wseResource $ decodeWSES $ parameters "selection"
  17   unlinkSharedOntologyWithUI input resources
  18   ""
  19
  20 createNewHandler :: Variable -> (String -> Maybe String) -> <WriteGraph> String
  21 createNewHandler input parameters = do
  22   createSharedOntologyWithUI L0.SharedOntology
  23   ""
  24
  25 importHandler :: Variable -> (String -> Maybe String) -> <WriteGraph> String
  26 importHandler input parameters = do
  27   importSharedOntologyWithUI input
  28   ""
  29
  30 fooHandler :: Variable -> CommandContext -> <WriteGraph> Maybe CommandResult
  31 fooHandler self ctx = do
  32   val = fromJust $ possibleString ctx "selected"
  33   setProjectComponentState self "currentSelection" val
  34   Nothing
  35
  36 availableRanges :: Variable -> <ReadGraph> [String]
  37 availableRanges input = do
  38   u = uri input
  39   res = represents input
  40   ranges = objectsWithType res L0.ConsistsOf SHEET.Range
  41   map nameOf ranges
  42
  43 defaultRange :: Variable -> <ReadGraph> String
  44 defaultRange input = do
  45   ranges = availableRanges input
  46   if (length ranges) == 0 then "" else ranges!0
  47
  48 currentRangeName :: Variable -> Variable -> <ReadGraph> String
  49 currentRangeName self input =
  50   projectComponentState self "#currentSelection" (defaultRange input)
  51
  52 currentRangeExpressionVariable :: Variable -> Variable -> <ReadGraph> Variable
  53 currentRangeExpressionVariable self input = do
  54   name = projectComponentState self "./Combo#currentSelection" (defaultRange input)
  55   browse input ("/" + name + "#cells")
  56
  57 currentRangeExpression :: Variable -> Variable -> <ReadGraph> String
  58 currentRangeExpression self input = do
  59   variable = currentRangeExpressionVariable self input
  60   value $ browse variable "#expression"
  61
  62 currentRangeTextAndErrors :: Variable -> Variable -> <ReadGraph> TextAndErrors
  63 currentRangeTextAndErrors self input = do
  64   expression = currentRangeExpression self input
  65   createTextAndErrors expression []
  66
  67 fooHandler2 :: Variable -> CommandContext -> <WriteGraph> Maybe CommandResult
  68 fooHandler2 self ctx = do
  69   val = fromJust $ possibleString ctx "text"
  70   setExpression self val
  71   Nothing
  72
  73 modifyCodeHandler :: Variable -> Variable -> CommandContext -> <WriteGraph> Maybe CommandResult
  74 modifyCodeHandler self input ctx = do
  75   val = fromJust $ possibleString ctx "text"
  76   variable = currentRangeExpressionVariable self input
  77   setExpression variable val
  78   Nothing
  79
  80 standardPropertiesElementTransformation :: Variable -> <ReadGraph> Variable
  81 standardPropertiesElementTransformation var = do
  82   match getPossibleType var with
  83     Nothing -> var
  84     Just resourceType -> if isInheritedFrom resourceType DIA.Element then do
  85         match possibleObject (represents var) MOD.ElementToComponent with
  86           Nothing -> var
  87           Just component -> resourceVariable component
  88       else var
  89
  90 configureButtonClickHandler :: Resource -> CommandContext -> <Proc> Maybe CommandResult
  91 configureButtonClickHandler indexRoot context = do
  92     showIssueConfigurationDialog indexRoot
  93     Nothing
  94
  95 configureButtonClick :: Variable -> <ReadGraph,Proc> AbstractEventHandler
  96 configureButtonClick self = do
  97   indexRoot = represents $ contextVariable self
  98   eventHandler2 $ configureButtonClickHandler indexRoot
  99
 100 validateButtonClickHandler :: Resource -> CommandContext -> <Proc> Maybe CommandResult
 101 validateButtonClickHandler indexRoot context = do
 102     runActiveValidations (createNullProgressMonitor ()) indexRoot
 103     Nothing
 104
 105 validateButtonClick :: Variable -> <ReadGraph,Proc> AbstractEventHandler
 106 validateButtonClick self = do
 107   indexRoot = represents $ contextVariable self
 108   eventHandler2 $ validateButtonClickHandler indexRoot
 109
 110 issueSourceExplorerCheckHandler :: Resource -> CommandContext -> <Proc> Maybe CommandResult
 111 issueSourceExplorerCheckHandler indexRoot context = match possibleValue context "item" with
 112   Nothing -> Nothing
 113   Just issueSource -> match possibleValue context "checked" with
 114     Nothing -> Nothing
 115     Just value -> if value then do
 116         syncWrite $ \_ -> claim issueSource ISSUE.IssueSource.Selected (parent issueSource)
 117         Nothing
 118       else do
 119         syncWrite $ \_ -> denyByPredicate issueSource ISSUE.IssueSource.Selected
 120         Nothing
 121
 122 issueSourceExplorerCheck :: Variable -> <ReadGraph,Proc> AbstractEventHandler
 123 issueSourceExplorerCheck self = do
 124   indexRoot = represents $ contextVariable self
 125   eventHandler2 $ issueSourceExplorerCheckHandler indexRoot
 126
 127 usedIssueSources :: Resource -> <ReadGraph> [Resource]
 128 usedIssueSources indexRoot = do
 129    objectsWithType indexRoot L0.ConsistsOf ISSUE.IssueSource
 130
 131 checkedStateRule :: BrowseNodeRule CheckedState
 132 checkedStateRule (ResourceX r) = if existsStatement3 r ISSUE.IssueSource.Selected (parent r) then CHECKED else NOT_CHECKED
 133