steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Remove stack display from listener tool, and tweak appearance

db4
Slava Pestov 2008-11-20 21:59:22 -06:00
parent f27ebdd1ef
commit 08f7e02a3b
4 changed files with 54 additions and 63 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
basis/ui/tools/interactor/interactor.factor
View File

@ -178,10 +178,6 @@ M: interactor stream-read-quot
] ]
} cond ; } cond ;
M: interactor pref-dim*
[ line-height 4 * 0 swap 2array ] [ call-next-method ] bi
vmax ;
interactor "interactor" f { interactor "interactor" f {
{ T{ key-down f f "RET" } evaluate-input } { T{ key-down f f "RET" } evaluate-input }
{ T{ key-down f { C+ } "k" } clear-input } { T{ key-down f { C+ } "k" } clear-input }

86
basis/ui/tools/listener/listener.factor
View File

@ -1,20 +1,21 @@
! Copyright (C) 2005, 2008 Slava Pestov. ! Copyright (C) 2005, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: inspector ui.tools.interactor ui.tools.inspector USING: inspector help help.markup io io.styles
ui.tools.workspace help.markup io io.styles kernel models namespaces parser quotations sequences vocabs words
kernel models namespaces parser quotations sequences ui.commands prettyprint listener debugger threads boxes concurrency.flags
math arrays generic accessors combinators assocs fry ui.commands
ui.gadgets ui.gadgets.editors ui.gadgets.labelled ui.gadgets ui.gadgets.editors ui.gadgets.labelled
ui.gadgets.panes ui.gadgets.buttons ui.gadgets.scrollers ui.gadgets.panes ui.gadgets.buttons ui.gadgets.scrollers
ui.gadgets.tracks ui.gestures ui.operations vocabs words ui.gadgets.tracks ui.gadgets.borders ui.gestures ui.operations
prettyprint listener debugger threads boxes concurrency.flags ui.tools.browser ui.tools.interactor ui.tools.inspector
math arrays generic accessors combinators assocs ; ui.tools.workspace ;
IN: ui.tools.listener IN: ui.tools.listener
TUPLE: listener-gadget < track input output stack ; TUPLE: listener-gadget < track input output ;
: listener-output, ( listener -- listener ) : listener-output, ( listener -- listener )
<scrolling-pane> >>output <scrolling-pane>
dup output>> <scroller> "Output" <labelled-gadget> 1 track-add ; [ >>output ] [ <scroller> 1 track-add ] bi ;
: listener-streams ( listener -- input output ) : listener-streams ( listener -- input output )
[ input>> ] [ output>> <pane-stream> ] bi ; [ input>> ] [ output>> <pane-stream> ] bi ;
@ -23,17 +24,13 @@ TUPLE: listener-gadget < track input output stack ;
output>> <pane-stream> <interactor> ; output>> <pane-stream> <interactor> ;
: listener-input, ( listener -- listener ) : listener-input, ( listener -- listener )
dup <listener-input> >>input dup <listener-input>
dup input>> [ >>input ] [ 1 <border> { 0 0 } >>align f track-add ] bi ;
<limited-scroller>
{ 0 100 } >>min-dim
{ 1/0. 100 } >>max-dim
"Input" <labelled-gadget>
f track-add ;
: welcome. ( -- ) : welcome. ( -- )
"If this is your first time with Factor, please read the " print "If this is your first time with Factor, please read the " print
"handbook" ($link) "." print nl ; "handbook" ($link) ". To see a list of keyboard shortcuts," print
"press F1." print nl ;
M: listener-gadget focusable-child* M: listener-gadget focusable-child*
input>> ; input>> ;
@ -60,7 +57,7 @@ M: listener-gadget tool-scroller
: call-listener ( quot -- ) : call-listener ( quot -- )
[ workspace-busy? not ] get-workspace* listener>> [ workspace-busy? not ] get-workspace* listener>>
[ dup wait-for-listener (call-listener) ] 2curry '[ _ _ dup wait-for-listener (call-listener) ]
"Listener call" spawn drop ; "Listener call" spawn drop ;
M: listener-command invoke-command ( target command -- ) M: listener-command invoke-command ( target command -- )
@ -76,7 +73,7 @@ M: listener-operation invoke-command ( target command -- )
: listener-run-files ( seq -- ) : listener-run-files ( seq -- )
[ [
[ [ run-file ] each ] curry call-listener '[ _ [ run-file ] each ] call-listener
] unless-empty ; ] unless-empty ;
: com-end ( listener -- ) : com-end ( listener -- )
@ -122,20 +119,8 @@ M: engine-word word-completion-string
[ select-all ] [ select-all ]
2bi ; 2bi ;
TUPLE: stack-display < track ; : ui-help-hook ( topic -- )
browser-gadget call-tool ;
: <stack-display> ( workspace -- gadget )
listener>>
{ 0 1 } stack-display new-track
over <toolbar> f track-add
swap stack>> [ [ stack. ] curry try ] t "Data stack" <labelled-pane>
1 track-add ;
M: stack-display tool-scroller
find-workspace listener>> tool-scroller ;
: ui-listener-hook ( listener -- )
>r datastack r> stack>> set-model ;
: ui-error-hook ( error listener -- ) : ui-error-hook ( error listener -- )
find-workspace debugger-popup ; find-workspace debugger-popup ;
@ -146,17 +131,20 @@ M: stack-display tool-scroller
: listener-thread ( listener -- ) : listener-thread ( listener -- )
dup listener-streams [ dup listener-streams [
[ [ ui-listener-hook ] curry listener-hook set ] [ ui-help-hook ] help-hook set
[ [ ui-error-hook ] curry error-hook set ] [ '[ _ ui-error-hook ] error-hook set ]
[ [ ui-inspector-hook ] curry inspector-hook set ] tri [ '[ _ ui-inspector-hook ] inspector-hook set ] bi
welcome. welcome.
listener listener
] with-streams* ; ] with-streams* ;
: start-listener-thread ( listener -- ) : start-listener-thread ( listener -- )
[ '[
[ input>> register-self ] [ listener-thread ] bi _
] curry "Listener" spawn drop ; [ input>> register-self ]
[ listener-thread ]
bi
] "Listener" spawn drop ;
: restart-listener ( listener -- ) : restart-listener ( listener -- )
#! Returns when listener is ready to receive input. #! Returns when listener is ready to receive input.
@ -168,12 +156,9 @@ M: stack-display tool-scroller
[ wait-for-listener ] [ wait-for-listener ]
} cleave ; } cleave ;
: init-listener ( listener -- )
f <model> >>stack drop ;
: <listener-gadget> ( -- gadget ) : <listener-gadget> ( -- gadget )
{ 0 1 } listener-gadget new-track { 0 1 } listener-gadget new-track
dup init-listener add-toolbar
listener-output, listener-output,
listener-input, ; listener-input, ;
@ -181,12 +166,21 @@ M: stack-display tool-scroller
\ listener-help H{ { +nullary+ t } } define-command \ listener-help H{ { +nullary+ t } } define-command
: com-auto-use ( -- )
auto-use? [ not ] change ;
\ com-auto-use H{ { +nullary+ t } { +listener+ t } } define-command
listener-gadget "misc" "Miscellaneous commands" {
{ T{ key-down f f "F1" } listener-help }
} define-command-map
listener-gadget "toolbar" f { listener-gadget "toolbar" f {
{ f restart-listener } { f restart-listener }
{ T{ key-down f { A+ } "c" } clear-output } { T{ key-down f { A+ } "a" } com-auto-use }
{ T{ key-down f { A+ } "C" } clear-stack } { T{ key-down f { A+ } "c" } clear-output }
{ T{ key-down f { A+ } "C" } clear-stack }
{ T{ key-down f { C+ } "d" } com-end } { T{ key-down f { C+ } "d" } com-end }
{ T{ key-down f f "F1" } listener-help }
} define-command-map } define-command-map
M: listener-gadget handle-gesture ( gesture gadget -- ? ) M: listener-gadget handle-gesture ( gesture gadget -- ? )

2
basis/ui/tools/tools-docs.factor
View File

@ -32,7 +32,7 @@ ARTICLE: "ui-listener" "UI listener"
{ $heading "Editing commands" } { $heading "Editing commands" }
"The text editing commands are standard; see " { $link "gadgets-editors" } "." "The text editing commands are standard; see " { $link "gadgets-editors" } "."
{ $heading "Implementation" } { $heading "Implementation" }
"Listeners are instances of " { $link listener-gadget } ". The listener consists of an output area (instance of " { $link pane } "), and an input area (instance of " { $link interactor } "), and a stack display kept up to date using a " { $link listener-hook } "." ; "Listeners are instances of " { $link listener-gadget } ". The listener consists of an output area (instance of " { $link pane } ") and an input area (instance of " { $link interactor } ")." ;
ARTICLE: "ui-inspector" "UI inspector" ARTICLE: "ui-inspector" "UI inspector"
"The graphical inspector builds on the terminal inspector (see " { $link "inspector" } ") and provides in-place editing of slot values." "The graphical inspector builds on the terminal inspector (see " { $link "inspector" } ") and provides in-place editing of slot values."

25
basis/ui/tools/tools.factor
View File

@ -19,8 +19,7 @@ IN: ui.tools
<toggle-buttons> ; <toggle-buttons> ;
: <workspace-book> ( workspace -- gadget ) : <workspace-book> ( workspace -- gadget )
dup <gadget>
<stack-display>
<browser-gadget> <browser-gadget>
<inspector-gadget> <inspector-gadget>
<profiler-gadget> <profiler-gadget>
@ -34,14 +33,14 @@ IN: ui.tools
dup <workspace-book> >>book dup <workspace-book> >>book
dup <workspace-tabs> f track-add dup <workspace-tabs> f track-add
dup book>> 1/5 track-add dup book>> 0 track-add
dup listener>> 4/5 track-add dup listener>> 1 track-add
dup <toolbar> f track-add ; add-toolbar ;
: resize-workspace ( workspace -- ) : resize-workspace ( workspace -- )
dup sizes>> over control-value zero? [ dup sizes>> over control-value 0 = [
1/5 over set-second 0 over set-second
4/5 swap set-third 1 swap set-third
] [ ] [
2/3 over set-second 2/3 over set-second
1/3 swap set-third 1/3 swap set-third
@ -55,13 +54,15 @@ M: workspace model-changed
[ workspace-window ] ui-hook set-global [ workspace-window ] ui-hook set-global
: com-listener ( workspace -- ) stack-display select-tool ; : select-tool ( workspace n -- ) swap book>> model>> set-model ;
: com-browser ( workspace -- ) browser-gadget select-tool ; : com-listener ( workspace -- ) 0 select-tool ;
: com-inspector ( workspace -- ) inspector-gadget select-tool ; : com-browser ( workspace -- ) 1 select-tool ;
: com-profiler ( workspace -- ) profiler-gadget select-tool ; : com-inspector ( workspace -- ) 2 select-tool ;
: com-profiler ( workspace -- ) 3 select-tool ;
workspace "tool-switching" f { workspace "tool-switching" f {
{ T{ key-down f { A+ } "1" } com-listener } { T{ key-down f { A+ } "1" } com-listener }