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
drop "ui-listener" ;
: workspace-busy? ( workspace -- ? )
listener-gadget swap find-tool nip tool-gadget
listener-gadget-input interactor-busy? ;
: 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 -- )
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 ;
: find-workspace ( -- workspace )
[ workspace? ] find-window [
dup raise-window world-gadget
] [
workspace-window find-workspace
] if* ;
: find-workspace* ( quot -- workspace )
[ dup workspace? [ over call ] [ drop f ] if ] find-window
[ nip dup raise-window world-gadget ]
[ workspace-window drop find-workspace* ] if* ; inline
: find-workspace ( -- workspace ) [ drop t ] find-workspace* ;
: call-tool ( arg class -- )
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
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 -- )
current-page tool-scroller [ scroll-up-page ] when* ;
@ -100,9 +100,9 @@ workspace "tool-switch" {
} define-commands
workspace "tool-window" {
{ "New listener" T{ key-down f { S+ } "F2" } [ listener-gadget tool-window drop ] }
{ "New definitions" T{ key-down f { S+ } "F3" } [ browser tool-window drop ] }
{ "New documentation" T{ key-down f { S+ } "F4" } [ help-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 ] }
{ "New documentation" T{ key-down f { S+ } "F4" } [ help-gadget tool-window ] }
} define-commands
workspace "workflow" {