Listener completion work in progress

basis/ui/gadgets/tables/tables.factor

@@ -209,8 +209,7 @@ M: table model-changed
 : thin-row-rect ( table row -- rect )
     row-rect [ { 0 1 } v* ] change-dim ;
 
-: (select-row) ( table row -- )
+: (select-row) ( table n -- )
-    over validate-row
     [ [ thin-row-rect ] [ drop ] 2bi scroll>rect ]
     [ >>selected-index relayout-1 ]
     2bi ;
@@ -232,8 +231,14 @@ M: table model-changed
     hand-click# get 2 =
     [ row-action ] [ update-selected-value ] if ;
 
-: select-row ( table row -- )
+: show-row-summary ( row table -- )
-    [ (select-row) ] [ drop update-selected-value ] 2bi ;
+    [ renderer>> row-value ] keep show-summary ;
+
+: select-row ( table n -- )
+    over validate-row
+    [ (select-row) ]
+    [ drop update-selected-value ]
+    [ over nth-row drop swap show-row-summary ] 2tri ;
 
 : prev-row ( table -- )
     dup selected-index>> [ 1- ] [ 0 ] if* select-row ;
@@ -253,9 +258,6 @@ M: table model-changed
 : valid-row? ( row table -- ? )
     control-value length 1- 0 swap between? ;
 
