Better history completion in listener

library/prettyprint/backend.factor

@@ -133,10 +133,9 @@ M: hashtable >pprint-sequence hash>alist \ H{ \ } t ;
 
 M: tuple >pprint-sequence tuple>array \ T{ \ } t ;
 
-M: wrapper >pprint-sequence
+M: wrapper >pprint-sequence wrapped 1array \ W{ \ } f ;
-    wrapped dup 1array swap word? [ \ \ f ] [ \ W{ \ } ] if f ;
 
-M: object pprint*
+: pprint-object ( obj -- )
     [
         >pprint-sequence H{ } <flow
         rot [ pprint-word ] when*
@@ -144,3 +143,12 @@ M: object pprint*
         swap pprint-elements
         block> [ pprint-word ] when* block>
     ] check-recursion ;
+    
+M: object pprint* pprint-object ;
+
+M: wrapper pprint*
+    dup wrapped word? [
+        \ \ pprint-word wrapped pprint-word
+    ] [
+        pprint-object
+    ] if ;

library/test/prettyprint.factor

@@ -78,3 +78,6 @@ unit-test
 [ ] [ \ compound see ] unit-test
 
 [ ] [ \ duplex-stream see ] unit-test
+
+[ "[ \\ + ]" ] [ [ \ + ] unparse ] unit-test
+[ "[ \\ [ ]" ] [ [ \ [ ] unparse ] unit-test

library/tools/completion.factor

@@ -56,10 +56,14 @@ USING: kernel arrays sequences math namespaces strings io ;
 
 : completion ( str quot obj -- pair )
     #! pair is { obj score }
-    [ swap call dup rot fuzzy score ] keep swap 2array ; inline
+    pick empty? [
+        2nip 1 2array
+    ] [
+        [ swap call dup rot fuzzy score ] keep swap 2array
+    ] if ; inline
 
 : completions ( str candidates quot -- seq )
-    pick empty? [
+    pick empty? pick length 100 >= and [
         3drop f
     ] [
         [ >r 2dup r> completion ] map 2nip rank-completions

library/ui/tools/listener.factor

@@ -124,26 +124,26 @@ M: listener-gadget tool-help
     [ set-listener-gadget-minibuffer ] 2keep
     dupd track-add request-focus ;
 
+: show-titled-minibuffer ( listener gadget title -- )
+    <labelled-gadget> swap show-minibuffer ;
+
 : minibuffer-action ( quot -- quot )
     [ find-listener hide-minibuffer ] swap append ;
 
 : show-word-search ( listener action -- )
     minibuffer-action
     >r dup listener-gadget-input selected-word r>
-    <word-search> "Word search" <labelled-gadget>
+    <word-search> "Word search" show-titled-minibuffer ;
-    swap show-minibuffer ;
 
 : show-source-files-search ( listener action -- )
     minibuffer-action
     "" swap <source-files-search>
-    "Source file search" <labelled-gadget>
+    "Source file search" show-titled-minibuffer ;
-    swap show-minibuffer ;
 
 : show-vocabs-search ( listener action -- )
     minibuffer-action
     >r dup listener-gadget-input selected-word r>
-    <vocabs-search> "Vocabulary search" <labelled-gadget>
+    <vocabs-search> "Vocabulary search" show-titled-minibuffer ;
-    swap show-minibuffer ;
 
 : listener-history ( listener -- seq )
     listener-gadget-input interactor-history <reversed> ;
@@ -151,14 +151,10 @@ M: listener-gadget tool-help
 : history-action ( string -- )
     find-listener listener-gadget-input set-editor-text ;
 
-: <history-gadget> ( listener -- gadget )
-    listener-history <model>
-    [ [ dup print-input ] make-pane ]
-    [ history-action ] minibuffer-action
-    <list> <scroller> "History" <labelled-gadget> ;
-
 : show-history ( listener -- )
-    [ <history-gadget> ] keep show-minibuffer ;
+    dup listener-gadget-input editor-text
+    over listener-history [ history-action ] minibuffer-action
+    <history-search> "History search" show-titled-minibuffer ;
 
 : completion-string ( word listener -- string )
     >r dup word-name swap word-vocabulary dup vocab r>

library/ui/tools/search.factor

@@ -81,7 +81,11 @@ M: live-search focusable-child* live-search-field ;
     <live-search> ;
 
 : <vocabs-search> ( string action -- gadget )
-    vocabs
+    vocabs [ string-completions ] curry
-    [ string-completions ] curry
     [ [ <vocab-link> ] string-completion. ]
     <live-search> ;
+
+: <history-search> ( string seq action -- gadget )
+    swap [ string-completions ] curry
+    [ dup <input> write-object ]
+    <live-search> ;