M: tuple >pprint-sequence tuple>array \ T{ \ } t ;
-M: wrapper >pprint-sequence
- wrapped dup 1array swap word? [ \ \ f ] [ \ W{ \ } ] if f ;
+M: wrapper >pprint-sequence wrapped 1array \ W{ \ } f ;
-M: object pprint*
+: pprint-object ( obj -- )
[
>pprint-sequence H{ } <flow
rot [ pprint-word ] when*
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 ;
: 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
[ 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>
- swap show-minibuffer ;
+ <word-search> "Word search" show-titled-minibuffer ;
: show-source-files-search ( listener action -- )
minibuffer-action
"" swap <source-files-search>
- "Source file search" <labelled-gadget>
- swap show-minibuffer ;
+ "Source file search" show-titled-minibuffer ;
: show-vocabs-search ( listener action -- )
minibuffer-action
>r dup listener-gadget-input selected-word r>
- <vocabs-search> "Vocabulary search" <labelled-gadget>
- swap show-minibuffer ;
+ <vocabs-search> "Vocabulary search" show-titled-minibuffer ;
: listener-history ( listener -- seq )
listener-gadget-input interactor-history <reversed> ;
: 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>
<live-search> ;
: <vocabs-search> ( string action -- gadget )
- vocabs
- [ string-completions ] curry
+ vocabs [ 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> ;