1 ! Copyright (C) 2005, 2006 Slava Pestov.
2 ! See http://factorcode.org/license.txt for BSD license.
4 USING: compiler arrays gadgets gadgets-frames gadgets-labels
5 gadgets-panes gadgets-scrolling gadgets-text gadgets-lists
6 gadgets-search gadgets-theme gadgets-tracks gadgets-workspace
7 generic hashtables tools io kernel listener math models
8 namespaces parser prettyprint sequences shells strings styles
9 threads words definitions ;
11 TUPLE: listener-gadget input output stack minibuffer ;
13 : ui-listener-hook ( listener -- )
14 >r datastack r> listener-gadget-stack set-model ;
16 : listener-stream ( listener -- stream )
17 dup listener-gadget-input
18 swap listener-gadget-output <pane-stream>
21 : <listener-input> ( -- gadget )
22 gadget get listener-gadget-output
23 <pane-stream> <interactor> ;
25 : <stack-display> ( -- gadget )
26 gadget get listener-gadget-stack
27 [ stack. ] "Stack" <labelled-pane> ;
29 : init-listener ( listener -- )
30 f <model> swap set-listener-gadget-stack ;
32 : listener-thread ( listener -- )
34 [ ui-listener-hook ] curry listener-hook set
35 find-messages batch-errors set
39 : start-listener ( listener -- )
40 [ >r clear r> init-namespaces listener-thread ] in-thread
43 C: listener-gadget ( -- gadget )
47 set-listener-gadget-output
51 { [ <stack-display> ] f f 1/6 }
54 set-listener-gadget-input
55 [ <scroller> "Input" <labelled-gadget> ]
58 } { 0 1 } make-track* ;
60 M: listener-gadget focusable-child*
61 listener-gadget-input ;
63 M: listener-gadget call-tool* ( input listener -- )
64 >r input-string r> listener-gadget-input set-editor-text ;
66 M: listener-gadget tool-scroller
67 listener-gadget-output find-scroller ;
69 M: listener-gadget tool-help
72 : find-listener ( -- listener )
73 listener-gadget find-workspace show-tool tool-gadget ;
75 : (call-listener) ( quot listener -- )
76 listener-gadget-input interactor-call ;
78 : call-listener ( quot -- )
79 find-listener (call-listener) ;
81 : listener-run-files ( seq -- )
85 [ [ run-file ] each ] curry call-listener
88 : listener-eof ( listener -- )
89 listener-gadget-input f swap interactor-eval ;
91 : clear-listener-output ( listener -- )
92 [ listener-gadget-output [ pane-clear ] curry ] keep
95 : clear-listener-stack ( listener -- )
96 [ clear ] swap (call-listener) ;
98 : hide-minibuffer ( listener -- )
99 dup listener-gadget-minibuffer dup
100 [ over track-remove ] [ drop ] if
101 dup listener-gadget-input request-focus
102 f swap set-listener-gadget-minibuffer ;
104 : show-minibuffer ( gadget listener -- )
105 [ hide-minibuffer ] keep
106 [ set-listener-gadget-minibuffer ] 2keep
107 dupd track-add request-focus ;
109 : minibuffer-action ( quot -- quot )
110 [ find-listener hide-minibuffer ] swap append ;
112 : show-word-search ( listener action -- )
114 >r dup listener-gadget-input selected-word r>
115 <word-search> "Word search" <labelled-gadget>
116 swap show-minibuffer ;
118 : show-source-files-search ( listener action -- )
120 "" swap <source-files-search>
121 "Source file search" <labelled-gadget>
122 swap show-minibuffer ;
124 : show-vocabs-search ( listener action -- )
126 >r dup listener-gadget-input selected-word r>
127 <vocabs-search> "Vocabulary search" <labelled-gadget>
128 swap show-minibuffer ;
130 : show-list ( seq presenter action listener -- )
131 >r minibuffer-action <list> <scroller> r> show-minibuffer ;
133 : listener-history ( listener -- seq )
134 listener-gadget-input interactor-history <reversed> ;
136 : show-history ( listener -- )
138 listener-gadget-input <model>
139 [ [ dup print-input ] make-pane ]
140 [ listener-gadget-input set-editor-text ]
143 : insert-completion ( completion -- )
144 word-name find-listener listener-gadget-input user-input ;
146 listener-gadget "Toolbar" {
147 { "Restart" T{ key-down f { C+ } "r" } [ start-listener ] }
150 T{ key-down f { C+ } "h" }
155 T{ key-down f f "CLEAR" }
156 [ clear-listener-output ]
160 T{ key-down f { C+ } "CLEAR" }
161 [ clear-listener-stack ]
163 { "Send EOF" T{ key-down f { C+ } "d" } [ listener-eof ] }
166 listener-gadget "Listener commands" {
169 T{ key-down f f "TAB" }
170 [ [ insert-completion ] show-word-search ]
174 T{ key-down f { C+ } "e" }
175 [ [ edit-file ] show-source-files-search ]
179 T{ key-down f { C+ } "u" }
180 [ [ [ use+ ] curry call-listener ] show-vocabs-search ]
184 T{ key-down f f "ESCAPE" }