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

Listener doesn't print a garbage quotation when commands are invoked

db4
Slava Pestov 2009-02-12 09:48:05 -06:00
parent 8fd159dadd
commit 39a4969faa
4 changed files with 24 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
basis/ui/backend/cocoa/tools/tools.factor
View File

@ -57,7 +57,7 @@ CLASS: {
} }
{ "refreshAll:" "id" { "id" "SEL" "id" } { "refreshAll:" "id" { "id" "SEL" "id" }
[ 3drop [ refresh-all ] call-listener f ] [ 3drop [ refresh-all ] \ refresh-all call-listener f ]
} ; } ;
: install-app-delegate ( -- ) : install-app-delegate ( -- )

7
basis/ui/tools/deploy/deploy.factor
View File

@ -77,9 +77,10 @@ TUPLE: deploy-gadget < pack vocab settings ;
swap find-deploy-vocab set-deploy-config ; swap find-deploy-vocab set-deploy-config ;
: com-deploy ( gadget -- ) : com-deploy ( gadget -- )
dup com-save [ com-save ]
dup find-deploy-vocab '[ _ deploy ] call-listener [ find-deploy-vocab '[ _ deploy ] \ deploy call-listener ]
close-window ; [ close-window ]
tri ;
: com-help ( -- ) : com-help ( -- )
"ui.tools.deploy" com-follow ; "ui.tools.deploy" com-follow ;

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

@ -90,8 +90,8 @@ M: input (print-input)
dup presented associate dup presented associate
[ string>> H{ { font-style bold } } format ] with-nesting nl ; [ string>> H{ { font-style bold } } format ] with-nesting nl ;
M: object (print-input) M: word (print-input)
short. ; "Command: " write . ;
: print-input ( object interactor -- ) : print-input ( object interactor -- )
output>> [ (print-input) ] with-output-stream* ; output>> [ (print-input) ] with-output-stream* ;
@ -131,9 +131,11 @@ M: object (print-input)
M: interactor stream-readln M: interactor stream-readln
interactor-read dup [ first ] when ; interactor-read dup [ first ] when ;
: interactor-call ( quot interactor -- ) : (call-listener) ( quot command listener -- )
dup interactor-busy? [ 2drop ] [ input>> dup interactor-busy? [ 3drop ] [
[ print-input ] [ interactor-continue ] 2bi [ print-input drop ]
[ nip interactor-continue ]
3bi
] if ; ] if ;
M: interactor stream-read M: interactor stream-read
@ -237,19 +239,16 @@ M: string listener-input
get-listener input>> get-listener input>>
[ set-editor-string ] [ request-focus ] bi ; [ set-editor-string ] [ request-focus ] bi ;
: (call-listener) ( quot listener -- ) : call-listener ( quot command -- )
input>> interactor-call ;
: call-listener ( quot -- )
get-ready-listener get-ready-listener
'[ _ _ dup wait-for-listener (call-listener) ] '[ _ _ _ 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 -- )
command-quot call-listener ; [ command-quot ] [ nip ] 2bi call-listener ;
M: listener-operation invoke-command ( target command -- ) M: listener-operation invoke-command ( target command -- )
operation-quot call-listener ; [ operation-quot ] [ nip command>> ] 2bi call-listener ;
: eval-listener ( string -- ) : eval-listener ( string -- )
get-listener input>> [ set-editor-string ] keep get-listener input>> [ set-editor-string ] keep
@ -257,6 +256,7 @@ M: listener-operation invoke-command ( target command -- )
: listener-run-files ( seq -- ) : listener-run-files ( seq -- )
[ [
[ \ listener-run-files ] dip
'[ _ [ run-file ] each ] call-listener '[ _ [ run-file ] each ] call-listener
] unless-empty ; ] unless-empty ;
@ -269,7 +269,7 @@ M: listener-operation invoke-command ( target command -- )
\ clear-output H{ { +listener+ t } } define-command \ clear-output H{ { +listener+ t } } define-command
: clear-stack ( listener -- ) : clear-stack ( listener -- )
[ clear ] swap (call-listener) ; [ [ clear ] \ clear ] dip (call-listener) ;
: use-if-necessary ( word seq -- ) : use-if-necessary ( word seq -- )
2dup [ vocabulary>> ] dip and [ 2dup [ vocabulary>> ] dip and [

7
basis/ui/ui.factor
View File

@ -95,7 +95,12 @@ M: world ungraft*
children>> [ restore-gadget ] each ; children>> [ restore-gadget ] each ;
: restore-world ( world -- ) : restore-world ( world -- )
[ reset-world ] [ init-text-rendering ] [ restore-gadget ] tri ; {
[ reset-world ]
[ init-text-rendering ]
[ f >>images drop ]
[ restore-gadget ]
} cleave ;
: update-hand ( world -- ) : update-hand ( world -- )
dup hand-world get-global eq? dup hand-world get-global eq?