-import "Simantics/DB"\r
-import "Comparator"\r
-import "Map" as Map\r
-include "Simantics/Testing/BuiltinKeys" as BuiltinKeys\r
-import "Simantics/Testing/BrowseContext"\r
-import "Simantics/Ontologies"\r
-\r
-importJava "org.eclipse.jface.action.Action" where\r
- data Action\r
- \r
- @JavaName getText\r
- getActionText :: Action -> <Proc> String\r
- \r
- @JavaName getId\r
- getActionId :: Action -> <Proc> String\r
-\r
-importJava "org.simantics.modeling.ui.actions.ModeledActions" where\r
- """\r
- Comparator for comparing Actions together. Handy for sorting\r
- """\r
- ACTION_COMPARATOR :: Comparator Action\r
-\r
-instance Ord Action where\r
- compare = compareWithComparator ACTION_COMPARATOR\r
-\r
-importJava "org.simantics.browsing.ui.model.actions.IActionCategory" where\r
- """\r
- Interface for storing Actions with ActionCategories\r
- """\r
- data IActionCategory\r
- \r
- @JavaName getLabel\r
- """\r
- Gives the label of the ActionCategory e.g. `New` or `Edit`\r
- """\r
- getIActionCateogryLabel :: IActionCategory -> <Proc> String\r
- \r
- @JavaName getPriority\r
- """\r
- Gives the priority of the current ActionCategory\r
- """\r
- getIActionCategoryPriority :: IActionCategory -> <Proc> Double\r
- \r
- @JavaName isSubmenu\r
- """\r
- Boolean value indicating if the category has submenu or not\r
- """\r
- isIActionCategorySubmenu :: IActionCategory -> <Proc> Boolean\r
-\r
-importJava "org.simantics.browsing.ui.model.actions.ActionBrowseContext" where\r
- """\r
- ActionBrowseContext holds all contributions related to given set of action browse contexts.\r
- """\r
- data ActionBrowseContext\r
- \r
- """\r
- Gets all the actions for the given NodeContext\r
- """\r
- getActions :: ActionBrowseContext -> NodeContext -> [NodeContext] -> <ReadGraph> Map.T IActionCategory [Action]\r
- @private\r
- create :: [Resource] -> <ReadGraph> ActionBrowseContext\r
-\r
-importJava "org.simantics.browsing.ui.model.browsecontexts.BrowseContexts" where\r
- toActionBrowseContextG :: Vector String -> <ReadGraph> ActionBrowseContext\r
-\r
-"""\r
-Creates a new ActionBrowseContext for the given Collection of Resources.\r
-"""\r
-createActionBrowseContext :: [Resource] -> <ReadGraph> ActionBrowseContext\r
-createActionBrowseContext resource = do\r
- create resource\r
-\r
-"""\r
-Test function for browsing whole BrowseContext for all NodeContexts recursively. Also goes through ActionBrowseContexts\r
-"""\r
-browseAllContext :: BrowseContext -> NodeContext -> <Proc> ()\r
-browseAllContext browse node = do\r
- children = syncRead $ \_ -> browseContextChildren browse node\r
- lista = collectionToList children\r
- if length lista > 0\r
- then do\r
- all = browseAllContext browse\r
- map all lista\r
- browseDeepImpl browse node\r
- else browseDeepImpl browse node\r
-\r
-@private\r
-browseDeepImpl :: BrowseContext -> NodeContext -> <Proc> ()\r
-browseDeepImpl browse node = do\r
- labeldecorator = syncRead $ \_ -> browseContextLabelDecorator browse node\r
- stubbi = decorateLabelStub labeldecorator\r
- labels = syncRead $ \_ -> browseContextLabel browse node\r
- Map.iter(\k v -> (stubbi k v)) labels\r
- images = syncRead $ \_ -> browseContextImage browse node\r
- state = syncRead $ \_ -> browseContextCheckedState browse node\r
- imagedecorator = syncRead $ \_ -> browseContextImageDecorator browse node\r
- res = getConstant node BuiltinKeys.INPUT\r
- actioncontext = syncRead $ \_ -> createActionBrowseContext [PROJECT.ProjectActionContext]\r
- actions = syncRead $ \_ -> getActions actioncontext node [node]\r
- Map.iter (\k v -> do\r
- laabel = getIActionCateogryLabel k\r
- prioo = getIActionCategoryPriority k\r
- subm = isIActionCategorySubmenu k\r
- //print (laabel + " " + (show prioo) + " " + (show subm))\r
- iter printActionDetails (sort v)\r
- ) actions\r
- modifier = syncRead $ \_ -> browseContextModifier browse node "single"\r
- match modifier with\r
- Nothing -> ()\r
- Just modif -> do\r
- val = getValue modif\r
- valid = isValid modif val\r
- ()\r
-\r
-@private\r
-printActionDetails :: Action -> <Proc> ()\r
-printActionDetails action = do\r
- teext = getActionText action\r
- iid = getActionId action\r
- //print ("-- " + teext + " (" + iid + ")")\r
- ()\r
-\r
-@private\r
-decorateLabelStub :: LabelDecorator -> String -> String -> <Proc> ()\r
-decorateLabelStub decorator key value = do\r
- fontti = decorateFont decorator getDefaultFontDescriptor key 0\r
- fontti = decorateBackground decorator Nothing key 0\r
- fontti = decorateForeground decorator Nothing key 0\r
- laabeli = decorateLabel decorator value key 0\r
- ()\r
+import "Simantics/DB"
+import "Comparator"
+import "Map" as Map
+include "Simantics/Testing/BuiltinKeys" as BuiltinKeys
+import "Simantics/Testing/BrowseContext"
+import "Simantics/Ontologies"
+
+importJava "org.eclipse.jface.action.Action" where
+ data Action
+
+ @JavaName getText
+ getActionText :: Action -> <Proc> String
+
+ @JavaName getId
+ getActionId :: Action -> <Proc> String
+
+importJava "org.simantics.modeling.ui.actions.ModeledActions" where
+ """
+ Comparator for comparing Actions together. Handy for sorting
+ """
+ ACTION_COMPARATOR :: Comparator Action
+
+instance Ord Action where
+ compare = compareWithComparator ACTION_COMPARATOR
+
+importJava "org.simantics.browsing.ui.model.actions.IActionCategory" where
+ """
+ Interface for storing Actions with ActionCategories
+ """
+ data IActionCategory
+
+ @JavaName getLabel
+ """
+ Gives the label of the ActionCategory e.g. `New` or `Edit`
+ """
+ getIActionCateogryLabel :: IActionCategory -> <Proc> String
+
+ @JavaName getPriority
+ """
+ Gives the priority of the current ActionCategory
+ """
+ getIActionCategoryPriority :: IActionCategory -> <Proc> Double
+
+ @JavaName isSubmenu
+ """
+ Boolean value indicating if the category has submenu or not
+ """
+ isIActionCategorySubmenu :: IActionCategory -> <Proc> Boolean
+
+importJava "org.simantics.browsing.ui.model.actions.ActionBrowseContext" where
+ """
+ ActionBrowseContext holds all contributions related to given set of action browse contexts.
+ """
+ data ActionBrowseContext
+
+ """
+ Gets all the actions for the given NodeContext
+ """
+ getActions :: ActionBrowseContext -> NodeContext -> [NodeContext] -> <ReadGraph> Map.T IActionCategory [Action]
+ @private
+ create :: [Resource] -> <ReadGraph> ActionBrowseContext
+
+importJava "org.simantics.browsing.ui.model.browsecontexts.BrowseContexts" where
+ toActionBrowseContextG :: Vector String -> <ReadGraph> ActionBrowseContext
+
+"""
+Creates a new ActionBrowseContext for the given Collection of Resources.
+"""
+createActionBrowseContext :: [Resource] -> <ReadGraph> ActionBrowseContext
+createActionBrowseContext resource = do
+ create resource
+
+"""
+Test function for browsing whole BrowseContext for all NodeContexts recursively. Also goes through ActionBrowseContexts
+"""
+browseAllContext :: BrowseContext -> NodeContext -> <Proc> ()
+browseAllContext browse node = do
+ children = syncRead $ \_ -> browseContextChildren browse node
+ lista = collectionToList children
+ if length lista > 0
+ then do
+ all = browseAllContext browse
+ map all lista
+ browseDeepImpl browse node
+ else browseDeepImpl browse node
+
+@private
+browseDeepImpl :: BrowseContext -> NodeContext -> <Proc> ()
+browseDeepImpl browse node = do
+ labeldecorator = syncRead $ \_ -> browseContextLabelDecorator browse node
+ stubbi = decorateLabelStub labeldecorator
+ labels = syncRead $ \_ -> browseContextLabel browse node
+ Map.iter(\k v -> (stubbi k v)) labels
+ images = syncRead $ \_ -> browseContextImage browse node
+ state = syncRead $ \_ -> browseContextCheckedState browse node
+ imagedecorator = syncRead $ \_ -> browseContextImageDecorator browse node
+ res = getConstant node BuiltinKeys.INPUT
+ actioncontext = syncRead $ \_ -> createActionBrowseContext [PROJECT.ProjectActionContext]
+ actions = syncRead $ \_ -> getActions actioncontext node [node]
+ Map.iter (\k v -> do
+ laabel = getIActionCateogryLabel k
+ prioo = getIActionCategoryPriority k
+ subm = isIActionCategorySubmenu k
+ //print (laabel + " " + (show prioo) + " " + (show subm))
+ iter printActionDetails (sort v)
+ ) actions
+ modifier = syncRead $ \_ -> browseContextModifier browse node "single"
+ match modifier with
+ Nothing -> ()
+ Just modif -> do
+ val = getValue modif
+ valid = isValid modif val
+ ()
+
+@private
+printActionDetails :: Action -> <Proc> ()
+printActionDetails action = do
+ teext = getActionText action
+ iid = getActionId action
+ //print ("-- " + teext + " (" + iid + ")")
+ ()
+
+@private
+decorateLabelStub :: LabelDecorator -> String -> String -> <Proc> ()
+decorateLabelStub decorator key value = do
+ fontti = decorateFont decorator getDefaultFontDescriptor key 0
+ fontti = decorateBackground decorator Nothing key 0
+ fontti = decorateForeground decorator Nothing key 0
+ laabeli = decorateLabel decorator value key 0
+ ()
Code Review / simantics / platform.git / blobdiff