UI tool improvements

library/ui/load.factor

@@ -36,6 +36,7 @@ PROVIDE: library/ui {
     "text/interactor.factor"
     "gadgets/presentations.factor"
     "ui.factor"
+    "tools/tools.factor"
     "tools/listener.factor"
     "tools/walker.factor"
     "tools/search.factor"
@@ -43,6 +44,7 @@ PROVIDE: library/ui {
     "tools/help.factor"
     "tools/dataflow.factor"
     "tools/workspace.factor"
+    "tools/operations.factor"
 } {
     "test/models.factor"
     "test/document.factor"

library/ui/tools/browser.factor

@@ -4,7 +4,8 @@ USING: arrays sequences kernel gadgets-panes definitions
 prettyprint gadgets-theme gadgets-borders gadgets
 generic gadgets-scrolling math io words models styles
 namespaces gadgets-tracks gadgets-presentations gadgets-grids
-gadgets-frames help gadgets-buttons gadgets-search tools ;
+gadgets-workspace gadgets-frames help gadgets-buttons
+gadgets-search tools ;
 IN: gadgets-browser
 
 TUPLE: browser navigator definitions search ;
@@ -104,3 +105,10 @@ browser {
         { "Clear" T{ key-down f f "CLEAR" } [ clear-browser ] }
     }
 } define-commands
+
+M: browser call-tool*
+    over vocab-link? [
+        >r vocab-link-name r> show-vocab
+    ] [
+        show-word
+    ] if ;

library/ui/tools/dataflow.factor

@@ -5,7 +5,7 @@ USING: namespaces arrays sequences io inference math kernel
 generic prettyprint words gadgets opengl gadgets-panes
 gadgets-labels gadgets-theme gadgets-presentations
 gadgets-buttons gadgets-borders gadgets-scrolling
-gadgets-frames optimizer models ;
+gadgets-frames gadgets-workspace optimizer models ;
 
 : shuffle-in dup shuffle-in-d swap shuffle-in-r append ;
 
@@ -111,35 +111,30 @@ M: object node>gadget
     { 5 5 } over set-pack-gap
     swap <node-gadget> dup faint-boundary ;
 
+: (compute-heights) ( node -- )
+    [
+        [ node-d-height ] keep
+        [ node-r-height ] keep
+        [ 3array , ] keep
+        node-successor (compute-heights)
+    ] when* ;
+
 : node-in-d# node-in-d length ;
 : node-out-d# node-out-d length ;
 
 : node-in-r# node-in-r length ;
 : node-out-r# node-out-r length ;
 
-SYMBOL: d-height
-SYMBOL: r-height
-
-: (compute-heights) ( node -- )
-    [
-        dup node-in-d# d-height [ swap - ] change
-        dup node-in-r# r-height [ swap - ] change
-        d-height get r-height get pick 3array ,
-        dup node-out-d# d-height [ + ] change
-        dup node-out-r# r-height [ + ] change
-        node-successor (compute-heights)
-    ] when* ;
-
 : normalize-d-height ( seq -- seq )
-    [ [ first ] map infimum ] keep
+    [ [ dup first swap third node-in-d# - ] map infimum ] keep
     [ first3 >r >r swap - r> r> 3array ] map-with ;
 
 : normalize-r-height ( seq -- seq )
-    [ [ second ] map infimum ] keep
+    [ [ dup second swap third node-in-r# - ] map infimum ] keep
     [ first3 >r rot - r> 3array ] map-with ;
 
 : compute-heights ( nodes -- pairs )
-    [ 0 d-height set 0 r-height set (compute-heights) ] { } make
+    [ (compute-heights) ] { } make
     normalize-d-height normalize-r-height ;
 
 : node-r-skew-1 ( node -- n )
@@ -149,17 +144,18 @@ SYMBOL: r-height
     dup node-in-d# over node-out-r# [-] swap node-out-d# [-] ;
 
 SYMBOL: prev-node 
+
 : node-r-skew ( node -- n )
     node-r-skew-1 prev-node get [ node-r-skew-2 - ] when* ;
 
 : print-node ( d-height r-height node -- )
     [
         [
-            pick over node-in-d# + 0 <height-gadget> ,
+            pick 0 <height-gadget> ,
             2dup node-in-r# + over node-r-skew <height-gadget> ,
         ] { } make make-pile ,
         [
-            rot 0 <height-gadget> ,
+            rot over node-in-d# - 0 <height-gadget> ,
             node>gadget ,
             0 <height-gadget> ,
         ] { } make make-pile 1 over set-pack-fill ,
@@ -190,3 +186,12 @@ C: dataflow-gadget ( -- gadget )
     f <history> over set-dataflow-gadget-history {
         { [ <dataflow-pane> ] f [ <scroller> ] @center }
     } make-frame* ;
+
+M: dataflow-gadget call-tool* ( node dataflow -- )
+    dup dataflow-gadget-history add-history
+    dataflow-gadget-history set-model ;
+
+IN: tools
+
+: show-dataflow ( quot -- )
+    dataflow optimize dataflow-gadget call-tool ;

library/ui/tools/help.factor

@@ -3,7 +3,7 @@
 IN: gadgets-help
 USING: gadgets gadgets-borders gadgets-buttons gadgets-frames
 gadgets-panes gadgets-search gadgets-scrolling help kernel
-models namespaces sequences gadgets-tracks ;
+models namespaces sequences gadgets-tracks gadgets-workspace ;
 
 TUPLE: help-gadget history search ;
 
@@ -36,3 +36,5 @@ C: help-gadget ( -- gadget )
     } { 0 1 } make-track* ;
 
 M: help-gadget focusable-child* help-gadget-search ;
+
+M: help-gadget call-tool* show-help ;

library/ui/tools/listener.factor

@@ -3,9 +3,9 @@
 IN: gadgets-listener
 USING: arrays gadgets gadgets-frames gadgets-labels
 gadgets-panes gadgets-scrolling gadgets-text gadgets-theme
-gadgets-tracks generic hashtables tools io
+gadgets-tracks gadgets-workspace generic hashtables tools io
 kernel listener math models namespaces parser prettyprint
-sequences shells styles threads words memory ;
+sequences shells strings styles threads words memory ;
 
 TUPLE: listener-gadget input output stack ;
 
@@ -63,3 +63,25 @@ M: listener-gadget focusable-child*
 
 : clear-output ( -- )
     stdio get duplex-stream-out pane-clear ;
+
+G: call-listener ( quot/string listener -- )
+    1 standard-combination ;
+
+M: quotation call-listener
+    listener-gadget-input interactor-call ;
+
+M: string call-listener
+    listener-gadget-input set-editor-text ;
+
+M: input call-listener
+    >r input-string r> call-listener ;
+
+M: listener-gadget call-tool* ( quot/string listener -- )
+    call-listener ;
+
+: listener-run-files ( seq -- )
+    dup empty? [
+        drop
+    ] [
+        [ [ run-file ] each ] curry listener-gadget call-tool
+    ] if ;

library/ui/tools/operations.factor

@@ -0,0 +1,230 @@
+! Copyright (C) 2006 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+IN: gadgets-workspace
+USING: definitions gadgets gadgets-browser gadgets-dataflow
+gadgets-help gadgets-listener gadgets-text gadgets-workspace
+hashtables help inference kernel namespaces parser prettyprint
+scratchpad sequences strings styles syntax test tools words
+generic ;
+
+V{ } clone operations set-global
+
+: define-operation ( class props -- )
+    <operation> operations get push-new ;
+
+M: operation invoke-command ( target operation -- )
+    dup command-quot swap operation-listener?
+    [ curry listener-gadget call-tool ] [ call ] if ;
+
+: modify-operation ( quot operation -- operation )
+    clone
+    [ command-quot append ] keep
+    [ set-command-quot ] keep ;
+
+: modify-operations ( quot operations -- operations )
+    [ modify-operation ] map-with ;
+
+: modify-listener-operation ( quot operation -- operation )
+    clone t over set-operation-listener?
+    modify-operation ;
+
+: modify-listener-operations ( quot operations -- operations )
+    [ modify-listener-operation ] map-with ;
+
+! Objects
+[ drop t ] H{
+    { +button+ 1 }
+    { +name+ "Inspect" }
+    { +quot+ [ inspect ] }
+    { +listener+ t }
+} define-operation
+
+! Input
+[ input? ] H{
+    { +button+ 1 }
+    { +name+ "Input" }
+    { +quot+ [ listener-gadget call-tool ] }
+} define-operation
+
+! Words
+[ word? ] H{
+    { +button+ 1 }
+    { +group+ "Words" }
+    { +name+ "Browse" }
+    { +gesture+ T{ key-down f { A+ } "b" } }
+    { +quot+ [ browser call-tool ] }
+} define-operation
+
+[ word? ] H{
+    { +button+ 2 }
+    { +group+ "Words" }
+    { +name+ "Edit" }
+    { +gesture+ T{ key-down f { A+ } "e" } }
+    { +quot+ [ edit ] }
+} define-operation
+
+[ word? ] H{
+    { +button+ 3 }
+    { +group+ "Words" }
+    { +name+ "Documentation" }
+    { +gesture+ T{ key-down f { A+ } "h" } }
+    { +quot+ [ help-gadget call-tool ] }
+} define-operation
+
+[ word? ] H{
+    { +group+ "Words" }
+    { +name+ "Usage" }
+    { +gesture+ T{ key-down f { A+ } "u" } }
+    { +quot+ [ usage. ] }
+    { +listener+ t }
+} define-operation
+
+[ word? ] H{
+    { +group+ "Words" }
+    { +name+ "Reload" }
+    { +gesture+ T{ key-down f { A+ } "r" } }
+    { +quot+ [ reload ] }
+    { +listener+ t }
+} define-operation
+
+[ word? ] H{
+    { +group+ "Words" }
+    { +name+ "Watch" }
+    { +quot+ [ watch ] }
+    { +listener+ t }
+} define-operation
+
+! Vocabularies
+[ vocab-link? ] H{
+    { +button+ 1 }
+    { +name+ "Browse" }
+    { +quot+ [ browser call-tool ] }
+} define-operation
+
+! Link
+[ link? ] H{
+    { +button+ 1 }
+    { +name+ "Follow" }
+    { +quot+ [ help-gadget call-tool ] }
+} define-operation
+
+[ link? ] H{
+    { +button+ 2 }
+    { +name+ "Edit" }
+    { +quot+ [ edit ] }
+} define-operation
+
+[ word-link? ] H{
+    { +button+ 3 }
+    { +name+ "Definition" }
+    { +quot+ [ link-name browser call-tool ] }
+} define-operation
+
+! Strings
+[ string? ] H{
+    { +group+ "Words" }
+    { +name+ "Apropos (all)" }
+    { +gesture+ T{ key-down f { A+ } "a" } }
+    { +quot+ [ apropos ] }
+    { +listener+ t }
+} define-operation
+
+: usable-words ( -- seq )
+    [
+        use get [ hash-values [ dup set ] each ] each
+    ] make-hash hash-values natural-sort ;
+
+[ string? ] H{
+    { +group+ "Words" }
+    { +name+ "Apropos (used)" }
+    { +gesture+ T{ key-down f f "TAB" } }
+    { +quot+ [ usable-words (apropos) ] }
+    { +listener+ t }
+} define-operation
+
+! Quotations
+[ quotation? ] H{
+    { +group+ "Quotations" }
+    { +name+ "Infer" }
+    { +gesture+ T{ key-down f { C+ A+ } "i" } }
+    { +quot+ [ infer . ] }
+    { +listener+ t }
+} define-operation
+
+[ quotation? ] H{
+    { +group+ "Quotations" }
+    { +name+ "Dataflow" }
+    { +gesture+ T{ key-down f { C+ A+ } "d" } }
+    { +quot+ [ show-dataflow ] }
+    { +listener+ t }
+} define-operation
+
+[ quotation? ] H{
+    { +group+ "Quotations" }
+    { +name+ "Walk" }
+    { +gesture+ T{ key-down f { C+ A+ } "w" } }
+    { +quot+ [ walk ] }
+    { +listener+ t }
+} define-operation
+
+[ quotation? ] H{
+    { +group+ "Quotations" }
+    { +name+ "Time" }
+    { +gesture+ T{ key-down f { C+ A+ } "t" } }
+    { +quot+ [ time ] }
+    { +listener+ t }
+} define-operation
+
+! Dataflow nodes
+[ word? ] H{
+    { +group+ "Words" }
+    { +name+ "Word dataflow" }
+    { +quot+ [ word-def dataflow-gadget call-tool ] }
+} define-operation
+
+[ [ node? ] is? ] H{
+    { +button+ 1 }
+    { +group+ "Nodes" }
+    { +name+ "Quotation dataflow" }
+    { +quot+ [ dataflow-gadget call-tool ] }
+} define-operation
+
+! Define commands in terms of operations
+
+! Tile commands
+tile
+[ tile-definition ] \ word class-operations modify-operations
+[ command-name "Browse" = not ] subset
+T{ command f f "Close" f [ close-tile ] } add*
+define-commands*
+
+! Interactor commands
+: selected-word ( editor -- string )
+    dup gadget-selection?
+    [ dup T{ word-elt } select-elt ] unless
+    gadget-selection ;
+
+: word-action ( target -- quot )
+    selected-word search ;
+
+: quot-action ( quot -- quot )
+    field-commit parse ;
+
+interactor [
+    {
+        "Listener"
+        { "Evaluate" T{ key-down f f "RETURN" } [ interactor-commit ] }
+        { "Send EOF" T{ key-down f { C+ } "d" } [ f swap interactor-eval ] }
+    } <commands> %
+
+    [ word-action ] \ word class-operations modify-listener-operations %
+    [ selected-word ] string class-operations modify-listener-operations %
+    [ quot-action ] quotation class-operations modify-listener-operations %
+
+    {
+        "Listener"
+        { "History" T{ key-down f { C+ } "h" } [ [ interactor-history. ] swap interactor-call ] }
+        { "Clear output" T{ key-down f f "CLEAR" } [ [ clear-output ] swap interactor-call ] }
+        { "Clear stack" T{ key-down f { C+ } "CLEAR" } [ [ clear ] swap interactor-call ] }
+    } <commands> %
+] { } make define-commands*

library/ui/tools/tools.factor

@@ -0,0 +1,26 @@
+! Copyright (C) 2006 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+IN: gadgets-workspace
+USING: gadgets gadgets-books gadgets-controls gadgets-workspace
+generic kernel models scratchpad sequences syntax ;
+
+DEFER: workspace-window
+
+GENERIC: call-tool* ( arg tool -- )
+
+TUPLE: workspace ;
+
+TUPLE: tool gadget ;
+
+: show-tool ( class workspace -- tool )
+    [ book-pages [ tool-gadget class eq? ] find-with swap ] keep
+    control-model set-model* ;
+
+: select-tool ( workspace class -- ) swap show-tool drop ;
+
+: find-workspace ( -- workspace )
+    [ workspace? ] find-window
+    [ world-gadget ] [ workspace-window find-workspace ] if* ;
+
+: call-tool ( arg class -- )
+    find-workspace show-tool call-tool* ;

library/ui/tools/walker.factor

@@ -3,7 +3,7 @@
 IN: gadgets-walker
 USING: arrays errors gadgets gadgets-buttons gadgets-frames
 gadgets-listener gadgets-panes gadgets-scrolling gadgets-text
-gadgets-tracks generic hashtables tools
+gadgets-tracks gadgets-workspace generic hashtables tools
 interpreter io kernel kernel-internals listener math models
 namespaces sequences shells threads vectors ;
 
@@ -60,3 +60,35 @@ C: walker-gadget ( -- gadget )
         { [ walker-gadget-model$ <retainstack-display> ] f f 1/4 }
         { [ walker-gadget-model$ <callstack-display> ] f f 1/3 }
     } { 0 1 } make-track* ;
+
+M: walker-gadget call-tool* ( continuation walker -- )
+    dup reset-walker [
+        V{ } clone meta-history set
+        restore-normally
+    ] with-walker ;
+
+: walker-inspect ( walker -- )
+    walker-gadget-ns [ meta-interp get ] bind
+    [ inspect ] curry listener-gadget call-tool ;
+
+: walker-step-all ( walker -- )
+    dup [ step-all ] walker-command reset-walker
+    find-workspace listener-gadget select-tool ;
+
+walker-gadget {
+    {
+        "Walker"
+        { "Step" T{ key-down f f "s" } [ walker-step ] }
+        { "Step in" T{ key-down f f "i" } [ walker-step-in ] }
+        { "Step out" T{ key-down f f "o" } [ walker-step-out ] }
+        { "Step back" T{ key-down f f "b" } [ walker-step-back ] }
+        { "Continue" T{ key-down f f "c" } [ walker-step-all ] }
+        { "Inspect" T{ key-down f f "n" } [ walker-inspect ] }
+    }
+} define-commands
+
+[ walker-gadget call-tool stop ] break-hook set-global
+
+IN: tools
+
+: walk ( quot -- ) [ break ] swap append call ;

library/ui/tools/workspace.factor

@@ -1,18 +1,11 @@
 ! Copyright (C) 2006 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: arrays compiler gadgets gadgets-listener gadgets-buttons
-gadgets-walker gadgets-help gadgets-walker sequences
-gadgets-browser gadgets-books gadgets-frames gadgets-controls
-gadgets-grids gadgets-presentations kernel models namespaces
-styles words help parser tools memory generic threads
-gadgets-text gadgets-dataflow definitions inference test
-prettyprint math strings hashtables tools modules interpreter
-optimizer inference ;
 IN: gadgets-workspace
-
+USING: arrays compiler gadgets gadgets-books gadgets-browser
-GENERIC: call-tool* ( arg tool -- )
+gadgets-buttons gadgets-controls gadgets-dataflow gadgets-frames
-
+gadgets-grids gadgets-help gadgets-listener
-TUPLE: tool gadget ;
+gadgets-presentations gadgets-walker gadgets-workspace generic
+kernel math modules scratchpad sequences syntax words ;
 
 C: tool ( gadget -- tool )
     {
@@ -24,8 +17,6 @@ M: tool focusable-child* tool-gadget ;
 
 M: tool call-tool* tool-gadget call-tool* ;
 
-TUPLE: workspace ;
-
 : workspace-tabs
     {
         { "Listener" <listener-gadget> }
@@ -58,23 +49,10 @@ M: workspace pref-dim* delegate pref-dim* { 550 650 } vmax ;
     [ init-tabs ] keep
     open-window ;
 
-: show-tool ( class workspace -- tool )
-    [ book-pages [ tool-gadget class eq? ] find-with swap ] keep
-    control-model set-model* ;
-
-: find-workspace ( -- workspace )
-    [ workspace? ] find-window
-    [ world-gadget ] [ workspace-window find-workspace ] if* ;
-
-: call-tool ( arg class -- )
-    find-workspace show-tool call-tool* ;
-
 : commands-window ( workspace -- )
     dup find-world world-focus [ ] [ gadget-child ] ?if
     [ commands. ] "Commands" pane-window ;
 
-: select-tool ( workspace class -- ) swap show-tool drop ;
-
 : tool-window ( class -- ) workspace-window show-tool drop ;
 
 workspace {
@@ -101,298 +79,3 @@ workspace {
         { "Recompile changed words" T{ key-down f f "F8" } [ drop [ recompile ] listener-gadget call-tool ] }
     }
 } define-commands
-
-! Walker tool
-IN: gadgets-walker
-
-M: walker-gadget call-tool* ( continuation walker -- )
-    dup reset-walker [
-        V{ } clone meta-history set
-        restore-normally
-    ] with-walker ;
-
-: walker-inspect ( walker -- )
-    walker-gadget-ns [ meta-interp get ] bind
-    [ inspect ] curry listener-gadget call-tool ;
-
-: walker-step-all ( walker -- )
-    dup [ step-all ] walker-command reset-walker
-    find-workspace listener-gadget select-tool ;
-
-walker-gadget {
-    {
-        "Walker"
-        { "Step" T{ key-down f f "s" } [ walker-step ] }
-        { "Step in" T{ key-down f f "i" } [ walker-step-in ] }
-        { "Step out" T{ key-down f f "o" } [ walker-step-out ] }
-        { "Step back" T{ key-down f f "b" } [ walker-step-back ] }
-        { "Continue" T{ key-down f f "c" } [ walker-step-all ] }
-        { "Inspect" T{ key-down f f "n" } [ walker-inspect ] }
-    }
-} define-commands
-
-[ walker-gadget call-tool stop ] break-hook set-global
-
-! Dataflow tool
-M: dataflow-gadget call-tool* ( node dataflow -- )
-    dup dataflow-gadget-history add-history
-    dataflow-gadget-history set-model ;
-
-IN: tools
-
-: walk ( quot -- ) [ break ] swap append call ;
-
-: show-dataflow ( quot -- )
-    dataflow optimize dataflow-gadget call-tool ;
-
-IN: gadgets-workspace
-
-! Listener tool
-G: call-listener ( quot/string listener -- )
-    1 standard-combination ;
-
-M: quotation call-listener
-    listener-gadget-input interactor-call ;
-
-M: string call-listener
-    listener-gadget-input set-editor-text ;
-
-M: input call-listener
-    >r input-string r> call-listener ;
-
-M: listener-gadget call-tool* ( quot/string listener -- )
-    call-listener ;
-
-: listener-run-files ( seq -- )
-    dup empty? [
-        drop
-    ] [
-        [ [ run-file ] each ] curry listener-gadget call-tool
-    ] if ;
-
-! Browser tool
-M: browser call-tool*
-    over vocab-link? [
-        >r vocab-link-name r> show-vocab
-    ] [
-        show-word
-    ] if ;
-
-! Help tool
-M: help-gadget call-tool* show-help ;
-
-! Operations
-V{ } clone operations set-global
-
-: define-operation ( class props -- )
-    <operation> operations get push-new ;
-
-M: operation invoke-command ( target operation -- )
-    dup command-quot swap operation-listener?
-    [ curry listener-gadget call-tool ] [ call ] if ;
-
-: modify-operation ( quot operation -- operation )
-    clone
-    [ command-quot append ] keep
-    [ set-command-quot ] keep ;
-
-: modify-operations ( quot operations -- operations )
-    [ modify-operation ] map-with ;
-
-: modify-listener-operation ( quot operation -- operation )
-    clone t over set-operation-listener?
-    modify-operation ;
-
-: modify-listener-operations ( quot operations -- operations )
-    [ modify-listener-operation ] map-with ;
-
-! Objects
-[ drop t ] H{
-    { +button+ 1 }
-    { +name+ "Inspect" }
-    { +quot+ [ inspect ] }
-    { +listener+ t }
-} define-operation
-
-! Input
-[ input? ] H{
-    { +button+ 1 }
-    { +name+ "Input" }
-    { +quot+ [ listener-gadget call-tool ] }
-} define-operation
-
-! Words
-[ word? ] H{
-    { +button+ 1 }
-    { +group+ "Words" }
-    { +name+ "Browse" }
-    { +gesture+ T{ key-down f { A+ } "b" } }
-    { +quot+ [ browser call-tool ] }
-} define-operation
-
-[ word? ] H{
-    { +button+ 2 }
-    { +group+ "Words" }
-    { +name+ "Edit" }
-    { +gesture+ T{ key-down f { A+ } "e" } }
-    { +quot+ [ edit ] }
-} define-operation
-
-[ word? ] H{
-    { +button+ 3 }
-    { +group+ "Words" }
-    { +name+ "Documentation" }
-    { +gesture+ T{ key-down f { A+ } "h" } }
-    { +quot+ [ help-gadget call-tool ] }
-} define-operation
-
-[ word? ] H{
-    { +group+ "Words" }
-    { +name+ "Usage" }
-    { +gesture+ T{ key-down f { A+ } "u" } }
-    { +quot+ [ usage. ] }
-    { +listener+ t }
-} define-operation
-
-[ word? ] H{
-    { +group+ "Words" }
-    { +name+ "Reload" }
-    { +gesture+ T{ key-down f { A+ } "r" } }
-    { +quot+ [ reload ] }
-    { +listener+ t }
-} define-operation
-
-[ word? ] H{
-    { +group+ "Words" }
-    { +name+ "Watch" }
-    { +quot+ [ watch ] }
-    { +listener+ t }
-} define-operation
-
-! Vocabularies
-[ vocab-link? ] H{
-    { +button+ 1 }
-    { +name+ "Browse" }
-    { +quot+ [ browser call-tool ] }
-} define-operation
-
-! Link
-[ link? ] H{
-    { +button+ 1 }
-    { +name+ "Follow" }
-    { +quot+ [ help-gadget call-tool ] }
-} define-operation
-
-[ link? ] H{
-    { +button+ 2 }
-    { +name+ "Edit" }
-    { +quot+ [ edit ] }
-} define-operation
-
-[ word-link? ] H{
-    { +button+ 3 }
-    { +name+ "Definition" }
-    { +quot+ [ link-name browser call-tool ] }
-} define-operation
-
-! Strings
-[ string? ] H{
-    { +group+ "Words" }
-    { +name+ "Apropos (all)" }
-    { +gesture+ T{ key-down f { A+ } "a" } }
-    { +quot+ [ apropos ] }
-    { +listener+ t }
-} define-operation
-
-: usable-words ( -- seq )
-    [
-        use get [ hash-values [ dup set ] each ] each
-    ] make-hash hash-values natural-sort ;
-
-[ string? ] H{
-    { +group+ "Words" }
-    { +name+ "Apropos (used)" }
-    { +gesture+ T{ key-down f f "TAB" } }
-    { +quot+ [ usable-words (apropos) ] }
-    { +listener+ t }
-} define-operation
-
-! Quotations
-[ quotation? ] H{
-    { +group+ "Quotations" }
-    { +name+ "Infer" }
-    { +gesture+ T{ key-down f { C+ A+ } "i" } }
-    { +quot+ [ infer . ] }
-    { +listener+ t }
-} define-operation
-
-[ quotation? ] H{
-    { +group+ "Quotations" }
-    { +name+ "Dataflow" }
-    { +gesture+ T{ key-down f { C+ A+ } "d" } }
-    { +quot+ [ show-dataflow ] }
-    { +listener+ t }
-} define-operation
-
-[ quotation? ] H{
-    { +group+ "Quotations" }
-    { +name+ "Walk" }
-    { +gesture+ T{ key-down f { C+ A+ } "w" } }
-    { +quot+ [ walk ] }
-    { +listener+ t }
-} define-operation
-
-[ quotation? ] H{
-    { +group+ "Quotations" }
-    { +name+ "Time" }
-    { +gesture+ T{ key-down f { C+ A+ } "t" } }
-    { +quot+ [ time ] }
-    { +listener+ t }
-} define-operation
-
-! Dataflow nodes
-[ node? ] H{
-    { +group+ "Nodes" }
-    { +name+ "Display" }
-    { +quot+ [ dataflow-gadget call-tool ] }
-} define-operation
-
-! Define commands in terms of operations
-
-! Tile commands
-tile
-[ tile-definition ] \ word class-operations modify-operations
-[ command-name "Browse" = not ] subset
-T{ command f f "Close" f [ close-tile ] } add*
-define-commands*
-
-! Interactor commands
-: selected-word ( editor -- string )
-    dup gadget-selection?
-    [ dup T{ word-elt } select-elt ] unless
-    gadget-selection ;
-
-: word-action ( target -- quot )
-    selected-word search ;
-
-: quot-action ( quot -- quot )
-    field-commit parse ;
-
-interactor [
-    {
-        "Listener"
-        { "Evaluate" T{ key-down f f "RETURN" } [ interactor-commit ] }
-        { "Send EOF" T{ key-down f { C+ } "d" } [ f swap interactor-eval ] }
-    } <commands> %
-
-    [ word-action ] \ word class-operations modify-listener-operations %
-    [ selected-word ] string class-operations modify-listener-operations %
-    [ quot-action ] quotation class-operations modify-listener-operations %
-
-    {
-        "Listener"
-        { "History" T{ key-down f { C+ } "h" } [ [ interactor-history. ] swap interactor-call ] }
-        { "Clear output" T{ key-down f f "CLEAR" } [ [ clear-output ] swap interactor-call ] }
-        { "Clear stack" T{ key-down f { C+ } "CLEAR" } [ [ clear ] swap interactor-call ] }
-    } <commands> %
-] { } make define-commands*