Working on UI completion

TODO.FACTOR.txt

@@ -11,6 +11,11 @@
 - some way of intercepting all gestures
 - better help result ranking
 - minibuffer should show a title
+- browser: toolbar is missing
+- new search gadget:
+  - field does not move caret properly
+  - use it instead of the old search gadget
+  - listener: 'edit a file' feature
 
 + ui:
 

library/load.factor

@@ -231,4 +231,5 @@ PROVIDE: library {
     "test/threads.factor"
     "test/tuple.factor"
     "test/words.factor"
+    "test/tools.factor"
 } ;

library/test/tools.factor

@@ -0,0 +1,4 @@
+IN: temporary
+USING: tools ;
+
+[ ] [ "" apropos ] unit-test

library/tools/word-tools.factor

@@ -97,8 +97,12 @@ generic ;
     ] keep 3array ;
 
 : completions ( str words -- seq )
-    [ completion ] map-with [ first zero? not ] subset
-    [ [ first ] 2apply swap - ] sort dup length 20 min head ;
+    over empty? [
+        2drop f
+    ] [
+        [ completion ] map-with [ first zero? not ] subset
+        [ [ first ] 2apply swap - ] sort dup length 20 min head
+    ] if ;
 
 : fuzzy. ( fuzzy full -- )
     dup length [

library/ui/gadgets/lists.factor

@@ -16,10 +16,14 @@ C: list ( model presenter action -- gadget )
     0 over set-list-index
     dup list-theme ;
 
+: bound-index ( list -- )
+    dup list-index over control-value length 1- max 0 min
+    swap set-list-index ;
+
 M: list model-changed
     dup clear-gadget
-    dup control-value over list-presenter map
-    swap add-gadgets ;
+    dup control-value over list-presenter map over add-gadgets
+    bound-index ;
 
 : selected-rect ( list -- rect )
     dup list-index swap gadget-children 2dup bounds-check?
@@ -62,7 +66,7 @@ M: list focusable-child* drop t ;
 : call-action ( list -- )
     dup list-value swap list-action call ;
 
-\ list H{
+list H{
     { T{ button-down } [ request-focus ] }
     { T{ key-down f f "UP" } [ select-prev ] }
     { T{ key-down f f "DOWN" } [ select-next ] }

library/ui/tools/listener.factor

@@ -3,10 +3,10 @@
 IN: gadgets-listener
 USING: compiler arrays gadgets gadgets-frames gadgets-labels
 gadgets-panes gadgets-scrolling gadgets-text gadgets-lists
-gadgets-theme gadgets-tracks gadgets-workspace generic
-hashtables tools io kernel listener math models namespaces
-parser prettyprint sequences shells strings styles threads words
-memory ;
+gadgets-search gadgets-theme gadgets-tracks gadgets-workspace
+generic hashtables tools io kernel listener math models
+namespaces parser prettyprint sequences shells strings styles
+threads words ;
 
 TUPLE: listener-gadget input output stack minibuffer use ;
 
@@ -107,6 +107,10 @@ M: listener-gadget tool-help
     [ set-listener-gadget-minibuffer ] 2keep
     dupd track-add request-focus ;
 
+: show-word-search ( listener action -- )
+    >r dup listener-gadget-input selected-word r> <word-search>
+    swap show-minibuffer ;
+
 : show-list ( seq presenter action listener -- )
     >r >r >r <model> r> r> <list> <scroller> r>
     show-minibuffer ;
@@ -127,17 +131,6 @@ M: listener-gadget tool-help
         >r peek word-name r> listener-gadget-input user-input
     ] keep hide-minibuffer ;
 
-: show-completions ( listener words -- )
-    over listener-gadget-input selected-word swap completions
-    over
-    >r [ [ completion. ] make-pane ] [ insert-completion ] r>
-    show-list ;
-
-: used-words ( listener -- seq )
-    listener-gadget-use
-    [ [ hash-values [ dup set ] each ] each ] make-hash
-    hash-values natural-sort ;
-
 listener-gadget "Toolbar" {
     { "Restart" T{ key-down f { C+ } "r" } [ start-listener ] }
     {
@@ -160,14 +153,9 @@ listener-gadget "Toolbar" {
 
 listener-gadget "Listener commands" {
     {
-        "Complete word (used vocabs)"
+        "Complete word"
         T{ key-down f f "TAB" }
-        [ dup used-words show-completions ]
-    }
-    {
-        "Complete word (all vocabs)"
-        T{ key-down f f "TAB" }
-        [ all-words show-completions ]
+        [ [ insert-completion ] show-word-search ]
     }
     {
         "Hide minibuffer"

library/ui/tools/search.factor

@@ -4,7 +4,7 @@ IN: gadgets-search
 USING: arrays gadgets gadgets-frames gadgets-labels
 gadgets-panes gadgets-scrolling gadgets-text gadgets-theme
 generic help tools kernel models sequences words
-gadgets-borders ;
+gadgets-borders gadgets-lists namespaces ;
 
 TUPLE: search-gadget input ;
 
@@ -25,3 +25,68 @@ C: search-gadget ( quot -- )
     } make-frame* ;
 
 M: search-gadget focusable-child* search-gadget-input ;
+
+
+! Here is the new one
+TUPLE: live-search field list model producer action presenter ;
+
+: find-live-search [ live-search? ] find-parent ;
+
+: find-search-list find-live-search live-search-list ;
+
+: update-live-search ( live-search -- )
+    dup live-search-field editor-text
+    over live-search-producer call
+    swap live-search-model set-model ;
+
+TUPLE: search-field ;
+
+C: search-field ( string -- gadget )
+    <editor> over set-gadget-delegate
+    dup dup set-control-self
+    [ set-editor-text ] keep ;
+
+M: search-field model-changed
+    dup find-live-search update-live-search
+    delegate model-changed ;
+
+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 ] }
+} set-gestures
+
+: <search-list>
+    gadget get live-search-model
+    gadget get live-search-presenter
+    gadget get live-search-action
+    <list> ;
+
+C: live-search ( string action producer presenter -- gadget )
+    [ set-live-search-presenter ] keep
+    [ set-live-search-producer ] keep
+    [ set-live-search-action ] keep
+    f <model> over set-live-search-model
+    {
+        {
+            [ <search-field> ]
+            set-live-search-field
+            f
+            @top
+        }
+        {
+            [ <search-list> ]
+            set-live-search-list
+            [ <scroller> ]
+            @center
+        }
+    } make-frame* ;
+
+M: live-search focusable-child* live-search-field ;
+
+: <word-search> ( string action -- gadget )
+    \ third add*
+    all-words
+    [ completions ] curry
+    [ [ completion. ] make-pane ]
+    <live-search> ;