Experimental new developer tools in UI

TODO.FACTOR.txt

@@ -14,20 +14,11 @@
 
 - fix ui listener delay
 - we have trouble drawing rectangles
-- remaining walker tasks:
-  - integrate walker with listener
-  - <input> handled by walker itself
-  - ^W in interactor
-  - ^I in interactor
-  - error handling is still screwy
-  - continuation handling is also screwy
-  - keyboard commands
 - editor:
   - only redraw visible lines
   - more efficient multi-line inserts
   - editor should support stream output protocol
 - slider needs to be modelized
-- listener tab completion
 - track individual method usages
 - modularize core
 - track module files and modification times, and a list of assets loaded
@@ -43,14 +34,9 @@
 
 + ui:
 
-- list of key bindings
-- presentation types
-- present/accept
 - graphical module manager tool
 - figure out what goes in the .app and what doesn't
 - should be possible to drop an image file on the .app to run it
-- the UI listener has a shitty design. perhaps it should not call out
-  to the real listener.
 - add-gadget, model-changed, set-model should compile
 - shortcuts:
   - find a listener

library/syntax/parser.factor

@@ -27,7 +27,7 @@ namespaces prettyprint sequences strings vectors words ;
 SYMBOL: string-mode
 
 : do-what-i-mean ( string -- restarts )
-    all-words [ word-name = ] subset-with natural-sort [
+    words-named natural-sort [
         [ "Use the word " swap synopsis append ] keep 2array
     ] map ;
 
@@ -36,14 +36,15 @@ TUPLE: no-word name ;
 : no-word ( name -- word )
     dup <no-word> swap do-what-i-mean condition ;
 
+: search ( str -- word )
+    dup use get hash-stack [ ] [
+        no-word dup word-vocabulary use+
+    ] ?if ;
+
 : scan-word ( -- obj )
     scan dup [
         dup ";" = not string-mode get and [
-            dup use get hash-stack [ ] [
+            dup string>number [ ] [ search ] ?if
-                dup string>number [ ] [
-                    no-word dup word-vocabulary use+
-                ] ?if
-            ] ?if
         ] unless
     ] when ;
 

library/tools/word-tools.factor

@@ -84,8 +84,8 @@ math namespaces prettyprint sequences strings styles ;
     ] keep
     3array ;
 
-: completions ( str -- seq )
+: completions ( str words -- seq )
-    all-words [ completion ] map-with [ first zero? not ] subset
+    [ completion ] map-with [ first zero? not ] subset
     [ [ first ] 2apply swap - ] sort dup length 20 min head ;
 
 : fuzzy. ( fuzzy full -- )
@@ -94,7 +94,7 @@ math namespaces prettyprint sequences strings styles ;
         [ hilite-style >r ch>string r> format ] [ write1 ] if 
     ] 2each drop ;
 
-: apropos ( str -- )
+: (apropos) ( str words -- )
     completions [
         first3 dup presented associate [
             dup word-vocabulary write bl word-name fuzzy.
@@ -102,3 +102,5 @@ math namespaces prettyprint sequences strings styles ;
             write
         ] with-nesting terpri
     ] each ;
+
+: apropos ( str -- ) all-words (apropos) ;

library/ui/text/field.factor

@@ -3,17 +3,15 @@
 IN: gadgets-text
 USING: gadgets gadgets-controls generic kernel models sequences ;
 
-TUPLE: field model history ;
+TUPLE: field model ;
 
 C: field ( model -- field )
     <editor> over set-delegate
-    V{ } clone over set-field-history
     [ set-field-model ] keep
     dup dup set-control-self ;
 
 : field-commit ( field -- string )
     [ editor-text ] keep
-    [ field-history push-new ] 2keep
     [ field-model [ dupd set-model ] when* ] keep
     select-all ;
 

library/ui/text/interactor.factor

@@ -3,19 +3,20 @@
 IN: gadgets-text
 USING: gadgets gadgets-controls gadgets-panes generic hashtables
 help io kernel namespaces prettyprint styles threads sequences
-vectors ;
+vectors jedit definitions parser words ;
 
-TUPLE: interactor output continuation queue busy? ;
+TUPLE: interactor history output continuation queue busy? ;
 
 C: interactor ( output -- gadget )
     [ set-interactor-output ] keep
     f <field> over set-gadget-delegate
