core-foundation.run-loop: Fix botched rename. Ugh. Fixes #775 on mac at least.

db4
Doug Coleman 2014-07-04 00:53:46 -07:00
parent 138ec84642
commit 525fe70306
1 changed files with 9 additions and 7 deletions

View File

@ -60,14 +60,16 @@ CFSTRING: CFRunLoopDefaultMode "kCFRunLoopDefaultMode"
TUPLE: run-loop-state fds sources timers ; TUPLE: run-loop-state fds sources timers ;
SYMBOL: run-loop
: <run-loop> ( -- run-loop ) : <run-loop> ( -- run-loop )
V{ } clone V{ } clone V{ } clone \ run-loop-state boa ; V{ } clone V{ } clone V{ } clone \ run-loop-state boa ;
: run-loop ( -- run-loop ) : get-run-loop ( -- run-loop )
\ run-loop-state [ <run-loop> ] initialize-alien ; \ run-loop [ <run-loop> ] initialize-alien ;
: add-source-to-run-loop ( source -- ) : add-source-to-run-loop ( source -- )
[ run-loop sources>> push ] [ get-run-loop sources>> push ]
[ [
CFRunLoopGetMain CFRunLoopGetMain
swap CFRunLoopDefaultMode swap CFRunLoopDefaultMode
@ -81,7 +83,7 @@ TUPLE: run-loop-state fds sources timers ;
[ [
<CFFileDescriptor> |CFRelease <CFFileDescriptor> |CFRelease
[ enable-all-callbacks ] [ enable-all-callbacks ]
[ run-loop fds>> push ] [ get-run-loop fds>> push ]
[ create-fd-source |CFRelease add-source-to-run-loop ] [ create-fd-source |CFRelease add-source-to-run-loop ]
tri tri
] with-destructors ; ] with-destructors ;
@ -100,7 +102,7 @@ PRIVATE>
: add-timer-to-run-loop ( timer -- ) : add-timer-to-run-loop ( timer -- )
[ reset-timer ] [ reset-timer ]
[ run-loop timers>> push ] [ get-run-loop timers>> push ]
[ [
CFRunLoopGetMain CFRunLoopGetMain
swap CFRunLoopDefaultMode swap CFRunLoopDefaultMode
@ -108,13 +110,13 @@ PRIVATE>
] tri ; ] tri ;
: invalidate-run-loop-timers ( -- ) : invalidate-run-loop-timers ( -- )
run-loop [ get-run-loop [
[ [ CFRunLoopTimerInvalidate ] [ CFRelease ] bi ] each [ [ CFRunLoopTimerInvalidate ] [ CFRelease ] bi ] each
V{ } clone V{ } clone
] change-timers drop ; ] change-timers drop ;
: reset-run-loop ( -- ) : reset-run-loop ( -- )
run-loop get-run-loop
[ timers>> [ reset-timer ] each ] [ timers>> [ reset-timer ] each ]
[ fds>> [ enable-all-callbacks ] each ] bi ; [ fds>> [ enable-all-callbacks ] each ] bi ;