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