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

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