X-Git-Url: https://gerrit.simantics.org/r/gitweb?a=blobdiff_plain;f=bundles%2Forg.simantics.modeling.ui%2Fscl%2FSimantics%2FTesting%2FActionBrowseContext.scl;fp=bundles%2Forg.simantics.modeling.ui%2Fscl%2FSimantics%2FTesting%2FActionBrowseContext.scl;h=ecacf009097034cbc6dd9c43bdc40d4df0aa5a00;hb=0ae2b770234dfc3cbb18bd38f324125cf0faca07;hp=510603d5194be82c216e2cee440dfe535ab3111a;hpb=24e2b34260f219f0d1644ca7a138894980e25b14;p=simantics%2Fplatform.git diff --git a/bundles/org.simantics.modeling.ui/scl/Simantics/Testing/ActionBrowseContext.scl b/bundles/org.simantics.modeling.ui/scl/Simantics/Testing/ActionBrowseContext.scl index 510603d51..ecacf0090 100644 --- a/bundles/org.simantics.modeling.ui/scl/Simantics/Testing/ActionBrowseContext.scl +++ b/bundles/org.simantics.modeling.ui/scl/Simantics/Testing/ActionBrowseContext.scl @@ -1,130 +1,130 @@ -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 -> String - - @JavaName getId - getActionId :: Action -> 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 -> String - - @JavaName getPriority - """ - Gives the priority of the current ActionCategory - """ - getIActionCategoryPriority :: IActionCategory -> Double - - @JavaName isSubmenu - """ - Boolean value indicating if the category has submenu or not - """ - isIActionCategorySubmenu :: IActionCategory -> 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] -> Map.T IActionCategory [Action] - @private - create :: [Resource] -> ActionBrowseContext - -importJava "org.simantics.browsing.ui.model.browsecontexts.BrowseContexts" where - toActionBrowseContextG :: Vector String -> ActionBrowseContext - -""" -Creates a new ActionBrowseContext for the given Collection of Resources. -""" -createActionBrowseContext :: [Resource] -> ActionBrowseContext -createActionBrowseContext resource = do - create resource - -""" -Test function for browsing whole BrowseContext for all NodeContexts recursively. Also goes through ActionBrowseContexts -""" -browseAllContext :: BrowseContext -> NodeContext -> () -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 -> () -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 -> () -printActionDetails action = do - teext = getActionText action - iid = getActionId action - //print ("-- " + teext + " (" + iid + ")") - () - -@private -decorateLabelStub :: LabelDecorator -> String -> String -> () -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 - () +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 -> String + + @JavaName getId + getActionId :: Action -> 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 -> String + + @JavaName getPriority + """ + Gives the priority of the current ActionCategory + """ + getIActionCategoryPriority :: IActionCategory -> Double + + @JavaName isSubmenu + """ + Boolean value indicating if the category has submenu or not + """ + isIActionCategorySubmenu :: IActionCategory -> 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] -> Map.T IActionCategory [Action] + @private + create :: [Resource] -> ActionBrowseContext + +importJava "org.simantics.browsing.ui.model.browsecontexts.BrowseContexts" where + toActionBrowseContextG :: Vector String -> ActionBrowseContext + +""" +Creates a new ActionBrowseContext for the given Collection of Resources. +""" +createActionBrowseContext :: [Resource] -> ActionBrowseContext +createActionBrowseContext resource = do + create resource + +""" +Test function for browsing whole BrowseContext for all NodeContexts recursively. Also goes through ActionBrowseContexts +""" +browseAllContext :: BrowseContext -> NodeContext -> () +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 -> () +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 -> () +printActionDetails action = do + teext = getActionText action + iid = getActionId action + //print ("-- " + teext + " (" + iid + ")") + () + +@private +decorateLabelStub :: LabelDecorator -> String -> String -> () +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 + ()