+    V{ } clone over set-interactor-history
     dup dup set-control-self ;
 
 M: interactor graft*
     f over set-interactor-busy? delegate graft* ;
 
-: interactor-eval ( string interactor -- )
+: (interactor-eval) ( string interactor -- )
     dup interactor-busy? [
         2drop
     ] [
@@ -33,31 +34,62 @@ SYMBOL: structured-input
     ] with-stream*
     >r structured-input set-global
     "\"structured-input\" \"gadgets-text\" lookup get-global call"
-    r> interactor-eval ;
+    r> (interactor-eval) ;
 
 : interactor-input. ( string interactor -- )
     interactor-output [ dup print-input ] with-stream* ;
 
+: interactor-eval ( string interactor -- )
+    dup control-model clear-doc
+    2dup interactor-history push-new
+    2dup interactor-input.
+    (interactor-eval) ;
+
 : interactor-commit ( interactor -- )
     dup interactor-busy? [
         drop
     ] [
-        dup field-commit
+        [ field-commit ] keep interactor-eval
-        over control-model clear-doc
+    ] if ;
-        swap 2dup interactor-input. interactor-eval
+
+: quot-action ( interactor word -- )
+    over interactor-busy? [
+        2drop
+    ] [
+        [ "[ " % over field-commit % " ] " % % ] "" make
+        swap interactor-eval
     ] if ;
 
 : interactor-history. ( interactor -- )
     dup interactor-output [
         "History:" print
-        field-history [ dup print-input ] each
+        interactor-history [ dup print-input ] each
     ] with-stream* ;
 
+: word-action ( interactor word -- )
+    over gadget-selection?
+    [ over T{ word-elt } editor-select-prev ] unless
+    over gadget-selection add* swap interactor-call ;
+
+: usable-words ( -- seq )
+    use get [ hash-values natural-sort ] map concat prune ;
+
+: use-word ( str -- )
+    words-named [ word-vocabulary dup print use+ ] each ;
+
 interactor H{
     { T{ key-down f f "RETURN" } [ interactor-commit ] }
-    { T{ key-down f { C+ } "h" } [ interactor-history. ] }
+    { T{ key-down f { C+ } "h" } [ dup [ interactor-history. ] curry swap interactor-call ] }
-    { T{ key-down f { C+ } "b" } [ interactor-output pane-clear ] }
+    { T{ key-down f { C+ } "b" } [ dup [ interactor-output pane-clear ] curry swap interactor-call ] }
     { T{ key-down f { C+ } "d" } [ f swap interactor-eval ] }
+    { T{ key-down f { C+ } "i" } [ "infer ." quot-action ] }
+    { T{ key-down f { C+ } "w" } [ "walk" quot-action ] }
+    { T{ key-down f { A+ } "s" } [ [ search see ] word-action ] }
+    { T{ key-down f { A+ } "j" } [ [ search jedit ] word-action ] }
+    { T{ key-down f { A+ } "r" } [ [ search reload ] word-action ] }
+    { T{ key-down f { A+ } "a" } [ [ apropos ] word-action ] }
+    { T{ key-down f { A+ } "u" } [ [ use-word ] word-action ] }
+    { T{ key-down f f "TAB" } [ [ usable-words (apropos) ] word-action ] }
 } set-gestures
 
 M: interactor stream-readln

library/ui/tools/walker.factor

@@ -127,6 +127,13 @@ C: walker-gadget ( -- gadget )
     } make-frame*
     dup walker-thread ;
 
+\ walker-gadget H{
+    { T{ key-down f { C+ } "s" } [ \ step walker-command ] }
+    { T{ key-down f { C+ } "n" } [ \ step-in walker-command ] }
+    { T{ key-down f { C+ } "o" } [ \ step-out walker-command ] }
+    { T{ key-down f { C+ } "l" } [ \ step-all walker-command ] }
+} set-gestures
+
 : walker-tool
     [ walker-gadget? ] [ <walker-gadget> ] [ (walk) ] ;
 

library/words.factor

@@ -183,6 +183,9 @@ TUPLE: check-create name vocab ;
         ] when lookup
     ] when ;
 
+: words-named ( str -- seq )
+    all-words [ word-name = ] subset-with ;
+
 ! Definition protocol
 M: word where "loc" word-prop ;