Working on completion in UI

library/ui/tools/operations.factor

@@ -61,17 +61,33 @@ M: operation invoke-command ( target operation -- )
 
 [ pathname? ] H{
     { +name+ "Run file" }
+    { +keyboard+ T{ key-down f { A+ } "r" } }
     { +quot+ [ pathname-string [ run-file ] curry call-listener ] }
 } define-operation
 
 ! Words
 [ word? ] H{
-    { +default+ t }
+    { +primary+ t }
     { +name+ "Browse" }
     { +keyboard+ T{ key-down f { A+ } "b" } }
     { +quot+ [ browser call-tool ] }
 } define-operation
 
+: word-completion-string ( word listener -- string )
+    >r dup word-name swap word-vocabulary dup vocab r>
+    listener-gadget-use memq?
+    [ drop ] [ [ "USE: " % % " " % % ] "" make ] if ;
+
+: insert-word ( word -- )
+    find-listener [ word-completion-string ] keep
+    listener-gadget-input user-input ;
+
+[ word? ] H{
+    { +secondary+ t }
+    { +name+ "Insert" }
+    { +quot+ [ insert-word ] }
+} define-operation
+
 [ word? ] H{
     { +name+ "Edit" }
     { +keyboard+ T{ key-down f { A+ } "e" } }
@@ -129,28 +145,33 @@ M: operation invoke-command ( target operation -- )
 
 ! Vocabularies
 [ vocab-link? ] H{
-    { +default+ t }
+    { +primary+ t }
     { +name+ "Browse" }
+    { +keyboard+ T{ key-down f { A+ } "b" } }
     { +quot+ [ browser call-tool ] }
 } define-operation
 
 [ vocab-link? ] H{
     { +name+ "Enter in" }
+    { +keyboard+ T{ key-down f { A+ } "i" } }
     { +quot+ [ vocab-link-name [ set-in ] curry call-listener ] }
 } define-operation
 
 [ vocab-link? ] H{
+    { +secondary+ t }
     { +name+ "Use" }
     { +quot+ [ vocab-link-name [ use+ ] curry call-listener ] }
 } define-operation
 
 [ vocab-link? ] H{
     { +name+ "Forget" }
+    { +keyboard+ T{ key-down f { A+ } "f" } }
     { +quot+ [ vocab-link-name forget-vocab ] }
 } define-operation
 
 ! Modules
 [ module? ] H{
+    { +primary+ t }
     { +name+ "Run" }
     { +quot+ [ module-name run-module ] }
     { +listener+ t }
@@ -158,45 +179,53 @@ M: operation invoke-command ( target operation -- )
 
 [ module? ] H{
     { +name+ "Documentation" }
+    { +keyboard+ T{ key-down f { A+ } "h" } }
     { +quot+ [ module-help [ help-gadget call-tool ] when* ] }
 } define-operation
 
 [ module? ] H{
     { +name+ "Edit" }
+    { +keyboard+ T{ key-down f { A+ } "e" } }
     { +quot+ [ edit ] }
 } define-operation
 
 [ module? ] H{
     { +name+ "Reload" }
+    { +keyboard+ T{ key-down f { A+ } "r" } }
     { +quot+ [ reload-module ] }
     { +listener+ t }
 } define-operation
 
 [ module? ] H{
     { +name+ "See" }
+    { +keyboard+ T{ key-down f { A+ } "b" } }
     { +quot+ [ see ] }
     { +listener+ t }
 } define-operation
 
 ! Link
 [ link? ] H{
-    { +default+ t }
+    { +primary+ t }
+    { +secondary+ t }
     { +name+ "Follow" }
     { +quot+ [ help-gadget call-tool ] }
 } define-operation
 
 [ link? ] H{
     { +name+ "Edit" }
+    { +keyboard+ T{ key-down f { A+ } "e" } }
     { +quot+ [ edit ] }
 } define-operation
 
 [ link? ] H{
     { +name+ "Reload" }
+    { +keyboard+ T{ key-down f { A+ } "r" } }
     { +quot+ [ reload ] }
 } define-operation
 
 [ word-link? ] H{
     { +name+ "Definition" }
+    { +keyboard+ T{ key-down f { A+ } "b" } }
     { +quot+ [ link-name browser call-tool ] }
 } define-operation
 
@@ -230,9 +259,8 @@ M: operation invoke-command ( target operation -- )
 } define-operation
 
 ! Dataflow nodes
-
 [ [ node? ] is? ] H{
-    { +default+ t }
+    { +primary+ t }
     { +name+ "Show dataflow" }
     { +quot+ [ dataflow-gadget call-tool ] }
 } define-operation
@@ -245,13 +273,6 @@ M: operation invoke-command ( target operation -- )
 
 ! Define commands in terms of operations
 
-! Tile commands
-tile "toolbar"
-\ word class-operations [ tile-definition ] modify-operations
-[ command-name "Browse" = not ] subset
-{ "Close" f [ close-tile ] } add*
-define-commands
-
 ! Interactor commands
 : word-action ( target -- quot )
     selected-word search ;
@@ -278,3 +299,28 @@ link class-operations [ help-action ] modify-operations
 [ command-name "Follow" = not ] subset
 append
 define-commands
+
+\ word-search "operations"
+\ word class-operations
+[ search-action ] modify-operations
+define-commands
+
+\ vocab-search "operations"
+\ vocab-link class-operations
+[ search-action ] modify-operations
+define-commands
+
+\ module-search "operations"
+\ module class-operations
+[ search-action ] modify-operations
+define-commands
+
+\ source-file-search "operations"
+\ pathname class-operations
+[ search-action ] modify-operations
+define-commands
+
+\ help-search "operations"
+\ link class-operations
+[ search-action ] modify-operations
+define-commands

library/ui/tools/search.factor

@@ -9,7 +9,7 @@ completion styles strings modules ;
 
 TUPLE: live-search field list ;
 
-: find-live-search [ live-search? ] find-parent ;
+: find-live-search [ [ live-search? ] is? ] find-parent ;
 
 : find-search-list find-live-search live-search-list ;
 
@@ -23,7 +23,7 @@ C: search-field ( -- gadget )
 search-field H{
     { T{ key-down f f "UP" } [ find-search-list select-prev ] }
     { T{ key-down f f "DOWN" } [ find-search-list select-next ] }
-    { T{ key-down f f "RETURN" } [ find-search-list call-action ] }
+    { T{ key-down f f "RETURN" } [ find-search-list list-action ] }
 } set-gestures
 
 : <search-model> ( producer -- model )
@@ -31,10 +31,10 @@ search-field H{
     [ "\n" join ] <filter>
     swap <filter> ;
 
-: <search-list> ( action seq producer presenter -- gadget )
+: <search-list> ( hook seq producer presenter -- gadget )
     -rot curry <search-model> <list> ;
 
-C: live-search ( string action seq producer presenter -- gadget )
+C: live-search ( string hook seq producer presenter -- gadget )
     {
         {
             [ <search-field> ]
@@ -53,43 +53,73 @@ C: live-search ( string action seq producer presenter -- gadget )
 
 M: live-search focusable-child* live-search-field ;
 
-: <word-search> ( string action -- gadget )
-    all-words
+: delegate>live-search ( string hook seq producer presenter gadget -- )
+    >r <live-search> r> set-gadget-delegate ;
+
+TUPLE: word-search ;
+
+C: word-search ( string action words -- gadget )
+    >r
     [ word-completions ]
     [ word-name ]
-    <live-search> ;
+    r>
+    [ delegate>live-search ] keep ;
 
 : help-completions ( str pairs -- seq )
     >r >lower r>
     [ second >lower ] swap completions
     [ first <link> ] map ;
 
-: <help-search> ( string action -- gadget )
+TUPLE: help-search ;
+
+C: help-search ( string action -- gadget )
+    >r
     all-articles [ dup article-title 2array ] map
+    [ [ second ] 2apply <=> ] sort
     [ help-completions ]
     [ article-title ]
-    <live-search> ;
+    r>
+    [ delegate>live-search ] keep ;
 
-: <source-files-search> ( string action -- gadget )
+TUPLE: source-file-search ;
+
+C: source-file-search ( string action -- gadget )
+    >r
     source-files get hash-keys natural-sort
     [ string-completions [ <pathname> ] map ]
     [ pathname-string ]
-    <live-search> ;
+    r>
+    [ delegate>live-search ] keep ;
 
 : module-completions ( str modules -- seq )
     [ module-name ] swap completions ;
 
-: <modules-search> ( string action -- gadget )
+TUPLE: module-search ;
+
+: module-search ( string action -- gadget )
+    >r
     available-modules [ module-completions ]
     [ module-name ]
-    <live-search> ;
+    r>
+    [ delegate>live-search ] keep ;
 
-: <vocabs-search> ( string action -- gadget )
+TUPLE: vocab-search ;
+
+C: vocab-search ( string action -- gadget )
+    >r
     vocabs [ string-completions [ <vocab-link> ] map ]
     [ vocab-link-name ]
-    <live-search> ;
+    r>
+    [ delegate>live-search ] keep ;
 
-: <history-search> ( string action seq -- gadget )
+TUPLE: history-search ;
+
+C: history-search ( string action seq -- gadget )
+    >r
     [ string-completions [ <input> ] map ]
     [ input-string ]
-    <live-search> ;
+    r>
+    [ delegate>live-search ] keep ;
+
+: search-action ( search -- obj )
+    live-search-list list-value ;