Pimp playground, re-bind several UI keys

playground.factor

@@ -1,7 +1,11 @@
 ! Set up factor UI and editor integration for this project
 ! Use emacs as the editor and switch UI to dark mode
 ! Run this to start development in the UI
-USING: editors.emacs io.backend kernel threads ui ui.theme.switching vocabs.loader ;
+USING: accessors combinators combinators.short-circuit continuations
+editors.emacs fuel.remote io.backend kernel namespaces sequences syntax threads
+tools.continuations ui ui.commands ui.gadgets.editors ui.gestures
+ui.theme.switching ui.tools ui.tools.browser ui.tools.common ui.tools.listener
+vocabs vocabs.hierarchy vocabs.loader vocabs.metadata vocabs.parser ;
 
 ! Add project's root to vocabulary roots and load all project components
 ! current-directory get
@@ -9,8 +13,53 @@ USING: editors.emacs io.backend kernel threads ui ui.theme.switching vocabs.load
 
 ! Fire up the UI. This gives you graphical code walker support without the need
 ! to open a graphical listener window first.
-IN: scratchpad
+IN: playground
 
 : setup-ui ( dark? -- )
     [ dark-mode ] [ light-mode ] if
     [ [ ] with-ui ] in-thread ;
+
+: ui-commands ( -- )
+    browser-gadget "toolbar" f {
+        { T{ key-down f { C+ } "t" } com-back }
+        { T{ key-down f { C+ } "f" } com-forward }
+        { T{ key-down f { A+ } "H" } com-home }
+        { T{ key-down f f "F1" } browser-help }
+        { T{ key-down f { A+ } "F1" } glossary }
+    } define-command-map
+
+    interactor "interactor" f {
+        { T{ key-down f f "RET" } evaluate-input }
+          { T{ key-down f { C+ } "u" } clear-editor }
+    } define-command-map
+
+    listener-gadget "scrolling"
+    "The listener's scroller can be scrolled from the keyboard."
+    {
+        { T{ key-down f { C+ } "y" } com-scroll-up }
+        { T{ key-down f { C+ } "e" } com-scroll-down }
+        { T{ key-down f { C+ } "b" } com-page-up }
+        { T{ key-down f { C+ } "f" } com-page-down }
+    } define-command-map
+
+    ;
+
+: run ( -- )
+    t setup-ui
+    fuel-start-remote-listener*
+    ui-commands
+    ui-tools-main ;
+
+MAIN: run
+
+: pg-vocabs-to-load ( root prefix -- seq )
+    disk-vocabs-in-root/prefix [ {
+            [ don't-load? ]
+            [ name>> "llvm" = ]
+            [ name>> "llvm.ffi" = ]
+            [ name>> "llvm.reader" = ]
+            [ name>> "llvm.wrappers" = ]
+            [ name>> "llvm.examples.sumfunc" = ]
+    } 1|| ] reject no-prefixes ;
+
+: pg-load-all ( -- ) "" [ vocab-roots get ] dip [ pg-vocabs-to-load require-all ] curry each ;