bundles/org.simantics.modeling.ui/scl/Simantics/Testing/ActionBrowseContext.scl

   1 import "Simantics/DB"
   2 import "Comparator"
   3 import "Map" as Map
   4 include "Simantics/Testing/BuiltinKeys" as BuiltinKeys
   5 import "Simantics/Testing/BrowseContext"
   6 import "Simantics/Ontologies"
   7
   8 importJava "org.eclipse.jface.action.Action" where
   9     data Action
  10
  11     @JavaName getText
  12     getActionText :: Action -> <Proc> String
  13
  14     @JavaName getId
  15     getActionId :: Action -> <Proc> String
  16
  17 importJava "org.simantics.modeling.ui.actions.ModeledActions" where
  18     """
  19     Comparator for comparing Actions together. Handy for sorting
  20     """
  21     ACTION_COMPARATOR :: Comparator Action
  22
  23 instance Ord Action where
  24     compare = compareWithComparator ACTION_COMPARATOR
  25
  26 importJava "org.simantics.browsing.ui.model.actions.IActionCategory" where
  27     """
  28     Interface for storing Actions with ActionCategories
  29     """
  30     data IActionCategory
  31
  32     @JavaName getLabel
  33     """
  34     Gives the label of the ActionCategory e.g. `New` or `Edit`
  35     """
  36     getIActionCateogryLabel :: IActionCategory -> <Proc> String
  37
  38     @JavaName getPriority
  39     """
  40     Gives the priority of the current ActionCategory
  41     """
  42     getIActionCategoryPriority :: IActionCategory -> <Proc> Double
  43
  44     @JavaName isSubmenu
  45     """
  46     Boolean value indicating if the category has submenu or not
  47     """
  48     isIActionCategorySubmenu :: IActionCategory -> <Proc> Boolean
  49
  50 importJava "org.simantics.browsing.ui.model.actions.ActionBrowseContext" where
  51     """
  52     ActionBrowseContext holds all contributions related to given set of action browse contexts.
  53     """
  54     data ActionBrowseContext
  55
  56     """
  57     Gets all the actions for the given NodeContext
  58     """
  59     getActions :: ActionBrowseContext -> NodeContext -> [NodeContext] -> <ReadGraph> Map.T IActionCategory [Action]
  60     @private
  61     create :: [Resource] -> <ReadGraph> ActionBrowseContext
  62
  63 importJava "org.simantics.browsing.ui.model.browsecontexts.BrowseContexts" where
  64     toActionBrowseContextG :: Vector String -> <ReadGraph> ActionBrowseContext
  65
  66 """
  67 Creates a new ActionBrowseContext for the given Collection of Resources.
  68 """
  69 createActionBrowseContext :: [Resource] -> <ReadGraph> ActionBrowseContext
  70 createActionBrowseContext resource = do
  71     create resource
  72
  73 """
  74 Test function for browsing whole BrowseContext for all NodeContexts recursively. Also goes through ActionBrowseContexts
  75 """
  76 browseAllContext :: BrowseContext -> NodeContext -> <Proc> ()
  77 browseAllContext browse node = do
  78     children = syncRead $ \_ -> browseContextChildren browse node
  79     lista = collectionToList children
  80     if length lista > 0
  81     then do
  82         all = browseAllContext browse
  83         map all lista
  84         browseDeepImpl browse node
  85     else browseDeepImpl browse node
  86
  87 @private
  88 browseDeepImpl :: BrowseContext -> NodeContext -> <Proc> ()
  89 browseDeepImpl browse node = do
  90     labeldecorator = syncRead $ \_ -> browseContextLabelDecorator browse node
  91     stubbi = decorateLabelStub labeldecorator
  92     labels = syncRead $ \_ -> browseContextLabel  browse node
  93     Map.iter(\k v -> (stubbi k v)) labels
  94     images = syncRead $ \_ -> browseContextImage browse node
  95     state = syncRead $ \_ -> browseContextCheckedState browse node
  96     imagedecorator = syncRead $ \_ -> browseContextImageDecorator browse node
  97     res = getConstant node BuiltinKeys.INPUT
  98     actioncontext = syncRead $ \_ -> createActionBrowseContext [PROJECT.ProjectActionContext]
  99     actions = syncRead $ \_ -> getActions actioncontext node [node]
 100     Map.iter (\k v -> do
 101         laabel = getIActionCateogryLabel k
 102         prioo = getIActionCategoryPriority k
 103         subm = isIActionCategorySubmenu k
 104         //print (laabel + " " + (show prioo) + " " + (show subm))
 105         iter printActionDetails (sort v)
 106     ) actions
 107     modifier = syncRead $ \_ -> browseContextModifier browse node "single"
 108     match modifier with
 109         Nothing -> ()
 110         Just modif -> do
 111             val = getValue modif
 112             valid = isValid modif val
 113             ()
 114
 115 @private
 116 printActionDetails :: Action -> <Proc> ()
 117 printActionDetails action = do
 118     teext = getActionText action
 119     iid = getActionId action
 120     //print ("-- " + teext + " (" + iid + ")")
 121     ()
 122
 123 @private
 124 decorateLabelStub :: LabelDecorator -> String -> String -> <Proc> ()
 125 decorateLabelStub decorator key value = do
 126     fontti = match decorateFont decorator (Just getDefaultFontDescriptor) key 0 with
 127       Nothing -> ""
 128       Just font -> ""
 129     fontti = decorateBackground decorator Nothing key 0
 130     fontti = decorateForeground decorator Nothing key 0
 131     laabeli = decorateLabel decorator value key 0
 132     ()