-: show-row-summary ( row table -- )
-    [ renderer>> row-value ] keep show-summary ;
-
 : if-mouse-row ( table true false -- )
     [ [ mouse-row ] keep 2dup valid-row? ]
     [ ] [ '[ nip @ ] ] tri* if ; inline

basis/ui/gadgets/wrappers/wrappers.factor

@@ -1,4 +1,4 @@
-! Copyright (C) 2005, 2008 Slava Pestov.
+! Copyright (C) 2005, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors ui.gadgets kernel ;
 
@@ -8,7 +8,7 @@ TUPLE: wrapper < gadget ;
 
 : new-wrapper ( child class -- wrapper ) new-gadget swap add-gadget ;
 
-: <wrapper> ( child -- border ) wrapper new-wrapper ;
+: <wrapper> ( child -- wrapper ) wrapper new-wrapper ;
 
 M: wrapper pref-dim* ( wrapper -- dim ) gadget-child pref-dim ;
 

basis/ui/gestures/gestures.factor

@@ -34,9 +34,11 @@ M: send-gesture send-queued-gesture
 
 TUPLE: propagate-gesture gesture gadget ;
 
+: resend-gesture ( gesture gadget -- ? )
+    [ handle-gesture ] with each-parent ;
+
 M: propagate-gesture send-queued-gesture
-    [ gesture>> ] [ gadget>> ] bi
+    [ gesture>> ] [ gadget>> ] bi resend-gesture drop ;
-    [ handle-gesture ] with each-parent drop ;
 
 : propagate-gesture ( gesture gadget -- )
     \ propagate-gesture queue-gesture ;

basis/ui/tools/listener/listener.factor

@@ -1,6 +1,6 @@
 ! Copyright (C) 2005, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: inspector help help.markup io io.styles kernel models
+USING: inspector kernel help help.markup io io.styles models
 strings namespaces parser quotations sequences vocabs words
 continuations prettyprint listener debugger threads boxes
 concurrency.flags math arrays generic accessors combinators
@@ -11,14 +11,15 @@ ui.commands ui.gadgets ui.gadgets.editors ui.gadgets.labelled
 ui.gadgets.panes ui.gadgets.buttons ui.gadgets.scrollers
 ui.gadgets.packs ui.gadgets.tracks ui.gadgets.borders
 ui.gadgets.frames ui.gadgets.grids ui.gadgets.status-bar
-ui.gestures ui.operations ui.tools.browser
+ui.gadgets.wrappers ui.gestures ui.operations ui.tools.browser
 ui.tools.debugger ui.tools.inspector ui.tools.common ui ;
 IN: ui.tools.listener
 
 ! If waiting is t, we're waiting for user input, and invoking
 ! evaluate-input resumes the thread.
 TUPLE: interactor < source-editor
-output history flag mailbox thread waiting help ;
+output history flag mailbox thread waiting help
+completion-popup ;
 
 : register-self ( interactor -- )
     <mailbox> >>mailbox
@@ -411,4 +412,69 @@ M: listener-gadget graft*
     [ call-next-method ] [ restart-listener ] bi ;
 
 M: listener-gadget ungraft*
-    [ com-end ] [ call-next-method ] bi ;
+    [ com-end ] [ call-next-method ] bi ;
+
+! Foo
+: <summary-gadget> ( model -- gadget )
+    [ summary ] <filter> <label-control> ;
+
+SINGLETON: completion-renderer
+M: completion-renderer row-columns drop name>> 1array ;
+M: completion-renderer row-value drop ;
+
+: <completion-table> ( interactor quot -- table )
+    [ one-word-elt <element-model> 1/3 seconds <delay> ] dip
+    '[ [ { } ] [ @ keys 20 short head ] if-empty ] <filter>
+    <table> completion-renderer >>renderer ;
+
+TUPLE: completion-popup < wrapper interactor ;
+
+: <completion-popup> ( interactor quot -- popup )
+    dupd
+    <completion-table>
+    <limited-scroller>
+        { 300 300 } >>min-dim
+        { 300 300 } >>max-dim
+    completion-popup new-wrapper
+        white <solid> >>interior
+        swap >>interactor ;
+
+: hide-completion-popup ( popup -- )
+    interactor>> f >>completion-popup find-world hide-glass ;
+
+completion-popup H{
+    { T{ key-down f f "ESC" } [ hide-completion-popup ] }
+} set-gestures
+
+: <word-completion-popup> ( interactor -- table )
+    [ words-matching ] <completion-popup> ;
+
+: <vocab-completion-popup> ( interactor -- table )
+    [ vocabs-matching ] <completion-popup> ;
+
+: show-completion-popup ( interactor popup -- )
+    [ >>completion-popup ] keep
+    [ find-world ] dip
+    { 0 0 } show-glass ;
+
+: word-completion-popup ( interactor -- )
+    dup <word-completion-popup> show-completion-popup ;
+
+: pass-to-popup? ( gesture interactor -- ? )
+    [ [ key-down? ] [ key-up? ] bi or ]
+    [ completion-popup>> ]
+    bi* and ;
+
+M: interactor handle-gesture
+    2dup pass-to-popup? [
+        2dup completion-popup>>
+        focusable-child resend-gesture
+        [ call-next-method ] [ 2drop f ] if
+    ] [ call-next-method ] if ;
+
+: test-it ( interactor -- )
+    dup <word-completion-popup> show-completion-popup ;
+
+interactor "completion" f {
+    { T{ key-down f f "TAB" } word-completion-popup }
+} define-command-map

basis/ui/tools/profiler/profiler.factor

@@ -22,15 +22,19 @@ generic class ;
 
 { 700 400 } profiler-gadget set-tool-dim
 
-SINGLETON: word-renderer
+SINGLETONS: word-renderer vocab-renderer ;
+UNION: profiler-renderer word-renderer vocab-renderer ;
 
 ! Value is a { word count } pair
-M: word-renderer row-columns
+M: profiler-renderer row-columns
     drop [ [ present ] map ] [ { "All" "" } ] if* ;
 
-M: word-renderer row-value
+M: profiler-renderer row-value
     drop dup [ first ] when ;
 
+M: vocab-renderer row-value
+    call-next-method dup [ vocab ] when ;
+
 SINGLETON: method-renderer
 
 ! Value is a { method-body count } pair
@@ -53,7 +57,6 @@ M: method-renderer row-value drop first ;
 
 : <profiler-table> ( model -- table )
     [ match? ] <search-table>
-        word-renderer >>renderer
         { 0 1 } >>column-alignment
         0 >>filled-column ;
 
@@ -102,9 +105,11 @@ M: method-renderer row-value drop first ;
     { 1 0 } <track>
         profiler vocabs>> <profiler-table>
             profiler vocab>> >>selected-value
+            vocab-renderer >>renderer
         "Vocabularies" <labelled-gadget>
     1/2 track-add
         profiler <words-model> <profiler-table>
+            word-renderer >>renderer
         "Words" <labelled-gadget>
     1/2 track-add ;
 
@@ -113,10 +118,12 @@ M: method-renderer row-value drop first ;
         { 1 0 } <track>
             profiler <generic-model> <profiler-table>
                 profiler generic>> >>selected-value
+                word-renderer >>renderer
             "Generic words" <labelled-gadget>
         1/2 track-add
             profiler <class-model> <profiler-table>
                 profiler class>> >>selected-value
+                word-renderer >>renderer
             "Classes" <labelled-gadget>
         1/2 track-add
     1/2 track-add