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 help ;
11 TUPLE: listener-gadget input output stack use minibuffer ;
13 : ui-listener-hook ( listener -- )
14 use get over set-listener-gadget-use
15 >r datastack r> listener-gadget-stack set-model ;
17 : listener-stream ( listener -- stream )
18 dup listener-gadget-input
19 swap listener-gadget-output <pane-stream>
22 : <listener-input> ( -- gadget )
23 gadget get listener-gadget-output
24 <pane-stream> <interactor> ;
26 : <stack-display> ( -- gadget )
27 gadget get listener-gadget-stack
28 [ stack. ] "Stack" <labelled-pane> ;
30 : init-listener ( listener -- )
31 f <model> swap set-listener-gadget-stack ;
34 "If this is your first time with Factor, please read " print
35 "ui-tools" ($link) ", and especially " write
36 "ui-listener" ($link) "." print terpri ;
38 : listener-thread ( listener -- )
40 [ ui-listener-hook ] curry listener-hook set
41 find-messages batch-errors set
46 : start-listener ( listener -- )
47 [ >r clear r> init-namespaces listener-thread ] in-thread
50 C: listener-gadget ( -- gadget )
54 set-listener-gadget-output
58 { [ <stack-display> ] f f 1/6 }
61 set-listener-gadget-input
62 [ <scroller> "Input" <labelled-gadget> ]
65 } { 0 1 } make-track* ;
67 M: listener-gadget focusable-child*
68 listener-gadget-input ;
70 M: listener-gadget call-tool* ( input listener -- )
71 >r input-string r> listener-gadget-input set-editor-text ;
73 M: listener-gadget tool-scroller
74 listener-gadget-output find-scroller ;
76 M: listener-gadget tool-help
79 : find-listener ( -- listener )
80 listener-gadget find-workspace show-tool tool-gadget ;
82 : (call-listener) ( quot listener -- )
83 listener-gadget-input interactor-call ;
85 : call-listener ( quot -- )
86 find-listener (call-listener) ;
88 : listener-run-files ( seq -- )
92 [ run-files ] curry call-listener
95 : listener-eof ( listener -- )
96 listener-gadget-input f swap interactor-eval ;
98 : clear-listener-output ( listener -- )
99 [ listener-gadget-output [ pane-clear ] curry ] keep
102 : clear-listener-stack ( listener -- )
103 [ clear ] swap (call-listener) ;
105 : hide-minibuffer ( listener -- )
106 dup listener-gadget-minibuffer dup
107 [ over track-remove ] [ drop ] if
108 dup listener-gadget-input request-focus
109 f swap set-listener-gadget-minibuffer ;
111 : show-minibuffer ( gadget listener -- )
112 [ hide-minibuffer ] keep
113 [ set-listener-gadget-minibuffer ] 2keep
114 dupd track-add request-focus ;
116 : minibuffer-action ( quot -- quot )
117 [ find-listener hide-minibuffer ] swap append ;
119 : show-word-search ( listener action -- )
121 >r dup listener-gadget-input selected-word r>
122 <word-search> "Word search" <labelled-gadget>
123 swap show-minibuffer ;
125 : show-source-files-search ( listener action -- )
127 "" swap <source-files-search>
128 "Source file search" <labelled-gadget>
129 swap show-minibuffer ;
131 : show-vocabs-search ( listener action -- )
133 >r dup listener-gadget-input selected-word r>
134 <vocabs-search> "Vocabulary search" <labelled-gadget>
135 swap show-minibuffer ;
137 : listener-history ( listener -- seq )
138 listener-gadget-input interactor-history <reversed> ;
140 : history-action ( string -- )
141 find-listener listener-gadget-input set-editor-text ;
143 : <history-gadget> ( listener -- gadget )
144 listener-history <model>
145 [ [ dup print-input ] make-pane ]
146 [ history-action ] minibuffer-action
147 <list> <scroller> "History" <labelled-gadget> ;
149 : show-history ( listener -- )
150 [ <history-gadget> ] keep show-minibuffer ;
152 : completion-string ( word listener -- string )
153 >r dup word-name swap word-vocabulary dup vocab r>
154 listener-gadget-use memq?
155 [ drop ] [ [ "USE: " % % " " % % ] "" make ] if ;
157 : insert-completion ( completion -- )
158 find-listener [ completion-string ] keep
159 listener-gadget-input user-input ;
161 listener-gadget "toolbar" {
162 { "Restart" T{ key-down f { C+ } "r" } [ start-listener ] }
165 T{ key-down f { C+ } "h" }
170 T{ key-down f f "CLEAR" }
171 [ clear-listener-output ]
175 T{ key-down f { C+ } "CLEAR" }
176 [ clear-listener-stack ]
178 { "Send EOF" T{ key-down f { C+ } "d" } [ listener-eof ] }
181 listener-gadget "completion" {
184 T{ key-down f f "TAB" }
185 [ [ insert-completion ] show-word-search ]
189 T{ key-down f { C+ } "e" }
190 [ [ edit-file ] show-source-files-search ]
194 T{ key-down f { C+ } "u" }
195 [ [ [ use+ ] curry call-listener ] show-vocabs-search ]
199 T{ key-down f f "ESCAPE" }