Fix another race...
parent
59872525fd
commit
5352ea14ff
|
@ -45,21 +45,20 @@ M: listener-gadget tool-scroller
|
|||
listener-gadget-input interactor-flag wait-for-flag ;
|
||||
|
||||
: workspace-busy? ( workspace -- ? )
|
||||
workspace-listener
|
||||
dup wait-for-listener
|
||||
listener-gadget-input interactor-busy? ;
|
||||
|
||||
: get-listener ( -- listener )
|
||||
[ workspace-busy? not ] get-workspace* workspace-listener ;
|
||||
workspace-listener listener-gadget-input interactor-busy? ;
|
||||
|
||||
: listener-input ( string -- )
|
||||
get-listener listener-gadget-input set-editor-string ;
|
||||
get-workspace
|
||||
workspace-listener
|
||||
listener-gadget-input set-editor-string ;
|
||||
|
||||
: (call-listener) ( quot listener -- )
|
||||
listener-gadget-input interactor-call ;
|
||||
|
||||
: call-listener ( quot -- )
|
||||
get-listener (call-listener) ;
|
||||
[ workspace-busy? not ] get-workspace* workspace-listener
|
||||
[ dup wait-for-listener (call-listener) ] 2curry
|
||||
"Listener call" spawn drop ;
|
||||
|
||||
M: listener-command invoke-command ( target command -- )
|
||||
command-quot call-listener ;
|
||||
|
@ -68,7 +67,8 @@ M: listener-operation invoke-command ( target command -- )
|
|||
[ operation-hook call ] keep operation-quot call-listener ;
|
||||
|
||||
: eval-listener ( string -- )
|
||||
get-listener
|
||||
get-workspace
|
||||
workspace-listener
|
||||
listener-gadget-input [ set-editor-string ] keep
|
||||
evaluate-input ;
|
||||
|
||||
|
@ -96,7 +96,9 @@ M: listener-operation invoke-command ( target command -- )
|
|||
[ drop ] [ [ "USE: " % % " " % % ] "" make ] if ;
|
||||
|
||||
: insert-word ( word -- )
|
||||
get-listener [ word-completion-string ] keep
|
||||
get-workspace
|
||||
workspace-listener
|
||||
[ word-completion-string ] keep
|
||||
listener-gadget-input user-input ;
|
||||
|
||||
: quot-action ( interactor -- lines )
|
||||
|
|
|
@ -111,7 +111,7 @@ ARTICLE: "ui-workspace-keys" "UI keyboard shortcuts"
|
|||
{ $command-map workspace "scrolling" }
|
||||
{ $command-map workspace "workflow" }
|
||||
{ $heading "Implementation" }
|
||||
"Workspaces are instances of " { $link workspace-window } "." ;
|
||||
"Workspaces are instances of " { $link workspace } "." ;
|
||||
|
||||
ARTICLE: "ui-tools" "UI development tools"
|
||||
"The Factor development environment can seem rather different from what you are used to, because it is very simple and powerful.."
|
||||
|
|
|
@ -82,7 +82,7 @@ workspace "workflow" f {
|
|||
} define-command-map
|
||||
|
||||
[
|
||||
<workspace> "Factor workspace" open-status-window
|
||||
<workspace> dup "Factor workspace" open-status-window
|
||||
] workspace-window-hook set-global
|
||||
|
||||
: inspect-continuation ( traceback -- )
|
||||
|
|
|
@ -14,9 +14,12 @@ TUPLE: workspace book listener popup ;
|
|||
|
||||
SYMBOL: workspace-window-hook
|
||||
|
||||
: workspace-window ( -- workspace )
|
||||
: workspace-window* ( -- workspace )
|
||||
workspace-window-hook get call ;
|
||||
|
||||
: workspace-window ( -- )
|
||||
workspace-window* drop ;
|
||||
|
||||
GENERIC: call-tool* ( arg tool -- )
|
||||
|
||||
GENERIC: tool-scroller ( tool -- scroller )
|
||||
|
@ -33,9 +36,9 @@ M: gadget tool-scroller drop f ;
|
|||
: select-tool ( workspace class -- ) swap show-tool drop ;
|
||||
|
||||
: get-workspace* ( quot -- workspace )
|
||||
[ dup workspace? [ over call ] [ drop f ] if ] find-window
|
||||
[ nip dup raise-window gadget-child ]
|
||||
[ workspace-window get-workspace* ] if* ; inline
|
||||
[ >r dup workspace? r> [ drop f ] if ] curry find-window
|
||||
[ dup raise-window gadget-child ]
|
||||
[ workspace-window* ] if* ; inline
|
||||
|
||||
: get-workspace ( -- workspace ) [ drop t ] get-workspace* ;
|
||||
|
||||
|
|
Loading…
Reference in New Issue