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

Better handling of in-listener operations

slava 2006-11-11 05:43:39 +00:00
parent a791ed3a86
commit 8ffa366c86
3 changed files with 17 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
library/ui/tools/listener.factor
View File

@ -76,8 +76,14 @@ M: listener-gadget tool-scroller
M: listener-gadget tool-help M: listener-gadget tool-help
drop "ui-listener" ; drop "ui-listener" ;
: workspace-busy? ( workspace -- ? )
listener-gadget swap find-tool nip tool-gadget
listener-gadget-input interactor-busy? ;
: find-listener ( -- listener ) : find-listener ( -- listener )
listener-gadget find-workspace show-tool tool-gadget ; listener-gadget
[ workspace-busy? not ] find-workspace*
show-tool tool-gadget ;
: (call-listener) ( quot listener -- ) : (call-listener) ( quot listener -- )
listener-gadget-input interactor-call ; listener-gadget-input interactor-call ;

12
library/ui/tools/tools.factor
View File

@ -32,12 +32,12 @@ TUPLE: tool gadget ;
: select-tool ( workspace class -- ) swap show-tool drop ; : select-tool ( workspace class -- ) swap show-tool drop ;
: find-workspace ( -- workspace ) : find-workspace* ( quot -- workspace )
[ workspace? ] find-window [ [ dup workspace? [ over call ] [ drop f ] if ] find-window
dup raise-window world-gadget [ nip dup raise-window world-gadget ]
] [ [ workspace-window drop find-workspace* ] if* ; inline
workspace-window find-workspace
] if* ; : find-workspace ( -- workspace ) [ drop t ] find-workspace* ;
: call-tool ( arg class -- ) : call-tool ( arg class -- )
find-workspace show-tool call-tool* ; find-workspace show-tool call-tool* ;

8
library/ui/tools/workspace.factor
View File

@ -77,7 +77,7 @@ M: workspace pref-dim* delegate pref-dim* { 550 650 } vmax ;
open-window open-window
listener-gadget get-tool start-listener ; listener-gadget get-tool start-listener ;
: tool-window ( class -- ) workspace-window show-tool drop ; : tool-window ( class -- ) workspace-window show-tool 2drop ;
: tool-scroll-up ( workspace -- ) : tool-scroll-up ( workspace -- )
current-page tool-scroller [ scroll-up-page ] when* ; current-page tool-scroller [ scroll-up-page ] when* ;
@ -100,9 +100,9 @@ workspace "tool-switch" {
} define-commands } define-commands
workspace "tool-window" { workspace "tool-window" {
{ "New listener" T{ key-down f { S+ } "F2" } [ listener-gadget tool-window drop ] } { "New listener" T{ key-down f { S+ } "F2" } [ listener-gadget tool-window ] }
{ "New definitions" T{ key-down f { S+ } "F3" } [ browser tool-window drop ] } { "New definitions" T{ key-down f { S+ } "F3" } [ browser tool-window ] }
{ "New documentation" T{ key-down f { S+ } "F4" } [ help-gadget tool-window drop ] } { "New documentation" T{ key-down f { S+ } "F4" } [ help-gadget tool-window ] }
} define-commands } define-commands
workspace "workflow" { workspace "workflow" {